Newer
Older
!MNH_LIC Copyright 1995-2022 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, &
RODIER Quentin
committed
PUT,PVT,PWT,PTHVT,PRT,PHUT,PTKET,PSVT,PZWS,PATC, &
RODIER Quentin
committed
PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM,PLSZWSM, &
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, ONLY: TFILEDATA
WAUTELET Philippe
committed
!
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 !
RODIER Quentin
committed
REAL, DIMENSION(:,:), INTENT(OUT) :: PZWS
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCT,PSIGS ! secondary
! prognostic variables
! Larger Scale fields for relaxation and diffusion
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSUM, PLSVM, PLSWM
RODIER Quentin
committed
REAL, DIMENSION(:,:), INTENT(OUT) :: PLSZWSM
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, &
RODIER Quentin
committed
PUT,PVT,PWT,PTHVT,PRT,PHUT,PTKET,PSVT, PZWS,PATC, &
RODIER Quentin
committed
PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM,PLSZWSM, &
PDTHFRC,PDRVFRC,PTHREL,PRVREL, &
PVU_FLUX_M,PVTH_FLUX_M,PWTH_FLUX_M, &
WAUTELET Philippe
committed
TPSONFILE,KIUSON,KJUSON, &
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
142
143
144
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
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
WAUTELET Philippe
committed
! J. Escobar 05/03/2018: bypass gridnesting special case KD(X/Y)RATIO == 1 not parallelized
! S. Bielli S. 02/2019: Sea salt: significant sea wave height influences salt emission; 5 salt modes
! P. Wautelet 14/03/2019: correct ZWS when variable not present in file
WAUTELET Philippe
committed
! B. Vie 06/2020: Add prognostic supersaturation for LIMA
! P. Wautelet 11/03/2021: bugfix: correct name for NSV_LIMA_IMM_NUCL
WAUTELET Philippe
committed
! P. Wautelet 04/02/2022: use TSVLIST to manage metadata of scalar variables
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
WAUTELET Philippe
committed
USE MODD_2D_FRC, ONLY: L2D_ADV_FRC, L2D_REL_FRC
USE MODD_ADVFRC_n, ONLY: ADVFRC_MODEL
USE MODD_BIKHARDT_N, ONLY: XBFX1, XBFX2, XBFX3, XBFX4, XBFY1, XBFY2, XBFY3, XBFY4, &
XBMX1, XBMX2, XBMX3, XBMX4, XBMY1, XBMY2, XBMY3, XBMY4
USE MODD_CST, ONLY: XCPD, XP00, XRD, XRV
WAUTELET Philippe
committed
USE MODD_CONF_n, ONLY: CONF_MODEL
WAUTELET Philippe
committed
use modd_field, only: tfieldmetadata, TYPEREAL
USE MODD_FIELD_n, ONLY: FIELD_MODEL, XZWS_DEFAULT
WAUTELET Philippe
committed
USE MODD_IO, ONLY: TFILEDATA
WAUTELET Philippe
committed
USE MODD_LATZ_EDFLX, ONLY: LTH_FLX, LUV_FLX
WAUTELET Philippe
committed
USE MODD_LBC_n, ONLY: LBC_MODEL
WAUTELET Philippe
committed
USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_NSV, ONLY: NSV, NSV_CSBEG, NSV_CSEND, NSV_PPBEG, NSV_PPEND, NSV_USER, TSVLIST
WAUTELET Philippe
committed
USE MODD_RELFRC_n, ONLY: RELFRC_MODEL
USE MODD_SPAWN
use mode_bikhardt
WAUTELET Philippe
committed
USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_MSG
USE MODE_MODELN_HANDLER
USE MODE_MPPDB
USE MODE_THERMO
!
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
RODIER Quentin
committed
REAL, DIMENSION(:,:), INTENT(OUT) :: PZWS
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
RODIER Quentin
committed
REAL, DIMENSION(:,:), INTENT(OUT) :: PLSZWSM
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
RODIER Quentin
committed
REAL, DIMENSION(:,:), ALLOCATABLE :: ZZWS_C, ZLSZWSM_C
!$***** 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
!$
WAUTELET Philippe
committed
LOGICAL :: GOLDFILEFORMAT
! Arrays for reading fields of input SON 1 file
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWORK3D
RODIER Quentin
committed
REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK2D
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHT1,ZTHVT1
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZPABST1,ZHUT1
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZRT1
WAUTELET Philippe
committed
CHARACTER(LEN=3) :: YNUM3
CHARACTER(LEN=15) :: YVAL
WAUTELET Philippe
committed
TYPE(TFIELDMETADATA) :: TZFIELD
!-------------------------------------------------------------------------------
!
!* 1. PROLOGUE:
! ---------
!
IMI = GET_CURRENT_MODEL_INDEX()
CALL GOTO_MODEL(2)
CALL GO_TOMODEL_ll(2, IINFO_ll)
WAUTELET Philippe
committed
IF (PRESENT(TPSONFILE)) THEN
WAUTELET Philippe
committed
!If TPSONFILE file was written with a MesoNH version < 5.6, some variables had different names or were not available
GOLDFILEFORMAT = ( TPSONFILE%NMNHVERSION(1) < 5 &
.OR. ( TPSONFILE%NMNHVERSION(1) == 5 .AND. TPSONFILE%NMNHVERSION(2) <6 ) )
WAUTELET Philippe
committed
END IF
!
!* 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
RODIER Quentin
committed
ALLOCATE(ZWORK2D(KIUSON,KJUSON))
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:
! ---------------------------------------------------------
!
!
Juan Escobar
committed
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
!!$IF (KDXRATIO == 1 .AND. KDYRATIO == 1 ) THEN
!!$!
!!$!* 2.1 special case of spawning - no change of resolution :
!!$!
!!$!* 2.1.1 variables which always exist
!!$!
!!$ PUT (:,:,:) = FIELD_MODEL(1)%XUT (KXOR:KXEND,KYOR:KYEND,:)
!!$ PVT (:,:,:) = FIELD_MODEL(1)%XVT (KXOR:KXEND,KYOR:KYEND,:)
!!$ PWT (:,:,:) = FIELD_MODEL(1)%XWT (KXOR:KXEND,KYOR:KYEND,:)
!!$ PTHVT(:,:,:) = ZTHVT(KXOR:KXEND,KYOR:KYEND,:)
!!$!
!!$ PLSUM (:,:,:) = FIELD_MODEL(1)%XUT (KXOR:KXEND,KYOR:KYEND,:)
!!$ PLSVM (:,:,:) = FIELD_MODEL(1)%XVT (KXOR:KXEND,KYOR:KYEND,:)
!!$ PLSWM (:,:,:) = FIELD_MODEL(1)%XWT (KXOR:KXEND,KYOR:KYEND,:)
!!$ PLSTHM(:,:,:) = FIELD_MODEL(1)%XTHT(KXOR:KXEND,KYOR:KYEND,:)
!!$!
!!$ PLSRVM(:,:,:) = 0.
!!$!
!!$!$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(:,:,:) = FIELD_MODEL(1)%XTKET(KXOR:KXEND,KYOR:KYEND,:)
!!$ ENDIF
!!$!
!!$!* 2.1.3 moist variables
!!$!
!!$ IF (CONF_MODEL(1)%NRR /= 0) THEN
!!$ PRT (:,:,:,:) = FIELD_MODEL(1)%XRT (KXOR:KXEND,KYOR:KYEND,:,:)
!!$ PLSRVM(:,:,:) = FIELD_MODEL(1)%XRT (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 (:,:,:) = FIELD_MODEL(1)%XSRCT (KXOR:KXEND,KYOR:KYEND,:)
!!$ PSIGS(:,:,:) = FIELD_MODEL(1)%XSIGS(KXOR:KXEND,KYOR:KYEND,:)
!!$ ENDIF
!!$!
!!$!* 2.1.6 Large scale variables
!!$!
!!$ PLSUM (:,:,:) = LSFIELD_MODEL(1)%XLSUM (KXOR:KXEND,KYOR:KYEND,:)
!!$ PLSVM (:,:,:) = LSFIELD_MODEL(1)%XLSVM (KXOR:KXEND,KYOR:KYEND,:)
!!$ PLSWM (:,:,:) = LSFIELD_MODEL(1)%XLSWM (KXOR:KXEND,KYOR:KYEND,:)
!!$ PLSTHM(:,:,:) = LSFIELD_MODEL(1)%XLSTHM (KXOR:KXEND,KYOR:KYEND,:)
!!$ IF ( CONF_MODEL(1)%NRR > 0 ) THEN
!!$ PLSRVM (:,:,:) = LSFIELD_MODEL(1)%XLSRVM (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(:,:,:)= EDDYUV_FLUX_MODEL(1)%XVU_FLUX_M (KXOR:KXEND,KYOR:KYEND,:)
!!$ END IF
!!$!
!!$ IF (LTH_FLX) THEN
!!$ PVTH_FLUX_M(:,:,:)= EDDY_FLUX_MODEL(1)%XVTH_FLUX_M (KXOR:KXEND,KYOR:KYEND,:)
!!$ PWTH_FLUX_M(:,:,:)= EDDY_FLUX_MODEL(1)%XWTH_FLUX_M (KXOR:KXEND,KYOR:KYEND,:)
!!$ END IF
!!$!
!!$!-------------------------------------------------------------------------------
!!$!
!!$ELSE
!
!-------------------------------------------------------------------------------
!
!* 2.2 general case - change of resolution :
! -----------------------------------
!
!$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
RODIER Quentin
committed
ALLOCATE(ZZWS_C(IDIMX_C,IDIMY_C))
ALLOCATE(ZLSZWSM_C(IDIMX_C,IDIMY_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))
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.
RODIER Quentin
committed
ZZWS_C =0.
ZLSZWSM_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
!
RODIER Quentin
committed
CALL SET_LSFIELD_1WAY_ll(XZWS1(:,:),ZZWS_C(:,:),2)
CALL SET_LSFIELD_1WAY_ll(XLSZWSM1(:,:),ZLSZWSM_C(:,:),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()
!
!$***** 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)
RODIER Quentin
committed
! Interpolation of the ZWS variable at t
!
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,ZZWS_C,PZWS)
CALL MPPDB_CHECK2D(PZWS,"SPAWN_FIELD2:PZWS",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,ZLSZWSM_C,PLSZWSM)
CALL MPPDB_CHECK2D(PLSZWSM,"SPAWN_FIELD2:PLSZWSM",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, &
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
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)
Juan Escobar
committed
!!$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_Field_read(TPSONFILE,'UT',ZWORK3D) ! U wind component at time t
PUT(KIB2:KIE2,KJB2:KJE2,:) = ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
WAUTELET Philippe
committed
CALL IO_Field_read(TPSONFILE,'VT',ZWORK3D) ! V wind component at time t
PVT(KIB2:KIE2,KJB2:KJE2,:) = ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
WAUTELET Philippe
committed
CALL IO_Field_read(TPSONFILE,'WT',ZWORK3D) ! W wind component at time t
PWT(KIB2:KIE2,KJB2:KJE2,:) = ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
CALL IO_Field_read(TPSONFILE,'ZWS',ZWORK2D,IRESP) !
!If the field ZWS is not in the file, set its value to XZWS_DEFAULT
!ZWS is present in files since MesoNH 5.4.2
IF ( IRESP/=0 ) THEN
WRITE (YVAL,'( E15.8 )') XZWS_DEFAULT
CALL PRINT_MSG(NVERB_WARNING,'IO','SPAWN_FIELD2','ZWS not found in file: using default value: '//TRIM(YVAL)//' m')
ZWORK2D(:,:) = XZWS_DEFAULT
END IF
RODIER Quentin
committed
PZWS(KIB2:KIE2,KJB2:KJE2) = ZWORK2D(KIB1:KIE1,KJB1:KJE1)
!
! moist variables
!
IRR=1
IF (IRR<=CONF_MODEL(1)%NRR) THEN
GUSERV=.TRUE.
WAUTELET Philippe
committed
CALL IO_Field_read(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
WAUTELET Philippe
committed
CALL IO_Field_read(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
WAUTELET Philippe
committed
CALL IO_Field_read(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
WAUTELET Philippe
committed
CALL IO_Field_read(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
WAUTELET Philippe
committed
CALL IO_Field_read(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
WAUTELET Philippe
committed
CALL IO_Field_read(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
WAUTELET Philippe
committed
CALL IO_Field_read(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'
WAUTELET Philippe
committed
CALL IO_Field_read(TPSONFILE,'THT',ZWORK3D) ! Theta at time t
ZTHT1(:,:,:)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
WAUTELET Philippe
committed
CALL IO_Field_read(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
WAUTELET Philippe
committed
CALL IO_Field_read(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
!
WAUTELET Philippe
committed
DO JSV = 1, NSV
TZFIELD = TSVLIST(JSV)
WAUTELET Philippe
committed
IF ( GOLDFILEFORMAT ) THEN
IF ( ( JSV >= 1 .AND. JSV <= NSV_USER ) .OR. &
WAUTELET Philippe
committed
( JSV >= NSV_PPBEG .AND. JSV <= NSV_PPEND ) .OR. &
#ifdef MNH_FOREFIRE
WAUTELET Philippe
committed
( JSV >= NSV_FFBEG .AND. JSV <= NSV_FFEND ) .OR. &
#endif
WAUTELET Philippe
committed
( JSV >= NSV_CSBEG .AND. JSV <= NSV_CSEND ) ) THEN
WAUTELET Philippe
committed
!Some variables were written with an other name in MesoNH < 5.6
WAUTELET Philippe
committed
WRITE(TZFIELD%CMNHNAME,'(A3,I3.3)')'SVT',JSV
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CSTDNAME = ''
TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME)
ELSE
!Scalar variables were written with a T suffix in older versions
TZFIELD%CMNHNAME = TRIM( TZFIELD%CMNHNAME ) // 'T'
TZFIELD%CLONGNAME = TRIM( TZFIELD%CLONGNAME ) // 'T'
END IF
WAUTELET Philippe
committed
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
CALL IO_Field_read( TPSONFILE, TZFIELD, ZWORK3D, IRESP )
IF( IRESP == 0 ) PSVT(KIB2:KIE2, KJB2:KJE2, :, JSV) = ZWORK3D(KIB1:KIE1, KJB1:KJE1, :)
END DO
!
! Passive scalar variables
!
DO JSV = NSV_PPBEG, NSV_PPEND
WRITE( YNUM3, '( I3.3 )' ) JSV
TZFIELD = TFIELDMETADATA( &
CMNHNAME = 'ATC' // YNUM3, &
CSTDNAME = '', &
CLONGNAME = 'ATC' // YNUM3, &
CCOMMENT = 'X_Y_Z_ATC' // YNUM3, &
CUNITS = 'm-3', &
CDIR = 'XY', &
NGRID = 1, &
NTYPE = TYPEREAL, &
NDIMS = 3, &
LTIMEDEP = .TRUE. )
CALL IO_Field_read( TPSONFILE, TZFIELD, ZWORK3D, IRESP )
IF( IRESP == 0 ) PATC(KIB2:KIE2, KJB2:KJE2, :, JSV-NSV_PPBEG+1) = ZWORK3D(KIB1:KIE1, KJB1:KJE1, :)
END DO
!
! Secondary pronostic variables
!
IF (HTURB /= 'NONE' .AND. IRR>1) THEN
WAUTELET Philippe
committed
CALL IO_Field_read(TPSONFILE,'SRCT',ZWORK3D,IRESP) ! turbulent flux SRC at time t
IF(IRESP == 0) PSRCT(KIB2:KIE2,KJB2:KJE2,:) = &
ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
WAUTELET Philippe
committed
CALL IO_Field_read(TPSONFILE,'SIGS',ZWORK3D,IRESP) ! subgrid condensation
IF(IRESP == 0) PSIGS(KIB2:KIE2,KJB2:KJE2,:) = &
ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
END IF
END IF
!
!* 2.2.4 secondary prognostic variables correction
!
IF (CONF_MODEL(1)%NRR > 1 .AND. HTURB /= 'NONE') PSRCT(:,:,:) = MIN( 1.0, MAX( 0.0, PSRCT(:,:,:)) )
!
IF ( CONF_MODEL(1)%NRR == 0 ) THEN
PHUT (:,:,:)= 0.
END IF
!-------------------------------------------------------------------------------
!
CALL GOTO_MODEL(IMI)
CALL GO_TOMODEL_ll(IMI, IINFO_ll)
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
CONTAINS
!
SUBROUTINE COMPUTE_THV_HU(OUSERV,PR,PTH,PPABS,PTHV,PHU)
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
LOGICAL, INTENT(IN) :: OUSERV
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTH,PPABS
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PR
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTHV,PHU
!
!* 0.2 Declarations of local variables
!
REAL, DIMENSION(SIZE(PR,1),SIZE(PR,2),SIZE(PR,3)) :: ZSUMR ! sum of water ratios
!
IF (OUSERV) THEN
ZSUMR(:,:,:) = 0.
IRR=SIZE(PR,4)
DO JRR=1,IRR
ZSUMR(:,:,:) = ZSUMR(:,:,:) + PR(:,:,:,JRR)
END DO
PTHV(:,:,:)=PTH(:,:,:)*(1.+XRV/XRD*PR(:,:,:,1))/(1.+ZSUMR(:,:,:))
PHU (:,:,:)=100.*PPABS(:,:,:)/(XRD/XRV/MAX(PR(:,:,:,1),1.E-16)+1.) &
/SM_FOES(PTH(:,:,:)*(PPABS(:,:,:)/XP00)**(XRD/XCPD))
ELSE
PTHV(:,:,:)=PTH(:,:,:)
PHU (:,:,:)=0.
END IF
!
!
END SUBROUTINE COMPUTE_THV_HU
!
END SUBROUTINE SPAWN_FIELD2