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, HFMFILE, HLUOUT, HRAD, HTURBDIM,               &
 717                       HSCONV, HMF_CLOUD, OCLOSE_OUT, 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, HFMFILE, HLUOUT, HRAD, HTURBDIM,               &
 741                       HSCONV, HMF_CLOUD, OCLOSE_OUT, 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, HFMFILE, HLUOUT, 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, HFMFILE, HLUOUT, 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, HFMFILE, HLUOUT, HRAD,               &
 909                        HTURBDIM, OCLOSE_OUT, 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