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