Merge pull request #22 from wirc-sjsu/develop-w21
[WRF-Fire-merge.git] / wrftladj / module_microphysics_driver_tl.F
blob633e4fc9ac7256bb4d01d40d5ab5a0ab5cd51757
1 !        Generated by TAPENADE     (INRIA, Tropics team)
2 !  Tapenade 3.7 (r4786) - 21 Feb 2013 15:53
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
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
57 ! Model Layer
58    USE module_model_constants
59    USE module_wrf_error
60    USE module_configure, only: grid_config_rec_type
62 ! *** add new modules of schemes here
64    USE g_module_mp_nconvp    !  added by Zhuxiao
65    USE g_module_mp_mkessler
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
71   IMPLICIT NONE
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.
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.
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
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)
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
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
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
233   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: th
234   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: thd
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
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
306 ! Optional
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
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
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) 
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                                                                     )
435              ELSE
436                 CALL wrf_error_fatal ( 'arguments not present for calling g_mkessler' )
437              ENDIF
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
472 END MODULE g_module_microphysics_driver