wrftladj/module_microphysics_driver_tl.F

   1 !        Generated by TAPENADE     (INRIA, Tropics team)
   2 !  Tapenade 3.7 (r4786) - 21 Feb 2013 15:53
   3 !
   4 !  Differentiation of microphysics_driver in forward (tangent) mode (with options r8):
   5 !   variations   of useful results: th rainnc qv_curr rainncv
   6 !   with respect to varying inputs: th p rainnc pi_phy qv_curr
   7 !                rainncv rho dz8w
   8 !   RW status of diff variables: th:in-out p:in rainnc:in-out pi_phy:in
   9 !                qv_curr:in-out rainncv:in-out rho:in dz8w:in
  10 !WRF:MEDIATION_LAYER:PHYSICS
  11 ! *** add new modules of schemes here
  12 !
  13 MODULE g_module_microphysics_driver
  14 CONTAINS
  15 !======================
  16 !Variables required for CAMMGMP Scheme
  17 !======================
  18 ! for etampnew or etampold
  19 ! for mp_gsfcgce
  20 !                     ,ccntype                                           & ! for mp_milbrandt2mom
  21 ! HM, 9/22/09, add for refl
  22 ! YLIN
  23 ! Added the RI_CURR array to the call
  24 SUBROUTINE G_MICROPHYSICS_DRIVER(th, thd, rho, rhod, pi_phy, pi_phyd, p&
  25 &  , pd, ht, dz8w, dz8wd, p8w, dt, dx, dy, mp_physics, spec_zone, &
  26 &  specified, channel_switch, warm_rain, t8w, chem_opt, progn, cldfra, &
  27 &  cldfra_old, exch_h, nsource, qlsink, precr, preci, precs, precg, xland&
  28 &  , snowh, itimestep, f_ice_phy, f_rain_phy, f_rimef_phy, lowlyr, sr, id&
  29 &  , ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe&
  30 &  , jps, jpe, kps, kpe, i_start, i_end, j_start, j_end, kts, kte, &
  31 &  num_tiles, naer, dlf, dlf2, t_phy, p_hyd, p8w_hyd, tke_pbl, z_at_w, &
  32 &  qfx, rliq, turbtype3d, smaw3d, wsedl3d, cldfra_old_mp, cldfra_mp, &
  33 &  cldfra_mp_all, cldfrai, cldfral, cldfra_conv, alt, accum_mode, &
  34 &  aitken_mode, coarse_mode, icwmrsh3d, icwmrdp3d, shfrc3d, cmfmc3d, &
  35 &  cmfmc2_3d, config_flags, fnm, fnp, rh_old_mp, lcd_old_mp, qv_curr, &
  36 &  qv_currd, qc_curr, qc_currd, qr_curr, qr_currd, qi_curr, qs_curr, qg_curr, qndrop_curr, &
  37 &  qni_curr, qh_curr, qnh_curr, qzr_curr, qzi_curr, qzs_curr, qzg_curr, &
  38 &  qzh_curr, qns_curr, qnr_curr, qng_curr, qnn_curr, qnc_curr, qvolg_curr, qvolh_curr &
  39 &  ,qdcn_curr,qtcn_curr,qccn_curr,qrcn_curr,qnin_curr,fi_curr,fs_curr    & ! for ntu3m
  40 &  ,vi_curr,vs_curr,vg_curr,ai_curr,as_curr,ag_curr,ah_curr,i3m_curr     & ! for ntu3m
  41 &  ,f_qdcn,f_qtcn,f_qccn,f_qrcn,f_qnin,f_fi,f_fs,f_vi,f_vs,f_vg          & ! for ntu3m
  42 &  ,f_ai,f_as,f_ag,f_ah,f_i3m                                            & ! for ntu3m
  43 &  , f_qv, f_qc, f_qr, f_qi, f_qs, f_qg, f_qndrop, f_qni, f_qns, f_qnr, &
  44 &  f_qng, f_qnc, f_qnn, f_qh, f_qnh, f_qzr, f_qzi, f_qzs, f_qzg, f_qzh, &
  45 &  f_qvolg, f_qvolh, qrcuten, qscuten, qicuten, qt_curr, f_qt, &
  46 &  mp_restart_state, tbpvs_state, tbpvs0_state, hail, ice2, w, z, rainnc&
  47 &  , rainncd, rainncv, rainncvd, snownc, snowncv, hailnc, hailncv, &
  48 &  graupelnc, graupelncv, refl_10cm, ri_curr, diagflag, do_radar_ref)
  49 ! Framework
  50    USE module_state_description, ONLY :                                  &
  51                      KESSLERSCHEME, LINSCHEME, SBU_YLINSCHEME, WSM3SCHEME, WSM5SCHEME    &
  52                     ,WSM6SCHEME, ETAMPNEW, THOMPSON, MORR_TWO_MOMENT     &
  53                     ,GSFCGCESCHEME, WDM5SCHEME, WDM6SCHEME, NSSL_2MOM, NSSL_2MOMCCN, NSSL_2MOMG  &
  54                     ,NSSL_1MOM,NSSL_1MOMLFO & ! ,NSSL_3MOM       &
  55                     ,MILBRANDT2MOM, LSCONDSCHEME, MKESSLERSCHEME, CAMMGMPSCHEME, NTU  !,MILBRANDT3MOM, ntu3m
  56
  57 ! Model Layer
  58    USE module_model_constants
  59    USE module_wrf_error
  60    USE module_configure, only: grid_config_rec_type
  61
  62 ! *** add new modules of schemes here
  63
  64    USE g_module_mp_nconvp    !  added by Zhuxiao
  65    USE g_module_mp_mkessler
  66
  67 ! For checking model timestep is history time (for radar reflectivity)
  68    USE module_utility, ONLY: WRFU_Clock, WRFU_Alarm
  69    USE module_domain, ONLY : HISTORY_ALARM, Is_alarm_tstep
  70
  71   IMPLICIT NONE
  72
  73 ! ,NSSL_3MOM       &
  74 !,MILBRANDT3MOM
  75 ! Model Layer
  76 ! *** add new modules of schemes here
  77 !  USE module_mp_nconvp    !  added by Zhuxiao
  78 ! For checking model timestep is history time (for radar reflectivity)
  79 !======================================================================
  80 ! Grid structure in physics part of WRF
  81 !----------------------------------------------------------------------
  82 ! The horizontal velocities used in the physics are unstaggered
  83 ! relative to temperature/moisture variables. All predicted
  84 ! variables are carried at half levels except w, which is at full
  85 ! levels. Some arrays with names (*8w) are at w (full) levels.
  86 !
  87 !----------------------------------------------------------------------
  88 ! In WRF, kms (smallest number) is the bottom level and kme (largest
  89 ! number) is the top level.  In your scheme, if 1 is at the top level,
  90 ! then you have to reverse the order in the k direction.
  91 !
  92 !         kme      -   half level (no data at this level)
  93 !         kme    ----- full level
  94 !         kme-1    -   half level
  95 !         kme-1  ----- full level
  96 !         .
  97 !         .
  98 !         .
  99 !         kms+2    -   half level
 100 !         kms+2  ----- full level
 101 !         kms+1    -   half level
 102 !         kms+1  ----- full level
 103 !         kms      -   half level
 104 !         kms    ----- full level
 105 !
 106 !======================================================================
 107 ! Definitions
 108 !-----------
 109 ! Rho_d      dry density (kg/m^3)
 110 ! Theta_m    moist potential temperature (K)
 111 ! Qv         water vapor    mixing ratio (kg/kg)
 112 ! Qc         cloud water    mixing ratio (kg/kg)
 113 ! Qr         rain water     mixing ratio (kg/kg)
 114 ! Qi         cloud ice      mixing ratio (kg/kg)
 115 ! Qs         snow           mixing ratio (kg/kg)
 116 ! Qg         graupel        mixing ratio (kg/kg)
 117 ! Qh         hail           mixing ratio (kg/kg)
 118 ! Qndrop     droplet number mixing ratio (#/kg)
 119 ! Qni        cloud ice number concentration (#/kg)
 120 ! Qns        snow      number concentration (#/kg)
 121 ! Qnr        rain      number concentration (#/kg)
 122 ! Qng        graupel   number concentration (#/kg)
 123 ! Qnh        hail      number concentration (#/kg)
 124 ! Qzr        rain             reflectivity (m6/kg)
 125 ! Qzi        ice              reflectivity (m6/kg)
 126 ! Qzs        snow             reflectivity (m6/kg)
 127 ! Qzg        graupel          reflectivity (m6/kg)
 128 ! Qzh        hail             reflectivity (m6/kg)
 129 ! Qvolg        graupel   particle volume (m3/kg)
 130 ! Qvolh        hail      particle volume (m3/kg)
 131 !
 132 !----------------------------------------------------------------------
 133 !-- th        potential temperature    (K)
 134 !-- moist_new     updated moisture array   (kg/kg)
 135 !-- moist_old     Old moisture array       (kg/kg)
 136 !-- rho           density of air           (kg/m^3)
 137 !-- pi_phy        exner function           (dimensionless)
 138 !-- p             pressure                 (Pa)
 139 !-- RAINNC        grid scale precipitation (mm)
 140 !-- RAINNCV       one time step grid scale precipitation (mm/step)
 141 !-- SNOWNC        grid scale snow and ice (mm)
 142 !-- SNOWNCV       one time step grid scale snow and ice (mm/step)
 143 !-- GRAUPELNC     grid scale graupel (mm)
 144 !-- GRAUPELNCV    one time step grid scale graupel (mm/step)
 145 !-- HAILNC        grid scale hail (mm)
 146 !-- HAILNCV       one time step grid scale hail (mm/step)
 147 !-- SR            one time step mass ratio of snow to total precip
 148 !-- z             Height above sea level   (m)
 149 !-- dt            Time step              (s)
 150 !-- G             acceleration due to gravity  (m/s^2)
 151 !-- CP            heat capacity at constant pressure for dry air (J/kg/K)
 152 !-- R_d           gas constant for dry air (J/kg/K)
 153 !-- R_v           gas constant for water vapor (J/kg/K)
 154 !-- XLS           latent heat of sublimation   (J/kg)
 155 !-- XLV           latent heat of vaporization  (J/kg)
 156 !-- XLF           latent heat of melting       (J/kg)
 157 !-- rhowater      water density                      (kg/m^3)
 158 !-- rhosnow       snow density               (kg/m^3)
 159 !-- F_ICE_PHY     Fraction of ice.
 160 !-- F_RAIN_PHY    Fraction of rain.
 161 !-- F_RIMEF_PHY   Mass ratio of rimed ice (rime factor)
 162 !-- t8w           temperature at layer interfaces
 163 !-- cldfra, cldfra_old, current, previous cloud fraction
 164 !-- exch_h        vertical diffusivity (m2/s)
 165 !-- qlsink        Fractional cloud water sink (/s)
 166 !-- precr         rain precipitation rate at all levels (kg/m2/s)
 167 !-- preci         ice precipitation rate at all levels (kg/m2/s)
 168 !-- precs         snow precipitation rate at all levels (kg/m2/s)
 169 !-- precg         graupel precipitation rate at all levels (kg/m2/s)                             &
 170 !-- P_QV          species index for water vapor
 171 !-- P_QC          species index for cloud water
 172 !-- P_QR          species index for rain water
 173 !-- P_QI          species index for cloud ice
 174 !-- P_QS          species index for snow
 175 !-- P_QG          species index for graupel
 176 !-- P_QH          species index for hail
 177 !-- P_QNDROP      species index for cloud drop mixing ratio
 178 !-- P_QNR         species index for rain number concentration,
 179 !-- P_QNI         species index for cloud ice number concentration
 180 !-- P_QNS         species index for snow number concentration,
 181 !-- P_QNG         species index for graupel number concentration,
 182 !-- P_QNH         species index for hail number concentration,
 183 !-- P_QZR         species index for rain    reflectivity
 184 !-- P_QZI         species index for ice     reflectivity
 185 !-- P_QZS         species index for snow    reflectivity
 186 !-- P_QZG         species index for graupel reflectivity
 187 !-- P_QZH         species index for hail    reflectivity
 188 !-- P_QVOLG       species index for graupel particle volume,
 189 !-- P_QVOLH       species index for hail    particle volume,
 190 !-- id            grid id number
 191 !-- ids           start index for i in domain
 192 !-- ide           end index for i in domain
 193 !-- jds           start index for j in domain
 194 !-- jde           end index for j in domain
 195 !-- kds           start index for k in domain
 196 !-- kde           end index for k in domain
 197 !-- ims           start index for i in memory
 198 !-- ime           end index for i in memory
 199 !-- jms           start index for j in memory
 200 !-- jme           end index for j in memory
 201 !-- kms           start index for k in memory
 202 !-- kme           end index for k in memory
 203 !-- i_start       start indices for i in tile
 204 !-- i_end         end indices for i in tile
 205 !-- j_start       start indices for j in tile
 206 !-- j_end         end indices for j in tile
 207 !-- its           start index for i in tile
 208 !-- ite           end index for i in tile
 209 !-- jts           start index for j in tile
 210 !-- jte           end index for j in tile
 211 !-- kts           start index for k in tile
 212 !-- kte           end index for k in tile
 213 !-- num_tiles     number of tiles
 214 !-- diagflag      Logical to tell us when to produce diagnostics for history or restart
 215 !
 216 !======================================================================
 217   TYPE(GRID_CONFIG_REC_TYPE), INTENT(IN), OPTIONAL :: config_flags
 218   INTEGER, INTENT(IN) :: mp_physics
 219   LOGICAL, INTENT(IN) :: specified
 220   INTEGER, OPTIONAL, INTENT(IN) :: chem_opt, progn
 221 !, ccntype
 222   INTEGER, OPTIONAL, INTENT(IN) :: hail, ice2
 223 !
 224   INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde
 225   INTEGER, INTENT(IN) :: ims, ime, jms, jme, kms, kme
 226   INTEGER, OPTIONAL, INTENT(IN) :: ips, ipe, jps, jpe, kps, kpe
 227   INTEGER, INTENT(IN) :: kts, kte
 228   INTEGER, INTENT(IN) :: itimestep, num_tiles, spec_zone
 229   INTEGER, DIMENSION(num_tiles), INTENT(IN) :: i_start, i_end, j_start, &
 230 &  j_end
 231   LOGICAL, INTENT(IN) :: warm_rain
 232 !
 233   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: th
 234   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: thd
 235 !
 236 !
 237   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: rho, dz8w, &
 238 &  p8w, pi_phy, p
 239   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: rhod, dz8wd&
 240 &  , pi_phyd, pd
 241 !=================
 242 !Data for CAMMGMP scheme
 243   REAL, INTENT(IN), OPTIONAL :: accum_mode, aitken_mode, coarse_mode
 244 !1D variables required for CAMMGMP scheme
 245 !Factors for interpolation at "w" grid (interfaces)
 246   REAL, DIMENSION(kms:kme), INTENT(IN), OPTIONAL :: fnm, fnp
 247 !2D variables required for CAMMGMP scheme
 248 !Moisture flux at surface (kg m-2 s-1)
 249 !Vertically-integrated reserved cloud condensate(m/s)
 250   REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN), OPTIONAL :: qfx, rliq
 251 !3D variables required for CAMMGMP scheme
 252 !Detraining cloud water tendendcy
 253 !dq/dt due to export of cloud water into environment by shallow convection(kg/kg/s)
 254 !Temprature at the mid points (K)
 255 !Hydrostatic pressure(Pa)
 256 !Hydrostatic Pressure at level interface (Pa)
 257 !Height above sea level at layer interfaces (m)
 258 !Turbulence kinetic energy
 259 !Turbulent interface types [ no unit ]
 260 !Normalized Galperin instability function for momentum  ( 0<= <=4.964 and 1 at neutral ) [no units]
 261 !inverse density(m3/kg)
 262 !Shallow cumulus in-cloud water mixing ratio (kg/m2)
 263 !Deep Convection in-cloud water mixing ratio (kg/m2)
 264 !Shallow cloud fraction
 265 !Deep + Shallow Convective mass flux [ kg /s/m^2 ]
 266 !Shallow convective mass flux [ kg/s/m^2 ]
 267   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN), OPTIONAL :: &
 268 &  dlf, dlf2, t_phy, p_hyd, p8w_hyd, z_at_w, tke_pbl, turbtype3d, smaw3d&
 269 &  , alt, icwmrsh3d, icwmrdp3d, shfrc3d, cmfmc3d, cmfmc2_3d
 270 !In-outs
 271 !Old Cloud fraction for CAMMGMP microphysics only
 272 !Old RH
 273 !Old liquid cloud fraction
 274   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT), OPTIONAL ::&
 275 &  cldfra_old_mp, rh_old_mp, lcd_old_mp
 276 !In-outs -optional
 277 !outs
 278 !Sedimentation velocity of stratiform liquid cloud droplet (m/s)
 279 !Old Cloud fraction for CAMMGMP microphysics only
 280 !Old Cloud fraction for CAMMGMP microphysics only
 281 !Old Cloud fraction for CAMMGMP microphysics only
 282 !Old Cloud fraction for CAMMGMP microphysics only
 283   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT), OPTIONAL ::&
 284 &  wsedl3d, cldfra_mp, cldfra_mp_all, cldfrai, cldfral, cldfra_conv
 285   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: f_ice_phy&
 286 &  , f_rain_phy, f_rimef_phy
 287 !!$#ifdef WRF_CHEM
 288 !  REAL, INTENT(OUT), DIMENSION(ims:ime, kms:kme, jms:jme ) ::     &
 289 !!$#else
 290 !!$  REAL, DIMENSION(ims:ime, kms:kme, jms:jme ) ::     &
 291 !!$#endif
 292 ! cloud water sink (/s)
 293 ! rain precipitation rate at all levels (kg/m2/s)
 294 ! ice precipitation rate at all levels (kg/m2/s)
 295 ! snow precipitation rate at all levels (kg/m2/s)
 296 ! graupel precipitation rate at all levels (kg/m2/s)
 297   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(OUT) :: &
 298 &  qlsink, precr, preci, precs, precg
 299 !
 300   REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: xland
 301   REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN), OPTIONAL :: snowh
 302   REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: sr
 303   REAL, INTENT(IN) :: dt, dx, dy
 304   INTEGER, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: lowlyr
 305 !
 306 ! Optional
 307 !
 308   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(OUT) :: &
 309 &  refl_10cm
 310   LOGICAL, OPTIONAL, INTENT(IN) :: channel_switch
 311 ! aerosol number concentration (/kg)
 312   REAL, OPTIONAL, INTENT(INOUT) :: naer
 313   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
 314 &  w, z, t8w, cldfra, cldfra_old, exch_h, qv_curr, qc_curr, qr_curr, &
 315 &  qi_curr, qs_curr, qg_curr, qt_curr, qndrop_curr, qni_curr, qh_curr, &
 316 &  qnh_curr, qns_curr, qnr_curr, qng_curr, qnn_curr, qnc_curr, qzr_curr, &
 317 &  qzi_curr, qzs_curr, qzg_curr, qzh_curr, qvolg_curr, qvolh_curr
 318    REAL, DIMENSION(ims:ime,kms:kme,jms:jme), OPTIONAL, INTENT(INOUT) :: & ! for ntu3m
 319 &        qdcn_curr,qtcn_curr,qccn_curr,qrcn_curr,qnin_curr,fi_curr,     & ! for ntu3m
 320 &        fs_curr,vi_curr,vs_curr,vg_curr,ai_curr,as_curr,ag_curr,       & ! for ntu3m
 321 &        ah_curr,i3m_curr                                                 ! for ntu3m
 322    LOGICAL, OPTIONAL :: f_qdcn,f_qtcn,f_qccn,f_qrcn,f_qnin,f_fi,f_fs,   & ! for ntu3m
 323 &                       f_vi,f_vs,f_vg,f_ai,f_as,f_ag,f_ah,f_i3m          ! for ntu3m
 324   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
 325 &  qv_currd, qc_currd, qr_currd
 326   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(IN) :: &
 327 &  qrcuten, qscuten, qicuten
 328 ! YLIN
 329 ! Added RI_CURR similar to microphysics fields above
 330   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
 331 &  ri_curr
 332   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(OUT) :: &
 333 &  nsource
 334 !
 335   REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT), OPTIONAL :: rainnc, &
 336 &  rainncv, snownc, snowncv, graupelnc, graupelncv, hailnc, hailncv
 337   REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT), OPTIONAL :: rainncd&
 338 &  , rainncvd
 339   INTEGER, OPTIONAL, INTENT(IN) :: id
 340   REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(IN) :: ht
 341   REAL, DIMENSION(:), OPTIONAL, INTENT(INOUT) :: mp_restart_state, &
 342 &  tbpvs_state, tbpvs0_state
 343 !
 344   LOGICAL, OPTIONAL :: f_qv, f_qc, f_qr, f_qi, f_qs, f_qg, f_qndrop, &
 345 &  f_qni, f_qt, f_qns, f_qnr, f_qng, f_qnn, f_qnc, f_qh, f_qnh, f_qzr, &
 346 &  f_qzi, f_qzs, f_qzg, f_qzh, f_qvolg, f_qvolh
 347   LOGICAL, OPTIONAL, INTENT(IN) :: diagflag
 348   INTEGER, OPTIONAL, INTENT(IN) :: do_radar_ref
 349 ! LOCAL  VAR
 350   INTEGER :: i, j, k, its, ite, jts, jte, ij, sz, n
 351   LOGICAL :: channel
 352   REAL :: z0, z1, z2, w1, w2
 353 !---------------------------------------------------------------------
 354 !  check for microphysics type.  We need a clean way to
 355 !  specify these things!
 356 !---------------------------------------------------------------------
 357   channel = .false.
 358   IF (PRESENT(channel_switch)) channel = channel_switch
 359   IF (mp_physics .EQ. 0) THEN
 360     RETURN
 361   ELSE
 362     IF (specified) THEN
 363       sz = spec_zone
 364     ELSE
 365       sz = 0
 366     END IF
 367 !$OMP PARALLEL DO   &
 368 !$OMP PRIVATE ( ij, its, ite, jts, jte, i,j,k,n )
 369     DO ij=1,num_tiles
 370       IF (channel) THEN
 371         IF (i_start(ij) .LT. ids) THEN
 372           its = ids
 373         ELSE
 374           its = i_start(ij)
 375         END IF
 376         IF (i_end(ij) .GT. ide - 1) THEN
 377           ite = ide - 1
 378         ELSE
 379           ite = i_end(ij)
 380         END IF
 381       ELSE
 382         IF (i_start(ij) .LT. ids + sz) THEN
 383           its = ids + sz
 384         ELSE
 385           its = i_start(ij)
 386         END IF
 387         IF (i_end(ij) .GT. ide - 1 - sz) THEN
 388           ite = ide - 1 - sz
 389         ELSE
 390           ite = i_end(ij)
 391         END IF
 392       END IF
 393       IF (j_start(ij) .LT. jds + sz) THEN
 394         jts = jds + sz
 395       ELSE
 396         jts = j_start(ij)
 397       END IF
 398       IF (j_end(ij) .GT. jde - 1 - sz) THEN
 399         jte = jde - 1 - sz
 400       ELSE
 401         jte = j_end(ij)
 402       END IF
 403 ! 2009-06009 rce - zero all these for safety
 404       IF (PRESENT(qlsink)) qlsink(its:ite, kts:kte, jts:jte) = 0.
 405       IF (PRESENT(precr)) precr(its:ite, kts:kte, jts:jte) = 0.
 406       IF (PRESENT(preci)) preci(its:ite, kts:kte, jts:jte) = 0.
 407       IF (PRESENT(precs)) precs(its:ite, kts:kte, jts:jte) = 0.
 408       IF (PRESENT(precg)) precg(its:ite, kts:kte, jts:jte) = 0.
 409       SELECT CASE  (mp_physics)
 410
 411         CASE (MKESSLERSCHEME)
 412              CALL wrf_debug ( 100 , 'microphysics_driver: calling g_mkessler' )
 413              IF ( PRESENT( QV_CURR ) .AND. PRESENT( QC_CURR ) .AND.  &
 414                                            PRESENT( QR_CURR ) .AND.  &
 415                   PRESENT( RAINNC  ) .AND. PRESENT ( RAINNCV ) .AND.  &
 416                                            PRESENT( Z       ))  THEN
 417                CALL g_mkessler(                                        &
 418                   T=th,TD=thd                                              &
 419                  ,QV=qv_curr,QVD=qv_currd                                  &
 420                  ,QC=qc_curr,QCD=qc_currd                                  &
 421                  ,QR=qr_curr,QRD=qr_currd                                  &
 422                  ,P=p,PD=pd                                               &
 423                  ,RHO=rho, RHOD=rhod, PII=pi_phy,PIID=pi_phyd, DT_IN=dt, Z=z &
 424                  ,XLV=xlv, CP=cp &
 425                  ,EP2=ep_2,SVP1=svp1,SVP2=svp2                      &
 426                  ,SVP3=svp3,SVPT0=svpt0,RHOWATER=rhowater           &
 427                  ,DZ8W=dz8w                                         &
 428                  ,RAINNC=rainnc,RAINNCV=rainncv                     &
 429                  ,RAINNCD=rainncd,RAINNCVD=rainncvd                     &
 430                  ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
 431                  ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
 432                  ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
 433                                                                     )
 434
 435              ELSE
 436                 CALL wrf_error_fatal ( 'arguments not present for calling g_mkessler' )
 437              ENDIF
 438
 439
 440       CASE (lscondscheme)
 441 !    Added by Zhuxiao,  lscond (simplified Large-scale condensation scheme by Jimy )
 442         CALL WRF_DEBUG(100, 'microphysics_driver: calling lscond')
 443         IF (PRESENT(qv_curr) .AND. PRESENT(rainnc) .AND. PRESENT(rainncv&
 444 &            )) THEN
 445 ! added
 446           CALL LSCOND_D(th=th, thd=thd, p=p, pd=pd, qv=qv_curr, qvd=&
 447 &                  qv_currd, rho=rho, rhod=rhod, pii=pi_phy, piid=pi_phyd&
 448 &                  , r_v=r_v, xlv=xlv, cp=cp, ep2=ep_2, svp1=svp1, svp2=&
 449 &                  svp2, svp3=svp3, svpt0=svpt0, dz8w=dz8w, dz8wd=dz8wd, &
 450 &                  rainnc=rainnc, rainncd=rainncd, rainncv=rainncv, &
 451 &                  rainncvd=rainncvd, ids=ids, ide=ide, jds=jds, jde=jde&
 452 &                  , kds=kds, kde=kde, ims=ims, ime=ime, jms=jms, jme=jme&
 453 &                  , kms=kms, kme=kme, its=its, ite=ite, jts=jts, jte=jte&
 454 &                  , kts=kts, kte=kte)
 455         ELSE
 456           CALL WRF_ERROR_FATAL(&
 457 &                         'arguments not present for calling lscond')
 458         END IF
 459       CASE DEFAULT
 460         WRITE(wrf_err_message, *) &
 461 &        'The microphysics option does not exist: mp_physics = ', &
 462 &        mp_physics
 463         CALL WRF_ERROR_FATAL(wrf_err_message)
 464       END SELECT
 465     END DO
 466 !$OMP END PARALLEL DO
 467     CALL WRF_DEBUG(200, 'microphysics_driver: returning from')
 468     RETURN
 469   END IF
 470 END SUBROUTINE G_MICROPHYSICS_DRIVER
 471
 472 END MODULE g_module_microphysics_driver