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