Philippe 14/11/2016: minor: removed unused IO arguments
[MNH-git_open_source-lfs.git] / src / MNH / resolved_cloud.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 ! $Source$
6 !-----------------------------------------------------------------
7 !     ##########################
8       MODULE MODI_RESOLVED_CLOUD
9 !     ##########################
10 INTERFACE
11       SUBROUTINE RESOLVED_CLOUD ( HCLOUD, HACTCCN, HSCONV, HMF_CLOUD,                  &
12                                   KRR, KSPLITR, KSPLITG, KMI, KTCOUNT,                 &
13                                   HLBCX, HLBCY, HFMFILE, HLUOUT, HRAD, HTURBDIM,       &
14                                   OCLOSE_OUT, OSUBG_COND, OSIGMAS, HSUBG_AUCV,         &
15                                   PTSTEP, PZZ, PRHODJ, PRHODREF, PEXNREF,              &
16                                   PPABST, PTHT, PRT, PSIGS, PSIGQSAT, PMFCONV,         &
17                                   PTHM, PRCM, PPABSM,                                  &
18                                   PW_ACT,PDTHRAD, PTHS, PRS, PSVT, PSVS, PSRCS, PCLDFR,&
19                                   PCIT, OSEDIC, OACTIT, OSEDC, OSEDI,                  &
20                                   ORAIN, OWARM, OHHONI, OCONVHG,                       &
21                                   PCF_MF,PRC_MF, PRI_MF,                               &
22                                   PINPRC,PINPRC3D,PINPRR,PINPRR3D, PEVAP3D,            &
23                                   PINPRS,PINPRS3D,PINPRG,PINPRG3D,PINPRH,PINPRH3D,     &
24                                   PSOLORG,PMI,                                         &
25                                   PSPEEDC, PSPEEDR, PSPEEDS, PSPEEDG, PSPEEDH,         &
26                                   PSEA,PTOWN          )   
27 !
28 CHARACTER(LEN=4),         INTENT(IN)   :: HCLOUD   ! kind of cloud
29 CHARACTER(LEN=4),         INTENT(IN)   :: HACTCCN  ! kind of CCN activation scheme
30                                                    ! paramerization
31 CHARACTER(LEN=4),         INTENT(IN)   :: HSCONV   ! Shallow convection scheme
32 CHARACTER(LEN=4),         INTENT(IN)   :: HMF_CLOUD! Type of statistical cloud
33 INTEGER,                  INTENT(IN)   :: KRR      ! Number of moist variables
34 INTEGER,                  INTENT(IN)   :: KSPLITR  ! Number of small time step
35                                        ! integrations for  rain sedimendation
36 INTEGER,                  INTENT(IN)   :: KSPLITG  ! Number of small time step
37                                        ! integrations for  ice  sedimendation
38 INTEGER,                  INTENT(IN)   :: KMI      ! Model index
39 INTEGER,                  INTENT(IN)   :: KTCOUNT  ! Temporal loop counter
40 CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY   ! X and Y-direc. LBC type
41 CHARACTER(LEN=*),         INTENT(IN)   :: HFMFILE  ! Name of the output FM-file
42 CHARACTER(LEN=*),         INTENT(IN)   :: HLUOUT   ! Output-listing name for
43                                                    ! model n
44 CHARACTER*4,              INTENT(IN)   :: HRAD     ! Radiation scheme name
45 CHARACTER*4,              INTENT(IN)   :: HTURBDIM ! Dimensionality of the
46                                                    ! turbulence scheme
47 LOGICAL,                  INTENT(IN)   :: OCLOSE_OUT ! Conditional closure of
48                                                    ! the OUTPUT FM-file
49 LOGICAL,                  INTENT(IN)   :: OSUBG_COND ! Switch for Subgrid Cond.
50 LOGICAL,                  INTENT(IN)   :: OSIGMAS  ! Switch for Sigma_s:
51                                         ! use values computed in CONDENSATION
52                                         ! or that from turbulence scheme
53 CHARACTER(LEN=4),         INTENT(IN)   :: HSUBG_AUCV
54                                         ! Kind of Subgrid autoconversion method
55 REAL,                     INTENT(IN)   :: PTSTEP ! Time step :XTSTEP in namelist
56 !
57 !
58 REAL, DIMENSION(:,:,:),   INTENT(IN)   :: PZZ     ! Height (z)
59 REAL, DIMENSION(:,:,:),   INTENT(IN)   :: PRHODJ  !Dry density * Jacobian
60 REAL, DIMENSION(:,:,:),   INTENT(IN)   :: PRHODREF! Reference dry air density
61 REAL, DIMENSION(:,:,:),   INTENT(IN)   :: PEXNREF ! Reference Exner function
62 !
63 !
64 REAL, DIMENSION(:,:,:),   INTENT(IN)   :: PPABST  ! abs. pressure at time t
65 REAL, DIMENSION(:,:,:),   INTENT(IN)   :: PTHT    ! Theta at time t
66 REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PRT     ! Moist variables at time t
67 REAL, DIMENSION(:,:,:),   INTENT(IN)   :: PSIGS   ! Sigma_s at time t
68 REAL,                     INTENT(IN)   :: PSIGQSAT! coeff applied to qsat variance contribution
69 REAL, DIMENSION(:,:,:),   INTENT(IN)   :: PMFCONV ! convective mass flux
70 REAL, DIMENSION(:,:,:),   INTENT(IN)   :: PTHM    ! Theta at time t-Dt
71 REAL, DIMENSION(:,:,:),   INTENT(IN)   :: PPABSM   ! Pressure time t-Dt
72 REAL, DIMENSION(:,:,:),   INTENT(IN)   :: PRCM    ! Cloud water m.r. at time t-Dt
73 !
74 !
75 REAL, DIMENSION(:,:,:),   INTENT(IN)    :: PW_ACT ! W for CCN activation
76 REAL, DIMENSION(:,:,:),   INTENT(IN)    :: PDTHRAD ! THeta RADiative Tendancy
77 REAL, DIMENSION(:,:,:),   INTENT(INOUT) :: PTHS  ! Theta source
78 REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS   ! Moist  variable sources
79 REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT  ! Scalar variable at time t
80 REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS  ! Scalar variable sources
81 !
82 !
83 REAL, DIMENSION(:,:,:),   INTENT(OUT)   :: PSRCS ! Second-order flux
84                                                  ! s'rc'/2Sigma_s2 at time t+1
85                                                  ! multiplied by Lambda_3
86 REAL, DIMENSION(:,:,:), INTENT(INOUT)   :: PCLDFR! Cloud fraction
87 REAL, DIMENSION(:,:,:), INTENT(INOUT)   :: PCIT  ! Pristine ice number
88                                                  ! concentration at time t
89 LOGICAL,                  INTENT(IN)    :: OSEDIC! Switch to activate the
90                                                  ! cloud droplet sedimentation
91                                                  ! for ICE3            
92 LOGICAL,                  INTENT(IN)    :: OACTIT ! Switch to activate the
93                                                  ! activation through temp.
94                                                  ! evolution in C2R2 and KHKO
95 LOGICAL,                  INTENT(IN)    :: OSEDC ! Switch to activate the
96                                                  ! cloud droplet sedimentation
97                                                  ! for C2R2 or KHKO
98 LOGICAL,                  INTENT(IN)    :: OSEDI ! Switch to activate the
99                                                  ! cloud crystal sedimentation
100 LOGICAL,                  INTENT(IN)    :: ORAIN ! Switch to activate the
101                                                  ! raindrop formation
102 LOGICAL,                  INTENT(IN)    :: OWARM ! Control of the rain formation
103                                                  !  by slow warm microphysical
104                                                  !         processes
105 LOGICAL,                  INTENT(IN)    :: OHHONI! enable haze freezing
106 LOGICAL,                  INTENT(IN)    :: OCONVHG! Switch for conversion from
107                                                   ! hail to graupel
108 !
109 REAL, DIMENSION(:,:,:),     INTENT(IN)    :: PCF_MF! Convective Mass Flux Cloud fraction 
110 REAL, DIMENSION(:,:,:),     INTENT(IN)    :: PRC_MF! Convective Mass Flux liquid mixing ratio
111 REAL, DIMENSION(:,:,:),     INTENT(IN)    :: PRI_MF! Convective Mass Flux solid mixing ratio
112 !
113 REAL, DIMENSION(:,:), INTENT(INOUT)     :: PINPRC! Cloud instant precip
114 REAL, DIMENSION(:,:), INTENT(INOUT)     :: PINPRR! Rain instant precip
115 REAL, DIMENSION(:,:,:), INTENT(INOUT)   :: PINPRR3D ! sed flux of precip
116 REAL, DIMENSION(:,:,:), INTENT(INOUT)   :: PEVAP3D  ! evap profile
117 REAL, DIMENSION(:,:), INTENT(INOUT)     :: PINPRS! Snow instant precip
118 REAL, DIMENSION(:,:), INTENT(INOUT)     :: PINPRG! Graupel instant precip
119 REAL, DIMENSION(:,:), INTENT(INOUT)     :: PINPRH! Hail instant precip
120 REAL, DIMENSION(:,:,:), INTENT(INOUT)   :: PINPRC3D ! sed flux of precip
121 REAL, DIMENSION(:,:,:), INTENT(INOUT)   :: PINPRS3D ! sed flux of precip
122 REAL, DIMENSION(:,:,:), INTENT(INOUT)   :: PINPRG3D ! sed flux of precip
123 REAL, DIMENSION(:,:,:), INTENT(INOUT)   :: PINPRH3D ! sed flux of precip
124 REAL, DIMENSION(:,:,:,:), INTENT(IN)    :: PSOLORG ![%] solubility fraction of soa
125 REAL, DIMENSION(:,:,:,:), INTENT(IN)    :: PMI !
126 REAL, DIMENSION(:,:,:),   INTENT(OUT)   :: PSPEEDC ! Cloud sedimentation speed
127 REAL, DIMENSION(:,:,:),   INTENT(OUT)   :: PSPEEDR ! Rain sedimentation speed
128 REAL, DIMENSION(:,:,:),   INTENT(OUT)   :: PSPEEDS ! Snow sedimentation speed
129 REAL, DIMENSION(:,:,:),   INTENT(OUT)   :: PSPEEDG ! Graupel sedimentation speed
130 REAL, DIMENSION(:,:,:),   INTENT(OUT)   :: PSPEEDH ! Hail sedimentation speed
131 REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA      ! Land Sea mask
132 REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN      ! Town fraction
133 !
134 END SUBROUTINE RESOLVED_CLOUD
135 END INTERFACE
136 END MODULE MODI_RESOLVED_CLOUD
137 !
138 !     ##########################################################################
139       SUBROUTINE RESOLVED_CLOUD ( HCLOUD, HACTCCN, HSCONV, HMF_CLOUD,                  &
140                                   KRR, KSPLITR, KSPLITG, KMI, KTCOUNT,                 &
141                                   HLBCX, HLBCY, HFMFILE, HLUOUT, HRAD, HTURBDIM,       &
142                                   OCLOSE_OUT, OSUBG_COND, OSIGMAS, HSUBG_AUCV,         &
143                                   PTSTEP, PZZ, PRHODJ, PRHODREF, PEXNREF,              &
144                                   PPABST, PTHT, PRT, PSIGS, PSIGQSAT, PMFCONV,         &
145                                   PTHM, PRCM, PPABSM,                                  &
146                                   PW_ACT,PDTHRAD, PTHS, PRS, PSVT, PSVS, PSRCS, PCLDFR,&
147                                   PCIT, OSEDIC, OACTIT, OSEDC, OSEDI,                  &
148                                   ORAIN, OWARM, OHHONI, OCONVHG,                       &
149                                   PCF_MF,PRC_MF, PRI_MF,                               &
150                                   PINPRC,PINPRC3D,PINPRR,PINPRR3D, PEVAP3D,            &
151                                   PINPRS,PINPRS3D,PINPRG,PINPRG3D,PINPRH,PINPRH3D,     &
152                                   PSOLORG,PMI,                                         &
153                                   PSPEEDC, PSPEEDR, PSPEEDS, PSPEEDG, PSPEEDH,         &
154                                   PSEA,PTOWN          )   
155 !     ##########################################################################
156 !
157 !!****  * -  compute the  resolved clouds and precipitation
158 !!
159 !!    PURPOSE
160 !!    -------
161 !!      The purpose of this routine is to compute the  microphysical sources
162 !!    related to the resolved clouds and precipitation
163 !!
164 !!
165 !!**  METHOD
166 !!    ------
167 !!      The main actions of this routine is to call the routines computing the
168 !!    microphysical sources. Before that:
169 !!        - it computes the real absolute pressure,
170 !!        - negative values of the current guess of all mixing ratio are removed.
171 !!          This is done by a global filling algorithm based on a multiplicative
172 !!          method (Rood, 1987), in order to conserved the total mass in the
173 !!          simulation domain.
174 !!        - Sources are transformed in physical tendencies, by removing the
175 !!          multiplicative term Rhod*J.
176 !!        - External points values are filled owing to the use of cyclic
177 !!          l.b.c., in order to performe computations on the full domain.
178 !!      After calling to microphysical routines, the physical tendencies are
179 !!    switched back to prognostic variables.
180 !!
181 !!
182 !!    EXTERNAL
183 !!    --------
184 !!      Subroutine FMLOOK: to recover the logical unit number linked to a FMfile
185 !!      Subroutine SLOW_TERMS: Computes the explicit microphysical sources
186 !!      Subroutine FAST_TERMS: Performs the saturation adjustment for l
187 !!      Subroutine RAIN_ICE  : Computes the explicit microphysical sources for i
188 !!      Subroutine ICE_ADJUST: Performs the saturation adjustment for i+l
189 !!      MIN_ll,SUM3D_ll : distributed functions equivalent to MIN and SUM
190 !!
191 !!
192 !!    IMPLICIT ARGUMENTS
193 !!    ------------------
194 !!      Module MODD_PARAMETERS : contains declarations of parameter variables
195 !!         JPHEXT       : Horizontal external points number
196 !!         JPVEXT       : Vertical external points number
197 !!      Module MODD_CST
198 !!          XP00               ! Reference pressure
199 !!          XRD                ! Gaz  constant for dry air
200 !!          XCPD               ! Cpd (dry air)
201 !!
202 !!    REFERENCE
203 !!    ---------
204 !!
205 !!      Book1 and book2 of documentation ( routine RESOLVED_CLOUD )
206 !!
207 !!    AUTHOR
208 !!    ------
209 !!      E. Richard       * Laboratoire d'Aerologie*
210 !!
211 !!    MODIFICATIONS
212 !!    -------------
213 !!      Original    21/12/94
214 !!      Modifications: June 8, 1995 ( J.Stein )
215 !!                                   Cleaning to improve efficienty and clarity
216 !!                                  in agreement with the MESO-NH coding norm
217 !!                     March 1, 1996 ( J.Stein )
218 !!                                   store the cloud fraction
219 !!                     March 18, 1996 ( J.Stein )
220 !!                                   check that ZMASSPOS /= 0
221 !!                     Oct.  12, 1996 ( J.Stein )
222 !!                                   remove the negative values correction
223 !!                                   for the KES2 case
224 !!      Modifications: Dec 14, 1995 (J.-P. Pinty)
225 !!                                   Add the mixed-phase option
226 !!      Modifications: Jul 01, 1996 (J.-P. Pinty)
227 !!                                   Change arg. list in routine FAST_TERMS
228 !!      Modifications: Jan 27, 1997 (J.-P. Pinty)
229 !!                                   add W and SV in arg. list
230 !!      Modifications: March 23, 98 (E.Richard)
231 !!                                   correction of negative value based on
232 !!                                  rv+rc+ri and thetal or thetail conservation
233 !!      Modifications: April 08, 98 (J.-P. Lafore and V. Ducrocq )
234 !!                                  modify the  correction of negative values
235 !!      Modifications: June 08, 00  (J.-P. Pinty and J.-M. Cohard)
236 !!                                  add the C2R2 scheme
237 !!      Modifications: April 08, 01  (J.-P. Pinty)
238 !!                                  add the C3R5 scheme
239 !!      Modifications: July  21, 01  (J.-P. Pinty)
240 !!                                  Add OHHONI and PW_ACT (for haze freezing)
241 !!      Modifications: Sept 21, 01  (J.-P. Pinty)
242 !!                                  Add XCONC_CCN limitation
243 !!      Modifications: Nov  21, 02  (J.-P. Pinty)
244 !!                                  Add ICE4 and C3R5 options
245 !!                     June, 2005   (V. Masson)
246 !!                                  Technical change in interface for scalar arguments
247 !!      Modifications : March, 2006 (O.Geoffroy)
248 !!                                  Add KHKO scheme
249 !!      Modifications : March 2013  (O.Thouron)
250 !!                                  Add prognostic supersaturation
251 !!              July, 2015 (O.Nuissier/F.Duffourg) Add microphysics diagnostic for
252 !!                                      aircraft, ballon and profiler
253 !!      J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1 
254 !!      M.Mazoyer : 04/2016 : Temperature radiative tendency used for  
255 !!                            activation by cooling (OACTIT)
256 !-------------------------------------------------------------------------------
257 !
258 !*       0.    DECLARATIONS
259 !              ------------
260 USE MODE_ll
261 USE MODE_FM
262 !
263 USE MODD_CONF
264 USE MODD_CST
265 USE MODD_PARAMETERS
266 USE MODD_PARAM_ICE,  ONLY : CSEDIM
267 USE MODD_RAIN_ICE_DESCR
268 USE MODD_PARAM_C2R2
269 USE MODD_BUDGET
270 USE MODD_NSV
271 USE MODD_CH_AEROSOL , ONLY : LORILAM
272 USE MODD_DUST , ONLY : LDUST
273 USE MODD_SALT , ONLY : LSALT
274 !
275 USE MODI_SLOW_TERMS
276 USE MODI_FAST_TERMS
277 USE MODI_ICE_ADJUST
278 USE MODI_RAIN_ICE
279 USE MODI_RAIN_C2R2_KHKO
280 USE MODI_ICE_C1R3
281 USE MODI_C2R2_ADJUST
282 USE MODI_KHKO_NOTADJUST
283 USE MODI_C3R5_ADJUST
284 USE MODI_SHUMAN
285 USE MODI_BUDGET
286 USE MODI_GET_HALO
287 !
288 !
289 IMPLICIT NONE
290 !
291 !*       0.1   Declarations of dummy arguments :
292 !
293 !
294 !
295 CHARACTER(LEN=4),         INTENT(IN)   :: HCLOUD   ! kind of cloud
296                                                    ! paramerization
297 CHARACTER(LEN=4),         INTENT(IN)   :: HACTCCN  ! kind of CCN activation
298 CHARACTER(LEN=4),         INTENT(IN)   :: HSCONV   ! Shallow convection scheme
299 CHARACTER(LEN=4),         INTENT(IN)   :: HMF_CLOUD! Type of statistical cloud
300 INTEGER,                  INTENT(IN)   :: KRR      ! Number of moist variables
301 INTEGER,                  INTENT(IN)   :: KSPLITR  ! Number of small time step
302                                        ! integrations for  rain sedimendation
303 INTEGER,                  INTENT(IN)   :: KSPLITG  ! Number of small time step
304                                        ! integrations for  ice  sedimendation
305 INTEGER,                  INTENT(IN)   :: KMI      ! Model index
306 INTEGER,                  INTENT(IN)   :: KTCOUNT  ! Temporal loop counter
307 CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY   ! X and Y-direc. LBC type
308 CHARACTER(LEN=*),         INTENT(IN)   :: HFMFILE  ! Name of the output FM-file
309 CHARACTER(LEN=*),         INTENT(IN)   :: HLUOUT   ! Output-listing name for
310                                                    ! model n
311 CHARACTER*4,              INTENT(IN)   :: HRAD     ! Radiation scheme name
312 CHARACTER*4,              INTENT(IN)   :: HTURBDIM ! Dimensionality of the
313                                                    ! turbulence scheme
314 LOGICAL,                  INTENT(IN)   :: OCLOSE_OUT ! Conditional closure of
315                                                    ! the OUTPUT FM-file
316 LOGICAL,                  INTENT(IN)   :: OSUBG_COND ! Switch for Subgrid Cond.
317 LOGICAL,                  INTENT(IN)   :: OSIGMAS  ! Switch for Sigma_s:
318                                         ! use values computed in CONDENSATION
319                                         ! or that from turbulence scheme
320 CHARACTER(LEN=4),         INTENT(IN)   :: HSUBG_AUCV
321                                         ! Kind of Subgrid autoconversion method
322 REAL,                     INTENT(IN)   :: PTSTEP ! Time step :XTSTEP in namelist
323 !
324 !
325 REAL, DIMENSION(:,:,:),   INTENT(IN)   :: PZZ     ! Height (z)
326 REAL, DIMENSION(:,:,:),   INTENT(IN)   :: PRHODJ  !Dry density * Jacobian
327 REAL, DIMENSION(:,:,:),   INTENT(IN)   :: PRHODREF! Reference dry air density
328 REAL, DIMENSION(:,:,:),   INTENT(IN)   :: PEXNREF ! Reference Exner function
329 !
330 !
331 REAL, DIMENSION(:,:,:),   INTENT(IN)   :: PPABST  ! abs. pressure at time t
332 REAL, DIMENSION(:,:,:),   INTENT(IN)   :: PTHT    ! Theta at time t
333 REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PRT     ! Moist variables at time t
334 REAL, DIMENSION(:,:,:),   INTENT(IN)   :: PSIGS   ! Sigma_s at time t
335 REAL,                     INTENT(IN)   :: PSIGQSAT! coeff applied to qsat variance contribution
336 REAL, DIMENSION(:,:,:),   INTENT(IN)   :: PMFCONV ! convective mass flux
337 REAL, DIMENSION(:,:,:),   INTENT(IN)   :: PTHM    ! Theta at time t-Dt
338 REAL, DIMENSION(:,:,:),   INTENT(IN)   :: PPABSM   ! Pressure time t-Dt
339 REAL, DIMENSION(:,:,:),   INTENT(IN)   :: PRCM    ! Cloud water m.r. at time t-Dt
340 !
341 !
342 REAL, DIMENSION(:,:,:),   INTENT(IN)    :: PW_ACT ! W for CCN activation
343 REAL, DIMENSION(:,:,:),   INTENT(IN)    :: PDTHRAD ! THeta RADiative Tendancy
344 REAL, DIMENSION(:,:,:),   INTENT(INOUT) :: PTHS  ! Theta source
345 REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS   ! Moist  variable sources
346 REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT  ! Scalar variable at time t
347 REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS  ! Scalar variable sources
348 !
349 !
350 REAL, DIMENSION(:,:,:),   INTENT(OUT)   :: PSRCS ! Second-order flux
351                                                  ! s'rc'/2Sigma_s2 at time t+1
352                                                  ! multiplied by Lambda_3
353 REAL, DIMENSION(:,:,:), INTENT(INOUT)   :: PCLDFR! Cloud fraction
354 REAL, DIMENSION(:,:,:), INTENT(INOUT)   :: PCIT  ! Pristine ice number
355                                                  ! concentration at time t
356 LOGICAL,                  INTENT(IN)    :: OSEDIC! Switch to activate the
357                                                  ! cloud droplet sedimentation
358                                                  ! for ICE3            
359 LOGICAL,                  INTENT(IN)    :: OACTIT ! Switch to activate the
360                                                  ! activation through temp.
361                                                  ! evolution in C2R2 and KHKO
362 LOGICAL,                  INTENT(IN)    :: OSEDC ! Switch to activate the
363                                                  ! cloud droplet sedimentation
364 LOGICAL,                  INTENT(IN)    :: OSEDI ! Switch to activate the
365                                                  ! cloud crystal sedimentation
366 LOGICAL,                  INTENT(IN)    :: ORAIN ! Switch to activate the
367                                                  ! raindrop formation
368 LOGICAL,                  INTENT(IN)    :: OWARM ! Control of the rain formation
369                                                  !  by slow warm microphysical
370                                                  !         processes
371 LOGICAL,                  INTENT(IN)    :: OHHONI! enable haze freezing
372 LOGICAL,                  INTENT(IN)    :: OCONVHG! Switch for conversion from
373                                                   ! hail to graupel
374 !
375 REAL, DIMENSION(:,:,:),     INTENT(IN)    :: PCF_MF! Convective Mass Flux Cloud fraction 
376 REAL, DIMENSION(:,:,:),     INTENT(IN)    :: PRC_MF! Convective Mass Flux liquid mixing ratio
377 REAL, DIMENSION(:,:,:),     INTENT(IN)    :: PRI_MF! Convective Mass Flux solid mixing ratio
378 !
379 REAL, DIMENSION(:,:), INTENT(INOUT)     :: PINPRC! Cloud instant precip
380 REAL, DIMENSION(:,:), INTENT(INOUT)     :: PINPRR! Rain instant precip
381 REAL, DIMENSION(:,:,:), INTENT(INOUT)   :: PINPRR3D ! sed flux of precip
382 REAL, DIMENSION(:,:,:), INTENT(INOUT)   :: PEVAP3D  ! evap profile
383 REAL, DIMENSION(:,:), INTENT(INOUT)     :: PINPRS! Snow instant precip
384 REAL, DIMENSION(:,:), INTENT(INOUT)     :: PINPRG! Graupel instant precip
385 REAL, DIMENSION(:,:), INTENT(INOUT)     :: PINPRH! Hail instant precip
386 REAL, DIMENSION(:,:,:), INTENT(INOUT)   :: PINPRC3D ! sed flux of precip
387 REAL, DIMENSION(:,:,:), INTENT(INOUT)   :: PINPRS3D ! sed flux of precip
388 REAL, DIMENSION(:,:,:), INTENT(INOUT)   :: PINPRG3D ! sed flux of precip
389 REAL, DIMENSION(:,:,:), INTENT(INOUT)   :: PINPRH3D ! sed flux of precip
390 REAL, DIMENSION(:,:,:,:), INTENT(IN)    :: PSOLORG ![%] solubility fraction of soa
391 REAL, DIMENSION(:,:,:,:), INTENT(IN)    :: PMI !
392 REAL, DIMENSION(:,:,:),   INTENT(OUT)   :: PSPEEDC ! Cloud sedimentation speed
393 REAL, DIMENSION(:,:,:),   INTENT(OUT)   :: PSPEEDR ! Rain sedimentation speed
394 REAL, DIMENSION(:,:,:),   INTENT(OUT)   :: PSPEEDS ! Snow sedimentation speed
395 REAL, DIMENSION(:,:,:),   INTENT(OUT)   :: PSPEEDG ! Graupel sedimentation speed
396 REAL, DIMENSION(:,:,:),   INTENT(OUT)   :: PSPEEDH ! Hail sedimentation speed
397 REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA      ! Land Sea mask
398 REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN      ! Town fraction
399 !
400 !
401 !*       0.2   Declarations of local variables :
402 !
403 INTEGER :: JRR,JSV       ! Loop index for the moist and scalar variables
404 INTEGER :: IIB           !  Define the physical domain
405 INTEGER :: IIE           !
406 INTEGER :: IJB           !
407 INTEGER :: IJE           !
408 INTEGER :: IKB           !
409 INTEGER :: IKE           !
410 INTEGER :: IKU
411 INTEGER :: IINFO_ll      ! return code of parallel routine
412 INTEGER :: JK,JI
413 !
414 !
415 !
416 REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZDZZ
417 REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZT,ZEXN,ZLV,ZLS,ZCPH
418 REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZCOR
419                                     ! for the correction of negative rv
420 REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZZZ
421                                     ! model layer height
422 REAL  :: ZMASSTOT                   ! total mass  for one water category
423                                     ! including the negative values
424 REAL  :: ZMASSPOS                   ! total mass  for one water category
425                                     ! after removing the negative values
426 REAL  :: ZRATIO                     ! ZMASSTOT / ZMASSCOR
427 !
428 INTEGER                               :: ISVBEG ! first scalar index for microphysics
429 INTEGER                               :: ISVEND ! last  scalar index for microphysics
430 REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSVT   ! scalar variable for microphysics only
431 REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSVS   ! scalar tendency for microphysics only
432 !
433 !------------------------------------------------------------------------------
434 !
435 !*       1.     PRELIMINARY COMPUTATIONS
436 !               ------------------------
437 !
438 CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
439 IKB=1+JPVEXT
440 IKE=SIZE(PZZ,3) - JPVEXT
441 IKU=SIZE(PZZ,3)
442 !
443 IF (HCLOUD == 'C2R2' .OR. HCLOUD == 'KHKO') THEN
444   ISVBEG = NSV_C2R2BEG
445   ISVEND = NSV_C2R2END
446 ELSE IF (HCLOUD == 'C3R5') THEN
447   ISVBEG = NSV_C2R2BEG
448   ISVEND = NSV_C1R3END
449 ELSE
450   ISVBEG = 0
451   ISVEND = 0
452 END IF
453 !
454 IF (HCLOUD == 'C2R2' .OR. HCLOUD == 'C3R5' .OR. HCLOUD == 'KHKO') THEN
455   ALLOCATE(ZSVT(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3),ISVEND - ISVBEG + 1))
456   ALLOCATE(ZSVS(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3),ISVEND - ISVBEG + 1))
457   ZSVT(:,:,:,:) = PSVT(:,:,:,ISVBEG:ISVEND)
458   ZSVS(:,:,:,:) = PSVS(:,:,:,ISVBEG:ISVEND)
459 END IF
460 !
461 !*       2.     TRANSFORMATION INTO PHYSICAL TENDENCIES
462 !               ---------------------------------------
463 !
464 PTHS(:,:,:) = PTHS(:,:,:) / PRHODJ(:,:,:)
465 DO JRR = 1,KRR
466   PRS(:,:,:,JRR)  = PRS(:,:,:,JRR) / PRHODJ(:,:,:)
467 END DO
468 !
469 IF (HCLOUD == 'C2R2' .OR. HCLOUD == 'C3R5' .OR. HCLOUD == 'KHKO') THEN
470   DO JSV = 1,SIZE(ZSVS,4)
471     ZSVS(:,:,:,JSV) = ZSVS(:,:,:,JSV) / PRHODJ(:,:,:)
472   ENDDO
473 ENDIF
474 !
475 !  complete the lateral boundaries to avoid possible problems
476 !
477 DO JI=1,JPHEXT
478 PTHS(JI,:,:) = PTHS(IIB,:,:)
479 PTHS(IIE+JI,:,:) = PTHS(IIE,:,:)
480 PTHS(:,JI,:) = PTHS(:,IJB,:)
481 PTHS(:,IJE+JI,:) = PTHS(:,IJE,:)
482 !
483 PRS(JI,:,:,:) = PRS(IIB,:,:,:)
484 PRS(IIE+JI,:,:,:) = PRS(IIE,:,:,:)
485 PRS(:,JI,:,:) = PRS(:,IJB,:,:)
486 PRS(:,IJE+JI,:,:) = PRS(:,IJE,:,:)
487 END DO
488 !
489 !  complete the physical boundaries to avoid some computations
490 !
491 IF(LWEST_ll()  .AND. HLBCX(1) /= 'CYCL')  PRT(:IIB-1,:,:,2:) = 0.0
492 IF(LEAST_ll()  .AND. HLBCX(2) /= 'CYCL')  PRT(IIE+1:,:,:,2:) = 0.0
493 IF(LSOUTH_ll() .AND. HLBCY(1) /= 'CYCL')  PRT(:,:IJB-1,:,2:) = 0.0
494 IF(LNORTH_ll() .AND. HLBCY(2) /= 'CYCL')  PRT(:,IJE+1:,:,2:) = 0.0
495 !
496 IF (HCLOUD == 'C2R2' .OR. HCLOUD == 'C3R5' .OR. HCLOUD == 'KHKO') THEN
497 DO JI=1,JPHEXT
498   ZSVS(JI,:,:,:) = ZSVS(IIB,:,:,:)
499   ZSVS(IIE+JI,:,:,:) = ZSVS(IIE,:,:,:)
500   ZSVS(:,JI,:,:) = ZSVS(:,IJB,:,:)
501   ZSVS(:,IJE+JI,:,:) = ZSVS(:,IJE,:,:)
502 END DO
503 !
504 !  complete the physical boundaries to avoid some computations
505 !
506   IF(LWEST_ll()  .AND. HLBCX(1) /= 'CYCL')  ZSVT(:IIB-1,:,:,:) = 0.0
507   IF(LEAST_ll()  .AND. HLBCX(2) /= 'CYCL')  ZSVT(IIE+1:,:,:,:) = 0.0
508   IF(LSOUTH_ll() .AND. HLBCY(1) /= 'CYCL')  ZSVT(:,:IJB-1,:,:) = 0.0
509   IF(LNORTH_ll() .AND. HLBCY(2) /= 'CYCL')  ZSVT(:,IJE+1:,:,:) = 0.0
510 ENDIF
511 !
512 !  complete the vertical boundaries
513 !
514 PTHS(:,:,IKB-1) = PTHS(:,:,IKB)
515 PTHS(:,:,IKE+1) = PTHS(:,:,IKE)
516 !
517 PRS(:,:,IKB-1,:) = PRS(:,:,IKB,:)
518 PRS(:,:,IKE+1,:) = PRS(:,:,IKE,:)
519 !
520 PRT(:,:,IKB-1,:) = PRT(:,:,IKB,:)
521 PRT(:,:,IKE+1,:) = PRT(:,:,IKE,:)
522 !
523 IF (HCLOUD == 'C2R2' .OR. HCLOUD == 'C3R5' .OR. HCLOUD == 'KHKO') THEN
524   ZSVS(:,:,IKB-1,:) = ZSVS(:,:,IKB,:)
525   ZSVS(:,:,IKE+1,:) = ZSVS(:,:,IKE,:)
526   ZSVT(:,:,IKB-1,:) = ZSVT(:,:,IKB,:)
527   ZSVT(:,:,IKE+1,:) = ZSVT(:,:,IKE,:)
528 ENDIF
529 !
530 ! personal comment:  tranfering these variables to the
531 !                    microphysical routines would save
532 !                    computing time
533 !
534 ZEXN(:,:,:)= (PPABST(:,:,:)/XP00)**(XRD/XCPD)
535 ZT(:,:,:)= PTHT(:,:,:)*ZEXN(:,:,:)
536 ZLV(:,:,:)=XLVTT +(XCPV-XCL) *(ZT(:,:,:)-XTT)
537 ZLS(:,:,:)=XLSTT +(XCPV-XCI) *(ZT(:,:,:)-XTT)
538 ZCPH(:,:,:)=XCPD +XCPV*PRT(:,:,:,1)
539 !
540 !
541 !*       3.     REMOVE NEGATIVE VALUES
542 !               ----------------------
543 !
544 !*       3.1    Non local correction for precipitating species (Rood 87)
545 !
546 IF (HCLOUD == 'KESS' .OR. HCLOUD == 'ICE3'                       &
547     .OR.  HCLOUD == 'C2R2' .OR. HCLOUD == 'C3R5' .OR. HCLOUD == 'KHKO') THEN
548 !
549   DO JRR = 3,KRR
550     SELECT CASE (JRR)
551       CASE(3,5,6,7) ! rain, snow, graupel and hail
552
553         IF ( MIN_ll( PRS(:,:,:,JRR), IINFO_ll) < 0.0 ) THEN
554 !
555 ! compute the total water mass computation
556 !
557           ZMASSTOT = MAX( 0. , SUM3D_ll( PRS(:,:,:,JRR), IINFO_ll ) )
558 !
559 ! remove the negative values
560 !
561           PRS(:,:,:,JRR) = MAX( 0., PRS(:,:,:,JRR) )
562 !
563 ! compute the new total mass
564 !
565           ZMASSPOS = MAX(XMNH_TINY,SUM3D_ll( PRS(:,:,:,JRR), IINFO_ll ) )
566 !
567 ! correct again in such a way to conserve the total mass
568 !
569           ZRATIO = ZMASSTOT / ZMASSPOS
570           PRS(:,:,:,JRR) = PRS(:,:,:,JRR) * ZRATIO
571 !
572         END IF
573     END SELECT
574   END DO
575 END IF
576 !
577 !*       3.2    Adjustement for liquid and solid cloud
578 !
579 SELECT CASE ( HCLOUD )
580   CASE('KESS')
581     WHERE (PRS(:,:,:,2) < 0.)
582       PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,2)
583       PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,2) * ZLV(:,:,:) /  &
584            ZCPH(:,:,:) / ZEXN(:,:,:)
585       PRS(:,:,:,2) = 0.0
586     END WHERE
587 !
588 !
589 ! CASE('C2R2','KHKO')                                 
590 !   CALL GET_HALO(PRS(:,:,:,2))
591 !   CALL GET_HALO(ZSVS(:,:,:,2))
592 !   WHERE (PRS(:,:,:,2) < 0. .OR. ZSVS(:,:,:,2) < 0.)
593 !     ZSVS(:,:,:,1) = 0.0
594 !   END WHERE
595 !   DO JSV = 2, 3
596 !     WHERE (PRS(:,:,:,JSV) < 0. .OR. ZSVS(:,:,:,JSV) < 0.)
597 !       PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,JSV)
598 !       PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,JSV) * ZLV(:,:,:) /  &
599 !            ZCPH(:,:,:) / ZEXN(:,:,:)
600 !       PRS(:,:,:,JSV)  = 0.0
601 !       ZSVS(:,:,:,JSV) = 0.0
602 !     END WHERE
603 !   ENDDO
604 ! Commented 03/2013 O.Thouron 
605 ! (at least necessary to be commented for supersaturation variable)
606 !  ZSVS(:,:,:,:) = MAX( 0.0,ZSVS(:,:,:,:) )
607 !
608 !
609   CASE('ICE3','ICE4')
610     WHERE (PRS(:,:,:,4) < 0.)
611       PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,4)
612       PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,4) * ZLS(:,:,:) /  &
613            ZCPH(:,:,:) / ZEXN(:,:,:)
614       PRS(:,:,:,4) = 0.
615     END WHERE
616 !
617 !   cloud
618     WHERE (PRS(:,:,:,2) < 0.)
619       PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,2)
620       PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,2) * ZLV(:,:,:) /  &
621            ZCPH(:,:,:) / ZEXN(:,:,:)
622       PRS(:,:,:,2) = 0.
623     END WHERE
624 !
625 ! if rc or ri are positive, we can correct negative rv
626 !   cloud
627     WHERE ((PRS(:,:,:,1) <0.) .AND. (PRS(:,:,:,2)> 0.) )
628       PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,2)
629       PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,2) * ZLV(:,:,:) /  &
630            ZCPH(:,:,:) / ZEXN(:,:,:)
631       PRS(:,:,:,2) = 0.
632     END WHERE
633 !   ice
634     IF(KRR > 3) THEN
635       WHERE ((PRS(:,:,:,1) < 0.).AND.(PRS(:,:,:,4) > 0.))
636         ZCOR(:,:,:)=MIN(-PRS(:,:,:,1),PRS(:,:,:,4))
637         PRS(:,:,:,1) = PRS(:,:,:,1) + ZCOR(:,:,:)
638         PTHS(:,:,:) = PTHS(:,:,:) - ZCOR(:,:,:) * ZLS(:,:,:) /  &
639              ZCPH(:,:,:) / ZEXN(:,:,:)
640         PRS(:,:,:,4) = PRS(:,:,:,4) -ZCOR(:,:,:)
641       END WHERE
642     END IF
643 !
644    CASE('C3R5')
645     WHERE (PRS(:,:,:,2) < 0. .OR. ZSVS(:,:,:,2) < 0.)
646       ZSVS(:,:,:,1) = 0.0
647     END WHERE
648     DO JSV = 2, 3
649       WHERE (PRS(:,:,:,JSV) < 0. .OR. ZSVS(:,:,:,JSV) < 0.)
650         PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,JSV)
651         PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,JSV) * ZLV(:,:,:) /  &
652              ZCPH(:,:,:) / ZEXN(:,:,:)
653         PRS(:,:,:,JSV)  = 0.0
654         ZSVS(:,:,:,JSV) = 0.0
655       END WHERE
656     ENDDO
657     ZSVS(:,:,:,:) = MAX( 0.0,ZSVS(:,:,:,:) )
658 !   ice
659     WHERE (PRS(:,:,:,4) < 0.)
660       PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,4)
661       PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,4) * ZLV(:,:,:) /  &
662            ZCPH(:,:,:) / ZEXN(:,:,:)
663       PRS(:,:,:,4)  = 0.0
664       PSVS(:,:,:,4) = 0.0
665     END WHERE
666 !   cloud
667     WHERE (PRS(:,:,:,2) < 0.)
668       PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,2)
669       PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,2) * ZLV(:,:,:) /  &
670            ZCPH(:,:,:) / ZEXN(:,:,:)
671       PRS(:,:,:,2)  = 0.0
672       PSVS(:,:,:,2) = 0.0
673     END WHERE
674     PSVS(:,:,:,:) = MAX( 0.0,PSVS(:,:,:,:) )
675 !
676 END SELECT
677 !
678 !
679 !*       3.3  STORE THE BUDGET TERMS
680 !            ----------------------
681 !
682 IF ((HCLOUD /= 'KHKO') .AND. (HCLOUD /= 'C2R2') ) THEN
683  IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)  * PRHODJ(:,:,:), 4,'NEGA_BU_RTH')
684  IF (LBUDGET_RV) CALL BUDGET (PRS(:,:,:,1) * PRHODJ(:,:,:), 6,'NEGA_BU_RRV')
685  IF (LBUDGET_RC) CALL BUDGET (PRS(:,:,:,2) * PRHODJ(:,:,:), 7,'NEGA_BU_RRC')
686 END IF
687 IF (LBUDGET_RR) CALL BUDGET (PRS(:,:,:,3) * PRHODJ(:,:,:), 8,'NEGA_BU_RRR')
688 IF (LBUDGET_RI) CALL BUDGET (PRS(:,:,:,4) * PRHODJ(:,:,:) ,9,'NEGA_BU_RRI')
689 IF (LBUDGET_RS) CALL BUDGET (PRS(:,:,:,5) * PRHODJ(:,:,:),10,'NEGA_BU_RRS')
690 IF (LBUDGET_RG) CALL BUDGET (PRS(:,:,:,6) * PRHODJ(:,:,:),11,'NEGA_BU_RRG')
691 IF (LBUDGET_RH) CALL BUDGET (PRS(:,:,:,7) * PRHODJ(:,:,:),12,'NEGA_BU_RRH')
692 !
693
694 !*       3.4    Limitations of Na and Nc to the CCN max number concentration
695 !
696 ! Commented by O.Thouron 03/2013
697 !IF ((HCLOUD == 'C2R2' .OR. HCLOUD == 'C3R5' .OR. HCLOUD == 'KHKO') &
698 !     .AND.(XCONC_CCN > 0)) THEN
699 !  IF ((HACTCCN /= 'ABRK')) THEN
700 !  ZSVT(:,:,:,1) = MIN( ZSVT(:,:,:,1),XCONC_CCN )
701 !  ZSVT(:,:,:,2) = MIN( ZSVT(:,:,:,2),XCONC_CCN )
702 !  ZSVS(:,:,:,1) = MIN( ZSVS(:,:,:,1),XCONC_CCN )
703 !  ZSVS(:,:,:,2) = MIN( ZSVS(:,:,:,2),XCONC_CCN )
704 !  END IF
705 !END IF
706 !
707 !
708 !-------------------------------------------------------------------------------
709 !
710 SELECT CASE ( HCLOUD )
711   CASE ('REVE')
712 !
713 !*       4.     REVERSIBLE MICROPHYSICAL SCHEME
714 !               -------------------------------
715 !
716     CALL FAST_TERMS ( KRR, KMI, HLUOUT, HRAD, HTURBDIM,                        &
717                       HSCONV, HMF_CLOUD, OSUBG_COND, PTSTEP,                   &
718                       PRHODJ, PSIGS, PPABST,                                   &
719                       PCF_MF,PRC_MF,                                           &
720                       PRVT=PRT(:,:,:,1), PRCT=PRT(:,:,:,2),                    &
721                       PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2),                    &
722                       PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR                    )
723 !
724   CASE ('KESS')
725 !
726 !*       5.     KESSLER MICROPHYSICAL SCHEME
727 !               ----------------------------
728 !
729 !
730 !*       5.1    Compute the explicit microphysical sources
731 !
732     CALL SLOW_TERMS ( KSPLITR, PTSTEP, KMI, HSUBG_AUCV,                       &
733                       PZZ, PRHODJ, PRHODREF, PCLDFR,                          &
734                       PTHT, PRT(:,:,:,1), PRT(:,:,:,2), PRT(:,:,:,3), PPABST, &
735                       PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3),         &
736                       PINPRR, PINPRR3D, PEVAP3D                         )
737 !
738 !*       5.2    Perform the saturation adjustment
739 !
740     CALL FAST_TERMS ( KRR, KMI, HLUOUT, HRAD, HTURBDIM,                        &
741                       HSCONV, HMF_CLOUD, OSUBG_COND, PTSTEP,                   &
742                       PRHODJ, PSIGS, PPABST,                                   &
743                       PCF_MF,PRC_MF,                                           &
744                       PRVT=PRT(:,:,:,1), PRCT=PRT(:,:,:,2),                    &
745                       PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), PRRS=PRS(:,:,:,3), &
746                       PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR                    )
747 !
748 !
749   CASE ('C2R2','KHKO')
750 !
751 !*       7.     2-MOMENT WARM MICROPHYSICAL SCHEME C2R2 or KHKO
752 !               ---------------------------------------
753 !
754 !
755 !*       7.1    Compute the explicit microphysical sources
756 !
757 !
758     CALL RAIN_C2R2_KHKO ( HCLOUD, OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, KMI,          &
759                      HFMFILE, HLUOUT, OCLOSE_OUT, PZZ, PRHODJ, PRHODREF, PEXNREF, &
760                      PPABST, PTHT, PRT(:,:,:,1), PRT(:,:,:,2),  PRT(:,:,:,3),     &
761                      PTHM, PRCM, PPABSM,                                          &
762                      PW_ACT,PDTHRAD,PTHS, PRS(:,:,:,1),PRS(:,:,:,2),PRS(:,:,:,3), &
763                      ZSVT(:,:,:,1), ZSVT(:,:,:,2), ZSVT(:,:,:,3),                 &
764                      ZSVS(:,:,:,1), ZSVS(:,:,:,2), ZSVS(:,:,:,3),                 &
765                      PINPRC, PINPRR, PINPRR3D, PEVAP3D ,                          &
766                      PSVT(:,:,:,:), PSOLORG, PMI, HACTCCN           )
767 !
768 !
769 !*       7.2    Perform the saturation adjustment
770 !
771    IF (LSUPSAT) THEN
772     CALL KHKO_NOTADJUST (KRR, KTCOUNT,HFMFILE, HLUOUT, HRAD, OCLOSE_OUT,         &
773                          PTSTEP, PRHODJ, PPABSM, PPABST, PRHODREF, PZZ,          &
774                          PTHT,PRT(:,:,:,1),PRT(:,:,:,2),PRT(:,:,:,3),            &
775                          PTHS,PRS(:,:,:,1),PRS(:,:,:,2),PRS(:,:,:,3),            &
776                          ZSVS(:,:,:,2),ZSVS(:,:,:,1),                            &
777                          ZSVS(:,:,:,4), PCLDFR, PSRCS                            )
778 !
779    ELSE
780     CALL C2R2_ADJUST ( KRR,HFMFILE, HLUOUT, HRAD,                              &
781                        HTURBDIM, OCLOSE_OUT, OSUBG_COND, PTSTEP,               &
782                        PRHODJ, PSIGS, PPABST,                                  &
783                        PTHS=PTHS, PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2),        &
784                        PCNUCS=ZSVS(:,:,:,1), PCCS=ZSVS(:,:,:,2),               &
785                        PSRCS=PSRCS, PCLDFR=PCLDFR, PRRS=PRS(:,:,:,3)           )
786 !
787    END IF
788 !
789   CASE ('ICE3')
790 !
791 !*       9.     MIXED-PHASE MICROPHYSICAL SCHEME (WITH 3 ICE SPECIES)
792 !               -----------------------------------------------------
793 !
794 !
795 !*       9.1    Compute the explicit microphysical sources
796 !
797 !
798     DO JK=IKB,IKE
799       ZDZZ(:,:,JK)=PZZ(:,:,JK+1)-PZZ(:,:,JK)    
800     ENDDO
801     CALL RAIN_ICE ( OSEDIC,CSEDIM, HSUBG_AUCV, OWARM,1,IKU,1,            &
802                     KSPLITR, PTSTEP, KMI, KRR,                           &
803                     ZDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT,PCLDFR,&
804                     PTHT, PRT(:,:,:,1), PRT(:,:,:,2),                    &
805                     PRT(:,:,:,3), PRT(:,:,:,4),                          &
806                     PRT(:,:,:,5), PRT(:,:,:,6),                          &
807                     PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3),      &
808                     PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6),            &
809                     PINPRC,PINPRC3D,PINPRR, PINPRR3D, PEVAP3D,           &
810                     PINPRS,PINPRS3D, PINPRG,PINPRG3D, PSIGS,             &
811                     PSPEEDC, PSPEEDR, PSPEEDS, PSPEEDG, PSPEEDH,         &
812                     PSEA,PTOWN)
813 !
814 !*       9.2    Perform the saturation adjustment over cloud ice and cloud water
815 !
816     ZZZ = MZF(1,IKU,1, PZZ )
817     CALL ICE_ADJUST (1,IKU,1, KRR, KMI, HRAD, HTURBDIM,                      &
818                     OSUBG_COND, OSIGMAS, PTSTEP,PSIGQSAT,                    &
819                     PRHODJ, PEXNREF,  PSIGS, PMFCONV, PPABST, ZZZ,           &
820                     PCF_MF,PRC_MF,PRI_MF,                                    &   
821                     PRVT=PRT(:,:,:,1), PRCT=PRT(:,:,:,2),                    &
822                     PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2),                    &
823                     PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR,                   &
824                     PRRT=PRT(:,:,:,3), PRRS=PRS(:,:,:,3),                    &
825                     PRIT=PRT(:,:,:,4), PRIS=PRS(:,:,:,4),                    &
826                     PRST=PRT(:,:,:,5), PRSS=PRS(:,:,:,5),                    &
827                     PRGT=PRT(:,:,:,6), PRGS=PRS(:,:,:,6)                     )
828 !
829   CASE ('ICE4')
830 !
831 !*       10.    MIXED-PHASE MICROPHYSICAL SCHEME (WITH 4 ICE SPECIES)
832 !               -----------------------------------------------------
833 !
834 !
835 !*       10.1   Compute the explicit microphysical sources
836 !
837 !
838     DO JK=IKB,IKE
839       ZDZZ(:,:,JK)=PZZ(:,:,JK+1)-PZZ(:,:,JK)    
840     ENDDO
841     CALL RAIN_ICE ( OSEDIC,CSEDIM, HSUBG_AUCV, OWARM,1,IKU,1,             &
842                     KSPLITR, PTSTEP, KMI, KRR,                            &
843                     ZDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
844                     PTHT, PRT(:,:,:,1), PRT(:,:,:,2),                     &
845                     PRT(:,:,:,3), PRT(:,:,:,4),                           &
846                     PRT(:,:,:,5), PRT(:,:,:,6),                           &
847                     PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3),       &
848                     PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6),             &
849                     PINPRC,PINPRC3D, PINPRR, PINPRR3D, PEVAP3D,           &
850                     PINPRS,PINPRS3D, PINPRG,PINPRG3D, PSIGS,              &
851                     PSPEEDC, PSPEEDR, PSPEEDS, PSPEEDG, PSPEEDH,          &
852                     PSEA, PTOWN,                                          &
853                     PRT(:,:,:,7),  PRS(:,:,:,7), PINPRH,PINPRH3D,OCONVHG  )
854
855 !
856 !*       10.2   Perform the saturation adjustment over cloud ice and cloud water
857 !
858     ZZZ = MZF(1,IKU,1, PZZ )
859     CALL ICE_ADJUST (1,IKU,1, KRR, KMI, HRAD, HTURBDIM,                      &
860                     OSUBG_COND, OSIGMAS, PTSTEP,PSIGQSAT,                    &
861                     PRHODJ, PEXNREF, PSIGS, PMFCONV, PPABST, ZZZ,            &
862                     PCF_MF,PRC_MF,PRI_MF,                                    &                     
863                     PRVT=PRT(:,:,:,1), PRCT=PRT(:,:,:,2),                    &
864                     PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2),                    &
865                     PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR,                   &
866                     PRRT=PRT(:,:,:,3), PRRS=PRS(:,:,:,3),                    &
867                     PRIT=PRT(:,:,:,4), PRIS=PRS(:,:,:,4),                    &
868                     PRST=PRT(:,:,:,5), PRSS=PRS(:,:,:,5),                    &
869                     PRGT=PRT(:,:,:,6), PRGS=PRS(:,:,:,6),                    &
870                     PRHT=PRT(:,:,:,7), PRHS=PRS(:,:,:,7)                     )
871 !
872   CASE ('C3R5')
873 !
874 !*       11.    2-MOMENT MIXED-PHASE MICROPHYSICAL SCHEME (WITH 3 ICE SPECIES)
875 !               --------------------------------------------------------------
876 !
877 !
878 !*       11.1   Compute the explicit microphysical sources
879 !
880     CALL RAIN_C2R2_KHKO ( HCLOUD, OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, KMI,                  &
881                      HFMFILE, HLUOUT, OCLOSE_OUT, PZZ, PRHODJ, PRHODREF, PEXNREF, &
882                      PPABST, PTHT,                                                &
883                      PRT(:,:,:,1), PRT(:,:,:,2),                                  &
884                      PRT(:,:,:,3),                                                &
885                      PTHM, PRCM, PPABSM,                                          &
886                      PW_ACT,PDTHRAD,PTHS, PRS(:,:,:,1),PRS(:,:,:,2),PRS(:,:,:,3), &
887                      ZSVT(:,:,:,1), ZSVT(:,:,:,2), ZSVT(:,:,:,3),                 &
888                      ZSVS(:,:,:,1), ZSVS(:,:,:,2), ZSVS(:,:,:,3),                 &
889                      PINPRC, PINPRR, PINPRR3D, PEVAP3D,                           &
890                      PSVT(:,:,:,:), PSOLORG, PMI, HACTCCN )
891 !
892     CALL ICE_C1R3  ( OSEDI, OHHONI, KSPLITG, PTSTEP, KMI,                    &
893                      PZZ, PRHODJ, PRHODREF, PEXNREF,                         &
894                      PPABST, PW_ACT, PTHT,                            &
895                      PRT(:,:,:,1), PRT(:,:,:,2), PRT(:,:,:,3),               &
896                      PRT(:,:,:,4), PRT(:,:,:,5), PRT(:,:,:,6),               &
897                      PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
898                      PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6),               &
899                                     ZSVT(:,:,:,2), ZSVT(:,:,:,3),            &
900                                     ZSVT(:,:,:,4),                           &
901                      ZSVS(:,:,:,1), ZSVS(:,:,:,2), ZSVS(:,:,:,3),            &
902                      ZSVS(:,:,:,5), ZSVS(:,:,:,4),                           &
903                      PINPRS, PINPRG                                          )
904 !
905 !
906 !*       11.2   Perform the saturation adjustment
907 !
908     CALL C3R5_ADJUST ( KRR, KMI, HRAD,                                         &
909                        HTURBDIM, OSUBG_COND, PTSTEP,                           &
910                        PRHODREF, PRHODJ, PEXNREF, PSIGS, PPABST,               &
911                        PRVT=PRT(:,:,:,1), PRCT=PRT(:,:,:,2), PRRT=PRT(:,:,:,3),&
912                        PRIT=PRT(:,:,:,4), PRST=PRT(:,:,:,5), PRGT=PRT(:,:,:,6),&
913                        PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), PRRS=PRS(:,:,:,3),&
914                        PRIS=PRS(:,:,:,4), PRSS=PRS(:,:,:,5), PRGS=PRS(:,:,:,6),&
915                        PCCT=ZSVT(:,:,:,2), PCIT=ZSVT(:,:,:,4),                 &
916                        PCNUCS=ZSVS(:,:,:,1), PCCS=ZSVS(:,:,:,2),               &
917                        PINUCS=ZSVS(:,:,:,5), PCIS=ZSVS(:,:,:,4),               &
918                        PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR                   )
919 !
920 END SELECT
921 !
922 IF ( (HCLOUD == 'KHKO') .OR. (HCLOUD == 'C2R2') ) THEN
923 !    CALL GET_HALO(PRS(:,:,:,2))
924 !    CALL GET_HALO(ZSVS(:,:,:,2))
925 !    CALL GET_HALO(ZSVS(:,:,:,3))
926     WHERE (PRS(:,:,:,2) < 0. .OR. ZSVS(:,:,:,2) < 0.)
927       ZSVS(:,:,:,1) = 0.0
928     END WHERE
929     DO JSV = 2, 3
930       WHERE (PRS(:,:,:,JSV) < 0. .OR. ZSVS(:,:,:,JSV) < 0.)
931         PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,JSV)
932         PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,JSV) * ZLV(:,:,:) /  &
933              ZCPH(:,:,:) / ZEXN(:,:,:)
934         PRS(:,:,:,JSV)  = 0.0
935         ZSVS(:,:,:,JSV) = 0.0
936       END WHERE
937     ENDDO
938  IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)  * PRHODJ(:,:,:), 4,'NECON_BU_RTH')
939  IF (LBUDGET_RV) CALL BUDGET (PRS(:,:,:,1) * PRHODJ(:,:,:), 6,'NECON_BU_RRV')
940  IF (LBUDGET_RC) CALL BUDGET (PRS(:,:,:,2) * PRHODJ(:,:,:), 7,'NECON_BU_RRC')
941 END IF
942 !-------------------------------------------------------------------------------
943 !
944 !
945 !*      12.     SWITCH BACK TO THE PROGNOSTIC VARIABLES
946 !               ---------------------------------------
947 !
948 PTHS(:,:,:) = PTHS(:,:,:) * PRHODJ(:,:,:)
949 !
950 DO JRR = 1,KRR
951   PRS(:,:,:,JRR)  = PRS(:,:,:,JRR) * PRHODJ(:,:,:)
952 END DO
953 !
954 IF (HCLOUD == 'C2R2' .OR. HCLOUD == 'C3R5' .OR. HCLOUD == 'KHKO') THEN
955   DO JSV = 1,SIZE(ZSVS,4)
956     PSVS(:,:,:,JSV+ISVBEG-1) = ZSVS(:,:,:,JSV) * PRHODJ(:,:,:)
957   ENDDO
958   DO JSV = 1,SIZE(ZSVT,4)
959     PSVT(:,:,:,JSV+ISVBEG-1) = ZSVT(:,:,:,JSV)
960   ENDDO
961   DEALLOCATE(ZSVS)
962   DEALLOCATE(ZSVT)
963 ENDIF
964 !
965 !-------------------------------------------------------------------------------
966 !
967 END SUBROUTINE RESOLVED_CLOUD