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