Newer
Older
!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!#######################
MODULE MODI_SPAWN_FIELD2
!#######################
!
INTERFACE
!
SUBROUTINE SPAWN_FIELD2(KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,HTURB, &
PUT,PVT,PWT,PTHVT,PRT,PHUT,PTKET,PSVT,PATC, &
PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM, &
PDTHFRC,PDRVFRC,PTHREL,PRVREL, &
PVU_FLUX_M,PVTH_FLUX_M,PWTH_FLUX_M, &
WAUTELET Philippe
committed
TPSONFILE,KIUSON,KJUSON, &
KIB2,KJB2,KIE2,KJE2, &
KIB1,KJB1,KIE1,KJE1 )
!
WAUTELET Philippe
committed
USE MODD_IO_ll, ONLY : TFILEDATA
!
INTEGER, INTENT(IN) :: KXOR,KXEND ! horizontal position (i,j) of the ORigin and END
INTEGER, INTENT(IN) :: KYOR,KYEND ! of the model 2 domain, relative to model 1
INTEGER, INTENT(IN) :: KDXRATIO ! x and y-direction Resolution ratio
INTEGER, INTENT(IN) :: KDYRATIO ! between model 2 and model 1
CHARACTER (LEN=4), INTENT(IN) :: HTURB ! Kind of turbulence parameterization
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PUT,PVT,PWT ! model 2
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTKET ! variables
REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PRT,PSVT,PATC ! at t
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTHVT,PHUT !
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCT,PSIGS ! secondary
! prognostic variables
! Larger Scale fields for relaxation and diffusion
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSUM, PLSVM, PLSWM
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSTHM, PLSRVM
REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PDTHFRC,PDRVFRC
REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PTHREL,PRVREL
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PVU_FLUX_M,PVTH_FLUX_M,PWTH_FLUX_M
!
! Arguments for spawning with 2 input files (father+son1)
WAUTELET Philippe
committed
TYPE(TFILEDATA), OPTIONAL, INTENT(IN) :: TPSONFILE ! input FM-file SON
INTEGER, OPTIONAL, INTENT(IN) :: KIUSON ! upper dimensions of the
INTEGER, OPTIONAL, INTENT(IN) :: KJUSON !input FM-file SON
INTEGER, OPTIONAL, INTENT(IN) :: KIB2,KJB2 ! indexes for common
INTEGER, OPTIONAL, INTENT(IN) :: KIE2,KJE2 !domain in model2
INTEGER, OPTIONAL, INTENT(IN) :: KIB1,KJB1 !and in
INTEGER, OPTIONAL, INTENT(IN) :: KIE1,KJE1 !SON
END SUBROUTINE SPAWN_FIELD2
!
END INTERFACE
!
END MODULE MODI_SPAWN_FIELD2
WAUTELET Philippe
committed
! ##########################################################################
SUBROUTINE SPAWN_FIELD2(KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,HTURB, &
PUT,PVT,PWT,PTHVT,PRT,PHUT,PTKET,PSVT,PATC, &
PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM, &
PDTHFRC,PDRVFRC,PTHREL,PRVREL, &
PVU_FLUX_M,PVTH_FLUX_M,PWTH_FLUX_M, &
WAUTELET Philippe
committed
TPSONFILE,KIUSON,KJUSON, &
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
KIB2,KJB2,KIE2,KJE2, &
KIB1,KJB1,KIE1,KJE1 )
! ##########################################################################
!
!!**** *SPAWN_FIELD2 * - subroutine generating the model 2 prognostic and LS
!! fields, consistently with the spawning model 1.
!!
!! PURPOSE
!! -------
!!
!! The prognostic and LS fields are interpolated from the model 1, to
!! initialize the model 2.
!!
!!** METHOD
!! ------
!!
!! The model 2 variables are transmitted by argument (P or K prefixes),
!! while the ones of model 1 are declared through calls to MODD_...
!! (X or N prefixes)
!!
!! For the case where the resolution ratio between models is 1,
!! the horizontal interpolation becomes a simple equality.
!! For the general case where resolution ratio is not egal to one,
!! fields are interpolated using 2 types of interpolations:
!! 1. Clark and Farley (JAS 1984) on 9 points
!! 2. Bikhardt on 16 points
!!
!! EXTERNAL
!! --------
!!
!! Routine BIKHARDT : to perform horizontal interpolations
!! Routine CLARK_FARLEY : to perform horizontal interpolations
!!
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! Module MODD_PARAMETERS : contains parameters
!! Module MODD_CONF : contains NVERB
!! Module MODD_CONF1 : contains CONF_MODEL(1)%NRR (total Number of moist variables)
!! Module MODD_FIELD1 : contains pronostic variables of model 1
!! Module MODD_LSFIELD1 : contains LB and LS variables of model 1
!! Module MODD_REF1 : contains RHODJ of model 1
!! Module MODD_GRID1 : contains grid variables
!!
!! REFERENCE
!! ---------
!!
!! Book1 of the documentation
!! SUBROUTINE SPAWN_FIELD2 (Book2 of the documentation)
!!
!!
!! AUTHOR
!! ------
!!
!! J.P. Lafore * METEO-FRANCE *
!!
!! MODIFICATIONS
!! -------------
!!
!! Original 12/01/95
!! Modification 20/03/95 (I.Mallet) change Large Scale fields initialization
!! Modification 27/04/95 ( " ) remove R from the historical variables
!! Modification 17/04/96 (Lafore) Different resolution ratio case introduction
!! Modification 10/06/96 (V.Masson) remove the loops in case of no resolution change
!! and bug in initialization of ZBFY
!! Modification 10/06/96 (V.Masson) interpolation computations performed in
!! independant routines
!! 10/10/96 (J. Stein) add SRCM and SRCT
!! Modification 21/11/96 (Lafore) move from BIKHARDT2 to BIKHARDT routine
!! Modification 21/11/96 (Lafore) "surfacic" LS fields
!! Modification 10/07/97 (Masson) remove pressure interpolations
!! Modification 17/07/97 (Masson) add EPS and tests on other variables
!! Modification 14/09/97 (Masson) interpolation of relative humidity
!! Modification 14/09/97 (J. Stein) add the LB and LS fields
!! Modification 27/07/98 (P. Jabouille) compute HU for all the cases
!! Modification 01/02/01 (D.Gazen) add module MODD_NSV for NSV variable
!! Modification 07/07/05 (D.Barbary) spawn with 2 input files (father+son1)
!! Modification 05/06 Remove EPS, Clark and Farley
!! Modification 06/12 (M.Tomasini) Interpolation of turbulent fluxes (EDDY_FLUX)
!! for 2D west african monsoon
!! Modification 07/13 (Bosseur & Filippi) Adds Forefire
!! Modification 2014 (M.Faivre)
!! Modification 01/15 (C. Barthe) add LNOx
!! Modification 25/02/2015 (M.Moge) correction of the parallelization attempted by M.Faivre
!! Modification 15/04/2016 (P.Tulet) bug allocation ZSVT_C
!! 29/04/2016 (J.Escobar) bug in use of ZSVT_C in SET_LSFIELD_1WAY_ll
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_2D_FRC
USE MODD_ADVFRC_n
USE MODD_BIKHARDT_n
USE MODD_CH_AEROSOL, ONLY: CAERONAMES
USE MODD_CH_M9_n, ONLY: CNAMES, CICNAMES
USE MODD_CONF_n, ONLY: CONF_MODEL
USE MODD_DUST, ONLY: CDUSTNAMES
USE MODD_ELEC_DESCR, ONLY: CELECNAMES
USE MODD_FIELD_n, ONLY: FIELD_MODEL
USE MODD_IO_ll, ONLY : TFILEDATA
USE MODD_LATZ_EDFLX
USE MODD_LBC_n, ONLY: LBC_MODEL
USE MODD_LG, ONLY: CLGNAMES
USE MODD_LUNIT_n, ONLY: LUNIT_MODEL,TLUOUT
USE MODD_NSV
USE MODD_REF_n, ONLY: REF_MODEL
USE MODD_PARAMETERS
USE MODD_PARAM_LIMA , ONLY : NMOD_CCN, NMOD_IFN, NMOD_IMM, NINDICE_CCN_IMM,&
LSCAV, LAERO_MASS, LHHONI
USE MODD_PARAM_LIMA_COLD, ONLY : CLIMA_COLD_NAMES
USE MODD_PARAM_LIMA_WARM, ONLY : CLIMA_WARM_NAMES, CAERO_MASS
USE MODD_RAIN_C2R2_DESCR, ONLY: C2R2NAMES
USE MODD_SALT, ONLY: CSALTNAMES
USE MODD_SPAWN
USE MODE_FIELD, ONLY: TFIELDDATA,TYPEREAL
USE MODE_FMREAD
USE MODE_IO_ll, ONLY: UPCASE
USE MODE_MODELN_HANDLER
USE MODE_MPPDB
USE MODE_THERMO
!
USE MODI_BIKHARDT
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
!
INTEGER, INTENT(IN) :: KXOR,KXEND ! horizontal position (i,j) of the ORigin and END
INTEGER, INTENT(IN) :: KYOR,KYEND ! of the model 2 domain, relative to model 1
INTEGER, INTENT(IN) :: KDXRATIO ! x and y-direction Resolution ratio
INTEGER, INTENT(IN) :: KDYRATIO ! between model 2 and model 1
CHARACTER (LEN=4), INTENT(IN) :: HTURB ! Kind of turbulence parameterization
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PUT,PVT,PWT ! model 2
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTKET ! variables
REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PRT,PSVT,PATC ! at t
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTHVT,PHUT !
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCT,PSIGS ! secondary
! prognostic variables
! Larger Scale fields for relaxation and diffusion
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSUM, PLSVM, PLSWM
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSTHM, PLSRVM
REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PDTHFRC,PDRVFRC
REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PTHREL,PRVREL
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PVU_FLUX_M,PVTH_FLUX_M,PWTH_FLUX_M
! Arguments for spawning with 2 input files (father+son1)
WAUTELET Philippe
committed
TYPE(TFILEDATA), OPTIONAL, INTENT(IN) :: TPSONFILE ! input FM-file SON
INTEGER, OPTIONAL, INTENT(IN) :: KIUSON ! upper dimensions of the
INTEGER, OPTIONAL, INTENT(IN) :: KJUSON !input FM-file SON
INTEGER, OPTIONAL, INTENT(IN) :: KIB2,KJB2 ! indexes for common
INTEGER, OPTIONAL, INTENT(IN) :: KIE2,KJE2 !domain in model2
INTEGER, OPTIONAL, INTENT(IN) :: KIB1,KJB1 !and in
INTEGER, OPTIONAL, INTENT(IN) :: KIE1,KJE1 !SON
!
!* 0.2 Declarations of local variables
!
INTEGER :: ILUOUT ! Logical unit number for the output listing
INTEGER :: IRESP ! Return codes in FM routines
INTEGER :: JRR,JSV ! Loop index for moist and scalar variables
INTEGER :: IRR ! Number of moist variables
!
REAL, DIMENSION(SIZE(XRT1,1),SIZE(XRT1,2),SIZE(XRT1,3)) :: ZHUT ! relative humidity
WAUTELET Philippe
committed
REAL, DIMENSION(SIZE(XTHT1,1),SIZE(XTHT1,2),SIZE(XTHT1,3)) :: ZTHVT! virtual pot. T
! (model 1)
!$20140708
!$***** 3D
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZUT_C, ZLSUM_C
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZVT_C, ZLSVM_C
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWT_C
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHVT_C
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLSWM_C
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLSTHM_C
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLSRVM_C
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTKET_C
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZHUT_C, ZSRCM_C, ZSRCT_C, ZSIGS_C
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZVU_FLUX_M_C, ZVTH_FLUX_M_C, ZWTH_FLUX_M_C
!$***** 4D
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSVT_C
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZRT_C, ZDTHFRC_C, ZDRVFRC_C
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZTHREL_C, ZRVREL_C
!$
INTEGER :: IMI, JI,KI
!$20140708
INTEGER :: IDIMX_C, IDIMY_C
INTEGER :: IINFO_ll
!$
! Arrays for reading fields of input SON 1 file
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWORK3D
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHT1,ZTHVT1
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZPABST1,ZHUT1
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZRT1
TYPE(TFIELDDATA) :: TZFIELD
!-------------------------------------------------------------------------------
!
!* 1. PROLOGUE:
! ---------
!
IMI = GET_CURRENT_MODEL_INDEX()
CALL GOTO_MODEL(2)
CALL GO_TOMODEL_ll(2, IINFO_ll)
!
!* 1.0 recovers logical unit number of output listing
!
ILUOUT = TLUOUT%NLU
!
!* 1.1 Secondary variables
!
CALL COMPUTE_THV_HU(CONF_MODEL(1)%LUSERV,XRT1,XTHT1,XPABST1,ZTHVT,ZHUT)
!
!* 1.2 Working arrays for reading in SON input file
!
WAUTELET Philippe
committed
IF (PRESENT(TPSONFILE)) THEN
ALLOCATE(ZWORK3D(KIUSON,KJUSON,SIZE(PUT,3)))
ALLOCATE(ZPABST1(KIE1-KIB1+1,KJE1-KJB1+1,SIZE(PUT,3)))
ALLOCATE(ZTHT1(KIE1-KIB1+1,KJE1-KJB1+1,SIZE(PUT,3)))
ALLOCATE(ZTHVT1(KIE1-KIB1+1,KJE1-KJB1+1,SIZE(PUT,3)))
ALLOCATE(ZHUT1(KIE1-KIB1+1,KJE1-KJB1+1,SIZE(PUT,3)))
ALLOCATE(ZRT1(KIE1-KIB1+1,KJE1-KJB1+1, SIZE(PUT,3),SIZE(PRT,4)))
END IF
END IF
!
!-------------------------------------------------------------------------------
!
!* 2. INITIALIZATION OF PROGNOSTIC AND LS VARIABLES OF MODEL 2:
! ---------------------------------------------------------
!
!
IF (KDXRATIO == 1 .AND. KDYRATIO == 1 ) THEN
!
!* 2.1 special case of spawning - no change of resolution :
!
!* 2.1.1 variables which always exist
!
WAUTELET Philippe
committed
PUT (:,:,:) = XUT1(KXOR:KXEND,KYOR:KYEND,:)
PVT (:,:,:) = XVT1(KXOR:KXEND,KYOR:KYEND,:)
PWT (:,:,:) = XWT1(KXOR:KXEND,KYOR:KYEND,:)
PTHVT(:,:,:) = ZTHVT(KXOR:KXEND,KYOR:KYEND,:)
!
PLSUM (:,:,:) = PUT(:,:,:)
PLSVM (:,:,:) = PVT(:,:,:)
PLSWM (:,:,:) = PWT(:,:,:)
WAUTELET Philippe
committed
PLSTHM(:,:,:) = XTHT1(KXOR:KXEND,KYOR:KYEND,:)
!$20140707
CALL MPPDB_CHECK3D(PUT,"SPAWN_FIELD2:PUT",PRECISION)
CALL MPPDB_CHECK3D(PVT,"SPAWN_FIELD2:PVT",PRECISION)
!$
!* 2.1.2 TKE variable
!
IF (HTURB /= 'NONE') THEN
PTKET(:,:,:) = XTKET1(KXOR:KXEND,KYOR:KYEND,:)
ENDIF
!
!* 2.1.3 moist variables
!
IF (CONF_MODEL(1)%NRR /= 0) THEN
PRT (:,:,:,:) = XRT1 (KXOR:KXEND,KYOR:KYEND,:,:)
PLSRVM(:,:,:) = XRT1 (KXOR:KXEND,KYOR:KYEND,:,1)
PHUT (:,:,:) = ZHUT (KXOR:KXEND,KYOR:KYEND,:)
ENDIF
!
!* 2.1.4 scalar variables
!
IF (NSV /= 0) THEN
PSVT (:,:,:,:) = FIELD_MODEL(1)%XSVT (KXOR:KXEND,KYOR:KYEND,:,:)
ENDIF
!
!* 2.1.5 secondary prognostic variables
!
IF (CONF_MODEL(1)%NRR > 1) THEN
PSRCT(:,:,:) = XSRCT1 (KXOR:KXEND,KYOR:KYEND,:)
PSIGS(:,:,:) = XSIGS1(KXOR:KXEND,KYOR:KYEND,:)
ENDIF
!
!* 2.1.6 Large scale variables
!
PLSUM (:,:,:) = XLSUM1 (KXOR:KXEND,KYOR:KYEND,:)
PLSVM (:,:,:) = XLSVM1 (KXOR:KXEND,KYOR:KYEND,:)
PLSWM (:,:,:) = XLSWM1 (KXOR:KXEND,KYOR:KYEND,:)
PLSTHM(:,:,:) = XLSTHM1 (KXOR:KXEND,KYOR:KYEND,:)
PLSRVM (:,:,:) = XLSRVM1 (KXOR:KXEND,KYOR:KYEND,:)
END IF
!
!* 2.1.7 Advective forcing fields for 2D (Modif MT)
!
IF (L2D_ADV_FRC) THEN
PDTHFRC(:,:,:,:)= ADVFRC_MODEL(1)%XDTHFRC (KXOR:KXEND,KYOR:KYEND,:,:)
PDRVFRC(:,:,:,:)= ADVFRC_MODEL(1)%XDRVFRC (KXOR:KXEND,KYOR:KYEND,:,:)
ENDIF
IF (L2D_REL_FRC) THEN
PTHREL(:,:,:,:)= RELFRC_MODEL(1)%XTHREL (KXOR:KXEND,KYOR:KYEND,:,:)
PRVREL(:,:,:,:)= RELFRC_MODEL(1)%XRVREL (KXOR:KXEND,KYOR:KYEND,:,:)
ENDIF
!
!* 2.1.8 Turbulent fluxes for 2D (Modif MT)
!
IF (LUV_FLX) THEN
PVU_FLUX_M(:,:,:)= XVU_FLUX_M1 (KXOR:KXEND,KYOR:KYEND,:)
PVTH_FLUX_M(:,:,:)= XVTH_FLUX_M1 (KXOR:KXEND,KYOR:KYEND,:)
PWTH_FLUX_M(:,:,:)= XWTH_FLUX_M1 (KXOR:KXEND,KYOR:KYEND,:)
END IF
!
!-------------------------------------------------------------------------------
!
ELSE
!
!-------------------------------------------------------------------------------
!
!* 2.2 general case - change of resolution :
! -----------------------------------
!
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
!$20140708 get XDIM, YDIM = G2^G1@resol1
CALL GOTO_MODEL(1)
CALL GO_TOMODEL_ll(1, IINFO_ll)
CALL GET_CHILD_DIM_ll(2, IDIMX_C, IDIMY_C, IINFO_ll)
!
!$20140708 use ZTHVM_C in BIKAT top cal PTHVM_C
!$**** 3D
ALLOCATE(ZUT_C(IDIMX_C,IDIMY_C,SIZE(PUT,3)))
ALLOCATE(ZLSUM_C(IDIMX_C,IDIMY_C,SIZE(PUT,3)))
ALLOCATE(ZVT_C(IDIMX_C,IDIMY_C,SIZE(PVT,3)))
ALLOCATE(ZLSVM_C(IDIMX_C,IDIMY_C,SIZE(PVT,3)))
ALLOCATE(ZWT_C(IDIMX_C,IDIMY_C,SIZE(PVT,3)))
ALLOCATE(ZLSWM_C(IDIMX_C,IDIMY_C,SIZE(PVT,3)))
ALLOCATE(ZLSTHM_C(IDIMX_C,IDIMY_C,SIZE(PVT,3)))
ALLOCATE(ZLSRVM_C(IDIMX_C,IDIMY_C,SIZE(PVT,3)))
!$20140709
ALLOCATE(ZHUT_C(IDIMX_C,IDIMY_C,SIZE(PVT,3)))
ALLOCATE(ZTKET_C(IDIMX_C,IDIMY_C,SIZE(PVT,3)))
ALLOCATE(ZSRCT_C(IDIMX_C,IDIMY_C,SIZE(PVT,3)))
ALLOCATE(ZSIGS_C(IDIMX_C,IDIMY_C,SIZE(PVT,3)))
ALLOCATE(ZTHVT_C(IDIMX_C,IDIMY_C,SIZE(PUT,3)))
ALLOCATE(ZVU_FLUX_M_C(IDIMX_C,IDIMY_C,SIZE(PVT,3)))
ALLOCATE(ZVTH_FLUX_M_C(IDIMX_C,IDIMY_C,SIZE(PVT,3)))
ALLOCATE(ZWTH_FLUX_M_C(IDIMX_C,IDIMY_C,SIZE(PVT,3)))
!$***** 4D
ALLOCATE(ZRT_C(IDIMX_C,IDIMY_C,SIZE(PUT,3),SIZE(PRT,4)))
ALLOCATE(ZSVT_C(IDIMX_C,IDIMY_C,SIZE(PUT,3),NSV))
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
ALLOCATE(ZDRVFRC_C(IDIMX_C,IDIMY_C,SIZE(PUT,3),SIZE(PRT,4)))
ALLOCATE(ZDTHFRC_C(IDIMX_C,IDIMY_C,SIZE(PUT,3),SIZE(PRT,4)))
ALLOCATE(ZRVREL_C(IDIMX_C,IDIMY_C,SIZE(PUT,3),SIZE(PRT,4)))
ALLOCATE(ZTHREL_C(IDIMX_C,IDIMY_C,SIZE(PUT,3),SIZE(PRT,4)))
!$initialize
!$***** 3D
ZUT_C =0.
ZLSUM_C =0.
ZVT_C =0.
ZWT_C =0.
ZTHVT_C =0.
ZHUT_C =0.
ZTKET_C =0.
ZSRCT_C =0.
ZSIGS_C =0.
ZVU_FLUX_M_C=0.
ZVTH_FLUX_M_C=0.
ZWTH_FLUX_M_C=0.
!$***** 4D
ZRT_C =0.
ZSVT_C =0.
ZDRVFRC_C=0.
ZDTHFRC_C=0.
ZRVREL_C=0.
ZTHREL_C=00
!
!$***** 3D VARS
DO JI=1,SIZE(PUT,3)
CALL GOTO_MODEL(1)
CALL GO_TOMODEL_ll(1, IINFO_ll)
!
!$series of SET_LSFIELD_1WAY_ll
!$***** 3D VARS
WAUTELET Philippe
committed
CALL SET_LSFIELD_1WAY_ll(XUT1(:,:,JI),ZUT_C(:,:,JI),2)
CALL SET_LSFIELD_1WAY_ll(XLSUM1(:,:,JI), ZLSUM_C(:,:,JI),2)
WAUTELET Philippe
committed
CALL SET_LSFIELD_1WAY_ll(XVT1(:,:,JI),ZVT_C(:,:,JI),2)
CALL SET_LSFIELD_1WAY_ll(XLSVM1(:,:,JI),ZLSVM_C(:,:,JI),2)
CALL SET_LSFIELD_1WAY_ll(XWT1(:,:,JI),ZWT_C(:,:,JI),2)
CALL SET_LSFIELD_1WAY_ll(XLSWM1(:,:,JI),ZLSWM_C(:,:,JI),2)
!
CALL SET_LSFIELD_1WAY_ll(ZTHVT(:,:,JI), ZTHVT_C(:,:,JI),2)
CALL SET_LSFIELD_1WAY_ll(XLSTHM1(:,:,JI),ZLSTHM_C(:,:,JI),2)
!$conditionnal VARS
IF (HTURB /= 'NONE') THEN
CALL SET_LSFIELD_1WAY_ll(XTKET1(:,:,JI), ZTKET_C(:,:,JI),2)
ENDIF
IF (CONF_MODEL(1)%NRR>=1) THEN
CALL SET_LSFIELD_1WAY_ll(XLSRVM1(:,:,JI), ZLSRVM_C(:,:,JI),2)
CALL SET_LSFIELD_1WAY_ll(ZHUT(:,:,JI),ZHUT_C(:,:,JI),2)
ENDIF
IF (CONF_MODEL(1)%NRR>1 .AND. HTURB /='NONE') THEN
CALL SET_LSFIELD_1WAY_ll(XSRCT1(:,:,JI),ZSRCT_C(:,:,JI),2)
CALL SET_LSFIELD_1WAY_ll(XSIGS1(:,:,JI),ZSIGS_C(:,:,JI),2)
ENDIF
IF (LUV_FLX) &
CALL SET_LSFIELD_1WAY_ll(XVU_FLUX_M1(:,:,JI),ZVU_FLUX_M_C(:,:,JI),2)
CALL SET_LSFIELD_1WAY_ll(XVTH_FLUX_M1(:,:,JI),ZVTH_FLUX_M_C(:,:,JI),2)
CALL SET_LSFIELD_1WAY_ll(XWTH_FLUX_M1(:,:,JI),ZWTH_FLUX_M_C(:,:,JI),2)
ENDIF
!
CALL LS_FORCING_ll(2, IINFO_ll, .TRUE.)
CALL GO_TOMODEL_ll(2, IINFO_ll)
CALL GOTO_MODEL(2)
CALL UNSET_LSFIELD_1WAY_ll()
!
ENDDO
!if the child grid is the whole father grid, we first need to extrapolate
!the data on a "pseudo halo" before doing BIKHARDT interpolation
! -------> done in LS_FORCING_ll
!$***** 4D VARS
DO JI=1,SIZE(PUT,3)
DO KI=1,SIZE(PRT,4)
CALL GOTO_MODEL(1)
CALL GO_TOMODEL_ll(1, IINFO_ll)
IF (CONF_MODEL(1)%NRR>=1) THEN
CALL SET_LSFIELD_1WAY_ll(XRT1(:,:,JI,KI),ZRT_C(:,:,JI,KI),2)
ENDIF
IF ( L2D_ADV_FRC ) THEN
CALL SET_LSFIELD_1WAY_ll(ADVFRC_MODEL(1)%XDTHFRC(:,:,JI,KI),ZDTHFRC_C(:,:,JI,KI),2)
CALL SET_LSFIELD_1WAY_ll(ADVFRC_MODEL(1)%XDRVFRC(:,:,JI,KI),ZDRVFRC_C(:,:,JI,KI),2)
ENDIF
IF (L2D_REL_FRC) THEN
CALL SET_LSFIELD_1WAY_ll(RELFRC_MODEL(1)%XTHREL(:,:,JI,KI),ZTHREL_C(:,:,JI,KI),2)
CALL SET_LSFIELD_1WAY_ll(RELFRC_MODEL(1)%XRVREL(:,:,JI,KI),ZRVREL_C(:,:,JI,KI),2)
ENDIF
!
CALL LS_FORCING_ll(2, IINFO_ll, .TRUE.)
CALL GO_TOMODEL_ll(2, IINFO_ll)
CALL GOTO_MODEL(2)
CALL UNSET_LSFIELD_1WAY_ll()
!
ENDDO
ENDDO
!$***** 4D NSV
IF (NSV>=1) THEN
DO JI=1,SIZE(PUT,3)
DO KI=1,NSV
CALL GOTO_MODEL(1)
CALL GO_TOMODEL_ll(1, IINFO_ll)
CALL SET_LSFIELD_1WAY_ll(FIELD_MODEL(1)%XSVT(:,:,JI,KI),ZSVT_C(:,:,JI,KI),2)
CALL LS_FORCING_ll(2, IINFO_ll, .TRUE.)
CALL GO_TOMODEL_ll(2, IINFO_ll)
CALL GOTO_MODEL(2)
CALL UNSET_LSFIELD_1WAY_ll()
!
ENDDO
ENDDO
ENDIF
!if the child grid is the whole father grid, we first need to extrapolate
!the data on a "pseudo halo" before doing BIKHARDT interpolation
! -------> done in LS_FORCING_ll
!
!
CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,2, &
LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZUT_C,PUT)
CALL MPPDB_CHECK3D(PUT,"SPAWN_FIELD2:PUT",PRECISION)
!
CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,2, &
LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZLSUM_C,PLSUM)
CALL MPPDB_CHECK3D(PLSUM,"SPAWN_FIELD2:PLSUM",PRECISION)
!
CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,3, &
LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZVT_C,PVT)
CALL MPPDB_CHECK3D(PVT,"SPAWN_FIELD2:PVT",PRECISION)
!
CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,3, &
LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZLSVM_C,PLSVM)
CALL MPPDB_CHECK3D(PLSVM,"SPAWN_FIELD2:PLSVM",PRECISION)
!
CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,4, &
LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZWT_C,PWT)
CALL MPPDB_CHECK3D(PWT,"SPAWN_FIELD2:PWT",PRECISION)
!
CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,4, &
LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZLSWM_C,PLSWM)
CALL MPPDB_CHECK3D(PLSWM,"SPAWN_FIELD2:PLSWM",PRECISION)
!
CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1, &
LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZLSTHM_C,PLSTHM)
CALL MPPDB_CHECK3D(PLSTHM,"SPAWN_FIELD2:PLSTHM",PRECISION)
IF (CONF_MODEL(1)%NRR>=1) THEN
CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1, &
LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZLSRVM_C,PLSRVM)
CALL MPPDB_CHECK3D(PLSRVM,"SPAWN_FIELD2:PLSRVM",PRECISION)
ENDIF
!
CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1, &
LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZTHVT_C,PTHVT)
CALL MPPDB_CHECK3D(PTHVT,"SPAWN_FIELD2:PTHVT",PRECISION)
!
IF (HTURB /= 'NONE') THEN
CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1, &
LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZTKET_C,PTKET)
CALL MPPDB_CHECK3D(PTKET,"SPAWN_FIELD2:PTKET",PRECISION)
ENDIF
!
IF (CONF_MODEL(1)%NRR>=1) THEN
CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1, &
LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZHUT_C,PHUT)
CALL MPPDB_CHECK3D(PHUT,"SPAWN_FIELD2:PHUT",PRECISION)
ENDIF
!
IF (CONF_MODEL(1)%NRR>=1) THEN
CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1, &
LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZRT_C,PRT)
CALL MPPDB_CHECK3D(PRT(:,:,:,1),"SPAWN_FIELD2:PRT",PRECISION)
ENDIF
!
IF (NSV>=1) THEN
CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1, &
LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZSVT_C,PSVT)
CALL MPPDB_CHECK3D(PSVT(:,:,:,1),"SPAWN_FIELD2:PSVT",PRECISION)
ENDIF
!
IF (CONF_MODEL(1)%NRR>1 .AND. HTURB /='NONE') THEN
CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1, &
LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZSRCT_C,PSRCT)
CALL MPPDB_CHECK3D(PSRCT,"SPAWN_FIELD2:PSRCT",PRECISION)
ENDIF
!
IF (CONF_MODEL(1)%NRR>1 .AND. HTURB /='NONE') THEN
CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1, &
LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZSIGS_C,PSIGS)
CALL MPPDB_CHECK3D(PSIGS,"SPAWN_FIELD2:PSIGS",PRECISION)
ENDIF
!
IF ( L2D_ADV_FRC ) THEN ! MT adding for ADVFRC
CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1, &
LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY, &
ZDTHFRC_C,PDTHFRC)
!
CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1, &
LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY, &
ZDRVFRC_C,PDRVFRC)
ENDIF
IF (L2D_REL_FRC) THEN ! MT adding for REL FRC
WRITE(ILUOUT,FMT=*) 'SPAWN_FIELD2: Appel a BIKHARDT pour RELFRC'
CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1, &
LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY, &
ZTHREL_C,PTHREL)
!
CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1, &
LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY, &
ZRVREL_C,PRVREL)
ENDIF
!
IF ( LUV_FLX) THEN ! MT adding for EDDY_FLUX
CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1, &
LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY, &
ZVU_FLUX_M_C,PVU_FLUX_M)
CALL MPPDB_CHECK3D(PVU_FLUX_M,"SPAWN_FIELD2:PVU_FLUX_M",PRECISION)
CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1, &
LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY, &
ZVTH_FLUX_M_C,PVTH_FLUX_M)
CALL MPPDB_CHECK3D(PVTH_FLUX_M,"SPAWN_FIELD2:PVTH_FLUX_M",PRECISION)
!
CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1, &
LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY, &
ZWTH_FLUX_M_C,PWTH_FLUX_M)
CALL MPPDB_CHECK3D(PWTH_FLUX_M,"SPAWN_FIELD2:PWTH_FLUX_M",PRECISION)
ENDIF
!
END IF
!
IF (CONF_MODEL(1)%NRR>=3) THEN
WHERE (PRT(:,:,:,3)<1.E-20)
PRT(:,:,:,3)=0.
END WHERE
END IF
!
!
!* 2.2.3 Informations from model SON1
! (LS fields are not treated because they are identical in the father file)
!
WAUTELET Philippe
committed
IF (PRESENT(TPSONFILE)) THEN
!
!variables which always exist
!
WAUTELET Philippe
committed
CALL IO_READ_FIELD(TPSONFILE,'UT',ZWORK3D) ! U wind component at time t
PUT(KIB2:KIE2,KJB2:KJE2,:) = ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
WAUTELET Philippe
committed
CALL IO_READ_FIELD(TPSONFILE,'VT',ZWORK3D) ! V wind component at time t
PVT(KIB2:KIE2,KJB2:KJE2,:) = ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
WAUTELET Philippe
committed
CALL IO_READ_FIELD(TPSONFILE,'WT',ZWORK3D) ! W wind component at time t
PWT(KIB2:KIE2,KJB2:KJE2,:) = ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
!
! moist variables
!
IRR=1
IF (IRR<=CONF_MODEL(1)%NRR) THEN
GUSERV=.TRUE.
CALL IO_READ_FIELD(TPSONFILE,'RVT',ZWORK3D,IRESP) ! Vapor at time t
IF(IRESP==0) ZRT1(:,:,:,IRR)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
IF(IRESP==0) IRR=IRR+1
END IF
IF (IRR<=CONF_MODEL(1)%NRR) THEN
CALL IO_READ_FIELD(TPSONFILE,'RCT',ZWORK3D,IRESP) ! Cloud at time t
IF(IRESP==0) ZRT1(:,:,:,IRR)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
IF(IRESP==0) IRR=IRR+1
END IF
IF (IRR<=CONF_MODEL(1)%NRR) THEN
CALL IO_READ_FIELD(TPSONFILE,'RRT',ZWORK3D,IRESP) ! Rain at time t
IF(IRESP==0) ZRT1(:,:,:,IRR)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
IF(IRESP==0) IRR=IRR+1
END IF
IF (IRR<=CONF_MODEL(1)%NRR) THEN
CALL IO_READ_FIELD(TPSONFILE,'RIT',ZWORK3D,IRESP) ! Ice at time t
IF(IRESP==0) ZRT1(:,:,:,IRR)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
IF(IRESP==0) IRR=IRR+1
END IF
IF (IRR<=CONF_MODEL(1)%NRR) THEN
CALL IO_READ_FIELD(TPSONFILE,'RST',ZWORK3D,IRESP) ! Snow at time t
IF(IRESP==0) ZRT1(:,:,:,IRR)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
IF(IRESP==0) IRR=IRR+1
END IF
IF (IRR<=CONF_MODEL(1)%NRR) THEN
CALL IO_READ_FIELD(TPSONFILE,'RGT',ZWORK3D,IRESP) ! Graupel at time t
IF(IRESP==0) ZRT1(:,:,:,IRR)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
IF(IRESP==0) IRR=IRR+1
END IF
IF (IRR<=CONF_MODEL(1)%NRR) THEN
CALL IO_READ_FIELD(TPSONFILE,'HVT',ZWORK3D,IRESP) ! Hail at time t
IF(IRESP==0) ZRT1(:,:,:,IRR)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
IF(IRESP==0) IRR=IRR+1
END IF
IRR=IRR-1
WRITE(ILUOUT,FMT=*) 'SPAWN_FIELD2: spawing with a SON input file'
WRITE(ILUOUT,FMT=*) ' ',CONF_MODEL(1)%NRR,' moist variables in model1 and model2, ', &
IRR,' moist variables in input SON'
CALL IO_READ_FIELD(TPSONFILE,'THT',ZWORK3D) ! Theta at time t
ZTHT1(:,:,:)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
CALL IO_READ_FIELD(TPSONFILE,'PABST',ZWORK3D) ! Pressure at time t
ZPABST1(:,:,:)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
!
CALL COMPUTE_THV_HU(GUSERV,ZRT1,ZTHT1,ZPABST1,ZTHVT1,ZHUT1)
!
PTHVT(KIB2:KIE2,KJB2:KJE2,:) = ZTHVT1(:,:,:)
IF (CONF_MODEL(1)%NRR /= 0) THEN
PHUT(KIB2:KIE2,KJB2:KJE2,:) = ZHUT1(:,:,:)
PRT(KIB2:KIE2,KJB2:KJE2,:,:) = ZRT1(:,:,:,:)
END IF
!
! TKE variables
!
IF (HTURB/='NONE') THEN
CALL IO_READ_FIELD(TPSONFILE,'TKET',ZWORK3D,IRESP) ! Turbulence Kinetic Energy at time t
IF(IRESP==0) PTKET(KIB2:KIE2,KJB2:KJE2,:)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
END IF
!
! Scalar variables
!
IF (NSV /= 0) THEN
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
! User scalar variables
IF (NSV_USER>0) THEN
TZFIELD%CSTDNAME = ''
TZFIELD%CUNITS = 'kg kg-1'
TZFIELD%CDIR = 'XY'
TZFIELD%NGRID = 1
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
!
DO JSV = 1, NSV_USER ! Users Scalar Variables
WRITE(TZFIELD%CMNHNAME,'(A3,I3.3)')'SVT',JSV
TZFIELD%CLONGNAME = 'MesoNH: '//TRIM(TZFIELD%CMNHNAME)
TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME)
CALL IO_READ_FIELD(TPSONFILE,TZFIELD,ZWORK3D,IRESP)
IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
END DO
END IF
!
! microphysical C2R2 scheme scalar variables
IF (NSV_C2R2END>=NSV_C2R2BEG) THEN
TZFIELD%CSTDNAME = ''
TZFIELD%CUNITS = 'm-3'
TZFIELD%CDIR = 'XY'
TZFIELD%NGRID = 1
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
!
DO JSV = NSV_C2R2BEG,NSV_C2R2END
TZFIELD%CMNHNAME = TRIM(C2R2NAMES(JSV-NSV_C2R2BEG+1))//'T'
TZFIELD%CLONGNAME = 'MesoNH: '//TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
CALL IO_READ_FIELD(TPSONFILE,TZFIELD,ZWORK3D,IRESP)
IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
END DO
END IF
!
! LIMA variables
!
TZFIELD%CSTDNAME = ''
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
TZFIELD%CDIR = 'XY'
TZFIELD%CUNITS = 'kg-1'
TZFIELD%NGRID = 1
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
! Nc
TZFIELD%CMNHNAME = TRIM(CLIMA_WARM_NAMES(1))//'T'
TZFIELD%CMNHNAME = TRIM(CLIMA_WARM_NAMES(2))//'T'
! N CCN free
IF (JSV .GE. NSV_LIMA_CCN_FREE .AND. JSV .LT. NSV_LIMA_CCN_ACTI) THEN
WRITE(INDICE,'(I2.2)')(JSV - NSV_LIMA_CCN_FREE + 1)
TZFIELD%CMNHNAME = TRIM(CLIMA_WARM_NAMES(3))//INDICE//'T'
! N CCN acti
IF (JSV .GE. NSV_LIMA_CCN_ACTI .AND. JSV .LT. NSV_LIMA_CCN_ACTI + NMOD_CCN) THEN
WRITE(INDICE,'(I2.2)')(JSV - NSV_LIMA_CCN_ACTI + 1)
TZFIELD%CMNHNAME = TRIM(CLIMA_WARM_NAMES(4))//INDICE//'T'
! Scavenging
TZFIELD%CMNHNAME = TRIM(CAERO_MASS(1))//'T'
TZFIELD%CUNITS = 'kg kg-1'
TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_NAMES(1))//'T'
! N IFN free
IF (JSV .GE. NSV_LIMA_IFN_FREE .AND. JSV .LT. NSV_LIMA_IFN_NUCL) THEN
WRITE(INDICE,'(I2.2)')(JSV - NSV_LIMA_IFN_FREE + 1)
TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_NAMES(2))//INDICE//'T'
! N IFN nucl
IF (JSV .GE. NSV_LIMA_IFN_NUCL .AND. JSV .LT. NSV_LIMA_IFN_NUCL + NMOD_IFN) THEN
WRITE(INDICE,'(I2.2)')(JSV - NSV_LIMA_IFN_NUCL + 1)
TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_NAMES(3))//INDICE//'T'
! N IMM nucl
I = 0
IF (JSV .GE. NSV_LIMA_IMM_NUCL .AND. JSV .LT. NSV_LIMA_IMM_NUCL + NMOD_IMM) THEN
I = I + 1
WRITE(INDICE,'(I2.2)')(NINDICE_CCN_IMM(I))
TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_NAMES(4))//INDICE//'T'
! Hom. freez. of CCN
TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_NAMES(5))//'T'
! time t
TZFIELD%CLONGNAME = 'MesoNH: '//TRIM(TZFIELD%CMNHNAME)
CALL IO_READ_FIELD(TPSONFILE,TZFIELD,ZWORK3D,IRESP)
IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
END DO
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
!
! ELEC Scalar Variables
!
IF (NSV_ELECEND>=NSV_ELECBEG) THEN
TZFIELD%CSTDNAME = ''
TZFIELD%CDIR = 'XY'
TZFIELD%NGRID = 1
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
!
DO JSV = NSV_ELECBEG,NSV_ELECEND
TZFIELD%CMNHNAME = TRIM(CELECNAMES(JSV-NSV_ELECBEG+1))//'T'
TZFIELD%CLONGNAME = 'MesoNH: '//TRIM(TZFIELD%CMNHNAME)
IF (JSV .GT. NSV_ELECBEG .AND. JSV .LT. NSV_ELECEND) THEN
TZFIELD%CUNITS = 'C m-3'
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3,A8)')'X_Y_Z_','SVT',JSV,' (C/m3)'
ELSE
TZFIELD%CUNITS = 'm-3'
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3,A8)')'X_Y_Z_','SVT',JSV,' (nb ions/m3)'
END IF
CALL IO_READ_FIELD(TPSONFILE,TZFIELD,ZWORK3D,IRESP)
IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
END DO
END IF
!
! Chemical Scalar Variables
!
IF (NSV_CHEMEND>=NSV_CHEMBEG) THEN
TZFIELD%CSTDNAME = ''
TZFIELD%CUNITS = ''
TZFIELD%CDIR = 'XY'
TZFIELD%NGRID = 1
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
!
DO JSV = NSV_CHEMBEG,NSV_CHEMEND
TZFIELD%CMNHNAME = TRIM(CNAMES(JSV-NSV_CHEMBEG+1))//'T'
TZFIELD%CLONGNAME = 'MesoNH: '//TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3,A8)')'X_Y_Z_','SVT',JSV,' (ppp)'
CALL IO_READ_FIELD(TPSONFILE,TZFIELD,ZWORK3D,IRESP)
IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
END DO
END IF
!
! Ice phase chemical Scalar Variables
!
IF (NSV_CHICEND>=NSV_CHICBEG) THEN
CICNAMES(JSV-NSV_CHICBEG+1) = UPCASE(CICNAMES(JSV-NSV_CHICBEG+1))
TZFIELD%CSTDNAME = ''
TZFIELD%CUNITS = ''
TZFIELD%CDIR = 'XY'
TZFIELD%NGRID = 1
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
!
DO JSV = NSV_CHICBEG,NSV_CHICEND
TZFIELD%CMNHNAME = TRIM(CICNAMES(JSV-NSV_CHICBEG+1))//'T'
TZFIELD%CLONGNAME = 'MesoNH: '//TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3,A8)')'X_Y_Z_','SVT',JSV,' (ppp)'
CALL IO_READ_FIELD(TPSONFILE,TZFIELD,ZWORK3D,IRESP)
IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
END DO
END IF
!
! Orilam Scalar Variables
!
IF (NSV_AEREND>=NSV_AERBEG) THEN
TZFIELD%CSTDNAME = ''
TZFIELD%CUNITS = 'ppp'
TZFIELD%CDIR = 'XY'
TZFIELD%NGRID = 1
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
!
DO JSV = NSV_AERBEG,NSV_AEREND
TZFIELD%CMNHNAME = TRIM(UPCASE(CAERONAMES(JSV-NSV_AERBEG+1)))//'T'
TZFIELD%CLONGNAME = 'MesoNH: '//TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
CALL IO_READ_FIELD(TPSONFILE,TZFIELD,ZWORK3D,IRESP)
IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
END DO
END IF
!
! Dust Scalar Variables
!
IF (NSV_DSTEND>=NSV_DSTBEG) THEN
TZFIELD%CSTDNAME = ''
TZFIELD%CUNITS = 'ppp'
TZFIELD%CDIR = 'XY'
TZFIELD%NGRID = 1
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
!
DO JSV = NSV_DSTBEG,NSV_DSTEND
TZFIELD%CMNHNAME = TRIM(CDUSTNAMES(JSV-NSV_DSTBEG+1))//'T'
TZFIELD%CLONGNAME = 'MesoNH: '//TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
CALL IO_READ_FIELD(TPSONFILE,TZFIELD,ZWORK3D,IRESP)
IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
END DO
END IF
!
! Sea Salt Scalar Variables
!
IF (NSV_SLTEND>=NSV_SLTBEG) THEN
TZFIELD%CSTDNAME = ''
TZFIELD%CUNITS = 'ppp'
TZFIELD%CDIR = 'XY'
TZFIELD%NGRID = 1