Philippe 07/03/2019: IO bugfix: io_set_mnhversion must be called by all the processes
[MNH-git_open_source-lfs.git] / src / MNH / phys_paramn.f90
1 !MNH_LIC Copyright 1995-2018 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_PHYS_PARAM_n  
7 !    ########################
8 !
9 !
10 INTERFACE
11 !
12       SUBROUTINE PHYS_PARAM_n(KTCOUNT,TPFILE,OCLOSE_OUT,                                   &
13                               PRAD,PSHADOWS,PKAFR,PGROUND,PMAFL,PDRAG,PTURB,PTRACER,       &
14                               PTIME_BU, PWETDEPAER, OMASKkids,OCLOUD_ONLY                  )           
15 !
16 USE MODD_IO_ll, ONLY: TFILEDATA
17 !
18 INTEGER,           INTENT(IN)     :: KTCOUNT   ! temporal iteration count
19 TYPE(TFILEDATA),   INTENT(IN)     :: TPFILE    ! Synchronous output file
20 LOGICAL,           INTENT(IN)     :: OCLOSE_OUT! conditional closure of the 
21                                                ! OUTPUT FM-file
22 ! advection schemes                   
23 REAL*8,DIMENSION(2), INTENT(INOUT)  :: PRAD,PSHADOWS,PKAFR,PGROUND,PTURB,PMAFL,PDRAG,PTRACER ! to store CPU
24                                                ! time for computing time
25                                         
26 REAL*8,DIMENSION(2),              INTENT(INOUT)  :: PTIME_BU  ! time used in budget&LES budgets
27      !        statistics
28 REAL, DIMENSION(:,:,:,:), INTENT(INOUT)  :: PWETDEPAER
29 LOGICAL, DIMENSION(:,:), INTENT(IN) :: OMASKkids ! kids domains mask
30 LOGICAL, INTENT(OUT) :: OCLOUD_ONLY ! conditionnal radiation computations for
31                                 !      the only cloudy columns
32                                 !
33 END SUBROUTINE PHYS_PARAM_n
34 !
35 END INTERFACE
36 !
37 END MODULE MODI_PHYS_PARAM_n
38 !
39 !     ######################################################################
40       SUBROUTINE PHYS_PARAM_n(KTCOUNT,TPFILE,OCLOSE_OUT,                                   &
41                               PRAD,PSHADOWS,PKAFR,PGROUND,PMAFL,PDRAG,PTURB,PTRACER,       &
42                               PTIME_BU, PWETDEPAER, OMASKkids,OCLOUD_ONLY                  )           
43 !     ######################################################################
44 !
45 !!****  *PHYS_PARAM_n * -monitor of the parameterizations used by model _n
46 !!
47 !!    PURPOSE
48 !!    -------
49 !       The purpose of this routine is to update the sources by adding the
50 !     parameterized terms. This is realized by sequentially calling the
51 !     specialized routines.
52 !    
53 !!**  METHOD
54 !!    ------
55 !!      The first parametrization is the radiation scheme:
56 !!                                       ----------------
57 !!     *  CRAD = 'FIXE'
58 !!     In this case, a temporal interpolation  is performed for the downward
59 !!     surface fluxes XFLALWD and XFLASWD.
60 !!     *  CRAD = 'ECMWF'
61 !!     Several tests are performed before calling the radiation computations
62 !!     interface with the ECMWF radiation scheme code. A control is made to
63 !!     ensure that:
64 !!         - the full radiation code is called at the first model timestep
65 !!         - there is a priority for calling the full radiation instead of the
66 !!           cloud-only approximation if both must be called at the current
67 !!           timestep
68 !!         - the cloud-only option (approximation) is coherent with the
69 !!           occurence of one cloudy vertical column at least
70 !!      If all the above conditions are fulfilled (GRAD is .TRUE.) then the
71 !!     position of the sun is computed in routine SUNPOS_n and the interfacing
72 !!     routine RADIATIONS is called to update the radiative tendency XDTHRAD
73 !!     and the downward surface fluxes XFLALWD and XFLASWD. Finally, the
74 !!     radiative tendency is integrated as a source term in the THETA prognostic
75 !!     equation.
76 !!
77 !!      The second parameterization is the soil scheme:
78 !!                                         -----------
79 !!
80 !!     externalized surface
81 !!
82 !!       The third parameterization is the turbulence scheme:
83 !!                                         -----------------
84 !!     * CTURB='NONE'
85 !!     no turbulent mixing is taken into account
86 !!     * CTURB='TKEL'
87 !!     The turbulent fluxes are computed according to a one and half order
88 !!     closure of the hydrodynamical equations. This scheme is based on a
89 !!     prognostic for the turbulent kinetic energy and a mixing length
90 !!     computation ( the mesh size or a physically based length). Other
91 !!     turbulent moments are diagnosed according to a stationarization of the
92 !!     second order turbulent moments. This turbulent scheme forecasts
93 !!     either a purely vertical turbulent mixing or 3-dimensional mixing
94 !!     according to its internal degrees of freedom.
95 !!
96 !!
97 !!       The LAST parameterization is the chemistry scheme:
98 !!                                        -----------------
99 !!     The chemistry part of MesoNH has two namelists, NAM_SOLVER for the
100 !!     parameters concerning the stiff solver, and NAM_MNHCn concerning the
101 !!     configuration and options of the chemistry module itself.
102 !!     The switch LUSECHEM in NAM_CONF acitvates or deactivates the chemistry.
103 !!     The only variables of MesoNH that are modified by chemistry are the
104 !!     scalar variables. If calculation of chemical surface fluxes is
105 !!     requested, those fluxes are calculated before
106 !!     entering the turbulence scheme, since those fluxes are taken into
107 !!     account by TURB as surface boundary conditions.
108 !!     CAUTION: chemistry has allways to be called AFTER ALL OTHER TERMS
109 !!     that affect the scalar variables (dynamical terms, forcing,
110 !!     parameterizations (like TURB, CONVECTION), since it uses the variables
111 !!     XRSVS as input in case of the time-split option.
112 !!
113 !!    EXTERNAL
114 !!    --------
115 !!      Subroutine SUNPOS_n     : computes the position of the sun
116 !!      Subroutine RADIATIONS   : computes the radiative tendency and fluxes
117 !!      Subroutine TSZ0         : computes the surface from temporally
118 !!                                interpolated Ts and given z0
119 !!      Subroutine ISBA         : computes the surface fluxes from a soil scheme
120 !!      Subroutine TURB         : computes the turbulence source terms
121 !!      Subroutine CONVECTION   : computes the convection source term
122 !!      Subroutine CH_SURFACE_FLUX_n: computes the surface flux for chemical
123 !!                                species
124 !!      Subroutine CH_MONITOR_n : computes the chemistry source terms
125 !!                                that are applied to the scalar variables
126 !!
127 !!    IMPLICIT ARGUMENTS
128 !!    ------------------
129 !!      USE MODD_DYN
130 !!      USE MODD_CONF
131 !!      USE MODD_CONF_n
132 !!      USE MODD_CURVCOR_n
133 !!      USE MODD_DYN_n
134 !!      USE MODD_FIELD_n
135 !!      USE MODD_GR_FIELD_n
136 !!      USE MODD_LSFIELD_n
137 !!      USE MODD_GRID_n
138 !!      USE MODD_LBC_n
139 !!      USE MODD_PARAM_RAD_n
140 !!      USE MODD_RADIATIONS_n
141 !!      USE MODD_REF_n
142 !!      USE MODD_LUNIT_n
143 !!      USE MODD_TIME_n
144 !!      USE MODD_CH_MNHC_n
145 !!
146 !!    REFERENCE
147 !!    ---------
148 !!      None
149 !!
150 !!    AUTHOR
151 !!    ------
152 !!      J. Stein           * Meteo-France *
153 !!
154 !!    MODIFICATIONS
155 !!    -------------
156 !!      Original    05/01/95
157 !!      Modifications  Feb 14, 1995 (J.Cuxart)  add the I/O arguments,
158 !!             the director cosinus and change the names of the surface fluxes
159 !!      Modifications March 21, 1995 (J.M.Carriere) take into account liquid
160 !!                                             water
161 !!                    June 30,1995  (J.Stein)  initialize at 0 the surf. fluxes
162 !!      Modifications Sept. 1, 1995 (S.Belair) ISBA scheme
163 !!      Modifications Sept.25, 1995 (J.Stein)  switch on the radiation scheme
164 !!      Modifications Sept. 11, 1995 (J.-P. Pinty) radiation scheme
165 !!                    Nov.  15, 1995 (J.Stein) cleaning + change the temporal
166 !!                                   algorithm for the soil scheme-turbulence
167 !!                    Jan.  23, 1996 (J.Stein) add a new option for the surface
168 !!                                   fluxes where Ts and z0 are given
169 !!                    March 18, 1996 (J.Stein) add the cloud fraction
170 !!                    March 28, 1996 (J.Stein) the soil scheme gives energy
171 !!                                             fluxes + cleaning
172 !!                    June  17, 1996 (Lafore)  statistics of computing time
173 !!                    August 4, 1996 (K. Suhre) add chemistry
174 !!                    Oct.  12, 1996 (J.Stein) use XSRCM in the turbulence
175 !!                                             scheme
176 !!                    Nov.  18, 1996 (J.-P. Pinty) add domain translation
177 !!                                                 change arg. in radiations
178 !!                    Fev.   4, 1997 (J.Viviand) change isba's calling for ice
179 !!                    Jun.  22, 1997 (J.Stein) change the equation system and use
180 !!                                             the absolute pressure
181 !!                    Jul.  09, 1997 (V.Masson) add directional z0
182 !!                    Jan.  24, 1998 (P.Bechtold) add convective transport for tracers
183 !!                    Jan.  24, 1998 (J.-P. Pinty) split SW and LW part for radiation
184 !!                    Mai.  10, 1999 (P.Bechtold) shallow convection
185 !!                    Oct.  20, 1999 (P.Jabouille) domain translation for turbulence
186 !!                    Jan.  04, 2000 (V.Masson) removes TSZ0 case
187 !!                    Jan.  04, 2000 (V.Masson) modifies albedo computation
188 !                     Jul   02, 2000 (F.Solmon/V.Masson) adaptation for patch approach
189 !!                    Nov.  15, 2000 (V.Masson) LES routines
190 !!                    Nov.  15, 2000 (V.Masson) effect of slopes on surface fluxes
191 !!                    Feb.  02, 2001 (P.Tulet) add friction velocities and aerodynamical
192 !!                                             resistance (patch approach)
193 !!                    Jan.  04, 2000 (V.Masson) modify surf_rad_modif computation
194 !!                    Mar.  04, 2002 (F.Solmon) new interface for radiation call
195 !!                    Nov.  06, 2002 (V.Masson) LES budgets & budget time counters
196 !!                    Jan. 2004      (V.Masson) surface externalization
197 !!                    Jan.  13, 2004 (J.Escobar) bug correction : compute "GRAD" in parallel
198 !!                    Jan.  20, 2005 (P. Tulet)  add dust sedimentation 
199 !!                    Jan.  20, 2005 (P. Tulet)  climatologic SSA
200 !!                    Jan.  20, 2005 (P. Tulet)  add aerosol / dust scavenging
201 !!                    Jul. 2005       (N. Asencio) use the two-way result-fields
202 !!                                  before ground_param call
203 !!                    May 2006        Remove EPS
204 !!                    Oct. 2007      (J.Pergaud) Add shallow_MF
205 !!                    Oct. 2009     (C.Lac) Introduction of different PTSTEP according to the
206 !!                              advection schemes
207 !!                    Oct. 2009     (V. MAsson) optimization of Pergaud et al massflux scheme
208 !!                    Aug. 2010     (V.Masson, C.Lac) Exchange of SBL_DEPTH for
209 !!                                  reproducibility
210 !!                    Oct. 2010   (J.Escobar) init  ZTIME_LES_MF ( pb detected with g95 )
211 !!                    Feb. 2011 (V.Masson, C.Lac) SBL_DEPTH values on outer pts
212 !!                               for RMC01
213 !!                    Sept.2011 (J.Escobar) init YINST_SFU ='M'
214 !!
215 !!                        Specific for 2D modeling : 
216 !! 
217 !!                    06/2010    (P.Peyrille)  add Call to aerozon.f90 if LAERO_FT=T
218 !!                                to update 
219 !!                                aerosols and ozone climatology at each call to
220 !!                                phys_param otherwise it is constant to monthly average
221 !!                    03/2013  (C.Lac) FIT temporal scheme
222 !!                    01/2014 (C.Lac) correction for the nesting of 2D surface
223 !!                           fields if the number of the son model does not
224 !!                           follow the number of the dad model
225 !!      J.Escobar 21/03/2013: for HALOK comment all NHALO=1 test
226 !!                       2014  (M.Faivre)
227 !!  06/2016     (G.Delautier) phasage surfex 8
228 !!  2016 B.VIE LIMA
229 !!      M. Leriche 02/2017 Avoid negative fluxes if sv=0 outside the physics domain
230 !!      C.Lac  10/2017 : ch_monitor and aer_monitor extracted from phys_param
231 !!                       to be called directly by modeln as the last process 
232 !!                   02/2018 Q.Libois ECRAD
233 !!     28/03/2018 P. Wautelet: replace TEMPORAL_DIST by DATETIME_DISTANCE
234 !!  Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
235 !!-------------------------------------------------------------------------------
236 !
237 !*       0.     DECLARATIONS
238 !               ------------
239 !    
240 USE MODE_DATETIME
241 USE MODE_ll
242 USE MODE_FM
243 USE MODE_FMWRIT
244 USE MODD_ARGSLIST_ll, ONLY : LIST_ll
245 !
246 USE MODD_BLANK
247 USE MODD_CST
248 USE MODD_DYN
249 USE MODD_CONF
250 USE MODD_FRC
251 USE MODD_IO_ll, ONLY: TFILEDATA
252 USE MODD_PARAMETERS
253 USE MODD_GRID
254 USE MODD_NSV
255 USE MODD_LES
256 USE MODD_LES_BUDGET
257 !
258 USE MODD_CONF_n
259 USE MODD_CURVCOR_n
260 USE MODD_DYN_n
261 USE MODD_FIELD_n
262 USE MODD_LSFIELD_n
263 USE MODD_GRID_n
264 USE MODD_METRICS_n
265 USE MODD_LBC_n
266 USE MODD_REF_n
267 USE MODD_LUNIT_n
268 USE MODD_OUT_n
269 USE MODD_PARAM_n
270 USE MODD_PARAM_RAD_n
271 USE MODD_PARAM_KAFR_n
272 USE MODD_RADIATIONS_n
273 USE MODD_SHADOWS_n
274 USE MODD_DEEP_CONVECTION_n
275 USE MODD_TIME_n
276 USE MODD_TURB_n
277 USE MODD_CH_MNHC_n, ONLY : LUSECHEM,         &! indicates if chemistry is used
278                            LCH_CONV_SCAV,    &
279                            LCH_CONV_LINOX
280 USE MODD_PRECIP_n
281 USE MODD_PASPOL_n
282 USE MODD_BUDGET
283 USE MODD_RAIN_ICE_DESCR,  ONLY : XRTMIN
284 USE MODD_ICE_C1R3_DESCR,  ONLY : XRTMIN_C1R3=>XRTMIN
285 USE MODD_TURB_CLOUD, ONLY : CTURBLEN_CLOUD,NMODEL_CLOUD, &
286                             XCEI,XCEI_MIN,XCEI_MAX,XCOEF_AMPL_SAT
287 USE MODD_NESTING, ONLY : XWAY,NDAD, NDXRATIO_ALL, NDYRATIO_ALL
288 USE MODD_PARAM_ICE,        ONLY : LSEDIC
289 USE MODD_PARAM_C2R2,       ONLY : LSEDC
290 USE MODD_SUB_PHYS_PARAM_n
291 !
292 USE MODD_PARAM_MFSHALL_n
293 USE MODI_SHALLOW_MF_PACK
294 USE MODD_CLOUD_MF_n
295 USE MODD_ADV_n,            ONLY : XRTKEMS
296 !
297 USE MODI_SURF_RAD_MODIF
298 USE MODI_GROUND_PARAM_n
299 USE MODI_TURB
300 USE MODI_SUNPOS_n
301 USE MODI_RADIATIONS
302 USE MODI_CONVECTION
303 USE MODI_BUDGET
304 USE MODI_PASPOL
305 USE MODI_CONDSAMP
306 USE MODE_FM
307 USE MODE_MODELN_HANDLER
308 USE MODI_SEDIM_DUST
309 USE MODI_SEDIM_SALT
310 USE MODI_DUST_FILTER
311 USE MODI_SALT_FILTER
312 USE MODI_DRAG_VEG
313 USE MODD_DUST
314 USE MODD_SALT
315 USE MODD_PASPOL
316 USE MODD_CONDSAMP
317 USE MODD_CH_AEROSOL
318 USE MODE_DUST_PSD
319 USE MODE_SALT_PSD
320 USE MODE_AERO_PSD
321 USE MODE_MNH_TIMING
322 USE MODD_TURB_FLUX_AIRCRAFT_BALLOON, ONLY : XTHW_FLUX, XRCW_FLUX, XSVW_FLUX
323 USE MODD_DRAGTREE
324 !
325 USE MODD_TIME, ONLY : TDTEXP  ! Ajout PP
326 USE MODI_AEROZON          ! Ajout PP
327 !
328 USE MODI_EDDY_FLUX_n               ! Ajout PP
329 USE MODI_EDDYUV_FLUX_n             ! Ajout PP
330 USE MODI_EDDY_FLUX_ONE_WAY_n       ! Ajout PP
331 USE MODI_EDDYUV_FLUX_ONE_WAY_n     ! Ajout PP
332 USE MODD_DEF_EDDY_FLUX_n           ! Ajout PP
333 USE MODD_DEF_EDDYUV_FLUX_n         ! Ajout PP
334 USE MODD_LATZ_EDFLX
335 USE MODD_MNH_SURFEX_n
336 USE MODI_SWITCH_SBG_LES_N
337 USE MODD_TIME_n 
338 !
339 USE MODD_PARAM_LIMA,       ONLY : MSEDC => LSEDC, XRTMIN_LIMA=>XRTMIN
340 !
341 USE MODE_MPPDB
342 IMPLICIT NONE
343 !
344 !*      0.1    declarations of arguments
345 !
346 INTEGER,           INTENT(IN)     :: KTCOUNT   ! temporal iteration count
347 TYPE(TFILEDATA),   INTENT(IN)     :: TPFILE    ! Synchronous output file
348 LOGICAL,           INTENT(IN)     :: OCLOSE_OUT! conditional closure of the 
349                                                ! OUTPUT FM-file
350 ! advection schemes                   
351 REAL*8,DIMENSION(2), INTENT(INOUT)  :: PRAD,PSHADOWS,PKAFR,PGROUND,PTURB,PMAFL,PDRAG,PTRACER ! to store CPU
352                                                ! time for computing time
353                                                !        statistics
354 REAL*8,DIMENSION(2),              INTENT(INOUT)  :: PTIME_BU  ! time used in budget&LES budgets
355 REAL, DIMENSION(:,:,:,:), INTENT(INOUT)  :: PWETDEPAER
356 LOGICAL, DIMENSION(:,:), INTENT(IN) :: OMASKkids ! kids domains mask
357 LOGICAL, INTENT(OUT) :: OCLOUD_ONLY ! conditionnal radiation computations for
358                                 !      the only cloudy columns
359                                 !
360 !
361 !*      0.2    declarations of local variables
362 !
363 REAL, DIMENSION(:,:), ALLOCATABLE     :: ZSFU  ! surface flux of x and
364 REAL, DIMENSION(:,:), ALLOCATABLE     :: ZSFV  ! y component of wind
365 REAL, DIMENSION(:,:), ALLOCATABLE     :: ZSFTH ! surface flux of theta
366 REAL, DIMENSION(:,:), ALLOCATABLE     :: ZSFRV ! surface flux of vapor
367 REAL, DIMENSION(:,:,:), ALLOCATABLE   :: ZSFSV ! surface flux of scalars
368 REAL, DIMENSION(:,:), ALLOCATABLE     :: ZSFCO2! surface flux of CO2
369 !
370 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDIR_ALB ! direct albedo
371 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSCA_ALB ! diffuse albedo
372 REAL, DIMENSION(:,:,:),   ALLOCATABLE :: ZEMIS    ! emissivity
373 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZTSRAD   ! surface temperature
374 REAL, DIMENSION(:,:,:,:), ALLOCATABLE  :: ZRGDST,ZSIGDST,ZNDST,ZSVDST
375 REAL, DIMENSION(:,:,:,:), ALLOCATABLE  :: ZRGSLT,ZSIGSLT,ZNSLT,ZSVSLT
376 REAL, DIMENSION(:,:,:,:), ALLOCATABLE  :: ZRGAER,ZSIGAER,ZNAER,ZSVAER
377 REAL, DIMENSION(:,:,:,:), ALLOCATABLE  :: ZSVT
378 !
379 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZEXN   ! Atmospheric density and Exner
380 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSIGMF   ! MF contribution to XSIGS
381 !
382 REAL, DIMENSION(0:24) :: ZRG_HOUR =  (/ 0., 0., 0., 0., 0., 32.04, 114.19,  &
383                                       228.01, 351.25, 465.49, 557.24,       &
384                                       616.82, 638.33, 619.43, 566.56,       &
385                                       474.71, 359.20, 230.87, 115.72,       &
386                                       32.48, 0., 0., 0., 0., 0. /)
387 !
388 REAL, DIMENSION(0:24) :: ZRAT_HOUR = (/ 326.00, 325.93, 325.12, 324.41,     &
389                                       323.16, 321.95, 322.51, 325.16,       &
390                                       328.01, 331.46, 335.58, 340.00,       &
391                                       345.20, 350.32, 354.20, 356.58,       &
392                                       356.56, 355.33, 352.79, 351.34,       &
393                                       347.00, 342.00, 337.00, 332.00,       &
394                                       326.00     /)
395 !
396 INTEGER  :: IHOUR               ! parameters necessary for the temporal
397 REAL     :: ZTIME, ZDT          ! interpolation
398 REAL     :: ZTEMP_DIST          ! time between 2 instants (in seconds)
399 !
400 LOGICAL :: GRAD                 ! conditionnal call for the full radiation
401                                 !         computations
402 REAL    :: ZRAD_GLOB_ll         ! 'real' global parallel mask of 'GRAD'
403 INTEGER :: INFO_ll              ! error report of parallel routines
404                                 !      the only cloudy columns
405 !
406 REAL*8,DIMENSION(2)    :: ZTIME1,ZTIME2,ZTIME3,ZTIME4       ! for computing time analysis
407 REAL*8,DIMENSION(2)    :: ZTIME_LES_MF         ! time spent in LES computation in shallow conv.
408 LOGICAL :: GDCONV               ! conditionnal call for the deep convection
409                                 !         computations
410 REAL, DIMENSION(:,:,:), ALLOCATABLE  :: ZRC, ZRI, ZWT ! additional dummies
411 REAL, DIMENSION(:,:),   ALLOCATABLE  :: ZDXDY         ! grid area
412                     ! for rc, ri, w required if main variables not allocated
413 !
414 INTEGER :: IIU, IJU, IKU                              ! dimensional indexes
415 !
416 INTEGER     :: JSV              ! Loop index for Scalar Variables
417 INTEGER     :: JSWB             ! loop on SW spectral bands
418 INTEGER     :: IIB,IIE,IJB,IJE, IKB, IKE
419 INTEGER     :: IMODEIDX
420               ! index values for the Beginning or the End of the physical
421               ! domain in x and y directions
422 TYPE(LIST_ll), POINTER :: TZFIELDS_ll   ! list of fields to exchange
423 INTEGER                :: IINFO_ll       ! return code of parallel routine
424 !
425 !* variables for writing in a fm file
426 !
427 INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
428                                     !in LFI subroutines at the open of the file
429 INTEGER           :: ILUOUT         ! logical unit numbers of output-listing
430 INTEGER           :: IMI            ! model index
431 INTEGER           :: JKID           ! loop index to look for the KID models
432 REAL              :: ZINIRADIUSI, ZINIRADIUSJ ! ORILAM initial radius
433 REAL, DIMENSION(NMODE_DST)    :: ZINIRADIUS  ! DUST initial radius
434 REAL, DIMENSION(NMODE_SLT)    :: ZINIRADIUS_SLT  ! Sea Salt initial radius
435 REAL, DIMENSION(SIZE(XRSVS,1), SIZE(XRSVS,2), SIZE(XRSVS,3), SIZE(XRSVS,4))  :: ZRSVS
436 LOGICAL :: GCLD                     ! conditionnal call for dust wet deposition
437 ! * arrays to store the surface fields before radiation and convection scheme
438 !  calls
439 INTEGER           :: IMODSON        ! Number of son models of IMI with XWAY=2
440 INTEGER           :: IKIDM          ! index loop                                 
441 REAL, DIMENSION(:,:,:),   ALLOCATABLE  :: ZSAVE_INPRR,ZSAVE_INPRS,ZSAVE_INPRG,ZSAVE_INPRH
442 REAL, DIMENSION(:,:,:),   ALLOCATABLE  :: ZSAVE_INPRC,ZSAVE_PRCONV,ZSAVE_PRSCONV
443 REAL, DIMENSION(:,:,:,:), ALLOCATABLE  :: ZSAVE_DIRFLASWD, ZSAVE_SCAFLASWD,ZSAVE_DIRSRFSWD
444 !
445 !-----------------------------------------------------------------------------
446 !
447 NULLIFY(TZFIELDS_ll)
448 IMI=GET_CURRENT_MODEL_INDEX()
449 !
450 ILUOUT = TLUOUT%NLU
451 CALL GET_DIM_EXT_ll ('B',IIU,IJU)
452 IKU=SIZE(XTHT,3)
453 IKB = 1 + JPVEXT
454 IKE = IKU - JPVEXT
455 CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
456 !
457 ZTIME1 = 0.0
458 ZTIME2 = 0.0
459 ZTIME3 = 0.0
460 ZTIME4 = 0.0
461 PTIME_BU = 0.
462 ZTIME_LES_MF = 0.0
463 PWETDEPAER(:,:,:,:) = 0.
464 !
465 !* allocation of variables used in more than one parameterization
466 !
467 ALLOCATE(ZSFU  (IIU,IJU))         ! surface schemes + turbulence
468 ALLOCATE(ZSFV  (IIU,IJU))
469 ALLOCATE(ZSFTH (IIU,IJU))
470 ALLOCATE(ZSFRV (IIU,IJU))
471 ALLOCATE(ZSFSV (IIU,IJU,NSV))
472 ALLOCATE(ZSFCO2(IIU,IJU))
473 !
474 !* if XWAY(son)=2 save surface fields before radiation or convective scheme
475 !  calls
476 !
477 IMODSON = 0
478 DO JKID = IMI+1,NMODEL  ! min value of the possible kids
479  IF (IMI == NDAD(JKID) .AND. XWAY(JKID) == 2. .AND. CPROGRAM=='MESONH' &
480   .AND. (CCONF == 'RESTA' .OR. (CCONF == 'START' .AND. KTCOUNT /= 1))) THEN
481   IMODSON = IMODSON + 1
482  END IF
483 END DO
484 !
485  IF (IMODSON /= 0 ) THEN
486    IF (LUSERC .AND. (                                               &
487        (LSEDIC .AND. CCLOUD(1:3) == 'ICE')                     .OR. &
488        (LSEDC  .AND. (CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO')) .OR. &
489        (MSEDC  .AND. CCLOUD=='LIMA')                                &
490       )) THEN
491      ALLOCATE( ZSAVE_INPRC(SIZE(XINPRC,1),SIZE(XINPRC,2),IMODSON))
492    ELSE
493      ALLOCATE( ZSAVE_INPRC(0,0,0))
494    END IF
495    IF (LUSERR) THEN
496      ALLOCATE( ZSAVE_INPRR(SIZE(XINPRR,1),SIZE(XINPRR,2),IMODSON))
497    ELSE
498      ALLOCATE( ZSAVE_INPRR(0,0,0))
499    END IF
500    IF (LUSERS) THEN
501      ALLOCATE( ZSAVE_INPRS(SIZE(XINPRS,1),SIZE(XINPRS,2),IMODSON))
502    ELSE
503      ALLOCATE( ZSAVE_INPRS(0,0,0))                              
504    END IF
505    IF (LUSERG) THEN
506      ALLOCATE( ZSAVE_INPRG(SIZE(XINPRG,1),SIZE(XINPRG,2),IMODSON))
507    ELSE
508      ALLOCATE( ZSAVE_INPRG(0,0,0))                                
509    END IF
510    IF (LUSERH) THEN
511      ALLOCATE( ZSAVE_INPRH(SIZE(XINPRH,1),SIZE(XINPRH,2),IMODSON))
512    ELSE
513      ALLOCATE( ZSAVE_INPRH(0,0,0))                               
514    END IF
515    IF (CDCONV /= 'NONE') THEN
516      ALLOCATE( ZSAVE_PRCONV(SIZE(XPRCONV,1),SIZE(XPRCONV,2),IMODSON))
517      ALLOCATE( ZSAVE_PRSCONV(SIZE(XPRSCONV,1),SIZE(XPRSCONV,2),IMODSON))
518    ELSE
519      ALLOCATE( ZSAVE_PRCONV(0,0,0))                                
520      ALLOCATE( ZSAVE_PRSCONV(0,0,0))                                    
521    END IF
522    IF (CRAD /= 'NONE') THEN
523      ALLOCATE( ZSAVE_DIRFLASWD(SIZE(XDIRFLASWD,1),SIZE(XDIRFLASWD,2),SIZE(XDIRFLASWD,3),IMODSON))
524      ALLOCATE( ZSAVE_SCAFLASWD(SIZE(XSCAFLASWD,1),SIZE(XSCAFLASWD,2),SIZE(XSCAFLASWD,3),IMODSON))
525      ALLOCATE( ZSAVE_DIRSRFSWD(SIZE(XDIRSRFSWD,1),SIZE(XDIRSRFSWD,2),SIZE(XDIRSRFSWD,3),IMODSON))
526    ELSE
527      ALLOCATE( ZSAVE_DIRFLASWD(0,0,0,0))
528      ALLOCATE( ZSAVE_SCAFLASWD(0,0,0,0))
529      ALLOCATE( ZSAVE_DIRSRFSWD(0,0,0,0)) 
530    END IF
531  ENDIF
532 !
533 IKIDM=0
534 DO JKID = IMI+1,NMODEL  ! min value of the possible kids
535  IF (IMI == NDAD(JKID) .AND. XWAY(JKID) == 2. .AND. CPROGRAM=='MESONH' &
536   .AND. (CCONF == 'RESTA' .OR. (CCONF == 'START' .AND. KTCOUNT /= 1))) THEN
537 ! BUG if number of the son does not follow the number of the dad
538 ! IKIDM = JKID-IMI
539   IKIDM = IKIDM + 1
540    IF (LUSERC .AND. (                                               &
541        (LSEDIC .AND. CCLOUD(1:3) == 'ICE')                     .OR. &
542        (LSEDC  .AND. (CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO')) .OR. &
543        (MSEDC  .AND. CCLOUD=='LIMA')                                &
544       )) THEN
545      ZSAVE_INPRC(:,:,IKIDM) = XINPRC(:,:)
546    END IF
547    IF (LUSERR) THEN
548      ZSAVE_INPRR(:,:,IKIDM) = XINPRR(:,:)
549    END IF
550    IF (LUSERS) THEN
551      ZSAVE_INPRS(:,:,IKIDM) = XINPRS(:,:)
552    END IF
553    IF (LUSERG) THEN
554      ZSAVE_INPRG(:,:,IKIDM) = XINPRG(:,:)
555    END IF
556    IF (LUSERH) THEN
557      ZSAVE_INPRH(:,:,IKIDM) = XINPRH(:,:)
558    END IF
559    IF (CDCONV /= 'NONE') THEN
560      ZSAVE_PRCONV(:,:,IKIDM) = XPRCONV(:,:)
561      ZSAVE_PRSCONV(:,:,IKIDM) = XPRSCONV(:,:)
562    END IF
563    IF (CRAD /= 'NONE') THEN
564      ZSAVE_DIRFLASWD(:,:,:,IKIDM) = XDIRFLASWD(:,:,:)
565      ZSAVE_SCAFLASWD(:,:,:,IKIDM) = XSCAFLASWD(:,:,:)
566      ZSAVE_DIRSRFSWD(:,:,:,IKIDM) = XDIRSRFSWD(:,:,:)
567    END IF
568  ENDIF
569 END DO
570 !
571 !-----------------------------------------------------------------------------
572 !
573 !*        1.    RADIATION SCHEME
574 !               ----------------
575 !
576 !
577 XTIME_BU_PROCESS = 0.
578 XTIME_LES_BU_PROCESS = 0.
579 !
580 CALL SECOND_MNH2(ZTIME1)
581 !
582 !
583 !*        1.1   Tests to control how the radiation package should be called (at the current timestep)
584 !               -----------------------------------------------------------
585 !
586 !
587 GRAD = .FALSE.
588 OCLOUD_ONLY = .FALSE.
589 !
590 IF (CRAD /='NONE') THEN
591 !
592 !  test to see if the partial radiations for cloudy must be called
593 !
594   IF (CRAD =='ECMW' .OR. CRAD =='ECRA') THEN
595     CALL DATETIME_DISTANCE(TDTRAD_CLONLY,TDTCUR,ZTEMP_DIST)
596     IF( MOD(NINT(ZTEMP_DIST/XTSTEP),NINT(XDTRAD_CLONLY/XTSTEP))==0 ) THEN
597       TDTRAD_CLONLY = TDTCUR
598       GRAD = .TRUE.
599       OCLOUD_ONLY = .TRUE.
600     END IF
601   END IF
602 !   
603 ! test to see if the full radiations must be called
604 !   
605   CALL DATETIME_DISTANCE(TDTCUR,TDTRAD_FULL,ZTEMP_DIST)
606   IF( MOD(NINT(ZTEMP_DIST/XTSTEP),NINT(XDTRAD/XTSTEP))==0 ) THEN
607     TDTRAD_FULL = TDTCUR
608     GRAD = .TRUE.
609     OCLOUD_ONLY = .FALSE.
610   END IF
611 !
612 ! tests to see if any cloud exists
613 !   
614   IF (CRAD =='ECMW' .OR. CRAD =='ECRA') THEN
615     IF (GRAD .AND. NRR.LE.3 ) THEN 
616       IF( MAXVAL(XCLDFR(:,:,:)).LE. 1.E-10 .AND. OCLOUD_ONLY ) THEN
617           GRAD = .FALSE.                ! only the cloudy verticals would be 
618                                         ! refreshed but there is no clouds 
619       END IF
620     END IF
621 !
622     IF (GRAD .AND. NRR.GE.4 ) THEN 
623       IF( CCLOUD(1:3)=='ICE' )THEN
624         IF( MAXVAL(XRT(:,:,:,2)).LE.XRTMIN(2) .AND.             &
625             MAXVAL(XRT(:,:,:,4)).LE.XRTMIN(4) .AND. OCLOUD_ONLY ) THEN
626             GRAD = .FALSE.            ! only the cloudy verticals would be 
627                                       ! refreshed but there is no cloudwater and ice
628         END IF
629       END IF
630       IF( CCLOUD=='C3R5' )THEN
631         IF( MAXVAL(XRT(:,:,:,2)).LE.XRTMIN_C1R3(2) .AND.             &
632             MAXVAL(XRT(:,:,:,4)).LE.XRTMIN_C1R3(4) .AND. OCLOUD_ONLY ) THEN
633             GRAD = .FALSE.            ! only the cloudy verticals would be 
634                                       ! refreshed but there is no cloudwater and ice
635         END IF
636       END IF
637       IF( CCLOUD=='LIMA' )THEN
638         IF( MAXVAL(XRT(:,:,:,2)).LE.XRTMIN_LIMA(2) .AND.             &
639             MAXVAL(XRT(:,:,:,4)).LE.XRTMIN_LIMA(4) .AND. OCLOUD_ONLY ) THEN
640             GRAD = .FALSE.            ! only the cloudy verticals would be 
641                                       ! refreshed but there is no cloudwater and ice
642         END IF
643       END IF      
644     END IF
645   END IF
646 !
647 END IF
648 !
649 ! global parallel mask for 'GRAD'
650 ZRAD_GLOB_ll = 0.0
651 IF (GRAD) ZRAD_GLOB_ll = 1.0
652 CALL REDUCESUM_ll(ZRAD_GLOB_ll,INFO_ll)
653 if (ZRAD_GLOB_ll .NE. 0.0 ) GRAD = .TRUE.
654 !
655 !
656 IF( GRAD ) THEN                                 
657   ALLOCATE(ZCOSZEN(IIU,IJU))
658   ALLOCATE(ZSINZEN(IIU,IJU))
659   ALLOCATE(ZAZIMSOL(IIU,IJU))
660 !
661 !
662 !*        1.2.  Astronomical computations
663 !               -------------------------
664 !
665 ! Ajout PP
666 IF (.NOT. OCLOUD_ONLY .AND. KTCOUNT /= 1)  THEN 
667  IF (LAERO_FT) THEN 
668   CALL AEROZON (XPABST,XTHT,XTSRAD,XLAT,XLON,TDTCUR,TDTEXP,   &
669          NDLON,NFLEV,CAER,NAER,NSTATM,                             &
670          XSINDEL,XCOSDEL,XTSIDER,XCORSOL,                          &
671          XSTATM,XOZON, XAER)
672  END IF
673 END IF
674 !
675 CALL SUNPOS_n   ( XZENITH, ZCOSZEN, ZSINZEN, ZAZIMSOL )
676 !
677 !*        1.3   Call to radiation scheme
678 !               ------------------------
679 !
680   SELECT CASE ( CRAD )
681 !
682 !*        1.3.1 TOP of Atmposphere radiation
683 !               ----------------------------
684     CASE('TOPA')
685 !
686       XFLALWD   (:,:)   = 300.
687       DO JSWB=1,NSWB_MNH
688         XDIRFLASWD(:,:,JSWB) = XI0 * MAX(COS(XZENITH(:,:)),0.)/FLOAT(NSWB_MNH)
689         XSCAFLASWD(:,:,JSWB) = 0.
690       END DO
691       XDTHRAD(:,:,:) = 0.
692      
693 !
694 !*        1.3.1 FIXEd radiative surface fluxes
695 !               ------------------------------
696 !
697     CASE('FIXE')
698       ZTIME = MOD(TDTCUR%TIME +XLON0*240., XDAY)
699       IHOUR = INT( ZTIME/3600. )
700       IF (IHOUR < 0) IHOUR=IHOUR + 24
701       ZDT = ZTIME/3600. - FLOAT(IHOUR)
702       XDIRFLASWD(:,:,:) =(( ZRG_HOUR(IHOUR+1)-ZRG_HOUR(IHOUR) )*ZDT + ZRG_HOUR(IHOUR)) / FLOAT(NSWB_MNH)
703       XFLALWD   (:,:)   = (ZRAT_HOUR(IHOUR+1)-ZRAT_HOUR(IHOUR))*ZDT + ZRAT_HOUR(IHOUR)
704       DO JSWB=1,NSWB_MNH
705         WHERE(ZCOSZEN(:,:)<0.) XDIRFLASWD(:,:,JSWB) = 0.
706       END DO
707
708       XSCAFLASWD(:,:,:) = XDIRFLASWD(:,:,:) * 0.2
709       XDIRFLASWD(:,:,:) = XDIRFLASWD(:,:,:) * 0.8
710       XDTHRAD(:,:,:) = 0.
711       !
712 !
713 !*        1.3.2 ECMWF or ECRAD radiative surface and atmospheric fluxes
714 !               ----------------------------------------------
715 !
716     CASE('ECMW' , 'ECRA')
717       IF (LLES_MEAN) OCLOUD_ONLY=.FALSE.
718       XRADEFF(:,:,:)=0.0
719       XSWU(:,:,:)=0.0
720       XSWD(:,:,:)=0.0
721       XLWU(:,:,:)=0.0
722       XLWD(:,:,:)=0.0
723       XDTHRADSW(:,:,:)=0.0
724       XDTHRADLW(:,:,:)=0.0
725       CALL RADIATIONS   ( OCLOSE_OUT, TPFILE,                                       &
726                LCLEAR_SKY,OCLOUD_ONLY, NCLEARCOL_TM1,CEFRADL, CEFRADI,COPWSW,COPISW,&
727                COPWLW,COPILW, XFUDG,                                                &
728                NDLON, NFLEV, NRAD_DIAG, NFLUX, NRAD,NAER,NSWB_OLD,NSWB_MNH,NLWB_MNH,      &
729                NSTATM, NRAD_COLNBR, ZCOSZEN, XSEA, XCORSOL,                         &
730                XDIR_ALB, XSCA_ALB, XEMIS, XCLDFR, XCCO2, XTSRAD, XSTATM, XTHT, XRT, &
731                XPABST,XOZON, XAER,XDST_WL, XAER_CLIM, XSVT,                         &
732                XDTHRAD, XFLALWD, XDIRFLASWD, XSCAFLASWD, XRHODREF, XZZ ,            &
733                XRADEFF, XSWU, XSWD, XLWU, XLWD, XDTHRADSW, XDTHRADLW                )
734 !
735
736       WRITE(UNIT=ILUOUT,FMT='("  RADIATIONS called for KTCOUNT=",I6,       &
737          &  "with the CLOUD_ONLY option set ",L2)')   KTCOUNT,OCLOUD_ONLY
738 !
739       WHERE( XDIRFLASWD(:,:,1) + XSCAFLASWD(:,:,1) >0. )
740         XALBUV(:,:) = (  XDIR_ALB(:,:,1) * XDIRFLASWD(:,:,1)   &
741                        + XSCA_ALB(:,:,1) * XSCAFLASWD(:,:,1) ) &
742                     / (XDIRFLASWD(:,:,1) + XSCAFLASWD(:,:,1) )
743       ELSEWHERE
744         XALBUV(:,:) = XDIR_ALB(:,:,1)
745       END WHERE
746 !
747   END SELECT
748 !
749   CALL SECOND_MNH2(ZTIME2)
750 !
751   PRAD = PRAD + ZTIME2 - ZTIME1
752 !
753   ZTIME1 = ZTIME2
754 !
755   CALL SURF_RAD_MODIF (XMAP, XXHAT, XYHAT,                 &
756                   ZCOSZEN, ZSINZEN, ZAZIMSOL, XZS, XZS_XY, &
757                   XDIRFLASWD, XDIRSRFSWD                   )
758 !
759 !* Azimuthal angle to be sent later to surface processes
760 !  Defined in radian, clockwise, from North
761 !
762   XAZIM = ZAZIMSOL
763 !
764   CALL SECOND_MNH2(ZTIME2)
765 !
766   PSHADOWS = PSHADOWS + ZTIME2 - ZTIME1
767 !
768   ZTIME1 = ZTIME2
769 !
770   DEALLOCATE(ZCOSZEN)
771   DEALLOCATE(ZSINZEN)
772   DEALLOCATE(ZAZIMSOL)
773 !
774 END IF
775 !
776 !
777 !*        1.4   control prints
778 !               --------------
779 !
780 !*        1.5   Radiative tendency integration
781 !               ------------------------------
782 !
783 IF (CRAD /='NONE') THEN
784   XRTHS(:,:,:) = XRTHS(:,:,:) + XRHODJ(:,:,:)*XDTHRAD(:,:,:)
785 END IF
786 !
787 !*        1.6   budget storage
788 !               --------------
789 !
790 IF (CRAD/='NONE' .AND. LBUDGET_TH) CALL BUDGET (XRTHS,4,'RAD_BU_RTH')
791 !
792 CALL SECOND_MNH2(ZTIME2)
793 !
794 PRAD = PRAD + ZTIME2 - ZTIME1 &
795      - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
796 !
797 PTIME_BU = PTIME_BU + XTIME_LES_BU_PROCESS + XTIME_BU_PROCESS
798 !
799 !
800 !-----------------------------------------------------------------------------
801 !
802 !*        2.    DEEP CONVECTION SCHEME
803 !               ----------------------
804 !
805 ZTIME1 = ZTIME2
806 XTIME_BU_PROCESS = 0.
807 XTIME_LES_BU_PROCESS = 0.
808 !
809 CALL SECOND_MNH2(ZTIME1)
810 !
811 IF( CDCONV /= 'NONE' .OR. CSCONV == 'KAFR' ) THEN
812 !
813 ! test to see if the deep convection scheme should be called
814 !
815   GDCONV = .FALSE.
816 !
817   CALL DATETIME_DISTANCE(TDTDCONV,TDTCUR,ZTEMP_DIST)
818   IF( MOD(NINT(ZTEMP_DIST/XTSTEP),NINT(XDTCONV/XTSTEP))==0 ) THEN
819     TDTDCONV = TDTCUR
820     GDCONV   = .TRUE.
821   END IF
822 !
823   IF( GDCONV ) THEN
824     IF (CDCONV == 'KAFR' .OR. CSCONV == 'KAFR' ) THEN
825         ALLOCATE( ZRC(IIU,IJU,IKU) )
826         ALLOCATE( ZRI(IIU,IJU,IKU) )
827         ALLOCATE( ZWT(IIU,IJU,IKU) )
828         ALLOCATE( ZDXDY(IIU,IJU) )
829         ! Compute grid area
830         ZDXDY(:,:) = SPREAD(XDXHAT(1:IIU),2,IJU) * SPREAD(XDYHAT(1:IJU),1,IIU)
831         !
832         IF( LUSERC .AND. LUSERI ) THEN
833           ZRC(:,:,:) = XRT(:,:,:,2)
834           ZRI(:,:,:) = XRT(:,:,:,4)
835         ELSE IF( LUSERC .AND. (.NOT. LUSERI) ) THEN
836           ZRC(:,:,:) = XRT(:,:,:,2)
837           ZRI(:,:,:) = 0.0
838         ELSE
839           ZRC(:,:,:) = 0.0
840           ZRI(:,:,:) = 0.0
841         END IF
842         WRITE(UNIT=ILUOUT,FMT='("  CONVECTION called for KTCOUNT=",I6)')  &
843                                               KTCOUNT
844         IF ( LFORCING .AND. L1D ) THEN
845           ZWT(:,:,:) = XWTFRC(:,:,:)
846         ELSE
847           ZWT(:,:,:) = XWT(:,:,:)
848         ENDIF
849         IF (LDUST) CALL DUST_FILTER(XSVT(:,:,:,NSV_DSTBEG:NSV_DSTEND), XRHODREF(:,:,:))
850         IF (LSALT) CALL SALT_FILTER(XSVT(:,:,:,NSV_SLTBEG:NSV_SLTEND), XRHODREF(:,:,:))
851         IF (LCH_CONV_LINOX) THEN
852           CALL CONVECTION( XDTCONV, CDCONV, CSCONV, LREFRESH_ALL, LDOWN, NICE, &
853                          LSETTADJ, XTADJD, XTADJS, LDIAGCONV, NENSM,           &
854                          XPABST, XZZ, ZDXDY,                                   &
855                          XTHT, XRT(:,:,:,1), ZRC, ZRI, XUT, XVT,               &
856                          ZWT,XTKET(:,:,IKB),                                   &
857                          NCOUNTCONV, XDTHCONV, XDRVCONV, XDRCCONV, XDRICONV,   &
858                          XPRCONV, XPRSCONV,                                    &
859                          XUMFCONV,XDMFCONV,XMFCONV,XPRLFLXCONV,XPRSFLXCONV,    &
860                          XCAPE, NCLTOPCONV, NCLBASCONV,                        &
861                          LCHTRANS, XSVT, XDSVCONV,                             &
862                          LUSECHEM, LCH_CONV_SCAV, LCH_CONV_LINOX,              &
863                          LDUST, LSALT,                                         &
864                          XRHODREF, XIC_RATE, XCG_RATE                          )
865         ELSE
866           CALL CONVECTION( XDTCONV, CDCONV, CSCONV, LREFRESH_ALL, LDOWN, NICE, &
867                          LSETTADJ, XTADJD, XTADJS, LDIAGCONV, NENSM,           &
868                          XPABST, XZZ, ZDXDY,                                   &
869                          XTHT, XRT(:,:,:,1), ZRC, ZRI, XUT, XVT,               &
870                          ZWT,XTKET(:,:,IKB),                                   &
871                          NCOUNTCONV, XDTHCONV, XDRVCONV, XDRCCONV, XDRICONV,   &
872                          XPRCONV, XPRSCONV,                                    &
873                          XUMFCONV,XDMFCONV,XMFCONV,XPRLFLXCONV,XPRSFLXCONV,    &
874                          XCAPE, NCLTOPCONV, NCLBASCONV,                        &
875                          LCHTRANS, XSVT, XDSVCONV,                             &
876                          LUSECHEM, LCH_CONV_SCAV, LCH_CONV_LINOX,              &
877                          LDUST, LSALT,                                         &
878                          XRHODREF )
879         END IF
880 !
881         DEALLOCATE( ZRC )
882         DEALLOCATE( ZRI )
883         DEALLOCATE( ZWT )
884         DEALLOCATE( ZDXDY )
885     END IF    
886   END IF
887 !
888 !  Deep convection tendency integration
889 !
890   XRTHS(:,:,:)  = XRTHS(:,:,:)  + XRHODJ(:,:,:) * XDTHCONV(:,:,:)
891   XRRS(:,:,:,1) = XRRS(:,:,:,1) + XRHODJ(:,:,:) * XDRVCONV(:,:,:)
892 !
893 !
894 ! Aerosols size distribution
895 ! Compute Rg and sigma before tracers convection tendency (for orilam, dust and sea
896 ! salt)
897 !
898
899   IF ( LCHTRANS ) THEN  ! update tracers for chemical transport
900     IF (LORILAM) ZRSVS(:,:,:,:) = XRSVS(:,:,:,:)    !
901     IF ((LDUST)) THEN ! dust convective balance
902       ALLOCATE(ZSIGDST(IIU,IJU,IKU,NMODE_DST))
903       ALLOCATE(ZRGDST(IIU,IJU,IKU,NMODE_DST))
904       ALLOCATE(ZNDST(IIU,IJU,IKU,NMODE_DST))
905       ALLOCATE(ZSVDST(IIU,IJU,IKU,NSV_DST))
906       !
907       DO JSV=1,NMODE_DST
908         IMODEIDX = JPDUSTORDER(JSV)
909         IF (CRGUNITD=="MASS") THEN
910           ZINIRADIUS(JSV) = XINIRADIUS(IMODEIDX) * EXP(-3.*(LOG(XINISIG(IMODEIDX)))**2)
911         ELSE
912           ZINIRADIUS(JSV) = XINIRADIUS(IMODEIDX)
913         END IF
914         ZSIGDST(:,:,:,JSV) = XINISIG(IMODEIDX)
915         ZRGDST(:,:,:,JSV)  = ZINIRADIUS(JSV)
916         ZNDST(:,:,:,JSV)   = XN0MIN(IMODEIDX)
917       ENDDO
918       !
919       DO JSV=NSV_DSTBEG,NSV_DSTEND
920         ZSVDST(:,:,:,JSV-NSV_DSTBEG+1) = XRSVS(:,:,:,JSV) * XTSTEP / XRHODJ(:,:,:) 
921       ENDDO
922       CALL PPP2DUST(ZSVDST(IIB:IIE,IJB:IJE,IKB:IKE,:), XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE),&
923               PSIG3D=ZSIGDST(IIB:IIE,IJB:IJE,IKB:IKE,:), PRG3D=ZRGDST(IIB:IIE,IJB:IJE,IKB:IKE,:),   &
924               PN3D=ZNDST(IIB:IIE,IJB:IJE,IKB:IKE,:))
925     END IF
926     !
927     IF ((LSALT)) THEN ! sea salt convective balance
928       ALLOCATE(ZSIGSLT(IIU,IJU,IKU,NMODE_SLT))
929       ALLOCATE(ZRGSLT(IIU,IJU,IKU,NMODE_SLT))
930       ALLOCATE(ZNSLT(IIU,IJU,IKU,NMODE_SLT))
931       ALLOCATE(ZSVSLT(IIU,IJU,IKU,NSV_SLT))
932       !
933       DO JSV=1,NMODE_SLT
934         IMODEIDX = JPSALTORDER(JSV)
935         IF (CRGUNITS=="MASS") THEN
936           ZINIRADIUS_SLT(JSV) = XINIRADIUS_SLT(IMODEIDX) * &
937                             EXP(-3.*(LOG(XINISIG_SLT(IMODEIDX)))**2)
938         ELSE
939           ZINIRADIUS_SLT(JSV) = XINIRADIUS_SLT(IMODEIDX)
940         END IF
941         ZSIGSLT(:,:,:,JSV) = XINISIG_SLT(IMODEIDX)
942         ZRGSLT(:,:,:,JSV)  = ZINIRADIUS_SLT(JSV)
943         ZNSLT(:,:,:,JSV)   = XN0MIN_SLT(IMODEIDX)
944       ENDDO
945       !
946       DO JSV=NSV_SLTBEG,NSV_SLTEND
947         ZSVSLT(:,:,:,JSV-NSV_SLTBEG+1) = XRSVS(:,:,:,JSV) * XTSTEP / XRHODJ(:,:,:) 
948       ENDDO
949       CALL PPP2SALT(ZSVSLT(IIB:IIE,IJB:IJE,IKB:IKE,:), XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE),&
950               PSIG3D=ZSIGSLT(IIB:IIE,IJB:IJE,IKB:IKE,:), PRG3D=ZRGSLT(IIB:IIE,IJB:IJE,IKB:IKE,:),   &
951               PN3D=ZNSLT(IIB:IIE,IJB:IJE,IKB:IKE,:))
952     END IF
953     !
954 !
955 ! Compute convective tendency for all tracers
956 !
957   IF (LCHTRANS) THEN
958     DO JSV = 1, SIZE(XRSVS,4)
959       XRSVS(:,:,:,JSV) = XRSVS(:,:,:,JSV) + XRHODJ(:,:,:) * XDSVCONV(:,:,:,JSV)
960     END DO
961     IF (LORILAM) THEN
962       DO JSV = NSV_AERBEG,NSV_AEREND
963         PWETDEPAER(:,:,:,JSV-NSV_AERBEG+1) = XDSVCONV(:,:,:,JSV) * XRHODJ(:,:,:)
964         XRSVS(:,:,:,JSV) = ZRSVS(:,:,:,JSV) 
965       END DO
966     END IF  
967   END IF
968 !
969   IF ((LDUST).AND.(LCHTRANS)) THEN ! dust convective balance
970     IF (CPROGRAM == "MESONH") THEN
971       DO JSV=NSV_DSTBEG,NSV_DSTEND
972           ZSVDST(:,:,:,JSV-NSV_DSTBEG+1) = XRSVS(:,:,:,JSV) * XTSTEP / XRHODJ(:,:,:) 
973       ENDDO
974     ELSE
975       DO JSV=NSV_DSTBEG,NSV_DSTEND
976         ZSVDST(:,:,:,JSV-NSV_DSTBEG+1) = XSVT(:,:,:,JSV)
977       ENDDO
978     ENDIF
979     CALL DUST2PPP(ZSVDST(IIB:IIE,IJB:IJE,IKB:IKE,:), &
980                     XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE), ZSIGDST(IIB:IIE,IJB:IJE,IKB:IKE,:),&
981                     ZRGDST(IIB:IIE,IJB:IJE,IKB:IKE,:))
982     DO JSV=NSV_DSTBEG,NSV_DSTEND
983       XRSVS(:,:,:,JSV) =  ZSVDST(:,:,:,JSV-NSV_DSTBEG+1) * XRHODJ(:,:,:) / XTSTEP
984     ENDDO
985     !
986     DEALLOCATE(ZSVDST)
987     DEALLOCATE(ZNDST)
988     DEALLOCATE(ZRGDST)
989     DEALLOCATE(ZSIGDST)
990   END IF
991     !
992   IF ((LSALT).AND.(LCHTRANS)) THEN ! sea salt convective balance
993     IF (CPROGRAM == "MESONH") THEN
994       DO JSV=NSV_SLTBEG,NSV_SLTEND
995         ZSVSLT(:,:,:,JSV-NSV_SLTBEG+1) = XRSVS(:,:,:,JSV) * XTSTEP / XRHODJ(:,:,:) 
996       ENDDO
997     ELSE
998       DO JSV=NSV_SLTBEG,NSV_SLTEND
999         ZSVSLT(:,:,:,JSV-NSV_SLTBEG+1) = XSVT(:,:,:,JSV)
1000       ENDDO
1001     END IF
1002     CALL SALT2PPP(ZSVSLT(IIB:IIE,IJB:IJE,IKB:IKE,:), &
1003                   XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE), ZSIGSLT(IIB:IIE,IJB:IJE,IKB:IKE,:),&
1004                   ZRGSLT(IIB:IIE,IJB:IJE,IKB:IKE,:))
1005     DO JSV=NSV_SLTBEG,NSV_SLTEND
1006       XRSVS(:,:,:,JSV) =  ZSVSLT(:,:,:,JSV-NSV_SLTBEG+1) * XRHODJ(:,:,:) / XTSTEP
1007     ENDDO
1008     !
1009     DEALLOCATE(ZSVSLT)
1010     DEALLOCATE(ZNSLT)
1011     DEALLOCATE(ZRGSLT)
1012     DEALLOCATE(ZSIGSLT)
1013   END IF
1014   !
1015 END IF
1016 !
1017   IF( LUSERC .AND. LUSERI ) THEN
1018     XRRS(:,:,:,2) = XRRS(:,:,:,2) + XRHODJ(:,:,:) * XDRCCONV(:,:,:)
1019     XRRS(:,:,:,4) = XRRS(:,:,:,4) + XRHODJ(:,:,:) * XDRICONV(:,:,:)
1020 !
1021   ELSE IF ( LUSERC .AND. (.NOT. LUSERI) ) THEN
1022 !
1023 !  If only cloud water but no cloud ice is used, the convective tendency
1024 !     for cloud ice is added to the tendency for cloud water
1025 !
1026       XRRS(:,:,:,2) = XRRS(:,:,:,2) + XRHODJ(:,:,:) * (XDRCCONV(:,:,:) + &
1027                                                        XDRICONV(:,:,:)   )
1028 !     and cloud ice is melted
1029 !
1030       XRTHS(:,:,:) = XRTHS(:,:,:) - XRHODJ(:,:,:) *                      &
1031          ( XP00/XPABST(:,:,:) )**(XRD/XCPD) * XLMTT / XCPD * XDRICONV(:,:,:)
1032 !
1033   ELSE IF ( (.NOT. LUSERC) .AND. (.NOT. LUSERI) ) THEN
1034 !
1035 !  If no cloud water and no cloud ice are used the convective tendencies for these
1036 !     variables are added to the water vapor tendency
1037 !
1038       XRRS(:,:,:,1) = XRRS(:,:,:,1) + XRHODJ(:,:,:) * (XDRCCONV(:,:,:) + &
1039                                                        XDRICONV(:,:,:)   )
1040 !     and all cloud condensate is evaporated
1041 !
1042       XRTHS(:,:,:) = XRTHS(:,:,:) - XRHODJ(:,:,:) / XCPD * (              &
1043                      XLVTT * XDRCCONV(:,:,:) + XLSTT * XDRICONV(:,:,:) ) *&
1044                     ( XP00 / XPABST(:,:,:) ) ** ( XRD / XCPD )
1045   END IF                                                               
1046 END IF
1047 !
1048 !  budget storage
1049 !
1050 IF (CDCONV == 'KAFR' .OR. CSCONV == 'KAFR' ) THEN
1051   IF (LBUDGET_TH) CALL BUDGET (XRTHS,4,'DCONV_BU_RTH')
1052   IF (LBUDGET_RV) CALL BUDGET (XRRS(:,:,:,1),6,'DCONV_BU_RRV')
1053   IF (LBUDGET_RC) CALL BUDGET (XRRS(:,:,:,2),7,'DCONV_BU_RRC')
1054   IF (LBUDGET_RI) CALL BUDGET (XRRS(:,:,:,4),9,'DCONV_BU_RRI')
1055   IF (LCHTRANS .AND. LBUDGET_SV) THEN
1056     DO JSV = 1, SIZE(XRSVS,4)
1057       CALL BUDGET (XRSVS(:,:,:,JSV),JSV+12,'DCONV_BU_RSV')
1058     END DO
1059   END IF
1060 END IF
1061 !
1062 CALL SECOND_MNH2(ZTIME2)
1063 !
1064 PKAFR = PKAFR + ZTIME2 - ZTIME1 &
1065        - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
1066 !
1067 PTIME_BU = PTIME_BU + XTIME_LES_BU_PROCESS + XTIME_BU_PROCESS
1068 !
1069 !-----------------------------------------------------------------------------
1070 !
1071 !*        3.    TURBULENT SURFACE FLUXES
1072 !               ------------------------
1073 !
1074 ZTIME1 = ZTIME2
1075 !
1076 IF (CSURF=='EXTE') THEN
1077   CALL GOTO_SURFEX(IMI)
1078 !
1079   IF( LTRANS ) THEN
1080     XUT(:,:,1+JPVEXT) = XUT(:,:,1+JPVEXT) + XUTRANS
1081     XVT(:,:,1+JPVEXT) = XVT(:,:,1+JPVEXT) + XVTRANS
1082   END IF
1083   !
1084   ALLOCATE(ZDIR_ALB(IIU,IJU,NSWB_MNH))
1085   ALLOCATE(ZSCA_ALB(IIU,IJU,NSWB_MNH))
1086   ALLOCATE(ZEMIS  (IIU,IJU,NLWB_MNH))
1087   ALLOCATE(ZTSRAD (IIU,IJU))
1088   !  
1089   IKIDM=0
1090   DO JKID = IMI+1,NMODEL  ! min value of the possible kids
1091     IF (IMI == NDAD(JKID) .AND. XWAY(JKID) == 2. .AND. &
1092      CPROGRAM=='MESONH' .AND. &
1093      (CCONF == 'RESTA' .OR. (CCONF == 'START' .AND. KTCOUNT /= 1))) THEN
1094     !  where kids exist, use the two-way output fields (i.e. OMASKkids true)
1095     !  rather than the farther calculations in radiation and convection schemes
1096 ! BUG if number of the son does not follow the number of the dad
1097 !    IKIDM = JKID-IMI
1098       IKIDM = IKIDM + 1
1099      IF (LUSERC .AND. (                                               &
1100          (LSEDIC .AND. CCLOUD(1:3) == 'ICE')                     .OR. &
1101          (LSEDC  .AND. (CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO')) .OR. &
1102          (MSEDC  .AND. CCLOUD=='LIMA')                                &
1103         )) THEN
1104          WHERE (OMASKkids(:,:) )
1105             XINPRC(:,:) = ZSAVE_INPRC(:,:,IKIDM)
1106           ENDWHERE
1107       END IF
1108       IF (LUSERR) THEN
1109         WHERE (OMASKkids(:,:) )
1110           XINPRR(:,:) = ZSAVE_INPRR(:,:,IKIDM)
1111         ENDWHERE
1112       END IF
1113       IF (LUSERS) THEN
1114         WHERE (OMASKkids(:,:) )
1115           XINPRS(:,:) = ZSAVE_INPRS(:,:,IKIDM)
1116        ENDWHERE
1117       END IF
1118       IF (LUSERG) THEN
1119         WHERE (OMASKkids(:,:) )
1120           XINPRG(:,:) = ZSAVE_INPRG(:,:,IKIDM)
1121         ENDWHERE
1122       END IF
1123       IF (LUSERH) THEN
1124         WHERE (OMASKkids(:,:) )
1125           XINPRH(:,:) = ZSAVE_INPRH(:,:,IKIDM)
1126         ENDWHERE
1127       END IF
1128       IF (CDCONV /= 'NONE') THEN
1129         WHERE (OMASKkids(:,:) )
1130           XPRCONV(:,:) = ZSAVE_PRCONV(:,:,IKIDM)
1131           XPRSCONV(:,:) = ZSAVE_PRSCONV(:,:,IKIDM)
1132         ENDWHERE
1133       END IF
1134       IF (CRAD /= 'NONE') THEN
1135         DO JSWB=1,NSWB_MNH
1136           WHERE (OMASKkids(:,:) ) 
1137             XDIRFLASWD(:,:,JSWB) = ZSAVE_DIRFLASWD(:,:,JSWB,IKIDM)
1138             XSCAFLASWD(:,:,JSWB) = ZSAVE_SCAFLASWD(:,:,JSWB,IKIDM)
1139             XDIRSRFSWD(:,:,JSWB) = ZSAVE_DIRSRFSWD(:,:,JSWB,IKIDM)
1140           ENDWHERE
1141         ENDDO
1142       END IF
1143     ENDIF
1144   END DO
1145   !
1146  IF (IMODSON /= 0 ) THEN
1147     DEALLOCATE( ZSAVE_INPRR,ZSAVE_INPRS,ZSAVE_INPRG,ZSAVE_INPRH)
1148     DEALLOCATE( ZSAVE_INPRC,ZSAVE_PRCONV,ZSAVE_PRSCONV)
1149     DEALLOCATE( ZSAVE_DIRFLASWD,ZSAVE_SCAFLASWD,ZSAVE_DIRSRFSWD)
1150  END IF
1151   CALL GROUND_PARAM_n(ZSFTH, ZSFRV, ZSFSV, ZSFCO2, ZSFU, ZSFV, &
1152                       ZDIR_ALB, ZSCA_ALB, ZEMIS, ZTSRAD        )
1153   !
1154   IF (SIZE(XEMIS)>0) THEN
1155     XDIR_ALB = ZDIR_ALB
1156     XSCA_ALB = ZSCA_ALB
1157     XEMIS    = ZEMIS
1158     XTSRAD   = ZTSRAD
1159   END IF
1160   !
1161   DEALLOCATE(ZDIR_ALB)
1162   DEALLOCATE(ZSCA_ALB)
1163   DEALLOCATE(ZEMIS   )
1164   DEALLOCATE(ZTSRAD  )
1165   !
1166   !
1167   IF( LTRANS ) THEN
1168     XUT(:,:,1+JPVEXT) = XUT(:,:,1+JPVEXT) - XUTRANS
1169     XVT(:,:,1+JPVEXT) = XVT(:,:,1+JPVEXT) - XVTRANS
1170   END IF
1171 !
1172 ELSE
1173   ZSFTH    = 0.
1174   ZSFRV    = 0.
1175   ZSFSV    = 0.
1176   ZSFCO2   = 0.
1177   ZSFU     = 0.
1178   ZSFV     = 0.
1179 END IF
1180 !
1181 CALL SECOND_MNH2(ZTIME2)
1182 !
1183 PGROUND = PGROUND + ZTIME2 - ZTIME1
1184 !
1185 !-----------------------------------------------------------------------------
1186 !
1187 !*        3.1    EDDY FLUXES PARAMETRIZATION
1188 !               ------------------
1189 !
1190 IF (IMI==1) THEN  ! On calcule les flus turb. comme preconise par PP
1191
1192    ! Heat eddy fluxes
1193    IF ( LTH_FLX ) CALL EDDY_FLUX_n(IMI,KTCOUNT,XVT,XTHT,XRHODJ,XRTHS,XVTH_FLUX_M,XWTH_FLUX_M)
1194    !
1195    ! Momentum eddy fluxes
1196    IF ( LUV_FLX ) CALL EDDYUV_FLUX_n(IMI,KTCOUNT,XVT,XTHT,XRHODJ,XRHODREF,XPABSM,XRVS,XVU_FLUX_M)
1197
1198 ELSE
1199    ! TEST pour maille infèrieure à 20km ? 
1200    !      car pb d'instabilités ?
1201    !      Pour le modèle fils, on spawne les flux du modèle père
1202    ! Heat eddy fluxes
1203    IF ( LTH_FLX ) CALL EDDY_FLUX_ONE_WAY_n (IMI,KTCOUNT,NDXRATIO_ALL(IMI),NDYRATIO_ALL(IMI),CLBCX,CLBCY)
1204    !
1205    ! Momentum eddy fluxes
1206    IF ( LUV_FLX ) CALL EDDYUV_FLUX_ONE_WAY_n (IMI,KTCOUNT,NDXRATIO_ALL(IMI),NDYRATIO_ALL(IMI),CLBCX,CLBCY)
1207    !
1208 END IF
1209 !-----------------------------------------------------------------------------
1210 !
1211 !*        4.    PASSIVE POLLUTANTS
1212 !               ------------------
1213 !
1214 ZTIME1 = ZTIME2
1215 !
1216 IF (LPASPOL) CALL PASPOL(XTSTEP, ZSFSV, ILUOUT, NVERB, OCLOSE_OUT, TPFILE)
1217 !
1218 !
1219 !*        4b.  PASSIVE POLLUTANTS FOR MASS-FLUX SCHEME DIAGNOSTICS
1220 !              ---------------------------------------------------
1221 !
1222 IF (LCONDSAMP) CALL CONDSAMP(XTSTEP, ZSFSV, ILUOUT, NVERB)
1223 !
1224 CALL SECOND_MNH2(ZTIME2)
1225 !
1226 PTRACER = PTRACER + ZTIME2 - ZTIME1
1227 !-----------------------------------------------------------------------------
1228 !
1229 !*        5.    Drag force 
1230 !               ----------
1231 !
1232 ZTIME1 = ZTIME2
1233 XTIME_BU_PROCESS = 0.
1234 XTIME_LES_BU_PROCESS = 0.
1235 !
1236 IF (LDRAGTREE) CALL DRAG_VEG(XTSTEP,XUT,XVT,XTKET,LDEPOTREE,XVDEPOTREE, &
1237                              CCLOUD, XPABST,XTHT,XRT,XSVT,       &
1238                              XRHODJ,XZZ,XRUS, XRVS,              &
1239                              XRTKES,XRTHS, XRRS,XRSVS)
1240 !
1241 CALL SECOND_MNH2(ZTIME2)
1242 !
1243 PDRAG = PDRAG + ZTIME2 - ZTIME1 &
1244              - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
1245 !
1246 PTIME_BU = PTIME_BU + XTIME_LES_BU_PROCESS + XTIME_BU_PROCESS
1247 !
1248 !-----------------------------------------------------------------------------
1249 !
1250 !*        6.    TURBULENCE SCHEME
1251 !               -----------------
1252 !
1253 ZTIME1 = ZTIME2
1254 XTIME_BU_PROCESS = 0.
1255 XTIME_LES_BU_PROCESS = 0.
1256 !
1257 ZSFTH(:,:)  = ZSFTH(:,:) * XDIRCOSZW(:,:)
1258 ZSFRV(:,:)  = ZSFRV(:,:) * XDIRCOSZW(:,:)
1259 DO JSV=1,NSV
1260   ZSFSV(:,:,JSV)  = ZSFSV(:,:,JSV) * XDIRCOSZW(:,:)
1261 END DO
1262 !
1263 IF (LLES_CALL) CALL SWITCH_SBG_LES_n
1264 !
1265 !
1266 IF ( CTURB == 'TKEL' ) THEN
1267 !
1268
1269 !*        6.1 complete surface fluxe fields on the border
1270 !
1271 !!$  IF(NHALO == 1) THEN
1272     CALL ADD2DFIELD_ll(TZFIELDS_ll,ZSFTH)
1273     CALL ADD2DFIELD_ll(TZFIELDS_ll,ZSFRV)
1274     CALL ADD2DFIELD_ll(TZFIELDS_ll,ZSFU)
1275     CALL ADD2DFIELD_ll(TZFIELDS_ll,ZSFV)
1276     IF(NSV >0)THEN
1277       DO JSV=1,NSV
1278         CALL ADD2DFIELD_ll(TZFIELDS_ll,ZSFSV(:,:,JSV))
1279       END DO
1280     END IF
1281     CALL ADD2DFIELD_ll(TZFIELDS_ll,ZSFCO2)
1282     CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
1283     CALL CLEANLIST_ll(TZFIELDS_ll)
1284 !!$  END IF
1285 !
1286   CALL MPPDB_CHECK2D(ZSFU,"phys_param::ZSFU",PRECISION)
1287   !
1288   IF ( CLBCX(1) /= "CYCL" .AND. LWEST_ll()) THEN
1289     ZSFTH(IIB-1,:)=ZSFTH(IIB,:)
1290     ZSFRV(IIB-1,:)=ZSFRV(IIB,:)
1291     ZSFU(IIB-1,:)=ZSFU(IIB,:)
1292     ZSFV(IIB-1,:)=ZSFV(IIB,:)
1293     IF (NSV>0)  THEN
1294       ZSFSV(IIB-1,:,:)=ZSFSV(IIB,:,:)
1295       WHERE ((ZSFSV(IIB-1,:,:).LT.0.).AND.(XSVT(IIB-1,:,IKB,:).EQ.0.))
1296           ZSFSV(IIB-1,:,:) = 0.
1297       END WHERE
1298     ENDIF
1299     ZSFCO2(IIB-1,:)=ZSFCO2(IIB,:)
1300   END IF
1301   IF ( CLBCX(2) /= "CYCL" .AND. LEAST_ll()) THEN
1302     ZSFTH(IIE+1,:)=ZSFTH(IIE,:)
1303     ZSFRV(IIE+1,:)=ZSFRV(IIE,:)
1304     ZSFU(IIE+1,:)=ZSFU(IIE,:)
1305     ZSFV(IIE+1,:)=ZSFV(IIE,:)
1306     IF (NSV>0) THEN
1307       ZSFSV(IIE+1,:,:)=ZSFSV(IIE,:,:)
1308       WHERE ((ZSFSV(IIE+1,:,:).LT.0.).AND.(XSVT(IIE+1,:,IKB,:).EQ.0.))
1309           ZSFSV(IIE+1,:,:) = 0.
1310       END WHERE
1311     ENDIF
1312     ZSFCO2(IIE+1,:)=ZSFCO2(IIE,:)
1313   END IF
1314   IF ( CLBCY(1) /= "CYCL" .AND. LSOUTH_ll()) THEN
1315     ZSFTH(:,IJB-1)=ZSFTH(:,IJB)
1316     ZSFRV(:,IJB-1)=ZSFRV(:,IJB)
1317     ZSFU(:,IJB-1)=ZSFU(:,IJB)
1318     ZSFV(:,IJB-1)=ZSFV(:,IJB)
1319     IF (NSV>0) THEN
1320       ZSFSV(:,IJB-1,:)=ZSFSV(:,IJB,:)
1321       WHERE ((ZSFSV(:,IJB-1,:).LT.0.).AND.(XSVT(:,IJB-1,IKB,:).EQ.0.))
1322           ZSFSV(:,IJB-1,:) = 0.
1323       END WHERE
1324     ENDIF
1325     ZSFCO2(:,IJB-1)=ZSFCO2(:,IJB)
1326   END IF
1327   IF ( CLBCY(2) /= "CYCL" .AND. LNORTH_ll()) THEN
1328     ZSFTH(:,IJE+1)=ZSFTH(:,IJE)
1329     ZSFRV(:,IJE+1)=ZSFRV(:,IJE)
1330     ZSFU(:,IJE+1)=ZSFU(:,IJE)
1331     ZSFV(:,IJE+1)=ZSFV(:,IJE)
1332     IF (NSV>0) THEN
1333       ZSFSV(:,IJE+1,:)=ZSFSV(:,IJE,:)
1334       WHERE ((ZSFSV(:,IJE+1,:).LT.0.).AND.(XSVT(:,IJE+1,IKB,:).EQ.0.))
1335           ZSFSV(:,IJE+1,:) = 0.
1336       END WHERE
1337     ENDIF
1338     ZSFCO2(:,IJE+1)=ZSFCO2(:,IJE)
1339   END IF
1340 !
1341   IF( LTRANS ) THEN
1342     XUT(:,:,:) = XUT(:,:,:) + XUTRANS
1343     XVT(:,:,:) = XVT(:,:,:) + XVTRANS
1344   END IF
1345 !
1346 !
1347 IF(ALLOCATED(XTHW_FLUX))  THEN
1348  DEALLOCATE(XTHW_FLUX)
1349  ALLOCATE(XTHW_FLUX(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)))
1350 ELSE
1351  ALLOCATE(XTHW_FLUX(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)))
1352 END IF
1353
1354 IF(ALLOCATED(XRCW_FLUX))  THEN
1355  DEALLOCATE(XRCW_FLUX)
1356  ALLOCATE(XRCW_FLUX(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)))
1357 ELSE
1358  ALLOCATE(XRCW_FLUX(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)))
1359 END IF
1360 !
1361 IF(ALLOCATED(XSVW_FLUX))  THEN
1362  DEALLOCATE(XSVW_FLUX)
1363  ALLOCATE(XSVW_FLUX(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),SIZE(XSVT,4)))
1364 ELSE
1365  ALLOCATE(XSVW_FLUX(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),SIZE(XSVT,4)))
1366 END IF
1367 !
1368    CALL TURB(1,IKU,1,IMI,NRR, NRRL, NRRI, CLBCX, CLBCY, 1,NMODEL_CLOUD,     &
1369       OCLOSE_OUT,LTURB_FLX,LTURB_DIAG,LSUBG_COND,LRMC01,                    &
1370       CTURBDIM,CTURBLEN,CTOM,CTURBLEN_CLOUD,CCLOUD,XIMPL,                   &
1371       XTSTEP,TPFILE,                                                        &
1372       XDXX,XDYY,XDZZ,XDZX,XDZY,XZZ,                                         &
1373       XDIRCOSXW,XDIRCOSYW,XDIRCOSZW,XCOSSLOPE,XSINSLOPE,                    &
1374       XRHODJ,XTHVREF,                                                       &
1375       ZSFTH,ZSFRV,ZSFSV,ZSFU,ZSFV,                                          &
1376       XPABST,XUT,XVT,XWT,XTKET,XSVT,XSRCT,XBL_DEPTH,XSBL_DEPTH,             &
1377       XCEI,XCEI_MIN,XCEI_MAX,XCOEF_AMPL_SAT,                                &
1378       XTHT,XRT,                                                             &
1379       XRUS,XRVS,XRWS,XRTHS,XRRS,XRSVS,XRTKES,XRTKEMS, XSIGS, XWTHVMF,       &
1380       XTHW_FLUX, XRCW_FLUX, XSVW_FLUX,XDYP, XTHP, XTR, XDISS,  XLEM         )
1381 !
1382 IF (LRMC01) THEN
1383   CALL ADD2DFIELD_ll(TZFIELDS_ll,XSBL_DEPTH)
1384   CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
1385   CALL CLEANLIST_ll(TZFIELDS_ll)
1386   IF ( CLBCX(1) /= "CYCL" .AND. LWEST_ll()) THEN
1387     XSBL_DEPTH(IIB-1,:)=XSBL_DEPTH(IIB,:)
1388   END IF
1389   IF ( CLBCX(2) /= "CYCL" .AND. LEAST_ll()) THEN
1390     XSBL_DEPTH(IIE+1,:)=XSBL_DEPTH(IIE,:)
1391   END IF
1392   IF ( CLBCY(1) /= "CYCL" .AND. LSOUTH_ll()) THEN
1393     XSBL_DEPTH(:,IJB-1)=XSBL_DEPTH(:,IJB)
1394   END IF
1395   IF ( CLBCY(2) /= "CYCL" .AND. LNORTH_ll()) THEN
1396     XSBL_DEPTH(:,IJE+1)=XSBL_DEPTH(:,IJE)
1397   END IF
1398 END IF
1399 !
1400 CALL SECOND_MNH2(ZTIME3)
1401 !
1402 !-----------------------------------------------------------------------------
1403 !
1404 !*        7.    EDMF SCHEME
1405 !               -----------
1406 !
1407 IF (CSCONV == 'EDKF') THEN
1408      ALLOCATE(ZEXN (IIU,IJU,IKU))
1409      ALLOCATE(ZSIGMF (IIU,IJU,IKU))
1410      ZSIGMF(:,:,:)=0.    
1411      ZEXN(:,:,:)=(XPABST(:,:,:)/XP00)**(XRD/XCPD)  
1412      !$20131113 check3d on ZEXN
1413      CALL MPPDB_CHECK3D(ZEXN,"physparan.7::ZEXN",PRECISION)
1414      CALL ADD3DFIELD_ll(TZFIELDS_ll, ZEXN)
1415      !$20131113 add update_halo_ll
1416      CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
1417      CALL CLEANLIST_ll(TZFIELDS_ll)
1418      CALL MPPDB_CHECK3D(ZEXN,"physparam.7::ZEXN",PRECISION)
1419  !    
1420      CALL SHALLOW_MF_PACK(NRR,NRRL,NRRI, CMF_UPDRAFT, CMF_CLOUD, LMIXUV,  &
1421                    OCLOSE_OUT,LMF_FLX,TPFILE,ZTIME_LES_MF,                &
1422                    XIMPL_MF, XTSTEP,                                      &
1423                    XDZZ, XZZ,                                             &
1424                    XRHODJ, XRHODREF, XPABST, ZEXN, ZSFTH, ZSFRV,          &
1425                    XTHT,XRT,XUT,XVT,XWT,XTKET,XSVT,                       &
1426                    XRTHS,XRRS,XRUS,XRVS,XRSVS,                            &
1427                    ZSIGMF,XRC_MF, XRI_MF, XCF_MF, XWTHVMF)
1428 !
1429 ELSE
1430     XWTHVMF(:,:,:)=0.
1431     XRC_MF(:,:,:)=0.
1432     XRI_MF(:,:,:)=0.
1433     XCF_MF(:,:,:)=0.
1434 ENDIF   
1435 !
1436 CALL SECOND_MNH2(ZTIME4)
1437
1438   IF( LTRANS ) THEN
1439     XUT(:,:,:) = XUT(:,:,:) - XUTRANS
1440     XVT(:,:,:) = XVT(:,:,:) - XVTRANS
1441   END IF
1442
1443   IF (CMF_CLOUD == 'STAT') THEN
1444     XSIGS =SQRT( XSIGS**2 + ZSIGMF**2 )
1445   ENDIF
1446   IF (CSCONV == 'EDKF') THEN
1447     DEALLOCATE(ZSIGMF)
1448     DEALLOCATE(ZEXN)
1449   ENDIF
1450 END IF
1451 !
1452 IF (LLES_CALL) CALL SWITCH_SBG_LES_n
1453 !
1454 CALL SECOND_MNH2(ZTIME2)
1455 !
1456 PTURB = PTURB + ZTIME2 - ZTIME1 - (XTIME_LES-ZTIME_LES_MF) - XTIME_LES_BU_PROCESS &
1457       - XTIME_BU_PROCESS - (ZTIME4 - ZTIME3)
1458 !
1459 PMAFL = PMAFL + ZTIME4 - ZTIME3 - ZTIME_LES_MF
1460 !
1461 PTIME_BU = PTIME_BU + XTIME_LES_BU_PROCESS + XTIME_BU_PROCESS
1462 !
1463 !
1464 !
1465 !-------------------------------------------------------------------------------
1466 !
1467 !* deallocation of variables used in more than one parameterization
1468 !
1469 DEALLOCATE(ZSFU  )         ! surface schemes + turbulence
1470 DEALLOCATE(ZSFV  )
1471 DEALLOCATE(ZSFTH )
1472 DEALLOCATE(ZSFRV )
1473 DEALLOCATE(ZSFSV )
1474 DEALLOCATE(ZSFCO2)
1475 !
1476 !-------------------------------------------------------------------------------
1477 !
1478 END SUBROUTINE PHYS_PARAM_n
1479