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