phys/module_shallowcu_driver.F

   1 !WRF:MEDIATION_LAYER:PHYSICS
   2 !
   3
   4 MODULE module_shallowcu_driver
   5
   6   implicit none
   7
   8   real, private, parameter :: QCLOUD_MIN = 0.0
   9   real, private, parameter :: QVAPOR_MIN = 0.0
  10
  11 CONTAINS
  12    SUBROUTINE shallowcu_driver(                                       &
  13                  ! Order dependent args for domain, mem, and tile dims
  14                       ids,ide, jds,jde, kds,kde                       &
  15                      ,ims,ime, jms,jme, kms,kme                       &
  16                      ,ips,ipe, jps,jpe, kps,kpe                       &
  17                      ,i_start,i_end,j_start,j_end,kts,kte,num_tiles   &
  18                  ! Order independent args (use VAR= in call)
  19                  ! --Prognostic
  20                      ,u,v,th,t                                        &
  21                      ,p,pi,rho,moist                                  &
  22                  ! --Other arguments
  23                      ,num_moist                                       &
  24                      ,itimestep,dt,dx,dx2d,area2d                     &
  25                      ,cudt,curr_secs,adapt_step_flag                  &
  26                      ,rainsh,pratesh,nca,rainshv                      &
  27                      ,z,z_at_w,dz8w,mavail,pblh,p8w                   &
  28                      ,tke_pbl                                         &
  29                      ,cldfra,cldfra_old,cldfra_old_mp,cldfra_conv     &
  30                      ,cldfrash                                        &
  31                      ,htop,hbot                                       &
  32                  ! Package selection variables
  33                      ,shcu_physics                                    &
  34                  ! Optional moisture tracers
  35                      ,qv_curr, qc_curr, qr_curr                       &
  36                      ,qi_curr, qs_curr, qg_curr                       &
  37                      ,qnc_curr,qni_curr                               &
  38 #if ( WRF_CHEM == 1 )
  39                      ,chem, chem_opt                                  &
  40 #endif
  41                  ! Optional output arguments for CAMZM scheme
  42                      ,dlf, rliq, rliq2,dlf2  &
  43                      ,cmfmc, cmfmc2       &
  44                  ! Optional output arguments for CAMUW scheme
  45                      ,cush, snowsh, icwmrsh, rprdsh, cbmf, cmfsl      &
  46                      ,cmflq, evapcsh                                  &
  47                  ! Optional moisture and other tendencies
  48                      ,rqvshten,rqcshten,rqrshten                      &
  49                      ,rqishten,rqsshten,rqgshten                      &
  50                      ,rqcnshten,rqinshten                             &
  51                      ,rqvblten,rqvften                                &
  52                      ,rushten,rvshten                                 &
  53                      ,rthshten,rthraten,rthblten,rthften              &
  54                  ! Optional moisture tracer flags
  55                      ,f_qv,f_qc,f_qr                                  &
  56                      ,f_qi,f_qs,f_qg                                  &
  57                      ,ht,shfrc3d,is_CAMMGMP_used                      &
  58                  ! for grims shallow convection with ysupbl
  59                      ,wstar,delta,kpbl,znu,raincv                   &
  60                  ! for nscv shallow convection
  61                      ,w,xland,hfx,qfx,mp_physics,pgcon              &
  62                      ,RDCASHTEN, RQCDCSHTEN, W0AVG                 &
  63                      ,clddpthb, cldtopb                               &
  64                      ,cldareaa, cldareab, cldliqa, cldliqb            &
  65                      ,cldfra_sh, ca_rad, cw_rad                       &
  66                      ,wub, pblmax, xlong                              &
  67                      ,rainshvb, capesave, radsave                     &
  68                      ,ainckfsa, ltopb                                 &
  69                      ,kdcldtop, kdcldbas                              &
  70                      ,el_pbl, rthratenlw, rthratensw, exch_h          &
  71                      ,dnw, xtime, xtime1, gmt                         &
  72                      ,qke,PBLHAVG, TKEAVG                             &
  73                      ,bl_pbl_physics                                  &
  74                      ,multi_perturb                                   &
  75                      ,pert_deng                                       &
  76                      ,perts_qvapor                                    &
  77                      ,perts_qcloud                                    &
  78                      ,perts_th                                        &
  79                      ,perts_w                                         &
  80                      ,pert_deng_qv, pert_deng_qc, pert_deng_t         &
  81                      ,pert_deng_w                                     &
  82                                                                       )
  83 !----------------------------------------------------------------------
  84    USE module_model_constants
  85    USE module_state_description, ONLY: CAMUWSHCUSCHEME    &
  86 # if (EM_CORE == 1)
  87                                        , CAMMGMPSCHEME    &
  88 # endif
  89                                        , G3SHCUSCHEME     &
  90                                        , GRIMSSHCUSCHEME  &
  91                                        , DENGSHCUSCHEME   &
  92                                        , NSCVSHCUSCHEME
  93 ! *** add new modules of schemes here
  94
  95    USE module_shcu_camuwshcu_driver, ONLY : camuwshcu_driver
  96    USE module_shcu_grims           , ONLY : grims
  97    USE module_shcu_nscv            , ONLY : shcu_nscv
  98    USE module_shcu_deng, ONLY: deng_shcu_driver
  99
 100    USE module_dm
 101    USE module_domain, ONLY: domain
 102 #if ( WRF_CHEM == 1 )
 103       USE module_state_description, ONLY: num_chem
 104 #endif
 105
 106    !  This driver calls subroutines for the shallow cumulus
 107    !  parameterizations.
 108    !
 109    !  1. G3 shallow cumulus
 110    !  2. UW shallow cumulus from CAM
 111    !  3. GRIMs shallow cumulus from GRIMs (available only with ysupbl)
 112    !  4. NCEP shallow cumulus scheme (separated from NSAS cumulus scheme)
 113    !                                 (Han and Pan 2011, YSU)
 114    !
 115 !----------------------------------------------------------------------
 116    IMPLICIT NONE
 117 !======================================================================
 118 ! Grid structure in physics part of WRF
 119 !----------------------------------------------------------------------
 120 ! The horizontal velocities used in the physics are unstaggered
 121 ! relative to temperature/moisture variables. All predicted
 122 ! variables are carried at half levels except w, which is at full
 123 ! levels. Some arrays with names (*8w) are at w (full) levels.
 124 !
 125 !----------------------------------------------------------------------
 126 ! In WRF, kms (smallest number) is the bottom level and kme (largest
 127 ! number) is the top level.  In your scheme, if 1 is at the top level,
 128 ! then you have to reverse the order in the k direction.
 129 !
 130 !         kme      -   half level (no data at this level)
 131 !         kme    ----- full level
 132 !         kme-1    -   half level
 133 !         kme-1  ----- full level
 134 !         .
 135 !         .
 136 !         .
 137 !         kms+2    -   half level
 138 !         kms+2  ----- full level
 139 !         kms+1    -   half level
 140 !         kms+1  ----- full level
 141 !         kms      -   half level
 142 !         kms    ----- full level
 143 !
 144 !======================================================================
 145 ! Definitions
 146 !-----------
 147 ! Rho_d      dry density (kg/m^3)
 148 ! Theta_m    moist potential temperature (K)
 149 ! Qv         water vapor mixing ratio (kg/kg)
 150 ! Qc         cloud water mixing ratio (kg/kg)
 151 ! Qr         rain water mixing ratio (kg/kg)
 152 ! Qi         cloud ice mixing ratio (kg/kg)
 153 ! Qs         snow mixing ratio (kg/kg)
 154 !-----------------------------------------------------------------
 155 !-- DT            time step (second)
 156 !-- CUDT          cumulus time step (minute)
 157 !-- curr_secs     current forecast time (seconds)
 158 !-- itimestep     number of time step (integer)
 159 !-- DX            horizontal space interval (m)
 160 !-- rr            dry air density (kg/m^3)
 161 !
 162 !-- RUSHTEN       Zonal wind tendency due to shallow
 163 !                 cumulus scheme precipitation (m/s/s)
 164 !-- RVSHTEN       Meridional wind tendency due to
 165 !                 cumulus scheme precipitation (m/s/s)
 166 !-- RTHSHTEN      Theta tendency due to shallow
 167 !                 cumulus scheme precipitation (K/s)
 168 !-- RQVSHTEN      Qv tendency due to shallow
 169 !                 cumulus scheme precipitation (kg/kg/s)
 170 !-- RQRSHTEN      Qr tendency due to shallow
 171 !                 cumulus scheme precipitation (kg/kg/s)
 172 !-- RQCSHTEN      Qc tendency due to shallow
 173 !                 cumulus scheme precipitation (kg/kg/s)
 174 !-- RQSSHTEN      Qs tendency due to shallow
 175 !                 cumulus scheme precipitation (kg/kg/s)
 176 !-- RQISHTEN      Qi tendency due to shallow
 177 !                 cumulus scheme precipitation (kg/kg/s)
 178 !-- RQGSHTEN      Qg tendency due to shallow
 179 !                 cumulus scheme precipitation (kg/kg/s)
 180 !
 181 !-- RAINSH        accumulated total shallow cumulus scheme precipitation (mm)
 182 !-- RAINSHV       time-step shallow cumulus scheme precipitation (mm)
 183 !-- PRATESH       precipitiation rate from shallow cumulus scheme (mm/s)
 184 !-- NCA           counter of the cloud relaxation
 185 !                 time in KF cumulus scheme (integer)
 186 !-- u_phy         u-velocity interpolated to theta points (m/s)
 187 !-- v_phy         v-velocity interpolated to theta points (m/s)
 188 !-- th_phy        potential temperature (K)
 189 !-- t_phy         temperature (K)
 190 !-- tke_pbl       turbulent kinetic energy from PBL scheme (m2/s2)
 191 !-- w             vertical velocity (m/s)
 192 !-- moist         moisture array (4D - last index is species) (kg/kg)
 193 !-- z             height above sea level at middle of layers (m)
 194 !-- z_at_w        height above sea level at layer interfaces (m)
 195 !-- dz8w          dz between full levels (m)
 196 !-- pblh          planetary boundary layer height (m)
 197 !-- mavail        soil moisture availability
 198 !-- p8w           pressure at full levels (Pa)
 199 !-- p_phy         pressure (Pa)
 200 !-- pi_phy        the exner function, (p/p0)**(R/Cp) (dimensionless)
 201 !                 points (dimensionless)
 202 !-- hfx           upward heat flux at surface (W/m2)
 203 !-- RTHRATEN      radiative temp forcing for Grell-Devenyi scheme
 204 !-- RTHBLTEN      PBL temp forcing for Grell-Devenyi scheme
 205 !-- RQVBLTEN      PBL moisture forcing for Grell-Devenyi scheme
 206 !-- RTHFTEN
 207 !-- RQVFTEN
 208 !-- cldfra        cloud fraction
 209 !-- cldfra_old    cloud fraction from previous time step
 210 !-- cldfrash      cloud fraction from shallow Cu
 211 !-- cldfra_old_mp cloud fraction from previous time step if CAMMGMP microphysics is used
 212 !-- cldfra_conv   convective cloud fraction
 213 !-- rho           density (kg/m^3)
 214 !-- XLV0          latent heat of vaporization constant
 215 !                 used in temperature dependent formula (J/kg)
 216 !-- XLV1          latent heat of vaporization constant
 217 !                 used in temperature dependent formula (J/kg/K)
 218 !-- XLS0          latent heat of sublimation constant
 219 !                 used in temperature dependent formula (J/kg)
 220 !-- XLS1          latent heat of sublimation constant
 221 !                 used in temperature dependent formula (J/kg/K)
 222 !-- R_d           gas constant for dry air ( 287. J/kg/K)
 223 !-- R_v           gas constant for water vapor (461 J/k/kg)
 224 !-- Cp            specific heat at constant pressure (1004 J/k/kg)
 225 !-- rvovrd        R_v divided by R_d (dimensionless)
 226 !-- G             acceleration due to gravity (m/s^2)
 227 !-- EP_1          constant for virtual temperature
 228 !                 (R_v/R_d - 1) (dimensionless)
 229 !--shfrc3d        Shallow cloud fraction
 230 !-- cmfmc         Deep + Shallow Convective m
 231 !-- ids           start index for i in domain
 232 !-- ide           end index for i in domain
 233 !-- jds           start index for j in domain
 234 !-- jde           end index for j in domain
 235 !-- kds           start index for k in domain
 236 !-- kde           end index for k in domain
 237 !-- ims           start index for i in memory
 238 !-- ime           end index for i in memory
 239 !-- jms           start index for j in memory
 240 !-- jme           end index for j in memory
 241 !-- kms           start index for k in memory
 242 !-- kme           end index for k in memory
 243 !-- i_start       start indices for i in tile
 244 !-- i_end         end indices for i in tile
 245 !-- j_start       start indices for j in tile
 246 !-- j_end         end indices for j in tile
 247 !-- kts           start index for k in tile
 248 !-- kte           end index for k in tile
 249 !-- num_tiles     number of tiles
 250 !-- HBOT          index of lowest model layer with convection
 251 !-- HTOP          index of highest model layer with convection
 252 !-- LBOT          index of lowest model layer with convection
 253 !-- LTOP          index of highest model layer with convection
 254 !-- periodic_x    T/F this is using periodic lateral boundaries in the X direction
 255 !-- periodic_y    T/F this is using periodic lateral boundaries in the Y-direction
 256 !
 257 !======================================================================
 258    LOGICAL,      INTENT(IN   )    :: is_CAMMGMP_used !BSINGH:01/31/2013: Added for CAMUWSHCU
 259    INTEGER,      INTENT(IN   )    ::                             &
 260                                       ids,ide, jds,jde, kds,kde, &
 261                                       ims,ime, jms,jme, kms,kme, &
 262                                                         kts,kte, &
 263                                       itimestep, num_tiles
 264 #if ( WRF_CHEM == 1 )
 265    INTEGER,      INTENT(IN   )    :: chem_opt
 266 #endif
 267
 268    INTEGER, DIMENSION(num_tiles), INTENT(IN) ::                       &
 269      &           i_start,i_end,j_start,j_end
 270
 271    INTEGER,      INTENT(IN   )    ::                             &
 272                   num_moist
 273
 274    INTEGER,      INTENT(IN   )    ::               shcu_physics
 275
 276    REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_moist ),      &
 277          INTENT(INOUT)  ::                                       &
 278                                                           moist
 279 #if ( WRF_CHEM == 1 )
 280    REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ),       &
 281          INTENT(INOUT)  ::                                    &
 282                                                           chem
 283 #endif
 284
 285
 286    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                 &
 287          INTENT(IN ) ::                                          &
 288                                                          cldfra  &
 289                                                     ,cldfra_old  &
 290                                                   ,cldfra_old_mp &
 291                                                     ,cldfra_conv &
 292                                                       ,       z  &
 293                                                       ,  z_at_w  &
 294                                                       ,    dz8w  &
 295                                                       ,     p8w  &
 296                                                       ,       p  &
 297                                                       ,      pi  &
 298                                                       ,       u  &
 299                                                       ,       v  &
 300                                                       ,       t  &
 301                                                       , tke_pbl  &
 302                                                       ,     rho
 303
 304    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                 &
 305          INTENT(INOUT) ::                                    th
 306
 307
 308    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN) ::           &
 309 !                 MAVAIL,PBLH,ht
 310                          PBLH,ht
 311
 312    REAL, DIMENSION( ims:ime , jms:jme ),                         &
 313           INTENT(INOUT) ::                               RAINSH  &
 314                                                     ,       NCA  &
 315                                                     ,      HTOP  &
 316                                                     ,      HBOT
 317
 318
 319    REAL, DIMENSION( ims:ime , jms:jme ),INTENT(INOUT),OPTIONAL :: &
 320         PRATESH, RAINSHV
 321    REAL, DIMENSION( ims:ime , jms:jme ) :: tmppratesh
 322
 323    REAL,  INTENT(IN   ) :: DT, DX
 324    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN), OPTIONAL :: &
 325         DX2D, AREA2D
 326    INTEGER,      INTENT(IN   ),OPTIONAL    ::                             &
 327                                       ips,ipe, jps,jpe, kps,kpe
 328    REAL,  INTENT(IN   ),OPTIONAL :: CUDT
 329    REAL,  INTENT(IN   ),OPTIONAL :: CURR_SECS
 330    LOGICAL,INTENT(IN   ),OPTIONAL    ::     adapt_step_flag
 331    REAL   :: cudt_pass, curr_secs_pass
 332    LOGICAL :: adapt_step_flag_pass
 333
 334 !
 335 ! optional arguments
 336 !
 337    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                 &
 338          OPTIONAL, INTENT(INOUT) ::                              &
 339                       ! optional moisture tracers
 340                       qv_curr, qc_curr, qr_curr                  &
 341                      ,qi_curr, qs_curr, qg_curr                  &
 342                      ! optional scalar tracers !BSINGH
 343                      ,qnc_curr,qni_curr                          &
 344                       ! optional moisture and other tendencies
 345                      ,rqvshten,rqcshten,rqrshten                 &
 346                      ,rqishten,rqsshten,rqgshten                 &
 347                      ,rqcnshten,rqinshten                        &
 348                      ,rqvblten,rqvften                           &
 349                      ,rthraten,rthblten                          &
 350                      ,rthften,rushten,rvshten,rthshten
 351
 352    REAL, DIMENSION( ims:ime , jms:jme ),                         &
 353                     OPTIONAL, INTENT(INOUT) ::                   &
 354                 rliq, rliq2 &
 355                ,cbmf, cush, snowsh
 356    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                 &
 357          OPTIONAL, INTENT(INOUT) ::                              &
 358                   cldfrash, cmfsl, cmflq, icwmrsh,               &
 359                   dlf, evapcsh,                                  &
 360                   cmfmc, cmfmc2, rprdsh
 361    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                 &
 362         INTENT(OUT) ::                                 &
 363                   dlf2                                             ! Required by CAMMGMP Microphysics
 364    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                 &
 365         INTENT(OUT) ::                                 &
 366                  shfrc3d                                           ! Required by wet scavenging code in WRF_CHEM
 367 ! for grims shallow convection with ysupbl
 368 !
 369    REAL, DIMENSION( ims:ime, jms:jme )                         , &
 370          OPTIONAL, INTENT(IN   )                 ::      wstar
 371    REAL, DIMENSION( ims:ime, jms:jme )                         , &
 372          OPTIONAL, INTENT(IN   )                 ::        delta
 373    REAL, DIMENSION( ims:ime, jms:jme )                         , &
 374          OPTIONAL, INTENT(IN   )                 ::       raincv
 375    REAL, DIMENSION( kms:kme )                                  , &
 376          OPTIONAL, INTENT(IN   )       ::                    znu
 377    INTEGER, DIMENSION( ims:ime , jms:jme )                     , &
 378          OPTIONAL, INTENT(IN)                    ::         kpbl
 379 !
 380 ! for nscv shallow convection
 381 !
 382    REAL, DIMENSION( ims:ime, kms:kme, jms:jme )                , &
 383          INTENT(INOUT) ::                                      w
 384    REAL, DIMENSION( ims:ime, jms:jme )                         , &
 385          INTENT(IN   ) ::                                  xland
 386    REAL, DIMENSION( ims:ime, jms:jme )                         , &
 387          OPTIONAL, INTENT(IN   ) ::                      hfx,qfx
 388    INTEGER, INTENT(IN), OPTIONAL ::                   mp_physics
 389    REAL,    INTENT(IN), OPTIONAL ::                        pgcon
 390
 391
 392 ! PSU-DENG Shallow cu variables
 393 !
 394    INTEGER,   INTENT(IN   ) ::           bl_pbl_physics
 395    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                 &
 396                    INTENT(IN   ) ::           qke
 397
 398    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                 &
 399                    INTENT(INOUT) ::           RDCASHTEN, RQCDCSHTEN
 400
 401    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                       &
 402                    INTENT(INOUT) :: cldareaa, cldareab,                &
 403                                     cldliqa,  cldliqb, wub,            &
 404                                     W0AVG, TKEAVG
 405    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                       &
 406                    INTENT(  OUT) :: cldfra_sh, ca_rad, cw_rad
 407
 408    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                 &
 409                    INTENT(INOUT) :: el_pbl, rthratenlw, rthratensw, exch_h
 410
 411    REAL, DIMENSION( kms:kme ), INTENT(IN   ) ::    &
 412                                    dnw
 413
 414    REAL, INTENT(IN   ) ::          xtime, gmt
 415
 416    REAL, DIMENSION( ims:ime, jms:jme ),                 &
 417                    INTENT(INOUT) ::                              &
 418                                   cldtopb, pblmax, rainshvb, capesave, radsave, &
 419                                   clddpthb, xtime1, PBLHAVG, MAVAIL
 420
 421    REAL, DIMENSION( ims:ime, jms:jme ),                 &
 422                    INTENT(IN   ) ::         xlong
 423
 424    INTEGER, DIMENSION( ims:ime, jms:jme ),                 &
 425                    INTENT(INOUT) ::                              &
 426                                                     ltopb, kdcldtop, kdcldbas
 427
 428    REAL, DIMENSION( ims:ime, 1:100, jms:jme ),                 &
 429                    INTENT(INOUT) ::                              &
 430                                  ainckfsa
 431
 432   REAL, DIMENSION( ims:ime, kms:kme, jms:jme )  :: tke_scr, kth_scr, bbls_scr
 433
 434     ! WRF-Solar EPS
 435   integer, intent (in) :: multi_perturb
 436   logical, intent (in) :: pert_deng
 437   real, intent(in) :: pert_deng_qv, pert_deng_qc, pert_deng_t, pert_deng_w
 438   real, dimension(ims:ime, kms:kme, jms:jme), optional, intent(inout) :: perts_qvapor, &
 439        perts_qcloud, perts_th, perts_w
 440
 441 !
 442 ! End PSU-DENG Shallow cu variables
 443 !
 444
 445 !
 446 ! Flags relating to the optional tendency arrays declared above
 447 ! Models that carry the optional tendencies will provdide the
 448 ! optional arguments at compile time; these flags all the model
 449 ! to determine at run-time whether a particular tracer is in
 450 ! use or not.
 451 !
 452    LOGICAL, INTENT(IN), OPTIONAL ::                             &
 453                                                       f_qv      &
 454                                                      ,f_qc      &
 455                                                      ,f_qr      &
 456                                                      ,f_qi      &
 457                                                      ,f_qs      &
 458                                                      ,f_qg
 459
 460
 461 ! LOCAL  VAR
 462
 463    INTEGER :: i,j,k,its,ite,jts,jte,ij
 464    CHARACTER(len=200) :: message
 465
 466
 467 !-----------------------------------------------------------------
 468
 469    if (.not. PRESENT(CURR_SECS)) then
 470       curr_secs_pass = -1
 471    else
 472       curr_secs_pass = curr_secs
 473    endif
 474
 475    if (.not. PRESENT(CUDT)) then
 476       cudt_pass = -1
 477    else
 478       cudt_pass = cudt
 479    endif
 480
 481    if (.not. PRESENT(adapt_step_flag)) then
 482       adapt_step_flag_pass = .false.
 483    else
 484       adapt_step_flag_pass = adapt_step_flag
 485    endif
 486
 487    ! Initialize tmppratesh to pratesh
 488
 489    if ( PRESENT ( pratesh ) ) then
 490       tmppratesh(:,:) = pratesh(:,:)
 491    else
 492       tmppratesh(:,:) = 0.
 493    end if
 494
 495
 496    IF (shcu_physics .eq. 0) return
 497
 498
 499 ! DON'T JUDGE TIME STEP HERE, SINCE KF NEEDS ACCUMULATED W FIELD.
 500 ! DO IT INSIDE THE INDIVIDUAL CUMULUS SCHEME
 501
 502 ! SET START AND END POINTS FOR TILES
 503 !$OMP PARALLEL DO   &
 504 !$OMP PRIVATE ( ij ,its,ite,jts,jte, i,j,k)
 505    DO ij = 1 , num_tiles
 506       its = i_start(ij)
 507       ite = i_end(ij)
 508       jts = j_start(ij)
 509       jte = j_end(ij)
 510
 511
 512    scps_select: SELECT CASE(shcu_physics)
 513
 514    CASE (G3SHCUSCHEME)
 515       ! This setting takes the place of ishallow in v3.1.1+
 516
 517    CASE (CAMUWSHCUSCHEME)
 518       CALL wrf_debug(100,'in camuw_scps')
 519       IF(.not.f_qi)THEN
 520          WRITE( message , * ) 'This shallow cumulus option requires ice microphysics option: f_qi = ', f_qi
 521          CALL wrf_error_fatal ( message )
 522       ENDIF
 523       CALL camuwshcu_driver(                                             &
 524             IDS=ids,IDE=ide,JDS=jds,JDE=jde,KDS=kds,KDE=kde              &
 525            ,IMS=ims,IME=ime,JMS=jms,JME=jme,KMS=kms,KME=kme              &
 526            ,ITS=its,ITE=ite,JTS=jts,JTE=jte,KTS=kts,KTE=kte              &
 527            ,NUM_MOIST=num_moist, DT=dt                                   &
 528            ,P=p, P8W=p8w, PI_PHY=pi                                      &
 529            ,Z=z, Z_AT_W=z_at_w, DZ8W=dz8w                                &
 530            ,T_PHY=t, U_PHY=u, V_PHY=v                                    &
 531            ,MOIST=moist, QV=qv_curr, QC=qc_curr, QI=qi_curr              &
 532            ,QNC=qnc_curr, QNI=qni_curr                                   &
 533 #if ( WRF_CHEM == 1 )
 534            ,CHEM=chem, CHEM_OPT=chem_opt                                 &
 535 #endif
 536            ,PBLH_IN=pblh, TKE_PBL=tke_pbl                                &
 537            ,CLDFRA=cldfra, CLDFRA_OLD=cldfra_old                         &
 538            ,CLDFRA_OLD_MP=cldfra_old_mp                                  &
 539            ,CLDFRA_CONV=cldfra_conv,IS_CAMMGMP_USED=is_CAMMGMP_used      &
 540            ,CLDFRASH=cldfrash                                            &
 541            ,CUSH_INOUT=cush, PRATESH=tmppratesh                          &
 542            ,SNOWSH=snowsh                                                &
 543            ,ICWMRSH=icwmrsh, CMFMC=cmfmc, CMFMC2_INOUT=cmfmc2            &
 544            ,RPRDSH_INOUT=rprdsh, CBMF_INOUT=cbmf                         &
 545            ,CMFSL=cmfsl, CMFLQ=cmflq, DLF=dlf,DLF2=dlf2                  & !DLF2 is required by CAMMGMP microphysics
 546            ,EVAPCSH_INOUT=evapcsh                                        &
 547            ,RLIQ=rliq, RLIQ2_INOUT=rliq2, CUBOT=hbot, CUTOP=htop         &
 548            ,RUSHTEN=rushten, RVSHTEN=rvshten, RTHSHTEN=rthshten          &
 549            ,RQVSHTEN=rqvshten, RQCSHTEN=rqcshten, RQRSHTEN=rqrshten      &
 550            ,RQISHTEN=rqishten, RQSSHTEN=rqsshten, RQGSHTEN=rqgshten      &
 551            ,RQCNSHTEN=rqcnshten,RQINSHTEN=rqinshten                      &
 552            ,HT=ht,SHFRC3D=shfrc3d,ITIMESTEP=itimestep                    &
 553                                                                          )
 554
 555    CASE (GRIMSSHCUSCHEME)
 556       CALL wrf_debug(100,'in grims_scps')
 557       IF ( PRESENT( wstar ) ) THEN
 558       CALL grims(                                                        &
 559             QV3D=qv_curr,T3D=t                                           &
 560            ,P3DI=p8w,P3D=p,PI3D=pi,Z3DI=Z_AT_W                           &
 561            ,WSTAR=wstar,HPBL=pblh,DELTA=delta                        &
 562            ,RTHSHTEN=rthshten,RQVSHTEN=rqvshten                          &
 563            ,DT=dt,G=g,XLV=xlv,RD=r_d,RV=r_v                        &
 564            ,RCP=rcp,P1000MB=p1000mb                                      &
 565            ,KPBL2D=kpbl,ZNU=znu,RAINCV=raincv                            &
 566            ,IDS=ids,IDE=ide,JDS=jds,JDE=jde,KDS=kds,KDE=kde              &
 567            ,IMS=ims,IME=ime,JMS=jms,JME=jme,KMS=kms,KME=kme              &
 568            ,ITS=its,ITE=ite,JTS=jts,JTE=jte,KTS=kts,KTE=kte              &
 569                                                                          )
 570       ENDIF
 571
 572    CASE (NSCVSHCUSCHEME)
 573       CALL wrf_debug(100,'in nscv_scps')
 574       IF ( PRESENT ( QFX ) .AND. PRESENT( HFX ) ) THEN
 575          CALL SHCU_NSCV(                                        &
 576                 DT=dt,P3DI=p8w,P3D=p,PI3D=pi                    &
 577                ,QC3D=QC_CURR,QI3D=QI_CURR,RHO3D=rho             &
 578                ,QV3D=QV_CURR,T3D=t                              &
 579                ,RAINCV=RAINCV                                   &
 580                ,XLAND=XLAND,DZ8W=dz8w,W=w,U3D=u,V3D=v           &
 581                ,HPBL=pblh,HFX=hfx,QFX=qfx                       &
 582                ,MP_PHYSICS=mp_physics                           &
 583                ,pgcon=pgcon                                     &
 584                ,CP=cp,CLIQ=cliq,CPV=cpv,G=g,XLV=xlv,R_D=r_d     &
 585                ,R_V=r_v,EP_1=ep_1,EP_2=EP_2                     &
 586                ,CICE=cice,XLS=xls,PSAT=psat                     &
 587                ,F_QI=f_qi,F_QC=f_qc                             &
 588                ,RTHSHTEN=RTHSHTEN,RQVSHTEN=RQVSHTEN             &
 589                ,RQCSHTEN=RQCSHTEN,RQISHTEN=RQISHTEN             &
 590                ,RUSHTEN=RUSHTEN,RVSHTEN=RVSHTEN                 &
 591                ,PRATESH=tmppratesh                              &
 592                ,HBOT=HBOT,HTOP=HTOP                             &
 593                ,IDS=ids,IDE=ide,JDS=jds,JDE=jde,KDS=kds,KDE=kde &
 594                ,IMS=ims,IME=ime,JMS=jms,JME=jme,KMS=kms,KME=kme &
 595                ,ITS=its,ITE=ite,JTS=jts,JTE=jte,KTS=kts,KTE=kte &
 596                                                                 )
 597       ELSE
 598          CALL wrf_error_fatal('Lacking arguments for SHCU_NSCV in shallow cumulus driver')
 599       ENDIF
 600
 601   CASE (DENGSHCUSCHEME)
 602       CALL wrf_debug(100,'in PSU-DENG Shallow Cu CPS')
 603
 604
 605      IF ( bl_pbl_physics == 2 ) THEN   ! MYJ
 606          DO j=jts,jte
 607          DO i=its,ite
 608          DO k=kts,kte
 609             tke_scr(I,K,J) = tke_pbl(I,K,J)
 610             kth_scr(I,K,J) = exch_h(I,K,J)
 611             bbls_scr(I,K,J) = el_pbl(I,K,J)
 612          ENDDO
 613          ENDDO
 614          ENDDO
 615       ELSE IF ( bl_pbl_physics == 5 ) THEN   ! MYNN
 616          DO j=jts,jte
 617          DO i=its,ite
 618          DO k=kts,kte
 619             tke_scr(I,K,J) = 0.5 * qke(I,K,J)
 620             kth_scr(I,K,J) = exch_h(I,K,J)
 621             bbls_scr(I,K,J) = el_pbl(I,K,J)
 622          ENDDO
 623          ENDDO
 624          ENDDO
 625       ELSE
 626          WRITE(message,*) 'PSU DENG ShCu currently does not support PBL option: ', &
 627                             bl_pbl_physics
 628          CALL wrf_error_fatal ( message )
 629          STOP
 630       ENDIF
 631
 632       if (pert_deng .and. multi_perturb == 1) &
 633           call Add_multi_perturb_shcu_perturbations (perts_qvapor, perts_qcloud, &
 634           perts_th, perts_w, pert_deng_qv, pert_deng_qc, pert_deng_t, pert_deng_w, &
 635           th, qv_curr, qc_curr, w, its, ite, jts, jte, ims, ime, jms, jme, kms, kme, &
 636           kts, kte)
 637
 638       CALL deng_shcu_driver(                                             &
 639             IDS=ids,IDE=ide,JDS=jds,JDE=jde,KDS=kds,KDE=kde              &
 640            ,IMS=ims,IME=ime,JMS=jms,JME=jme,KMS=kms,KME=kme              &
 641            ,ITS=its,ITE=ite,JTS=jts,JTE=jte,KTS=kts,KTE=kte              &
 642            ,DT=dt ,KTAU=itimestep ,DX=dx, xtime=xtime, gmt=gmt           &
 643            ,XLV=XLV, XLS=XLS                                             &
 644            ,XLV0=XLV0 ,XLV1=XLV1 ,XLS0=XLS0 ,XLS1=XLS1                   &
 645            ,CP=CP, R=R_d ,G=G                                            &
 646            ,SVP1=SVP1 ,SVP2=SVP2 ,SVP3=SVP3 ,SVPT0=SVPT0                 &
 647            ,ADAPT_STEP_FLAG=ADAPT_STEP_FLAG, DSIGMA=dnw                  &
 648            ,XLONG=xlong, HT=ht, PBLH=pblh                                &
 649            ,U=u,V=v, w=w, TH=th ,T=t                                     &
 650            ,QV=qv_curr, QC=qc_curr, QR=qr_curr, DZ8W=dz8w                &
 651            ,PCPS=p, RHO=rho, Z_AT_W=z_at_w, PI=pi                        &
 652            ,TKE=tke_scr, kth=kth_scr, bbls=bbls_scr                      &
 653            ,ten_radl=rthratenlw, ten_rads=rthratensw                     &
 654            ,RAINSH=RAINSH, RAINSHV=RAINSHV,rainshvb=rainshvb             &
 655            ,pblmax=pblmax, capesave=capesave, xtime1=xtime1              &
 656            ,radsave=radsave, clddpthb=clddpthb, cldtopb=cldtopb          &
 657            ,MAVAIL=MAVAIL, PBLHAVG=PBLHAVG                               &
 658            ,ainckfsa=ainckfsa                                            &
 659            ,ltopb=ltopb, kdcldtop=kdcldtop, kdcldbas=kdcldbas            &
 660            ,W0AVG=W0AVG, TKEAVG=TKEAVG                                   &
 661            ,cldareaa=cldareaa, cldareab=cldareab                         &
 662            ,cldliqa=cldliqa, cldliqb=cldliqb                             &
 663            ,cldfra_sh=cldfra_sh,ca_rad=ca_rad, cw_rad=cw_rad, wub=wub    &
 664            ,RUSHTEN=rushten, RVSHTEN=rvshten, RTHSHTEN=rthshten          &
 665            ,RQVSHTEN=rqvshten, RQCSHTEN=rqcshten, RQRSHTEN=rqrshten      &
 666            ,RDCASHTEN=RDCASHTEN, RQCDCSHTEN=RQCDCSHTEN)
 667
 668       if (pert_deng .and. multi_perturb == 1) &
 669           call Remove_multi_perturb_shcu_perturbations (perts_qvapor, perts_qcloud, &
 670           perts_th, perts_w, pert_deng_qv, pert_deng_qc, pert_deng_t, pert_deng_w, &
 671           th, qv_curr, qc_curr, w, its, ite, jts, jte, ims, ime, jms, jme, kms, kme, &
 672           kts, kte)
 673
 674    CASE DEFAULT
 675       WRITE( message , * ) 'The shallow cumulus option does not exist: shcu_physics = ', shcu_physics
 676       CALL wrf_error_fatal ( message )
 677
 678    END SELECT scps_select
 679
 680    ENDDO
 681    !$OMP END PARALLEL DO
 682
 683    !
 684    ! Copy pratesh back to output array, if necessary.
 685    !
 686    if (PRESENT(PRATESH)) then
 687       pratesh(:,:) = tmppratesh(:,:)
 688       if (PRESENT(RAINSHV)) then
 689          rainshv(:,:) = pratesh(:,:)*dt
 690       endif
 691    endif
 692
 693    END SUBROUTINE shallowcu_driver
 694
 695    subroutine  Add_multi_perturb_shcu_perturbations (perts_qvapor, perts_qcloud, &
 696        perts_th, perts_w, pert_deng_qv, pert_deng_qc, pert_deng_t, pert_deng_w, &
 697        th, qv_curr, qc_curr, w, its, ite, jts, jte, ims, ime, jms, jme, kms, kme, &
 698        kts, kte)
 699
 700      implicit none
 701
 702      integer, intent(in) :: its, ite, jts, jte, ims, ime, jms, jme, kms, kme, kts, kte
 703      real, intent(in) :: pert_deng_qv, pert_deng_qc, pert_deng_t, pert_deng_w
 704      real, dimension(ims:ime, kms:kme, jms:jme), optional, intent (in) :: perts_qvapor, &
 705        perts_qcloud, perts_th, perts_w
 706      real, dimension(ims:ime, kms:kme, jms:jme), intent (inout) :: th, w, qv_curr, qc_curr
 707
 708      integer :: i, j, k
 709
 710
 711      do j = jts, jte
 712        do k = kts, kte
 713          do i = its, ite
 714            qc_curr(i, k, j) = max ((1.0 + perts_qcloud(i, k, j) * pert_deng_qc) * qc_curr(i, k, j), QCLOUD_MIN)
 715            qv_curr(i, k, j) = max ((1.0 + perts_qvapor(i, k, j) * pert_deng_qv) * qv_curr(i, k, j), QVAPOR_MIN)
 716            th(i, k, j) = (1.0 + perts_th(i, k, j) * pert_deng_t) * th(i, k, j)
 717          end do
 718        end do
 719      end do
 720
 721      do j = jts, jte
 722        do k = kts + 1, kte
 723          do i = its, ite
 724            w(i, k, j) = (1.0 + perts_w(i, k, j) * pert_deng_t) * w(i, k, j)
 725          end do
 726        end do
 727      end do
 728
 729    end subroutine  Add_multi_perturb_shcu_perturbations
 730
 731    subroutine Remove_multi_perturb_shcu_perturbations (perts_qvapor, perts_qcloud, &
 732        perts_th, perts_w, pert_deng_qv, pert_deng_qc, pert_deng_t, pert_deng_w, &
 733        th, qv_curr, qc_curr, w, its, ite, jts, jte, ims, ime, jms, jme, kms, kme, &
 734        kts, kte)
 735
 736      implicit none
 737
 738      integer, intent(in) :: its, ite, jts, jte, ims, ime, jms, jme, kms, kme, kts, kte
 739      real, intent(in) :: pert_deng_qv, pert_deng_qc, pert_deng_t, pert_deng_w
 740      real, dimension(ims:ime, kms:kme, jms:jme), optional, intent (in) :: perts_qvapor, &
 741        perts_qcloud, perts_th, perts_w
 742      real, dimension(ims:ime, kms:kme, jms:jme), intent (inout) :: th, w, qv_curr, qc_curr
 743
 744      integer :: i, j, k
 745
 746
 747      do j = jts, jte
 748        do k = kts, kte
 749          do i = its, ite
 750            qc_curr(i, k, j) = max (qc_curr(i, k, j) / (1.0 + perts_qcloud(i, k, j) * pert_deng_qc), QCLOUD_MIN)
 751            qv_curr(i, k, j) = max (qv_curr(i, k, j) / (1.0 + perts_qvapor(i, k, j) * pert_deng_qv), QVAPOR_MIN)
 752            th(i, k, j) = th(i, k, j) / (1.0 + perts_th(i, k, j) * pert_deng_t)
 753          end do
 754        end do
 755      end do
 756
 757      do j = jts, jte
 758        do k = kts + 1, kte
 759          do i = its, ite
 760            w(i, k, j) = w(i, k, j) / (1.0 + perts_w(i, k, j) * pert_deng_w)
 761          end do
 762        end do
 763      end do
 764
 765    end subroutine  Remove_multi_perturb_shcu_perturbations
 766
 767 END MODULE module_shallowcu_driver