Juan 29/04/2016 : bug in use of ZSVT_C in SET_LSFIELD_1WAY_ll
[MNH-git_open_source-lfs.git] / src / MNH / spawn_field2.f90
1 !MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
2 !MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
3 !MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
4 !MNH_LIC for details. version 1.
5 !#######################
6 MODULE MODI_SPAWN_FIELD2
7 !#######################
8 !
9 INTERFACE
10 !
11       SUBROUTINE SPAWN_FIELD2(KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,HTURB,   &
12                PUT,PVT,PWT,PTHVT,PRT,PHUT,PTKET,PSVT,PATC,                     &
13                PSRCT,PSIGS,                                                    &
14                PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM,                                &
15                PDTHFRC,PDRVFRC,PTHREL,PRVREL,                                  &
16                PVU_FLUX_M,PVTH_FLUX_M,PWTH_FLUX_M,                             &
17                HSONFILE,KIUSON,KJUSON,                                         &
18                KIB2,KJB2,KIE2,KJE2,                                            &
19                KIB1,KJB1,KIE1,KJE1                                             )
20 !
21 INTEGER,   INTENT(IN)  :: KXOR,KXEND !  horizontal position (i,j) of the ORigin and END  
22 INTEGER,   INTENT(IN)  :: KYOR,KYEND ! of the model 2 domain, relative to model 1
23 INTEGER,   INTENT(IN)  :: KDXRATIO   !  x and y-direction Resolution ratio
24 INTEGER,   INTENT(IN)  :: KDYRATIO   ! between model 2 and model 1
25 CHARACTER (LEN=4), INTENT(IN) :: HTURB !  Kind of turbulence parameterization
26 !
27 REAL, DIMENSION(:,:,:),   INTENT(OUT) :: PUT,PVT,PWT        !  model 2
28 REAL, DIMENSION(:,:,:),   INTENT(OUT) :: PTKET              ! variables
29 REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PRT,PSVT,PATC      !   at t
30 REAL, DIMENSION(:,:,:),   INTENT(OUT) :: PTHVT,PHUT         !
31 !
32 REAL, DIMENSION(:,:,:),   INTENT(OUT) :: PSRCT,PSIGS  ! secondary
33                                                             ! prognostic variables
34            ! Larger Scale fields for relaxation and diffusion
35 REAL, DIMENSION(:,:,:),          INTENT(OUT) :: PLSUM, PLSVM, PLSWM 
36 REAL, DIMENSION(:,:,:),          INTENT(OUT) :: PLSTHM,  PLSRVM     
37 REAL, DIMENSION(:,:,:,:),        INTENT(OUT) :: PDTHFRC,PDRVFRC
38 REAL, DIMENSION(:,:,:,:),        INTENT(OUT) :: PTHREL,PRVREL
39 REAL, DIMENSION(:,:,:),          INTENT(OUT) :: PVU_FLUX_M,PVTH_FLUX_M,PWTH_FLUX_M
40 !
41            ! Arguments for spawning with 2 input files (father+son1)
42 CHARACTER (LEN=*), OPTIONAL, INTENT(IN) :: HSONFILE  ! name of the input FM-file SON
43 INTEGER,           OPTIONAL, INTENT(IN) :: KIUSON  ! upper dimensions of the
44 INTEGER,           OPTIONAL, INTENT(IN) :: KJUSON  !input FM-file SON
45 INTEGER,           OPTIONAL, INTENT(IN) :: KIB2,KJB2 ! indexes for common
46 INTEGER,           OPTIONAL, INTENT(IN) :: KIE2,KJE2 !domain in model2
47 INTEGER,           OPTIONAL, INTENT(IN) :: KIB1,KJB1 !and in
48 INTEGER,           OPTIONAL, INTENT(IN) :: KIE1,KJE1 !SON
49 END SUBROUTINE SPAWN_FIELD2
50 !
51 END INTERFACE
52 !
53 END MODULE MODI_SPAWN_FIELD2
54 !     ######spl
55       SUBROUTINE SPAWN_FIELD2(KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,HTURB,   &
56                PUT,PVT,PWT,PTHVT,PRT,PHUT,PTKET,PSVT,PATC,                     &
57                PSRCT,PSIGS,                                                    &
58                PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM,                                &
59                PDTHFRC,PDRVFRC,PTHREL,PRVREL,                                  &
60                PVU_FLUX_M,PVTH_FLUX_M,PWTH_FLUX_M,                             &
61                HSONFILE,KIUSON,KJUSON,                                         &
62                KIB2,KJB2,KIE2,KJE2,                                            &
63                KIB1,KJB1,KIE1,KJE1                                             )
64 !     ##########################################################################
65 !
66 !!****  *SPAWN_FIELD2 * - subroutine generating the model 2 prognostic and LS
67 !!                      fields, consistently with the spawning model 1.
68 !!
69 !!    PURPOSE
70 !!    -------
71 !!
72 !!      The prognostic and LS fields are interpolated from the model 1, to 
73 !!    initialize the model 2.
74 !!
75 !!**  METHOD
76 !!    ------
77 !!
78 !!      The model 2 variables are transmitted by argument (P or K prefixes),
79 !!    while the ones of model 1 are declared through calls to MODD_... 
80 !!    (X or N prefixes)
81 !!
82 !!      For the case where the resolution ratio between models is 1, 
83 !!    the horizontal interpolation becomes a simple equality.
84 !!      For the general case where resolution ratio is not egal to one,
85 !!    fields are interpolated using 2 types of interpolations:
86 !!                 1. Clark and Farley (JAS 1984) on 9 points 
87 !!                 2. Bikhardt on 16 points
88 !!
89 !!    EXTERNAL
90 !!    --------
91 !!      
92 !!      Routine BIKHARDT      : to perform horizontal interpolations
93 !!      Routine CLARK_FARLEY  : to perform horizontal interpolations
94 !!
95 !! 
96 !!    IMPLICIT ARGUMENTS
97 !!    ------------------ 
98 !!      Module MODD_PARAMETERS : contains parameters 
99 !!      Module MODD_CONF       : contains NVERB
100 !!      Module MODD_CONF1      : contains CONF_MODEL(1)%NRR (total Number of moist variables)
101 !!      Module MODD_FIELD1     : contains pronostic variables of model 1
102 !!      Module MODD_LSFIELD1   : contains LB and LS variables of model 1
103 !!      Module MODD_REF1       : contains RHODJ of model 1
104 !!      Module MODD_GRID1      : contains grid variables
105 !!
106 !!    REFERENCE
107 !!    ---------
108 !!
109 !!       Book1 of the documentation
110 !!       SUBROUTINE SPAWN_FIELD2 (Book2 of the documentation)
111 !!      
112 !!
113 !!    AUTHOR
114 !!    ------
115 !!
116 !!       J.P. Lafore     * METEO-FRANCE *
117 !!
118 !!    MODIFICATIONS
119 !!    -------------
120 !!
121 !!      Original    12/01/95
122 !!      Modification 20/03/95 (I.Mallet) change Large Scale fields initialization 
123 !!      Modification 27/04/95 (    "   ) remove R from the historical variables 
124 !!      Modification 17/04/96  (Lafore) Different resolution ratio case introduction
125 !!      Modification 10/06/96 (V.Masson) remove the loops in case of no resolution change
126 !!                                       and bug in initialization of ZBFY
127 !!      Modification 10/06/96 (V.Masson) interpolation computations performed in
128 !!                                       independant routines
129 !!                   10/10/96 (J. Stein) add SRCM and SRCT
130 !!      Modification 21/11/96 (Lafore)   move from BIKHARDT2 to BIKHARDT routine
131 !!      Modification 21/11/96 (Lafore)   "surfacic" LS fields
132 !!      Modification 10/07/97 (Masson)   remove pressure interpolations
133 !!      Modification 17/07/97 (Masson)   add EPS and tests on other variables
134 !!      Modification 14/09/97 (Masson)   interpolation of relative humidity
135 !!      Modification 14/09/97 (J. Stein) add the LB and LS fields
136 !!      Modification 27/07/98 (P. Jabouille) compute HU for all the cases
137 !!      Modification 01/02/01 (D.Gazen)  add module MODD_NSV for NSV variable
138 !!      Modification 07/07/05 (D.Barbary) spawn with 2 input files (father+son1)
139 !!      Modification 05/06                Remove EPS, Clark and Farley
140 !!      Modification 06/12  (M.Tomasini)  Interpolation of turbulent fluxes (EDDY_FLUX)
141 !!                                        for 2D west african monsoon
142 !!      Modification 07/13  (Bosseur & Filippi) Adds Forefire
143 !!      Modification 2014 (M.Faivre)
144 !!      Modification 01/15  (C. Barthe)   add LNOx
145 !!      Modification 25/02/2015 (M.Moge) correction of the parallelization attempted by M.Faivre
146 !!      Modification 15/04/2016 (P.Tulet) bug allocation ZSVT_C
147 !!                   29/04/2016 (J.Escobar) bug in use of ZSVT_C in SET_LSFIELD_1WAY_ll        
148 !-------------------------------------------------------------------------------
149 !
150 !*       0.     DECLARATIONS
151 !               ------------
152 !
153 USE MODD_PARAMETERS       ! Declarative modules 
154 USE MODD_CONF
155 USE MODD_CST
156 !
157 USE MODD_GRID_n,   ONLY:  GRID_MODEL 
158 USE MODD_CONF_n,   ONLY:  CONF_MODEL
159 USE MODD_LBC_n,    ONLY:  LBC_MODEL
160 USE MODD_LUNIT_n,  ONLY:  LUNIT_MODEL
161 USE MODD_FIELD_n,  ONLY:  FIELD_MODEL
162 USE MODD_LSFIELD_n,ONLY:  LSFIELD_MODEL
163 USE MODD_REF_n,    ONLY:  REF_MODEL
164 !
165 USE MODD_NSV
166 USE MODD_RAIN_C2R2_DESCR, ONLY: C2R2NAMES
167 USE MODD_CH_M9_n,         ONLY: CNAMES, CICNAMES
168 USE MODD_DUST,            ONLY: CDUSTNAMES
169 USE MODD_SALT,            ONLY: CSALTNAMES
170 USE MODD_CH_AEROSOL,      ONLY: CAERONAMES
171 USE MODD_LG,              ONLY: CLGNAMES
172 USE MODD_ELEC_DESCR,      ONLY: CELECNAMES
173 !
174 USE MODD_BIKHARDT_n
175 USE MODD_LUNIT_n
176 !
177 USE MODI_BIKHARDT
178 !
179 USE MODE_FMREAD
180 USE MODE_THERMO
181 USE MODE_MODELN_HANDLER
182 USE MODE_IO_ll, ONLY: UPCASE
183 !
184 USE MODD_ADVFRC_n 
185 USE MODD_RELFRC_n 
186 USE MODD_2D_FRC
187 !
188 USE MODD_LATZ_EDFLX
189 USE MODD_DEF_EDDY_FLUX_n           
190 USE MODD_DEF_EDDYUV_FLUX_n
191 !
192 USE MODE_MPPDB
193 USE MODE_ll
194 !
195 IMPLICIT NONE
196 !
197 !*       0.1   Declarations of dummy arguments :
198 !
199 !
200 INTEGER,   INTENT(IN)  :: KXOR,KXEND !  horizontal position (i,j) of the ORigin and END  
201 INTEGER,   INTENT(IN)  :: KYOR,KYEND ! of the model 2 domain, relative to model 1
202 INTEGER,   INTENT(IN)  :: KDXRATIO   !  x and y-direction Resolution ratio
203 INTEGER,   INTENT(IN)  :: KDYRATIO   ! between model 2 and model 1
204 CHARACTER (LEN=4), INTENT(IN) :: HTURB !  Kind of turbulence parameterization
205 !
206 REAL, DIMENSION(:,:,:),   INTENT(OUT) :: PUT,PVT,PWT        !  model 2
207 REAL, DIMENSION(:,:,:),   INTENT(OUT) :: PTKET              ! variables
208 REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PRT,PSVT,PATC      !   at t
209 REAL, DIMENSION(:,:,:),   INTENT(OUT) :: PTHVT,PHUT         !
210 !
211 REAL, DIMENSION(:,:,:),   INTENT(OUT) :: PSRCT,PSIGS  ! secondary
212                                                             ! prognostic variables
213            ! Larger Scale fields for relaxation and diffusion
214 REAL, DIMENSION(:,:,:),          INTENT(OUT) :: PLSUM, PLSVM, PLSWM 
215 REAL, DIMENSION(:,:,:),          INTENT(OUT) :: PLSTHM,  PLSRVM 
216 REAL, DIMENSION(:,:,:,:),        INTENT(OUT) :: PDTHFRC,PDRVFRC
217 REAL, DIMENSION(:,:,:,:),        INTENT(OUT) :: PTHREL,PRVREL
218 REAL, DIMENSION(:,:,:),          INTENT(OUT) :: PVU_FLUX_M,PVTH_FLUX_M,PWTH_FLUX_M
219            ! Arguments for spawning with 2 input files (father+son1)
220 CHARACTER (LEN=*), OPTIONAL, INTENT(IN) :: HSONFILE  ! name of the input FM-file SON
221 INTEGER,           OPTIONAL, INTENT(IN) :: KIUSON  ! upper dimensions of the
222 INTEGER,           OPTIONAL, INTENT(IN) :: KJUSON  !input FM-file SON
223 INTEGER,           OPTIONAL, INTENT(IN) :: KIB2,KJB2 ! indexes for common
224 INTEGER,           OPTIONAL, INTENT(IN) :: KIE2,KJE2 !domain in model2
225 INTEGER,           OPTIONAL, INTENT(IN) :: KIB1,KJB1 !and in
226 INTEGER,           OPTIONAL, INTENT(IN) :: KIE1,KJE1 !SON
227 !
228 !*       0.2    Declarations of local variables 
229 !
230 INTEGER             :: ILUOUT    ! Logical unit number for the output listing 
231 INTEGER             :: IRESP     ! Return codes in FM routines
232 INTEGER             :: JRR,JSV   ! Loop index for moist and scalar variables 
233 INTEGER             :: IRR       ! Number of moist variables 
234 !
235 REAL, DIMENSION(SIZE(FIELD_MODEL(1)%XRT,1),SIZE(FIELD_MODEL(1)%XRT,2),SIZE(FIELD_MODEL(1)%XRT,3)) :: ZHUT ! relative humidity
236                                                              ! (model 1)
237 REAL, DIMENSION(SIZE(FIELD_MODEL(1)%XTHT,1),SIZE(FIELD_MODEL(1)%XTHT,2),SIZE(FIELD_MODEL(1)%XTHT,3)) :: ZTHVT! virtual pot. T
238                                                                 ! (model 1)          
239 !$20140708
240 !$***** 3D
241 REAL, DIMENSION(:,:,:), ALLOCATABLE   :: ZUT_C, ZLSUM_C 
242 REAL, DIMENSION(:,:,:), ALLOCATABLE   :: ZVT_C, ZLSVM_C
243 REAL, DIMENSION(:,:,:), ALLOCATABLE   :: ZWT_C
244 REAL, DIMENSION(:,:,:), ALLOCATABLE   :: ZTHVT_C
245 REAL, DIMENSION(:,:,:), ALLOCATABLE   :: ZLSWM_C
246 REAL, DIMENSION(:,:,:), ALLOCATABLE   :: ZLSTHM_C
247 REAL, DIMENSION(:,:,:), ALLOCATABLE   :: ZLSRVM_C
248 REAL, DIMENSION(:,:,:), ALLOCATABLE   :: ZTKET_C
249 REAL, DIMENSION(:,:,:), ALLOCATABLE   :: ZHUT_C, ZSRCM_C, ZSRCT_C, ZSIGS_C
250 REAL, DIMENSION(:,:,:), ALLOCATABLE   :: ZVU_FLUX_M_C, ZVTH_FLUX_M_C, ZWTH_FLUX_M_C
251 !$***** 4D
252 REAL, DIMENSION(:,:,:,:), ALLOCATABLE   :: ZSVT_C
253 REAL, DIMENSION(:,:,:,:), ALLOCATABLE   :: ZRT_C, ZDTHFRC_C, ZDRVFRC_C
254 REAL, DIMENSION(:,:,:,:), ALLOCATABLE   :: ZTHREL_C, ZRVREL_C
255 !$                    
256 INTEGER  :: IMI, JI,KI
257 !$20140708
258 INTEGER  :: IDIMX_C, IDIMY_C
259 INTEGER  :: IINFO_ll
260 !$
261 ! Arrays for reading fields of input SON 1 file
262 REAL, DIMENSION(:,:,:), ALLOCATABLE   :: ZWORK3D
263 REAL, DIMENSION(:,:,:), ALLOCATABLE   :: ZTHT1,ZTHVT1
264 REAL, DIMENSION(:,:,:), ALLOCATABLE   :: ZPABST1,ZHUT1
265 REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZRT1
266 LOGICAL :: GUSERV
267 !
268 INTEGER             :: IGRID,ILENCH   !   File
269 CHARACTER (LEN=16)  :: YRECFM         ! management
270 CHARACTER (LEN=100) :: YCOMMENT       ! variables
271 CHARACTER (LEN=2)   :: YDIR
272 !
273 !-------------------------------------------------------------------------------
274 !
275 !*       1.    PROLOGUE:
276 !              ---------
277 !
278 IMI = GET_CURRENT_MODEL_INDEX()
279 CALL GOTO_MODEL(2)
280 CALL GO_TOMODEL_ll(2, IINFO_ll)
281 !
282 !*       1.0  recovers logical unit number of output listing
283 !
284 CALL FMLOOK_ll(CLUOUT,CLUOUT,ILUOUT,IRESP)
285 !
286 !*       1.1   Secondary variables
287 !
288 CALL COMPUTE_THV_HU(CONF_MODEL(1)%LUSERV,FIELD_MODEL(1)%XRT,FIELD_MODEL(1)%XTHT,FIELD_MODEL(1)%XPABST,ZTHVT,ZHUT)
289 !
290 !*       1.2   Working arrays for reading in SON input file
291 !
292 IF (PRESENT(HSONFILE)) THEN
293   ALLOCATE(ZWORK3D(KIUSON,KJUSON,SIZE(PUT,3)))
294   ALLOCATE(ZPABST1(KIE1-KIB1+1,KJE1-KJB1+1,SIZE(PUT,3)))
295   ALLOCATE(ZTHT1(KIE1-KIB1+1,KJE1-KJB1+1,SIZE(PUT,3)))
296   ALLOCATE(ZTHVT1(KIE1-KIB1+1,KJE1-KJB1+1,SIZE(PUT,3)))
297   IF (CONF_MODEL(1)%NRR /= 0) THEN
298     ALLOCATE(ZHUT1(KIE1-KIB1+1,KJE1-KJB1+1,SIZE(PUT,3)))
299     ALLOCATE(ZRT1(KIE1-KIB1+1,KJE1-KJB1+1, SIZE(PUT,3),SIZE(PRT,4)))
300   END IF
301 END IF
302
303 !-------------------------------------------------------------------------------
304 !
305 !*       2.    INITIALIZATION OF PROGNOSTIC AND LS VARIABLES OF MODEL 2:
306 !              ---------------------------------------------------------
307
308 !
309 IF (KDXRATIO == 1 .AND. KDYRATIO == 1 ) THEN
310 !
311 !*       2.1   special case of spawning - no change of resolution :
312 !
313 !*       2.1.1  variables which always exist
314 !
315   PUT  (:,:,:)   =  FIELD_MODEL(1)%XUT  (KXOR:KXEND,KYOR:KYEND,:)
316   PVT  (:,:,:)   =  FIELD_MODEL(1)%XVT  (KXOR:KXEND,KYOR:KYEND,:)
317   PWT  (:,:,:)   =  FIELD_MODEL(1)%XWT  (KXOR:KXEND,KYOR:KYEND,:)
318   PTHVT(:,:,:)   =  ZTHVT(KXOR:KXEND,KYOR:KYEND,:)
319 !
320   PLSUM (:,:,:)  =  FIELD_MODEL(1)%XUT (KXOR:KXEND,KYOR:KYEND,:)
321   PLSVM (:,:,:)  =  FIELD_MODEL(1)%XVT (KXOR:KXEND,KYOR:KYEND,:)
322   PLSWM (:,:,:)  =  FIELD_MODEL(1)%XWT (KXOR:KXEND,KYOR:KYEND,:)
323   PLSTHM(:,:,:)  =  FIELD_MODEL(1)%XTHT(KXOR:KXEND,KYOR:KYEND,:)
324 !
325   PLSRVM(:,:,:)  = 0.
326 !
327 !$20140707
328 CALL MPPDB_CHECK3D(PUT,"SPAWN_FIELD2:PUT",PRECISION)
329 CALL MPPDB_CHECK3D(PVT,"SPAWN_FIELD2:PVT",PRECISION)
330 !$
331 !*       2.1.2  TKE variable
332 !
333   IF (HTURB /= 'NONE') THEN
334     PTKET(:,:,:)   =  FIELD_MODEL(1)%XTKET(KXOR:KXEND,KYOR:KYEND,:)
335   ENDIF
336 !
337 !*       2.1.3  moist variables
338 !
339   IF (CONF_MODEL(1)%NRR /= 0) THEN
340     PRT  (:,:,:,:) =  FIELD_MODEL(1)%XRT  (KXOR:KXEND,KYOR:KYEND,:,:)
341     PLSRVM(:,:,:)  =  FIELD_MODEL(1)%XRT  (KXOR:KXEND,KYOR:KYEND,:,1)
342     PHUT (:,:,:)   =  ZHUT (KXOR:KXEND,KYOR:KYEND,:)
343   ENDIF
344 !
345 !*       2.1.4  scalar variables
346 !
347   IF (NSV /= 0) THEN
348     PSVT (:,:,:,:) =  FIELD_MODEL(1)%XSVT (KXOR:KXEND,KYOR:KYEND,:,:)
349   ENDIF
350 !
351 !*       2.1.5  secondary prognostic variables
352 !
353   IF (CONF_MODEL(1)%NRR > 1) THEN
354     PSRCT (:,:,:) =  FIELD_MODEL(1)%XSRCT (KXOR:KXEND,KYOR:KYEND,:)
355     PSIGS(:,:,:) =  FIELD_MODEL(1)%XSIGS(KXOR:KXEND,KYOR:KYEND,:)
356   ENDIF
357 !
358 !*       2.1.6  Large scale variables
359 !
360   PLSUM  (:,:,:)   =  LSFIELD_MODEL(1)%XLSUM  (KXOR:KXEND,KYOR:KYEND,:)
361   PLSVM  (:,:,:)   =  LSFIELD_MODEL(1)%XLSVM  (KXOR:KXEND,KYOR:KYEND,:)
362   PLSWM  (:,:,:)   =  LSFIELD_MODEL(1)%XLSWM  (KXOR:KXEND,KYOR:KYEND,:)
363   PLSTHM(:,:,:)    =  LSFIELD_MODEL(1)%XLSTHM (KXOR:KXEND,KYOR:KYEND,:)
364   IF ( CONF_MODEL(1)%NRR > 0 ) THEN
365     PLSRVM  (:,:,:)   =  LSFIELD_MODEL(1)%XLSRVM  (KXOR:KXEND,KYOR:KYEND,:) 
366   END IF
367 !
368 !*       2.1.7  Advective forcing fields for 2D (Modif MT)
369 !
370   IF (L2D_ADV_FRC) THEN
371     PDTHFRC(:,:,:,:)= ADVFRC_MODEL(1)%XDTHFRC (KXOR:KXEND,KYOR:KYEND,:,:)
372     PDRVFRC(:,:,:,:)= ADVFRC_MODEL(1)%XDRVFRC (KXOR:KXEND,KYOR:KYEND,:,:)
373   ENDIF
374   IF (L2D_REL_FRC) THEN
375     PTHREL(:,:,:,:)= RELFRC_MODEL(1)%XTHREL (KXOR:KXEND,KYOR:KYEND,:,:)
376     PRVREL(:,:,:,:)= RELFRC_MODEL(1)%XRVREL (KXOR:KXEND,KYOR:KYEND,:,:)
377   ENDIF
378 !
379 !*       2.1.8  Turbulent fluxes for 2D (Modif MT)                                    
380 !
381   IF (LUV_FLX) THEN
382     PVU_FLUX_M(:,:,:)= EDDYUV_FLUX_MODEL(1)%XVU_FLUX_M (KXOR:KXEND,KYOR:KYEND,:)
383   END IF
384 !
385   IF (LTH_FLX) THEN
386     PVTH_FLUX_M(:,:,:)= EDDY_FLUX_MODEL(1)%XVTH_FLUX_M (KXOR:KXEND,KYOR:KYEND,:)
387     PWTH_FLUX_M(:,:,:)= EDDY_FLUX_MODEL(1)%XWTH_FLUX_M (KXOR:KXEND,KYOR:KYEND,:)
388   END IF
389 !
390 !-------------------------------------------------------------------------------
391 !
392 ELSE
393 !
394 !-------------------------------------------------------------------------------
395 !
396 !*       2.2  general case - change of resolution :
397 !             -----------------------------------
398 !
399 !$20140708 get XDIM, YDIM = G2^G1@resol1
400   CALL GOTO_MODEL(1)
401   CALL GO_TOMODEL_ll(1, IINFO_ll)
402   CALL GET_CHILD_DIM_ll(2, IDIMX_C, IDIMY_C, IINFO_ll)
403 !
404 !$20140708 use  ZTHVM_C in BIKAT top cal PTHVM_C
405   !$**** 3D
406   ALLOCATE(ZUT_C(IDIMX_C,IDIMY_C,SIZE(PUT,3)))
407   ALLOCATE(ZLSUM_C(IDIMX_C,IDIMY_C,SIZE(PUT,3)))
408   ALLOCATE(ZVT_C(IDIMX_C,IDIMY_C,SIZE(PVT,3)))
409   ALLOCATE(ZLSVM_C(IDIMX_C,IDIMY_C,SIZE(PVT,3)))
410   ALLOCATE(ZWT_C(IDIMX_C,IDIMY_C,SIZE(PVT,3)))
411   ALLOCATE(ZLSWM_C(IDIMX_C,IDIMY_C,SIZE(PVT,3)))
412   ALLOCATE(ZLSTHM_C(IDIMX_C,IDIMY_C,SIZE(PVT,3)))
413   ALLOCATE(ZLSRVM_C(IDIMX_C,IDIMY_C,SIZE(PVT,3)))
414   !$20140709
415   ALLOCATE(ZHUT_C(IDIMX_C,IDIMY_C,SIZE(PVT,3)))
416   ALLOCATE(ZTKET_C(IDIMX_C,IDIMY_C,SIZE(PVT,3)))
417   ALLOCATE(ZSRCT_C(IDIMX_C,IDIMY_C,SIZE(PVT,3)))
418   ALLOCATE(ZSIGS_C(IDIMX_C,IDIMY_C,SIZE(PVT,3)))
419   ALLOCATE(ZTHVT_C(IDIMX_C,IDIMY_C,SIZE(PUT,3)))
420   ALLOCATE(ZVU_FLUX_M_C(IDIMX_C,IDIMY_C,SIZE(PVT,3)))
421   ALLOCATE(ZVTH_FLUX_M_C(IDIMX_C,IDIMY_C,SIZE(PVT,3)))
422   ALLOCATE(ZWTH_FLUX_M_C(IDIMX_C,IDIMY_C,SIZE(PVT,3)))
423   !$***** 4D
424   ALLOCATE(ZRT_C(IDIMX_C,IDIMY_C,SIZE(PUT,3),SIZE(PRT,4)))
425   ALLOCATE(ZSVT_C(IDIMX_C,IDIMY_C,SIZE(PUT,3),NSV))
426   ALLOCATE(ZDRVFRC_C(IDIMX_C,IDIMY_C,SIZE(PUT,3),SIZE(PRT,4)))
427   ALLOCATE(ZDTHFRC_C(IDIMX_C,IDIMY_C,SIZE(PUT,3),SIZE(PRT,4)))
428   ALLOCATE(ZRVREL_C(IDIMX_C,IDIMY_C,SIZE(PUT,3),SIZE(PRT,4)))
429   ALLOCATE(ZTHREL_C(IDIMX_C,IDIMY_C,SIZE(PUT,3),SIZE(PRT,4)))
430   !$initialize
431   !$***** 3D
432   ZUT_C   =0.
433   ZLSUM_C =0.
434   ZVT_C   =0.
435   ZWT_C   =0.
436   ZTHVT_C =0.
437   ZHUT_C  =0.
438   ZTKET_C =0.
439   ZSRCT_C =0.
440   ZSIGS_C =0.
441   ZVU_FLUX_M_C=0.
442   ZVTH_FLUX_M_C=0.
443   ZWTH_FLUX_M_C=0.
444   !$***** 4D
445   ZRT_C   =0.
446   ZSVT_C  =0.
447   ZDRVFRC_C=0.
448   ZDTHFRC_C=0.
449   ZRVREL_C=0.
450   ZTHREL_C=00
451 !
452   !$***** 3D VARS
453   DO JI=1,SIZE(PUT,3)
454     CALL GOTO_MODEL(1)
455     CALL GO_TOMODEL_ll(1, IINFO_ll)
456     !
457     !$series of SET_LSFIELD_1WAY_ll
458     !$***** 3D VARS
459     CALL SET_LSFIELD_1WAY_ll(FIELD_MODEL(1)%XUT(:,:,JI),ZUT_C(:,:,JI),2)
460     CALL SET_LSFIELD_1WAY_ll(LSFIELD_MODEL(1)%XLSUM(:,:,JI), ZLSUM_C(:,:,JI),2)
461     !
462     CALL SET_LSFIELD_1WAY_ll(FIELD_MODEL(1)%XVT(:,:,JI),ZVT_C(:,:,JI),2)
463     CALL SET_LSFIELD_1WAY_ll(LSFIELD_MODEL(1)%XLSVM(:,:,JI),ZLSVM_C(:,:,JI),2)
464     !
465     CALL SET_LSFIELD_1WAY_ll(FIELD_MODEL(1)%XWT(:,:,JI),ZWT_C(:,:,JI),2)
466     CALL SET_LSFIELD_1WAY_ll(LSFIELD_MODEL(1)%XLSWM(:,:,JI),ZLSWM_C(:,:,JI),2)
467     !
468     CALL SET_LSFIELD_1WAY_ll(ZTHVT(:,:,JI), ZTHVT_C(:,:,JI),2)
469     CALL SET_LSFIELD_1WAY_ll(LSFIELD_MODEL(1)%XLSTHM(:,:,JI),ZLSTHM_C(:,:,JI),2)
470     !$conditionnal VARS
471     IF (HTURB /= 'NONE') THEN
472       CALL SET_LSFIELD_1WAY_ll(FIELD_MODEL(1)%XTKET(:,:,JI), ZTKET_C(:,:,JI),2)
473     ENDIF
474     IF (CONF_MODEL(1)%NRR>=1) THEN
475       CALL SET_LSFIELD_1WAY_ll(LSFIELD_MODEL(1)%XLSRVM(:,:,JI), ZLSRVM_C(:,:,JI),2)
476       CALL SET_LSFIELD_1WAY_ll(ZHUT(:,:,JI),ZHUT_C(:,:,JI),2)
477     ENDIF
478     IF (CONF_MODEL(1)%NRR>1 .AND. HTURB /='NONE') THEN
479       CALL SET_LSFIELD_1WAY_ll(FIELD_MODEL(1)%XSRCT(:,:,JI),ZSRCT_C(:,:,JI),2)
480       CALL SET_LSFIELD_1WAY_ll(FIELD_MODEL(1)%XSIGS(:,:,JI),ZSIGS_C(:,:,JI),2)
481     ENDIF
482     IF (LUV_FLX)                                    &
483       CALL SET_LSFIELD_1WAY_ll(EDDYUV_FLUX_MODEL(1)%XVU_FLUX_M(:,:,JI),ZVU_FLUX_M_C(:,:,JI),2)
484     IF (LTH_FLX) THEN
485       CALL SET_LSFIELD_1WAY_ll(EDDY_FLUX_MODEL(1)%XVTH_FLUX_M(:,:,JI),ZVTH_FLUX_M_C(:,:,JI),2)
486       CALL SET_LSFIELD_1WAY_ll(EDDY_FLUX_MODEL(1)%XWTH_FLUX_M(:,:,JI),ZWTH_FLUX_M_C(:,:,JI),2) 
487     ENDIF
488     !
489     CALL LS_FORCING_ll(2, IINFO_ll, .TRUE.)
490     CALL GO_TOMODEL_ll(2, IINFO_ll)
491     CALL GOTO_MODEL(2)
492     CALL UNSET_LSFIELD_1WAY_ll()
493 !
494   ENDDO
495 !if the child grid is the whole father grid, we first need to extrapolate
496 !the data on a "pseudo halo" before doing BIKHARDT interpolation
497 ! -------> done in LS_FORCING_ll
498   !$***** 4D VARS
499   DO JI=1,SIZE(PUT,3)
500     DO KI=1,SIZE(PRT,4)
501       CALL GOTO_MODEL(1)
502       CALL GO_TOMODEL_ll(1, IINFO_ll)
503       IF (CONF_MODEL(1)%NRR>=1) THEN
504         CALL SET_LSFIELD_1WAY_ll(FIELD_MODEL(1)%XRT(:,:,JI,KI),ZRT_C(:,:,JI,KI),2)
505       ENDIF
506       IF ( L2D_ADV_FRC ) THEN
507         CALL SET_LSFIELD_1WAY_ll(ADVFRC_MODEL(1)%XDTHFRC(:,:,JI,KI),ZDTHFRC_C(:,:,JI,KI),2)
508         CALL SET_LSFIELD_1WAY_ll(ADVFRC_MODEL(1)%XDRVFRC(:,:,JI,KI),ZDRVFRC_C(:,:,JI,KI),2)
509       ENDIF
510       IF (L2D_REL_FRC) THEN
511         CALL SET_LSFIELD_1WAY_ll(RELFRC_MODEL(1)%XTHREL(:,:,JI,KI),ZTHREL_C(:,:,JI,KI),2)
512         CALL SET_LSFIELD_1WAY_ll(RELFRC_MODEL(1)%XRVREL(:,:,JI,KI),ZRVREL_C(:,:,JI,KI),2)
513       ENDIF
514       !
515       CALL LS_FORCING_ll(2, IINFO_ll, .TRUE.)
516       CALL GO_TOMODEL_ll(2, IINFO_ll)
517       CALL GOTO_MODEL(2)
518       CALL UNSET_LSFIELD_1WAY_ll()
519 !
520     ENDDO
521   ENDDO
522   !$***** 4D NSV 
523   IF (NSV>=1) THEN
524      DO JI=1,SIZE(PUT,3)
525         DO KI=1,NSV
526            CALL GOTO_MODEL(1)
527            CALL GO_TOMODEL_ll(1, IINFO_ll)           
528            CALL SET_LSFIELD_1WAY_ll(FIELD_MODEL(1)%XSVT(:,:,JI,KI),ZSVT_C(:,:,JI,KI),2)           
529            CALL LS_FORCING_ll(2, IINFO_ll, .TRUE.)
530            CALL GO_TOMODEL_ll(2, IINFO_ll)
531            CALL GOTO_MODEL(2)
532            CALL UNSET_LSFIELD_1WAY_ll()
533            !
534         ENDDO
535      ENDDO
536   ENDIF
537
538 !if the child grid is the whole father grid, we first need to extrapolate
539 !the data on a "pseudo halo" before doing BIKHARDT interpolation
540 ! -------> done in LS_FORCING_ll
541 !
542 !                        Interpolation of the U variable at t
543 !
544     CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
545                    XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
546                    2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,2,     &
547                    LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZUT_C,PUT)
548     CALL MPPDB_CHECK3D(PUT,"SPAWN_FIELD2:PUT",PRECISION)
549 !
550     CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
551                    XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
552                    2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,2,     &
553                    LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZLSUM_C,PLSUM)
554     CALL MPPDB_CHECK3D(PLSUM,"SPAWN_FIELD2:PLSUM",PRECISION)
555 !
556 !                        Interpolation of the V variable at t
557 !
558     CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
559                    XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
560                    2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,3,     &
561                    LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZVT_C,PVT)
562     CALL MPPDB_CHECK3D(PVT,"SPAWN_FIELD2:PVT",PRECISION)
563 !
564     CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
565                    XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
566                    2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,3,     &
567                    LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZLSVM_C,PLSVM)
568     CALL MPPDB_CHECK3D(PLSVM,"SPAWN_FIELD2:PLSVM",PRECISION)
569 !
570 !                        Interpolation of variables at t
571 !
572     CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
573                    XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
574                    2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,4,     &
575                    LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZWT_C,PWT)
576     CALL MPPDB_CHECK3D(PWT,"SPAWN_FIELD2:PWT",PRECISION)
577 !
578     CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
579                    XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
580                    2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,4,     &
581                    LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZLSWM_C,PLSWM)
582     CALL MPPDB_CHECK3D(PLSWM,"SPAWN_FIELD2:PLSWM",PRECISION)
583 !
584     CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
585                    XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
586                    2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1,     &
587                    LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZLSTHM_C,PLSTHM)
588     CALL MPPDB_CHECK3D(PLSTHM,"SPAWN_FIELD2:PLSTHM",PRECISION)
589 !
590 !
591     IF (CONF_MODEL(1)%NRR>=1) THEN
592       CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
593                      XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
594                      2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1,     &
595                      LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZLSRVM_C,PLSRVM)
596       CALL MPPDB_CHECK3D(PLSRVM,"SPAWN_FIELD2:PLSRVM",PRECISION)               
597     ENDIF
598 !
599     CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
600                    XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
601                    2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1,     &
602                    LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZTHVT_C,PTHVT)
603     CALL MPPDB_CHECK3D(PTHVT,"SPAWN_FIELD2:PTHVT",PRECISION)
604 !
605     IF (HTURB /= 'NONE') THEN
606       CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
607                      XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
608                      2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1,     &
609                      LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZTKET_C,PTKET)
610       CALL MPPDB_CHECK3D(PTKET,"SPAWN_FIELD2:PTKET",PRECISION)
611     ENDIF
612 !
613     IF (CONF_MODEL(1)%NRR>=1) THEN
614       CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
615                      XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
616                      2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1,     &
617                      LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZHUT_C,PHUT)
618       CALL MPPDB_CHECK3D(PHUT,"SPAWN_FIELD2:PHUT",PRECISION)
619     ENDIF
620 !
621     IF (CONF_MODEL(1)%NRR>=1) THEN
622       CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
623                      XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
624                      2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1,     &
625                      LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZRT_C,PRT)
626       CALL MPPDB_CHECK3D(PRT(:,:,:,1),"SPAWN_FIELD2:PRT",PRECISION)
627     ENDIF
628 !
629     IF (NSV>=1) THEN
630       CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
631                      XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
632                      2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1,     &
633                      LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZSVT_C,PSVT)
634       CALL MPPDB_CHECK3D(PSVT(:,:,:,1),"SPAWN_FIELD2:PSVT",PRECISION)
635     ENDIF
636 !
637     IF (CONF_MODEL(1)%NRR>1 .AND. HTURB /='NONE') THEN
638       CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
639                      XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
640                      2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1,     &
641                      LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZSRCT_C,PSRCT)
642       CALL MPPDB_CHECK3D(PSRCT,"SPAWN_FIELD2:PSRCT",PRECISION)
643     ENDIF
644 !
645     IF (CONF_MODEL(1)%NRR>1 .AND. HTURB /='NONE') THEN
646       CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
647                      XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
648                      2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1,     &
649                      LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZSIGS_C,PSIGS)
650       CALL MPPDB_CHECK3D(PSIGS,"SPAWN_FIELD2:PSIGS",PRECISION)
651     ENDIF
652 !
653     IF ( L2D_ADV_FRC ) THEN      ! MT adding for ADVFRC
654       CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
655                      XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
656                      2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1,     &
657                      LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,           &
658                      ZDTHFRC_C,PDTHFRC)
659 !
660       CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
661                      XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
662                      2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1,     &
663                      LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,           &
664                      ZDRVFRC_C,PDRVFRC)
665     ENDIF
666     IF (L2D_REL_FRC) THEN      ! MT adding for REL FRC
667        WRITE(ILUOUT,FMT=*) 'SPAWN_FIELD2: Appel a BIKHARDT pour RELFRC'
668       CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
669                      XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
670                      2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1,       &
671                      LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,           &
672                      ZTHREL_C,PTHREL)
673 !
674       CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
675                      XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
676                      2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1,       &
677                      LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,           &
678                      ZRVREL_C,PRVREL)
679     ENDIF
680 !
681     IF ( LUV_FLX) THEN      ! MT adding for EDDY_FLUX
682       CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
683                      XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
684                      2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1,       &
685                      LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,           &
686                      ZVU_FLUX_M_C,PVU_FLUX_M)
687       CALL MPPDB_CHECK3D(PVU_FLUX_M,"SPAWN_FIELD2:PVU_FLUX_M",PRECISION)
688     ENDIF
689 !
690     IF (LTH_FLX) THEN
691       CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
692                      XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
693                      2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1,       &
694                      LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,           &
695                      ZVTH_FLUX_M_C,PVTH_FLUX_M)
696       CALL MPPDB_CHECK3D(PVTH_FLUX_M,"SPAWN_FIELD2:PVTH_FLUX_M",PRECISION)
697 !
698       CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
699                      XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
700                      2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,1,       &
701                      LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,           &
702                      ZWTH_FLUX_M_C,PWTH_FLUX_M)
703       CALL MPPDB_CHECK3D(PWTH_FLUX_M,"SPAWN_FIELD2:PWTH_FLUX_M",PRECISION)
704     ENDIF
705 !
706 END IF
707 !
708 IF (CONF_MODEL(1)%NRR>=3) THEN
709   WHERE  (PRT(:,:,:,3)<1.E-20)
710     PRT(:,:,:,3)=0.
711   END WHERE
712 END IF
713 !
714 !
715 !*       2.2.3  Informations from model SON1
716 ! (LS fields are not treated because they are identical in the father file)
717 !
718 IF (PRESENT(HSONFILE)) THEN
719   YDIR='XY'
720   !
721   !variables which always exist
722   !
723   YRECFM='UT'             ! U wind component at time t
724   CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
725   PUT(KIB2:KIE2,KJB2:KJE2,:) = ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
726   YRECFM='VT'             ! V wind component at time t
727   CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
728   PVT(KIB2:KIE2,KJB2:KJE2,:) = ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
729   YRECFM='WT'             ! W wind component at time t
730   CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
731   PWT(KIB2:KIE2,KJB2:KJE2,:) = ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
732   !
733   ! moist variables
734   !
735   IRR=1
736   IF (IRR<=CONF_MODEL(1)%NRR) THEN
737     GUSERV=.TRUE.
738     YRECFM='RVT'             ! Vapor at time t
739     CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
740     IF(IRESP==0) ZRT1(:,:,:,IRR)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
741     IF(IRESP==0) IRR=IRR+1
742   END IF
743   IF (IRR<=CONF_MODEL(1)%NRR) THEN
744     YRECFM='RCT'             ! Cloud at time t
745     CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
746     IF(IRESP==0) ZRT1(:,:,:,IRR)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
747     IF(IRESP==0) IRR=IRR+1
748   END IF
749   IF (IRR<=CONF_MODEL(1)%NRR) THEN
750     YRECFM='RRT'             ! Rain at time t
751     CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
752     IF(IRESP==0) ZRT1(:,:,:,IRR)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
753     IF(IRESP==0) IRR=IRR+1
754   END IF
755   IF (IRR<=CONF_MODEL(1)%NRR) THEN
756     YRECFM='RIT'             ! Ice at time t
757     CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
758     IF(IRESP==0) ZRT1(:,:,:,IRR)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
759     IF(IRESP==0) IRR=IRR+1
760   END IF
761   IF (IRR<=CONF_MODEL(1)%NRR) THEN
762     YRECFM='RST'             ! Snow at time t
763     CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
764     IF(IRESP==0) ZRT1(:,:,:,IRR)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
765     IF(IRESP==0) IRR=IRR+1
766   END IF
767   IF (IRR<=CONF_MODEL(1)%NRR) THEN
768     YRECFM='RGT'             ! Graupel at time t
769     CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
770     IF(IRESP==0) ZRT1(:,:,:,IRR)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
771     IF(IRESP==0) IRR=IRR+1
772   END IF
773   IF (IRR<=CONF_MODEL(1)%NRR) THEN
774     YRECFM='RHT'             ! Hail at time t
775     CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
776     IF(IRESP==0) ZRT1(:,:,:,IRR)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
777     IF(IRESP==0) IRR=IRR+1
778   END IF
779   IRR=IRR-1
780   WRITE(ILUOUT,FMT=*) 'SPAWN_FIELD2: spawing with a SON input file'
781   WRITE(ILUOUT,FMT=*) '    ',CONF_MODEL(1)%NRR,' moist variables in model1 and model2, ',    &
782                              IRR,' moist variables in input SON'
783   YRECFM='THT'               ! Theta at time t
784   CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
785   ZTHT1(:,:,:)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
786   YRECFM='PABST'             ! Pressure at time t
787   CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
788   ZPABST1(:,:,:)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
789   !
790   CALL COMPUTE_THV_HU(GUSERV,ZRT1,ZTHT1,ZPABST1,ZTHVT1,ZHUT1)
791   !
792   PTHVT(KIB2:KIE2,KJB2:KJE2,:) = ZTHVT1(:,:,:)
793   IF (CONF_MODEL(1)%NRR /= 0) THEN
794     PHUT(KIB2:KIE2,KJB2:KJE2,:) = ZHUT1(:,:,:)  
795     PRT(KIB2:KIE2,KJB2:KJE2,:,:) = ZRT1(:,:,:,:)  
796   END IF
797   !
798   ! TKE variables
799   !
800   IF (HTURB/='NONE') THEN
801     YRECFM='TKET'             ! Turbulence Kinetic Energy at time t
802     CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
803     IF(IRESP==0) PTKET(KIB2:KIE2,KJB2:KJE2,:)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
804   END IF
805   !
806   ! Scalar variables
807   !
808   IF (NSV /= 0) THEN
809     DO JSV = 1, NSV_USER      ! Users Scalar Variables
810       WRITE(YRECFM,'(A3,I3.3)')'SVT',JSV
811       CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,  &
812                   YCOMMENT,IRESP)
813       IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
814     END DO
815     DO JSV = NSV_C2R2BEG,NSV_C2R2END  ! C2R2 Scalar Variables
816       YRECFM=TRIM(C2R2NAMES(JSV-NSV_C2R2BEG+1))//'T'
817       CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,  &
818                   YCOMMENT,IRESP)
819       IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
820     END DO
821     DO JSV = NSV_ELECBEG,NSV_ELECEND  ! ELEC Scalar Variables
822       YRECFM=TRIM(CELECNAMES(JSV-NSV_ELECBEG+1))//'T'
823       CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,  &
824                   YCOMMENT,IRESP)
825       IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
826     END DO
827     DO JSV = NSV_CHEMBEG,NSV_CHEMEND ! Chemical Scalar Variables
828       YRECFM=TRIM(CNAMES(JSV-NSV_CHEMBEG+1))//'T'
829       CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,  &
830                   YCOMMENT,IRESP)
831       IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
832     END DO
833     DO JSV = NSV_CHICBEG,NSV_CHICEND ! Ice phase chemical Scalar Variables
834       YRECFM=TRIM(CICNAMES(JSV-NSV_CHICBEG+1))//'T'
835       CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,  &
836                   YCOMMENT,IRESP)
837       IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
838     END DO
839     DO JSV = NSV_AERBEG,NSV_AEREND ! Orilam Scalar Variables
840       YRECFM=TRIM(UPCASE(CAERONAMES(JSV-NSV_AERBEG+1)))//'T'
841       CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,  &
842                   YCOMMENT,IRESP)
843       IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
844     END DO
845     DO JSV = NSV_DSTBEG,NSV_DSTEND ! Dust Scalar Variables
846       YRECFM=TRIM(CDUSTNAMES(JSV-NSV_DSTBEG+1))//'T'
847       CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,  &
848                   YCOMMENT,IRESP)
849       IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
850     END DO
851     DO JSV = NSV_SLTBEG,NSV_SLTEND ! Sea Salt Scalar Variables
852       YRECFM=TRIM(CSALTNAMES(JSV-NSV_SLTBEG+1))//'T'
853       CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,  &
854                   YCOMMENT,IRESP)
855       IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
856     END DO
857     DO JSV = NSV_LGBEG,NSV_LGEND     ! LG Scalar Variables
858       YRECFM=TRIM(CLGNAMES(JSV-NSV_LGBEG+1))//'T'
859       CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,  &
860                   YCOMMENT,IRESP)
861       IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
862     END DO
863     DO JSV = NSV_LNOXBEG,NSV_LNOXEND     ! LNOx Scalar Variables
864       YRECFM='LINOX'
865       CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,  &
866                   YCOMMENT,IRESP)
867       IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
868     END DO
869     DO JSV = NSV_PPBEG,NSV_PPEND     ! Passive scalar variables
870       WRITE(YRECFM,'(A3,I3.3)')'SVT',JSV
871       CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,  &
872                   YCOMMENT,IRESP)
873       IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
874     END DO
875 #ifdef MNH_FOREFIRE
876     DO JSV = NSV_FFBEG,NSV_FFEND     ! ForeFire variables
877       WRITE(YRECFM,'(A3,I3.3)')'SVM',JSV
878       CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,  &
879                   YCOMMENT,IRESP)
880       IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
881       WRITE(YRECFM,'(A3,I3.3)')'SVT',JSV
882       CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,  &
883                   YCOMMENT,IRESP)
884       IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
885     END DO
886 #endif
887     DO JSV = NSV_CSBEG,NSV_CSEND     ! Passive scalar variables
888       WRITE(YRECFM,'(A3,I3.3)')'SVT',JSV
889       CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,  &
890                   YCOMMENT,IRESP)
891       IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
892     END DO
893     DO JSV = 1,NSV_PP               ! Passive scalar variables
894       YRECFM='ATC'
895       CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
896       IF(IRESP==0) PATC(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
897     END DO
898 #ifdef MNH_FOREFIRE
899    DO JSV = 1,NSV_FF               ! ForeFire variables
900       YRECFM='ATC'
901       CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
902       IF(IRESP==0) PATC(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
903     END DO
904 #endif
905   END IF
906   !
907   ! Secondary pronostic variables
908   !
909   IF (HTURB /= 'NONE' .AND. IRR>1) THEN
910     YRECFM='SRCT'                  ! turbulent flux SRC at time t
911     CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
912     IF( IRESP /= 0 ) THEN
913       YRECFM='SRC'
914       CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,          &
915                   YCOMMENT,IRESP)
916     END IF
917     IF(IRESP == 0) PSRCT(KIB2:KIE2,KJB2:KJE2,:) =                    &
918                                         ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
919
920     YRECFM='SIGS'                  ! subgrid condensation
921     CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
922     IF(IRESP == 0) PSIGS(KIB2:KIE2,KJB2:KJE2,:) =                    &
923                                         ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
924   END IF
925 END IF
926 !
927 !*       2.2.4  secondary prognostic variables correction
928 !
929 IF (CONF_MODEL(1)%NRR > 1 .AND. HTURB /= 'NONE')  PSRCT(:,:,:) = MIN( 1.0, MAX( 0.0, PSRCT(:,:,:)) )
930 !
931 IF ( CONF_MODEL(1)%NRR == 0 ) THEN
932   PHUT (:,:,:)= 0.
933 END IF
934 !-------------------------------------------------------------------------------
935 !
936 CALL GOTO_MODEL(IMI)
937 CALL GO_TOMODEL_ll(IMI, IINFO_ll)
938 CONTAINS 
939 !      
940       SUBROUTINE COMPUTE_THV_HU(OUSERV,PR,PTH,PPABS,PTHV,PHU)
941 !
942 IMPLICIT NONE
943 !
944 !*       0.1   Declarations of dummy arguments :
945 !
946 LOGICAL, INTENT(IN)   :: OUSERV
947 REAL, DIMENSION(:,:,:),   INTENT(IN)   :: PTH,PPABS
948 REAL, DIMENSION(:,:,:,:), INTENT(IN)   :: PR
949 REAL, DIMENSION(:,:,:),   INTENT(OUT)  :: PTHV,PHU
950 !
951 !*       0.2    Declarations of local variables 
952 !
953 REAL, DIMENSION(SIZE(PR,1),SIZE(PR,2),SIZE(PR,3)) :: ZSUMR ! sum of water ratios
954 !
955 IF (OUSERV) THEN
956   ZSUMR(:,:,:) = 0.
957   IRR=SIZE(PR,4)
958   DO JRR=1,IRR
959     ZSUMR(:,:,:) = ZSUMR(:,:,:) + PR(:,:,:,JRR)
960   END DO
961   PTHV(:,:,:)=PTH(:,:,:)*(1.+XRV/XRD*PR(:,:,:,1))/(1.+ZSUMR(:,:,:))
962   PHU (:,:,:)=100.*PPABS(:,:,:)/(XRD/XRV/MAX(PR(:,:,:,1),1.E-16)+1.) &
963                /SM_FOES(PTH(:,:,:)*(PPABS(:,:,:)/XP00)**(XRD/XCPD))
964 ELSE
965   PTHV(:,:,:)=PTH(:,:,:)
966   PHU (:,:,:)=0.
967 END IF
968 !
969 !
970 END SUBROUTINE COMPUTE_THV_HU
971 !
972 END SUBROUTINE SPAWN_FIELD2