| blob | 53514d346e8f3beca427b2aee3bf8266977712d6 |
1 !WRF:MEDIATION_LAYER:PHYSICS
2 ! *** add new modules of schemes here
3 !
4 MODULE module_microphysics_driver
5 real, private, parameter :: QX_MIN = 1.E-12
6 real, private, parameter :: NI_MIN = 1.E-6
7 CONTAINS
9 SUBROUTINE microphysics_driver( &
10 th, rho, pi_phy, p &
11 ,ht, dz8w, p8w, dt,dx,dy &
12 ,mp_physics, spec_zone &
13 ,specified, channel_switch &
14 ,warm_rain &
15 ,t8w &
16 ,chem_opt, progn &
17 ,cldfra, cldfra_old, exch_h, nsource &
18 ,qlsink, precr, preci, precs, precg &
19 ,xland,snowh,itimestep &
20 ,f_ice_phy,f_rain_phy,f_rimef_phy &
21 ,lowlyr,sr, id &
22 ,ids,ide, jds,jde, kds,kde &
23 ,ims,ime, jms,jme, kms,kme &
24 ,ips,ipe, jps,jpe, kps,kpe &
25 ,i_start,i_end,j_start,j_end,kts,kte &
26 ,num_tiles, naer &
27 ,irrigation,sf_surf_irr_scheme, irr_daily_amount &
28 ,irr_start_hour,irr_num_hours,julian_in &
29 ,irr_start_julianday,irr_end_julianday &
30 ,irr_freq,irr_ph,irr_rand_field &
31 ,gmt,xtime &
32 !======================
33 !Variables required for CAMMGMP Scheme
34 ,dlf,dlf2,t_phy,p_hyd,p8w_hyd,tke_pbl,pblh &
35 ,z_at_mass,z_at_w,qfx &
36 ,rliq,turbtype3d,smaw3d,wsedl3d,cldfra_old_mp &
37 ,cldfra_mp,cldfra_mp_all,lradius,iradius &
38 ,cldfrai,cldfral,cldfra_conv &
39 ,alt &
40 ,accum_mode,aitken_mode,coarse_mode &
41 ,icwmrsh3d,icwmrdp3d,shfrc3d,cmfmc3d,cmfmc2_3d &
42 ,config_flags,fnm,fnp,rh_old_mp,lcd_old_mp &
43 #if ( WRF_CHEM == 1 )
44 ,chem &! For CAMMGMP scheme Prognostic aerosols
45 ,qme3d,prain3d,nevapr3d,rate1ord_cw2pr_st3d &
46 ,dgnum4D,dgnumwet4D &
47 #endif
48 !======================
49 ,qv_curr,qc_curr,qr_curr,qi_curr,qs_curr,qg_curr &
50 ,qic_curr,qip_curr,qid_curr &
51 ,qnic_curr,qnip_curr,qnid_curr &
52 ,qndrop_curr,qni_curr,qh_curr,qnh_curr &
53 ,qzr_curr,qzi_curr,qzs_curr,qzg_curr,qzh_curr &
54 ,qns_curr,qnr_curr,qng_curr,qnn_curr,qnc_curr &
55 ,qnwfa_curr,qnifa_curr,qnbca_curr & ! for water/ice-friendly/black carbon aerosols
56 ,f_qnwfa,f_qnifa,f_qnbca & ! for water/ice-friendly/black carbon aerosols
57 ,qvolg_curr,qvolh_curr &
58 ,qdcn_curr,qtcn_curr,qccn_curr,qrcn_curr & ! for ntu3m
59 ,qnin_curr,fi_curr,fs_curr,vi_curr,vs_curr & ! for ntu3m
60 ,vg_curr,ai_curr,as_curr,ag_curr,ah_curr,i3m_curr & ! for ntu3m
61 ,f_qdcn,f_qtcn,f_qccn,f_qrcn,f_qnin,f_fi,f_fs & ! for ntu3m
62 ,f_vi,f_vs,f_vg,f_ai,f_as,f_ag,f_ah,f_i3m & ! for ntu3m
63 ,qir_curr,qib_curr & ! for P3
64 ,qi2_curr,qni2_curr,qir2_curr,qib2_curr & ! for P3
65 ,qvoli_curr,qaoli_curr & ! for Jensen ISHMAEL
66 ,qvoli2_curr,qaoli2_curr & ! for Jensen ISHMAEL
67 ,qi3_curr,qni3_curr,qvoli3_curr,qaoli3_curr & ! for Jensen ISHMAEL
68 ,effr_curr,ice_effr_curr,tot_effr_curr &
69 ,qic_effr_curr,qip_effr_curr,qid_effr_curr &
70 ,f_qv,f_qc,f_qr,f_qi,f_qs,f_qg,f_qndrop,f_qni &
71 ,f_qns,f_qnr,f_qng,f_qnc,f_qnn,f_qh,f_qnh &
72 , f_qzr,f_qzi,f_qzs,f_qzg,f_qzh &
73 ,f_qvolg,f_qvolh &
74 ,f_qic,f_qip,f_qid &
75 ,f_qnic,f_qnip,f_qnid &
76 ,f_qir,f_qib & ! for P3
77 ,f_qi2,f_qni2,f_qir2,f_qib2 & ! for P3
78 ,f_qvoli,f_qaoli & ! for Jensen ISHMAEL
79 ,f_qvoli2,f_qaoli2 & ! for Jensen ISHMAEL
80 ,f_qi3,f_qni3,f_qvoli3,f_qaoli3 & ! for Jensen ISHMAEL
81 ,f_effr,f_ice_effr,f_tot_effr &
82 ,f_qic_effr,f_qip_effr,f_qid_effr &
83 ,cu_used &
84 ,qrcuten, qscuten, qicuten, qccuten &
85 ,qt_curr,f_qt &
86 ,mp_restart_state,tbpvs_state,tbpvs0_state & ! for etampnew or fer_mp_hires
87 ,hail,ice2 & ! for mp_gsfcgce
88 !NUWRF JJS 20110525 vvvvv
89 ,phys_tot, physc, physe, physd, physs, physm, physf& ! for gsfcgce
90 ,acphys_tot, acphysc, acphyse, acphysd & ! for gsfcgce
91 ,acphyss, acphysm, acphysf & ! for gsfcgce
93 ,re_cloud_gsfc, re_rain_gsfc, re_ice_gsfc &
94 ,re_snow_gsfc, re_graupel_gsfc, re_hail_gsfc & ! cloud effective radius
95 ,precr3d, preci3d, precs3d, precg3d, prech3d &
96 #if ( WRF_CHEM == 1 )
97 ,icn_diag, nc_diag & ! inline gocart
98 ,gsfcgce_gocart_coupling &
99 #endif
100 !NUWRF JJS 20110525 ^^^^^
101 ! ,ccntype & ! for mp_milbrandt2mom
102 ,u,v,w,z &
103 ,rainnc, rainncv &
104 ,snownc, snowncv &
105 ,hailnc, hailncv &
106 ,graupelnc, graupelncv &
107 ,hail_maxk1, hail_max2d &
108 #if ( WRF_CHEM == 1 )
109 ,rainprod, evapprod &
110 ,qv_b4mp, qc_b4mp, qi_b4mp, qs_b4mp &
111 #endif
112 ,qnwfa2d, qnifa2d, qnbca2d & ! for water/ice-friendly/black carbon aerosols
113 ,qnocbb2d, qnbcbb2d & ! for biomass burning aerosols
114 ,refl_10cm & ! HM, 9/22/09, add for refl
115 ,vmi3d & ! for P3
116 ,di3d & ! for P3
117 ,rhopo3d & ! for P3
118 ,phii3d & ! for Jensen ISHMAEL
119 ,vmi3d_2 & ! for P3
120 ,di3d_2 & ! for P3
121 ,rhopo3d_2 & ! for P3
122 ,phii3d_2 & ! for Jensen ISHMAEL
123 ,vmi3d_3 & ! for Jensen ISHMAEL
124 ,di3d_3 & ! for Jensen ISHMAEL
125 ,rhopo3d_3 & ! for Jensen ISHMAEL
126 ,phii3d_3 & ! for Jensen ISHMAEL
127 ,itype & ! for Jensen ISHMAEL
128 ,itype_2 & ! for Jensen ISHMAEL
129 ,itype_3 & ! for Jensen ISHMAEL
131 ! YLIN
132 ! Added the RI_CURR array to the call
133 ,ri_curr &
134 ,diagflag, do_radar_ref &
135 ,ke_diag &
136 ,re_cloud, re_ice, re_snow & ! G. Thompson
137 ,has_reqc, has_reqi, has_reqs & ! G. Thompson
138 ,ccn_conc & ! RAS
139 ,scalar,num_scalar &
140 ,kext_ql,kext_qs,kext_qg &
141 ,kext_qh,kext_qa &
142 ,kext_qic,kext_qid,kext_qip &
143 ,kext_ft_qic,kext_ft_qid,kext_ft_qip &
144 ,kext_ft_qs,kext_ft_qg &
145 ,height,tempc &
146 ,TH_OLD &
147 ,QV_OLD &
148 ,xlat,xlong,ivgtyp &
149 ,qrimef_curr,f_qrimef &
150 ,aercu_opt &
151 # if( EM_CORE==1 )
152 ,sbmradar,num_sbmradar &
153 ,sbm_diagnostics &
154 ,aerocu,aercu_fct,no_src_types_cu &
155 ,PBL,EFCG,EFIG,EFSG,WACT,CCN1_GS,CCN2_GS &
156 ,CCN3_GS,CCN4_GS,CCN5_GS,CCN6_GS,CCN7_GS &
157 ,NR_CU,QR_CU,NS_CU,QS_CU,CU_UAF,mskf_refl_10cm &
158 # endif
159 ,multi_perturb &
160 ,pert_thom, perts_qvapor, perts_qcloud, perts_qice &
161 ,perts_qsnow, perts_ni &
162 ,pert_thom_qv,pert_thom_qc,pert_thom_qi &
163 ,pert_thom_qs,pert_thom_ni &
164 )
166 ! Framework
167 USE module_state_description, ONLY : &
168 KESSLERSCHEME, LINSCHEME, SBU_YLINSCHEME, WSM3SCHEME, WSM5SCHEME &
169 ,WSM6SCHEME, ETAMPNEW, FER_MP_HIRES, THOMPSON, THOMPSONAERO, THOMPSONGH, FAST_KHAIN_LYNN_SHPUND, MORR_TWO_MOMENT &
170 ,GSFCGCESCHEME, WDM5SCHEME, WDM6SCHEME, NSSL_2MOM, MADWRF_MP &
171 ,FER_MP_HIRES_ADVECT &
172 ,WSM7SCHEME, WDM7SCHEME &
173 ,NUWRF4ICESCHEME &
174 ,MILBRANDT2MOM , CAMMGMPSCHEME,FULL_KHAIN_LYNN, P3_1CATEGORY, P3_1CATEGORY_NC, P3_2CATEGORY, P3_1CAT_3MOM &
175 ,MORR_TM_AERO, JENSEN_ISHMAEL, SPRINKLER, NTU !,MILBRANDT3MOM
176 USE module_state_description, ONLY : WSM6RSCHEME
177 #if ( WRFPLUS == 1 )
178 USE module_state_description, ONLY : LSCONDSCHEME, MKESSLERSCHEME
179 #endif
180 #if ( WRF_CHEM == 1 )
181 ! NUWRF
182 USE module_state_description, ONLY : &
183 num_chem & !inline gocart
184 ,p_bc1, p_bc2, p_oc1, p_oc2 & !inline gocart
185 ,p_dust_1, p_dust_2, p_dust_3 & !inline gocart
186 ,p_dust_4, p_dust_5 & !inline gocart
187 ,p_sulf, p_seas_1, p_seas_2 & !inline gocart
188 ,p_seas_3, p_seas_4
190 #endif
192 #ifdef DM_PARALLEL
193 USE module_dm, ONLY : &
194 local_communicator, mytask, wrf_dm_min_real, wrf_dm_max_real
195 #endif
197 ! Model Layer
198 USE module_model_constants
199 USE module_wrf_error
200 USE module_configure, only: grid_config_rec_type
201 #if ( WRF_CHEM == 1 )
202 !mchen USE module_state_description, only: num_scalar ! For CAMMGMP scheme Prognostic aerosols
203 USE module_state_description, only: num_chem ! mchen
204 USE modal_aero_data, only: ntot_amode_cam_mam => ntot_amode ! For CAMMGMP scheme Prognostic aerosols
205 #endif
207 ! *** add new modules of schemes here
209 USE module_mp_kessler
210 #if ( WRFPLUS == 1 )
211 USE module_mp_mkessler
212 USE module_mp_nconvp ! added by Zhuxiao
213 #endif
214 USE module_mp_lin
215 USE module_mp_sbu_ylin
216 USE module_mp_wsm3
217 USE module_mp_wsm5
218 USE module_mp_wsm6
219 USE module_mp_wsm6r, ONLY:wsm6r
220 USE module_mp_wsm7
221 USE module_mp_etanew
222 USE module_mp_fer_hires
223 USE module_mp_thompson
224 USE module_mp_full_sbm
225 #if ( BUILD_SBM_FAST == 1 )
226 USE module_mp_fast_sbm
227 #endif
228 USE module_mp_gsfcgce
229 USE module_mp_gsfcgce_4ice_nuwrf, only: gsfcgce_4ice_nuwrf
230 USE module_mp_morr_two_moment
231 USE microphy_p3
232 USE module_mp_jensen_ishmael
233 # if (EM_CORE == 1)
234 USE module_mp_morr_two_moment_aero
235 USE module_mp_ntu
236 # endif
237 USE module_mp_wdm5
238 USE module_mp_wdm6
239 USE module_mp_wdm7
240 USE module_mp_milbrandt2mom
241 # if (EM_CORE == 1)
242 USE module_mp_cammgmp_driver, ONLY: CAMMGMP ! CAM5's microphysics driver
243 # endif
244 ! USE module_mp_milbrandt3mom
245 #if (WRFPLUS != 1) & !defined( VAR4D )
246 USE module_mp_nssl_2mom
247 #endif
248 USE module_mixactivate, only: prescribe_aerosol_mixactivate
250 ! For checking model timestep is history time (for radar reflectivity)
251 USE module_utility, ONLY: WRFU_Clock, WRFU_Alarm
252 USE module_domain, ONLY : HISTORY_ALARM, Is_alarm_tstep
253 USE module_irrigation
255 USE module_fire_emis
257 !----------------------------------------------------------------------
258 ! This driver calls subroutines for the microphys.
259 !
260 ! Schemes
261 !
262 ! Kessler scheme
263 ! Lin et al. (1983), Rutledge and Hobbs (1984)
264 ! WRF Single-Moment 3-class, Hong, Dudhia and Chen (2004)
265 ! WRF Single-Moment 5-class, Hong, Dudhia and Chen (2004)
266 ! WRF Single-Moment 6-class, Lim and Hong (2003 WRF workshop)
267 ! Eta Grid-scale Cloud and Precipitation scheme (EGCP01, Ferrier)
268 ! * etampnew - what's in the operational 4-km High-Resolution Window Runs
269 ! Goddard 4-ice scheme (2016)
270 ! Thompson (2008)
271 ! Milbrandt and Yau (2005)
272 ! Morrison (2009)
273 ! CAM
274 ! SBU-YLin (2011)
275 ! WRF Double-Moment 5-class
276 ! WRF Double-Moment 6-class
278 !----------------------------------------------------------------------
279 IMPLICIT NONE
280 !======================================================================
281 ! Grid structure in physics part of WRF
282 !----------------------------------------------------------------------
283 ! The horizontal velocities used in the physics are unstaggered
284 ! relative to temperature/moisture variables. All predicted
285 ! variables are carried at half levels except w, which is at full
286 ! levels. Some arrays with names (*8w) are at w (full) levels.
287 !
288 !----------------------------------------------------------------------
289 ! In WRF, kms (smallest number) is the bottom level and kme (largest
290 ! number) is the top level. In your scheme, if 1 is at the top level,
291 ! then you have to reverse the order in the k direction.
292 !
293 ! kme - half level (no data at this level)
294 ! kme ----- full level
295 ! kme-1 - half level
296 ! kme-1 ----- full level
297 ! .
298 ! .
299 ! .
300 ! kms+2 - half level
301 ! kms+2 ----- full level
302 ! kms+1 - half level
303 ! kms+1 ----- full level
304 ! kms - half level
305 ! kms ----- full level
306 !
307 !======================================================================
308 ! Definitions
309 !-----------
310 ! Rho_d dry density (kg/m^3)
311 ! Theta_m moist potential temperature (K)
312 ! Qv water vapor mixing ratio (kg/kg)
313 ! Qc cloud water mixing ratio (kg/kg)
314 ! Qr rain water mixing ratio (kg/kg)
315 ! Qi cloud ice mixing ratio (kg/kg)
316 ! Qs snow mixing ratio (kg/kg)
317 ! Qg graupel mixing ratio (kg/kg)
318 ! Qh hail mixing ratio (kg/kg)
319 ! Qndrop droplet number mixing ratio (#/kg)
320 ! Qni cloud ice number concentration (#/kg)
321 ! Qns snow number concentration (#/kg)
322 ! Qnr rain number concentration (#/kg)
323 ! Qng graupel number concentration (#/kg)
324 ! Qnh hail number concentration (#/kg)
326 ! Qzr rain reflectivity (m6/kg)
327 ! Qzi ice reflectivity (m6/kg)
328 ! Qzs snow reflectivity (m6/kg)
329 ! Qzg graupel reflectivity (m6/kg)
330 ! Qzh hail reflectivity (m6/kg)
332 ! Qvolg graupel particle volume (m3/kg)
334 !
335 !----------------------------------------------------------------------
336 !-- th potential temperature (K)
337 !-- moist_new updated moisture array (kg/kg)
338 !-- moist_old Old moisture array (kg/kg)
339 !-- rho density of air (kg/m^3)
340 !-- pi_phy exner function (dimensionless)
341 !-- p pressure (Pa)
342 !-- RAINNC grid scale precipitation (mm)
343 !-- RAINNCV one time step grid scale precipitation (mm/step)
344 !-- SNOWNC grid scale snow and ice (mm)
345 !-- SNOWNCV one time step grid scale snow and ice (mm/step)
346 !-- GRAUPELNC grid scale graupel (mm)
347 !-- GRAUPELNCV one time step grid scale graupel (mm/step)
348 !-- HAILNC grid scale hail (mm)
349 !-- HAILNCV one time step grid scale hail (mm/step)
350 !-- SR one time step mass ratio of snow to total precip
351 !-- z Height above sea level (m)
352 !-- dt Time step (s)
353 !-- G acceleration due to gravity (m/s^2)
354 !-- CP heat capacity at constant pressure for dry air (J/kg/K)
355 !-- R_d gas constant for dry air (J/kg/K)
356 !-- R_v gas constant for water vapor (J/kg/K)
357 !-- XLS latent heat of sublimation (J/kg)
358 !-- XLV latent heat of vaporization (J/kg)
359 !-- XLF latent heat of melting (J/kg)
360 !-- rhowater water density (kg/m^3)
361 !-- rhosnow snow density (kg/m^3)
362 !-- F_ICE_PHY Fraction of ice.
363 !-- F_RAIN_PHY Fraction of rain.
364 !-- F_RIMEF_PHY Mass ratio of rimed ice (rime factor)
365 !-- t8w temperature at layer interfaces
366 !-- cldfra, cldfra_old, current, previous cloud fraction
367 !-- exch_h vertical diffusivity (m2/s)
368 !-- qlsink Fractional cloud water sink (/s)
369 !-- precr rain precipitation rate at all levels (kg/m2/s)
370 !-- preci ice precipitation rate at all levels (kg/m2/s)
371 !-- precs snow precipitation rate at all levels (kg/m2/s)
372 !-- precg graupel precipitation rate at all levels (kg/m2/s) &
373 !-- P_QV species index for water vapor
374 !-- P_QC species index for cloud water
375 !-- P_QR species index for rain water
376 !-- P_QI species index for cloud ice
377 !-- P_QS species index for snow
378 !-- P_QG species index for graupel
379 !-- P_QH species index for hail
380 !-- P_QNDROP species index for cloud drop mixing ratio
381 !-- P_QNR species index for rain number concentration,
382 !-- P_QNI species index for cloud ice number concentration
383 !-- P_QNS species index for snow number concentration,
384 !-- P_QNG species index for graupel number concentration,
385 !-- P_QNH species index for hail number concentration,
386 !-- P_QZR species index for rain reflectivity
387 !-- P_QZI species index for ice reflectivity
388 !-- P_QZS species index for snow reflectivity
389 !-- P_QZG species index for graupel reflectivity
390 !-- P_QZH species index for hail reflectivity
391 !-- P_QVOLG species index for graupel particle volume,
392 !-- id grid id number
393 !-- ids start index for i in domain
394 !-- ide end index for i in domain
395 !-- jds start index for j in domain
396 !-- jde end index for j in domain
397 !-- kds start index for k in domain
398 !-- kde end index for k in domain
399 !-- ims start index for i in memory
400 !-- ime end index for i in memory
401 !-- jms start index for j in memory
402 !-- jme end index for j in memory
403 !-- kms start index for k in memory
404 !-- kme end index for k in memory
405 !-- i_start start indices for i in tile
406 !-- i_end end indices for i in tile
407 !-- j_start start indices for j in tile
408 !-- j_end end indices for j in tile
409 !-- its start index for i in tile
410 !-- ite end index for i in tile
411 !-- jts start index for j in tile
412 !-- jte end index for j in tile
413 !-- kts start index for k in tile
414 !-- kte end index for k in tile
415 !-- num_tiles number of tiles
416 !-- diagflag Logical to tell us when to produce diagnostics for history or restart
417 !
418 !======================================================================
419 INTEGER,parameter :: iunit=6
420 INTEGER :: mpi_error_code=1
422 TYPE(grid_config_rec_type), INTENT(IN ) , OPTIONAL :: config_flags
423 INTEGER, INTENT(IN ) :: mp_physics
424 LOGICAL, INTENT(IN ) :: specified
425 INTEGER, OPTIONAL, INTENT(IN ) :: chem_opt, progn
426 INTEGER, OPTIONAL, INTENT(IN ) :: hail, ice2 !, ccntype
427 !
428 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
429 INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme,num_scalar
430 #if (EM_CORE == 1)
431 INTEGER, INTENT(IN ) :: num_sbmradar
432 INTEGER, INTENT(IN ) :: sbm_diagnostics
433 #endif
434 INTEGER, OPTIONAL, INTENT(IN ) :: ips,ipe, jps,jpe, kps,kpe
435 INTEGER, INTENT(IN ) :: kts,kte
436 INTEGER, INTENT(IN ) :: itimestep,num_tiles,spec_zone
437 INTEGER, DIMENSION(num_tiles), INTENT(IN) :: &
438 & i_start,i_end,j_start,j_end
440 LOGICAL, INTENT(IN ) :: warm_rain
441 !
442 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), &
443 INTENT(INOUT) :: th
444 !
446 !
447 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), &
448 INTENT(IN ) :: &
449 rho, &
450 dz8w, &
451 p8w, &
452 pi_phy, &
453 p
454 !NUWRF JJS 20101021 vvvvv
455 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), &
456 INTENT(INOUT), OPTIONAL :: phys_tot, &
457 physc, &
458 physe, &
459 physd, &
460 physs, &
461 physm, &
462 physf, &
463 acphys_tot, &
464 acphysc, &
465 acphyse, &
466 acphysd, &
467 acphyss, &
468 acphysm, &
469 acphysf
471 !NUWRF JJS 20101021 ^^^^^
472 !NUWRF JJS 20140225 vvvvv
473 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), &
474 INTENT(INOUT), OPTIONAL :: re_cloud_gsfc, &
475 re_rain_gsfc, &
476 re_ice_gsfc, &
477 re_snow_gsfc, &
478 re_graupel_gsfc, &
479 re_hail_gsfc
480 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), &
481 OPTIONAL, &
482 INTENT(INOUT) :: &
483 precr3d, & ! rain precipitation rate at all levels (kg/m2/s)
484 preci3d, & ! ice precipitation rate at all levels (kg/m2/s)
485 precs3d, & ! snow precipitation rate at all levels (kg/m2/s)
486 precg3d, & ! graupel precipitation rate at all levels (kg/m2/s)
487 prech3d ! graupel precipitation rate at all levels (kg/m2/s)
488 !NUWRF JJS 20140225 ^^^^^
490 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ),INTENT(INOUT), OPTIONAL :: th_old,qv_old
491 REAL,DIMENSION(ims:ime,kms:kme,jms:jme,num_scalar),INTENT(INOUT), OPTIONAL :: scalar
492 #if (EM_CORE == 1)
493 REAL, DIMENSION(ims:ime,kms:kme,jms:jme,num_sbmradar),INTENT(INOUT) :: sbmradar
494 #endif
495 INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(IN), OPTIONAL:: IVGTYP
496 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN), OPTIONAL :: XLAT, XLONG
498 !=================
499 !Data for CAMMGMP scheme
500 REAL,INTENT(IN), OPTIONAL ::accum_mode,aitken_mode,coarse_mode
501 !1D variables required for CAMMGMP scheme
502 REAL , DIMENSION( kms:kme ) , &
503 INTENT(IN ) , OPTIONAL :: fnm, & !Factors for interpolation at "w" grid (interfaces)
504 fnp
505 !2D variables required for CAMMGMP scheme
506 REAL, DIMENSION( ims:ime, jms:jme ), &
507 INTENT(IN), OPTIONAL :: &
508 qfx, & !Moisture flux at surface (kg m-2 s-1)
509 rliq !Vertically-integrated reserved cloud condensate(m/s)
511 ! WRF-Solar EPS
512 integer, intent (in), optional :: multi_perturb
513 logical, intent (in), optional :: pert_thom
514 real, intent (in), optional :: pert_thom_qv, pert_thom_qc, pert_thom_qi, pert_thom_qs, pert_thom_ni
515 real, dimension(ims:ime, kms:kme, jms:jme ), intent (in), optional :: perts_qvapor, perts_qcloud, perts_qice, &
516 perts_qsnow, perts_ni
517 real, dimension(:, :, :), allocatable :: qv_tmp, qc_tmp, qi_tmp, qs_tmp, qni_tmp
519 !3D variables required for CAMMGMP scheme
520 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
521 INTENT(IN), OPTIONAL :: &
522 dlf, & !Detraining cloud water tendendcy
523 dlf2, & !dq/dt due to export of cloud water into env by shal conv (kg/kg/s)
524 t_phy, & !Temprature at the mid points (K)
525 p_hyd, & !Hydrostatic pressure(Pa)
526 p8w_hyd, & !Hydrostatic Pressure at level interface (Pa)
527 z_at_mass, & !Height above sea level at grid cell center (m)
528 z_at_w, & !Height above sea level at layer interfaces (m)
529 tke_pbl, & !Turbulence kinetic energy
530 pblh, & !Planetary boundary layer height (m)
531 turbtype3d, & !Turbulent interface types [ no unit ]
532 smaw3d, & !Normalized Galperin instability function for momentum [no units]
533 alt, & !inverse density(m3/kg)
534 icwmrsh3d, & !Shallow cumulus in-cloud water mixing ratio (kg/m2)
535 icwmrdp3d, & !Deep Convection in-cloud water mixing ratio (kg/m2)
536 shfrc3d, & !Shallow cloud fraction
537 cmfmc3d, & !Deep + Shallow Convective mass flux [ kg /s/m^2 ]
538 cmfmc2_3d !Shallow convective mass flux [ kg/s/m^2 ]
539 #if ( WRF_CHEM == 1 )
540 !4D variables required for CAMMGMP scheme
541 REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme,ntot_amode_cam_mam ), &
542 INTENT(IN) :: &
543 dgnum4D, &
544 dgnumwet4D
545 #endif
546 !In-outs
547 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
548 INTENT(INOUT) , OPTIONAL :: &
549 cldfra_old_mp, & !Old Cloud fraction for CAMMGMP microphysics only
550 rh_old_mp, & !Old RH
551 lcd_old_mp !Old liquid cloud fraction
552 !In-outs -optional
553 #if ( WRF_CHEM == 1 )
554 REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_chem), &
555 INTENT(INOUT) :: &
556 chem !Chem array for CAMMGMP scheme Prognostic aerosols
557 #endif
558 !outs
559 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
560 INTENT(INOUT) , OPTIONAL:: &
561 wsedl3d, & !Sedimentation velocity of stratiform liquid cloud droplet (m/s)
562 cldfra_mp, & !Old Cloud fraction for CAMMGMP microphysics only
563 cldfra_mp_all, & !Old Cloud fraction for CAMMGMP microphysics only
564 cldfrai, & !Old Cloud fraction for CAMMGMP microphysics only
565 cldfral, & !Old Cloud fraction for CAMMGMP microphysics only
566 lradius, & !Old Cloud fraction for CAMMGMP microphysics only
567 iradius, & !Old Cloud fraction for CAMMGMP microphysics only
568 cldfra_conv
572 #if ( WRF_CHEM == 1 )
573 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
574 INTENT(INOUT), OPTIONAL :: &
575 qme3d, & !Net condensation rate (kg/kg/s)
576 prain3d, & !Rate of conversion of condensate to precipitation (kg/kg/s)
577 nevapr3d, & !Evaporation rate of rain + snow (kg/kg/s)
578 rate1ord_cw2pr_st3d !1st order rate for direct conversion of strat. cloud water to precip (1/s)
579 #endif
581 REAL, INTENT(INOUT), DIMENSION(ims:ime, kms:kme, jms:jme ) :: &
582 F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY
583 !!$#if ( WRF_CHEM == 1 )
584 ! REAL, INTENT(OUT), DIMENSION(ims:ime, kms:kme, jms:jme ) :: &
585 REAL, OPTIONAL, INTENT(OUT), DIMENSION(ims:ime, kms:kme, jms:jme ) :: &
586 !!$#else
587 !!$ REAL, DIMENSION(ims:ime, kms:kme, jms:jme ) :: &
588 !!$#endif
589 qlsink, & ! cloud water sink (/s)
590 precr, & ! rain precipitation rate at all levels (kg/m2/s)
591 preci, & ! ice precipitation rate at all levels (kg/m2/s)
592 precs, & ! snow precipitation rate at all levels (kg/m2/s)
593 precg ! graupel precipitation rate at all levels (kg/m2/s)
595 !
597 REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN) :: XLAND
598 REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN), OPTIONAL :: SNOWH
600 REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(OUT) :: SR
602 REAL, INTENT(IN ) :: dt,dx,dy
604 INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT) :: LOWLYR
606 !
607 ! Optional
608 !
609 REAL, OPTIONAL, DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(OUT) :: refl_10cm
610 REAL, OPTIONAL, DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: & ! for ntu3m
611 qdcn_curr,qtcn_curr,qccn_curr,qrcn_curr,qnin_curr, & ! for ntu3m
612 fi_curr,fs_curr,vi_curr,vs_curr,vg_curr,ai_curr, & ! for ntu3m
613 as_curr,ag_curr,ah_curr,i3m_curr ! for ntu3m
614 LOGICAL, OPTIONAL :: f_qdcn,f_qtcn,f_qccn,f_qrcn,f_qnin,f_fi,f_fs, & ! for ntu3m
615 f_vi,f_vs,f_vg,f_ai,f_as,f_ag,f_ah,f_i3m ! for ntu3m
616 REAL, OPTIONAL, DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(OUT) :: vmi3d,di3d,rhopo3d, & ! for P3
617 vmi3d_2,di3d_2,rhopo3d_2, & ! for P3
618 phii3d, & ! for Jensen ISHMAEL
619 phii3d_2, & ! for Jensen ISHMAEL
620 vmi3d_3,di3d_3,rhopo3d_3, & ! for Jensen ISHMAEL
621 phii3d_3, & ! for Jensen ISHMAEL
622 itype,itype_2,itype_3 ! for Jensen ISHMAEL
623 LOGICAL, OPTIONAL, INTENT(IN ) :: channel_switch
624 REAL, OPTIONAL, INTENT(INOUT ) :: naer ! aerosol number concentration (/kg)
625 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) , OPTIONAL :: qnwfa2d, qnifa2d, qnbca2d, &
626 qnocbb2d, qnbcbb2d
627 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
628 OPTIONAL, &
629 INTENT(INOUT ) :: &
630 u,v,w, z, t8w &
631 ,cldfra, cldfra_old, exch_h &
632 ,qv_curr,qc_curr,qr_curr,qi_curr,qs_curr,qg_curr &
633 ,qt_curr,qndrop_curr,qni_curr,qh_curr,qnh_curr &
634 ,qns_curr,qnr_curr,qng_curr,qnn_curr,qnc_curr &
635 ,qic_curr,qip_curr,qid_curr &
636 ,qnic_curr,qnip_curr,qnid_curr &
637 ,qzr_curr,qzi_curr,qzs_curr,qzg_curr,qzh_curr &
638 ,qir_curr,qib_curr & ! for P3
639 ,qi2_curr,qni2_curr,qir2_curr,qib2_curr & ! for P3
640 ,qvoli_curr,qaoli_curr & ! for Jensen ISHMAEL
641 ,qvoli2_curr,qaoli2_curr & ! for Jensen ISHMAEL
642 ,qi3_curr,qni3_curr,qvoli3_curr,qaoli3_curr & ! for Jensen ISHMAEL
643 ,effr_curr,ice_effr_curr,tot_effr_curr &
644 ,qic_effr_curr,qip_effr_curr,qid_effr_curr &
645 ,kext_ql,kext_qs,kext_qg &
646 ,kext_qh,kext_qa &
647 ,kext_qic,kext_qip,kext_qid,tempc,height &
648 ,kext_ft_qic,kext_ft_qip,kext_ft_qid &
649 ,kext_ft_qs,kext_ft_qg &
650 ,qnwfa_curr,qnifa_curr,qnbca_curr & ! Added by G. Thompson
651 ,qvolg_curr,qvolh_curr, qrimef_curr
653 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
654 OPTIONAL, &
655 INTENT(IN) :: qrcuten, qscuten, qicuten, qccuten
656 INTEGER, INTENT(IN), optional :: cu_used
657 #if ( WRF_CHEM == 1 )
658 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
659 INTENT(INOUT) :: rainprod, evapprod
660 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
661 INTENT(INOUT) :: qv_b4mp, qc_b4mp, qi_b4mp, qs_b4mp
662 #endif
663 ! YLIN
664 ! Added RI_CURR similar to microphysics fields above
665 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
666 OPTIONAL, &
667 INTENT(INOUT) :: ri_curr
670 REAL, DIMENSION(ims:ime, kms:kme, jms:jme ), &
671 OPTIONAL, &
672 INTENT(OUT ) :: &
673 nsource
675 !
676 REAL, DIMENSION( ims:ime , jms:jme ), &
677 INTENT(INOUT), &
678 OPTIONAL :: &
679 RAINNC &
680 ,RAINNCV &
681 ,SNOWNC &
682 ,SNOWNCV &
683 ,GRAUPELNC &
684 ,GRAUPELNCV &
685 ,HAILNC &
686 ,HAILNCV &
687 ,hail_maxk1, hail_max2d
689 #if ( WRF_CHEM == 1)
690 ! NUWRF JJS 20110525 vvvvv
691 ! for inline Gocart coupling
692 integer :: i24h
693 INTEGER, PARAMETER :: num_go = 14 ! number of the gocart aerosol species
694 REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_go) :: aero
695 REAL, DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(OUT) :: icn_diag
696 REAL, DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(OUT) :: nc_diag
697 integer, intent(in) :: gsfcgce_gocart_coupling ! EMK
698 REAL, PARAMETER :: frac(4)=(/ 0.01053,0.08421,0.25263,0.65263 /) !fraction for fine dust
700 ! NUWRF JJS 20110525 ^^^^^
701 #endif
705 INTEGER,OPTIONAL,INTENT(IN ) :: id
707 REAL , DIMENSION( ims:ime , jms:jme ) , OPTIONAL , &
708 INTENT(IN) :: ht
710 REAL, DIMENSION (:), OPTIONAL, INTENT(INOUT) :: mp_restart_state &
711 ,tbpvs_state,tbpvs0_state
712 !
714 LOGICAL, OPTIONAL :: f_qv,f_qc,f_qr,f_qi,f_qs,f_qg,f_qndrop,f_qni,f_qt &
715 ,f_qns,f_qnr,f_qng,f_qnn,f_qnc,f_qh,f_qnh,f_qzr &
716 ,f_effr,f_ice_effr,f_tot_effr &
717 ,f_qic_effr,f_qip_effr,f_qid_effr &
718 ,f_qic,f_qip,f_qid &
719 ,f_qnic,f_qnip,f_qnid &
720 ,f_qzi,f_qzs,f_qzg,f_qzh,f_qvolg,f_qvolh &
721 ,f_qrimef &
722 ,f_qir,f_qib & ! for P3
723 ,f_qi2,f_qni2,f_qir2,f_qib2 & ! for P3
724 ,f_qvoli,f_qaoli & ! for Jensen ISHMAEL
725 ,f_qvoli2,f_qaoli2 & ! for Jensen ISHMAEL
726 ,f_qi3,f_qni3,f_qvoli3,f_qaoli3 & ! for Jensen ISHMAEL
727 ,f_qnwfa, f_qnifa, f_qnbca ! Added by G. Thompson
730 LOGICAL, OPTIONAL, INTENT(IN) :: diagflag
731 INTEGER, OPTIONAL, INTENT(IN) :: ke_diag ! tells reflectivity calculation whether to do full depth or only k=1
732 REAL, INTENT(IN) :: ccn_conc ! RAS
733 INTEGER, OPTIONAL, INTENT(IN) :: do_radar_ref
734 REAL, DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: & ! G. Thompson
735 re_cloud, re_ice, re_snow
736 INTEGER, INTENT(IN):: has_reqc, has_reqi, has_reqs
738 INTEGER, INTENT(IN ) :: aercu_opt
739 # if (EM_CORE == 1)
740 INTEGER, OPTIONAL, INTENT(IN ) :: PBL
741 INTEGER, INTENT(IN ) :: no_src_types_cu
742 REAL, INTENT(IN ) :: aercu_fct
743 REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme, no_src_types_cu), INTENT(INOUT) &
744 :: aerocu
745 REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) &
746 :: EFCG, &
747 EFIG, &
748 EFSG, &
749 WACT, &
750 CCN1_GS, &
751 CCN2_GS, &
752 CCN3_GS, &
753 CCN4_GS, &
754 CCN5_GS, &
755 CCN6_GS, &
756 CCN7_GS, &
757 NR_CU, &
758 QR_CU, &
759 NS_CU, &
760 QS_CU
761 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme), INTENT(INOUT) &
762 :: CU_UAF
763 REAL, OPTIONAL, DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(OUT) :: mskf_refl_10cm
764 # endif
766 ! REAL , DIMENSION( ims:ime , jms:jme ), OPTIONAL, INTENT(INOUT) :: lwp
768 ! LOCAL VAR
770 INTEGER :: i,j,k,its,ite,jts,jte,ij,sz,n
771 LOGICAL :: channel
772 LOGICAL :: nssl_progn = .false.
773 REAL :: z0, z1, z2, w1, w2
775 integer, parameter :: ntot = 50
776 real :: wmin, wmax
777 integer :: ierr
778 ! IRRIGATION
780 REAL, DIMENSION( ims:ime , jms:jme ), OPTIONAL, INTENT(IN):: IRRIGATION !ARI
781 REAL, OPTIONAL, INTENT(IN):: irr_daily_amount, julian_in, xtime, gmt
782 INTEGER, OPTIONAL, INTENT(IN ):: sf_surf_irr_scheme, irr_start_hour, irr_num_hours, &
783 irr_start_julianday,irr_end_julianday,irr_freq,irr_ph
784 REAL, PARAMETER :: PI_GRECO=3.14159
785 INTEGER :: end_hour,a,b,xt24,irr_day,timing
786 REAL :: constants_irrigation,tloc,irr_start,phase
787 INTEGER, OPTIONAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT) :: irr_rand_field
789 ! To accommodate shared physics
790 character*256 :: errmsg
791 integer :: errflg
793 !---------------------------------------------------------------------
794 ! check for microphysics type. We need a clean way to
795 ! specify these things!
796 !---------------------------------------------------------------------
798 channel = .FALSE.
799 IF ( PRESENT ( channel_switch ) ) channel = channel_switch
801 if (mp_physics .eq. 0) return
802 IF( specified ) THEN
803 sz = spec_zone
804 ELSE
805 sz = 0
806 ENDIF
808 ! set this to true to print out the global max/min for W on each time step.
809 IF ( .false. ) THEN
810 wmax = maxval( w(ips:ipe,kps:kpe,jps:jpe) )
811 wmin = minval( w(ips:ipe,kps:kpe,jps:jpe) )
812 #if ( defined(DM_PARALLEL) && ! defined(STUBMPI) )
813 wmax = wrf_dm_max_real ( wmax )
814 wmin = wrf_dm_min_real ( wmin )
815 #endif
816 WRITE( wrf_err_message , * ) 'microphysics_driver: GLOBAL w max/min = ', wmax, wmin
817 CALL wrf_message ( wrf_err_message )
818 ENDIF
820 #ifdef XEON_OPTIMIZED_WSM5
821 ! the OpenMP loops are inside the scheme when running on MIC
822 IF ( mp_physics .EQ. WSM5SCHEME ) THEN
823 IF (channel) THEN
824 its = max(ips,ids)
825 ite = min(ipe,ide-1)
826 ELSE
827 its = max(ips,ids+sz)
828 ite = min(ipe,ide-1-sz)
829 ENDIF
830 jts = max(jps,jds+sz)
831 jte = min(jpe,jde-1-sz)
833 CALL wsm5( &
834 TH=th &
835 ,Q=qv_curr &
836 ,QC=qc_curr &
837 ,QR=qr_curr &
838 ,QI=qi_curr &
839 ,QS=qs_curr &
840 ,DEN=rho,PII=pi_phy,P=p,DELZ=dz8w &
841 ,DELT=dt,G=g,CPD=cp,CPV=cpv &
842 ,RD=r_d,RV=r_v,T0C=svpt0 &
843 ,EP1=ep_1, EP2=ep_2, QMIN=epsilon &
844 ,XLS=xls, XLV0=xlv, XLF0=xlf &
845 ,DEN0=rhoair0, DENR=rhowater &
846 ,CLIQ=cliq,CICE=cice,PSAT=psat &
847 ,RAIN=rainnc ,RAINNCV=rainncv &
848 ,SNOW=snownc ,SNOWNCV=snowncv &
849 ,SR=sr &
850 ,REFL_10CM=refl_10cm &
851 ,diagflag=diagflag &
852 ,do_radar_ref=do_radar_ref &
853 ,has_reqc=has_reqc & ! for radiation +
854 ,has_reqi=has_reqi &
855 ,has_reqs=has_reqs &
856 ,re_cloud=re_cloud &
857 ,re_ice=re_ice &
858 ,re_snow=re_snow & ! for radiation -
859 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
860 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
861 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
862 )
864 ELSE
865 #endif
867 !$OMP PARALLEL DO &
868 !$OMP PRIVATE ( ij, its, ite, jts, jte, i,j,k,n )
870 DO ij = 1 , num_tiles
871 IF (channel) THEN
872 its = max(i_start(ij),ids)
873 ite = min(i_end(ij),ide-1)
874 ELSE
875 its = max(i_start(ij),ids+sz)
876 ite = min(i_end(ij),ide-1-sz)
877 ENDIF
878 jts = max(j_start(ij),jds+sz)
879 jte = min(j_end(ij),jde-1-sz)
881 # if( EM_CORE==1 )
882 sf_surf_irr: SELECT CASE(sf_surf_irr_scheme)
883 CASE(SPRINKLER)
884 CALL sprinkler_irrigation( julian_in &
885 & ,irrigation, irr_daily_amount,rho,dz8w &
886 & ,irr_start_hour,irr_num_hours,irr_start_julianday &
887 & ,irr_end_julianday,irr_freq,irr_ph,qr_curr &
888 & ,gmt,xtime,dt,irr_rand_field &
889 & ,ids,ide, jds,jde & ! domain dims
890 & ,ims,ime, jms,jme, kms,kme & ! memory dims
891 & ,its,ite, jts,jte )
892 END SELECT sf_surf_irr
893 #endif
897 ! 2009-06009 rce - zero all these for safety
898 IF( PRESENT(qlsink) ) qlsink(its:ite,kts:kte,jts:jte) = 0.
899 IF( PRESENT(precr ) ) precr(its:ite,kts:kte,jts:jte) = 0.
900 IF( PRESENT(preci ) ) preci(its:ite,kts:kte,jts:jte) = 0.
901 IF( PRESENT(precs ) ) precs(its:ite,kts:kte,jts:jte) = 0.
902 IF( PRESENT(precg ) ) precg(its:ite,kts:kte,jts:jte) = 0.
904 !-----------
905 IF( PRESENT(chem_opt) .AND. PRESENT(progn) ) THEN
907 ! ERM: check whether to use built-in droplet nucleation or use qndrop from CHEM
908 IF ( mp_physics==NSSL_2MOM .and. config_flags%nssl_2moment_on==1 ) THEN
909 IF ( progn > 0 ) THEN
910 IF ( .not. (chem_opt == 0 .or. chem_opt == 401) ) nssl_progn = .true.
911 ELSE
912 nssl_progn = .false. ! use NUCOND for droplet nucleation
913 ENDIF
914 ENDIF
916 !Add pass for dust-only wrf-chem option - RAS
917 IF( (chem_opt==0 .OR. chem_opt==401) .AND. progn==1 .AND. (mp_physics==LINSCHEME .OR. mp_physics==MORR_TWO_MOMENT)) THEN
918 IF( PRESENT( QNDROP_CURR ) ) THEN
919 CALL wrf_debug ( 100 , 'microphysics_driver: calling prescribe_aerosol_mixactivate' )
920 ! 06-nov-2005 rce - id & itimestep added to arg list
921 call prescribe_aerosol_mixactivate ( &
922 id, itimestep, dt, naer, &
923 ccn_conc, chem_opt, & !RAS13.1
924 rho, th, pi_phy, w, cldfra, cldfra_old, &
925 z, dz8w, p8w, t8w, exch_h, &
926 qv_curr, qc_curr, qi_curr, qndrop_curr, &
927 nsource, &
928 ids,ide, jds,jde, kds,kde, &
929 ims,ime, jms,jme, kms,kme, &
930 its,ite, jts,jte, kts,kte, &
931 F_QC=f_qc, F_QI=f_qi )
932 END IF
933 ELSEIF ( (chem_opt==0 .OR. chem_opt==401) .AND. progn==1 .AND. &
934 (mp_physics==NSSL_2MOM .and. config_flags%nssl_2moment_on==1)) THEN
935 ! Do nothing here for the moment. Use activation of CCN within the NSSL_2MOM scheme instead, based on nssl_cccn namelist value.
936 ELSEIF ( progn==1 .AND. mp_physics/=LINSCHEME .AND. mp_physics/=MORR_TWO_MOMENT &
937 .AND. .not. (mp_physics==NSSL_2MOM .and. config_flags%nssl_2moment_on==1) ) THEN
938 call wrf_error_fatal( &
939 "SETTINGS ERROR: Prognostic cloud droplet number can only be used with the mp_physics=LINSCHEME or MORRISON or NSSL_2MOM.")
940 END IF
941 END IF
943 #if ( WRF_CHEM == 1)
944 !NUWRF JJS 20110525 vvvvv
945 ! Pack gocart aerosol species
946 ! All aerosol species in chem are in "ug/kg-dryair"
947 ! and conerted to (g/m**3)
949 aero(:,:,:,:) = 0.
950 do k = kts, kte
951 do j = jts, jte
952 do i = its, ite
953 aero(i,k,j, 1) = max(0.0, chem(i,k,j,p_sulf)*1.0e-6*p(i,k,j)* &
954 96.0/(8.314*th(i,k,j)*pi_phy(i,k,j))) ! 1 = SO4
955 aero(i,k,j, 2) = max(0.0, (chem(i,k,j,p_bc1)+chem(i,k,j,p_bc2))*1.0e-6*rho(i,k,j)) ! 2 = BC1+BC2
956 aero(i,k,j, 3) = max(0.0, chem(i,k,j,p_oc1)*1.0e-6*rho(i,k,j)*1.4e0) ! 3 = OC1
957 aero(i,k,j, 4) = max(0.0, chem(i,k,j,p_oc2)*1.0e-6*rho(i,k,j)*1.4e0) ! 4 = OC2
958 aero(i,k,j, 5) = max(0.0, chem(i,k,j,p_seas_1)*1.0e-6*rho(i,k,j)) ! 5 = SS1
959 aero(i,k,j, 6) = max(0.0, (chem(i,k,j,p_seas_2)+chem(i,k,j,p_seas_3)+ &
960 chem(i,k,j,p_seas_4))*1.0e-6*rho(i,k,j)) ! 6 = SS2+SS3+SS4
961 aero(i,k,j, 7) = max(0.0, chem(i,k,j,p_dust_1)*1.0e-6*rho(i,k,j)*frac(1)) ! 7 = DU1 dust mode 1
962 aero(i,k,j, 8) = max(0.0, chem(i,k,j,p_dust_1)*1.0e-6*rho(i,k,j)*frac(2)) ! 8 = DU1 dust mode 2
963 aero(i,k,j, 9) = max(0.0, chem(i,k,j,p_dust_1)*1.0e-6*rho(i,k,j)*frac(3)) ! 9 = DU1 dust mode 3
964 aero(i,k,j,10) = max(0.0, chem(i,k,j,p_dust_1)*1.0e-6*rho(i,k,j)*frac(4)) ! 10 = DU1 dust mode 4
965 aero(i,k,j,11) = max(0.0, chem(i,k,j,p_dust_2)*1.0e-6*rho(i,k,j)) ! 11 = DU2 dust mode 5
966 aero(i,k,j,12) = max(0.0, chem(i,k,j,p_dust_3)*1.0e-6*rho(i,k,j)) ! 11 = DU3 dust mode 6
967 aero(i,k,j,13) = max(0.0, chem(i,k,j,p_dust_4)*1.0e-6*rho(i,k,j)) ! 11 = DU4 dust mode 7
968 aero(i,k,j,14) = max(0.0, chem(i,k,j,p_dust_5)*1.0e-6*rho(i,k,j)) ! 11 = DU5 dust mode 8
969 enddo ! !
970 enddo ! j
971 enddo ! k
972 !NUWRF JJS 20110525 ^^^^^
973 #endif
975 micro_select: SELECT CASE(mp_physics)
977 CASE (KESSLERSCHEME)
978 CALL wrf_debug ( 100 , 'microphysics_driver: calling kessler' )
979 IF ( PRESENT( QV_CURR ) .AND. PRESENT( QC_CURR ) .AND. &
980 PRESENT( QR_CURR ) .AND. &
981 PRESENT( RAINNC ) .AND. PRESENT ( RAINNCV ) .AND. &
982 PRESENT( Z )) THEN
983 CALL kessler( &
984 T=th &
985 ,QV=qv_curr &
986 ,QC=qc_curr &
987 ,QR=qr_curr &
988 ,RHO=rho, PII=pi_phy,DT_IN=dt, Z=z, XLV=xlv, CP=cp &
989 ,EP2=ep_2,SVP1=svp1,SVP2=svp2 &
990 ,SVP3=svp3,SVPT0=svpt0,RHOWATER=rhowater &
991 ,DZ8W=dz8w &
992 ,RAINNC=rainnc,RAINNCV=rainncv &
993 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
994 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
995 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
996 )
997 ELSE
998 CALL wrf_error_fatal ( 'arguments not present for calling kessler' )
999 ENDIF
1000 #if ( WRFPLUS == 1 )
1001 CASE (MKESSLERSCHEME)
1002 CALL wrf_debug ( 100 , 'microphysics_driver: calling mkessler' )
1003 IF ( PRESENT( QV_CURR ) .AND. PRESENT( QC_CURR ) .AND. &
1004 PRESENT( QR_CURR ) .AND. &
1005 PRESENT( RAINNC ) .AND. PRESENT ( RAINNCV ) .AND. &
1006 PRESENT( Z )) THEN
1007 CALL mkessler( &
1008 T=th &
1009 ,QV=qv_curr &
1010 ,QC=qc_curr &
1011 ,QR=qr_curr &
1012 !whl P is not recomputed in the HL' Kessler; need be added here
1013 ,P=p &
1014 !end whl
1015 ,RHO=rho, PII=pi_phy,DT_IN=dt, Z=z, XLV=xlv, CP=cp &
1016 ,EP2=ep_2,SVP1=svp1,SVP2=svp2 &
1017 ,SVP3=svp3,SVPT0=svpt0,RHOWATER=rhowater &
1018 ,DZ8W=dz8w &
1019 ,RAINNC=rainnc,RAINNCV=rainncv &
1020 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
1021 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
1022 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
1023 )
1024 ELSE
1025 CALL wrf_error_fatal ( 'arguments not present for calling mkessler' )
1026 ENDIF
1027 #endif
1028 !
1029 CASE (THOMPSONAERO)
1030 if (pert_thom .and. multi_perturb == 1) then
1031 allocate (qv_tmp(its:ite, kts:kte, jts:jte))
1032 allocate (qc_tmp(its:ite, kts:kte, jts:jte))
1033 allocate (qi_tmp(its:ite, kts:kte, jts:jte))
1034 allocate (qs_tmp(its:ite, kts:kte, jts:jte))
1035 allocate (qni_tmp(its:ite, kts:kte, jts:jte))
1037 call Add_multi_perturb_mp_perturbations (perts_qvapor, perts_qcloud, perts_qice, &
1038 perts_qsnow, perts_ni, pert_thom_qv, pert_thom_qc, pert_thom_qi, pert_thom_qs, &
1039 pert_thom_ni, qv_curr, qc_curr, qi_curr, qs_curr, qni_curr, qv_tmp, qc_tmp, qi_tmp, &
1040 qs_tmp, qni_tmp, its, ite, jts, jte, ims, ime, jms, jme, kms, kme, kts, kte)
1041 end if
1043 CALL wrf_debug ( 100 , 'microphysics_driver: calling thompson' )
1044 IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND. &
1045 PRESENT( QR_CURR ) .AND. PRESENT ( QI_CURR ) .AND. &
1046 PRESENT( QS_CURR ) .AND. PRESENT ( QG_CURR ) .AND. &
1047 PRESENT( QNR_CURR) .AND. PRESENT ( QNI_CURR) .AND. &
1048 PRESENT( QNC_CURR) .AND. PRESENT ( QNWFA_CURR) .AND. &
1049 PRESENT( QNIFA_CURR).AND.PRESENT ( QNWFA2D) .AND. &
1050 PRESENT( QNIFA2D) .AND. &
1051 PRESENT( SNOWNC) .AND. PRESENT ( SNOWNCV) .AND. &
1052 PRESENT( GRAUPELNC).AND. PRESENT ( GRAUPELNCV) .AND. &
1053 PRESENT( RAINNC ) .AND. PRESENT ( RAINNCV ) ) THEN
1054 #if ( WRF_CHEM == 1 )
1055 qv_b4mp(its:ite,kts:kte,jts:jte) = qv_curr(its:ite,kts:kte,jts:jte)
1056 qc_b4mp(its:ite,kts:kte,jts:jte) = qc_curr(its:ite,kts:kte,jts:jte)
1057 qi_b4mp(its:ite,kts:kte,jts:jte) = qi_curr(its:ite,kts:kte,jts:jte)
1058 qs_b4mp(its:ite,kts:kte,jts:jte) = qs_curr(its:ite,kts:kte,jts:jte)
1059 #endif
1060 CALL mp_gt_driver( &
1061 QV=qv_curr, &
1062 QC=qc_curr, &
1063 QR=qr_curr, &
1064 QI=qi_curr, &
1065 QS=qs_curr, &
1066 QG=qg_curr, &
1067 NI=qni_curr, &
1068 NR=qnr_curr, &
1069 NC=qnc_curr, &
1070 NWFA=qnwfa_curr, &
1071 NIFA=qnifa_curr, &
1072 NBCA=qnbca_curr, &
1073 NWFA2D=qnwfa2d, &
1074 NIFA2D=qnifa2d, &
1075 NBCA2D=qnbca2d, &
1076 aer_init_opt=config_flags%aer_init_opt, &
1077 wif_input_opt=config_flags%wif_input_opt, &
1078 TH=th, &
1079 PII=pi_phy, &
1080 P=p, &
1081 W=w, &
1082 DZ=dz8w, &
1083 DT_IN=dt, &
1084 ITIMESTEP=itimestep, &
1085 RAINNC=RAINNC, &
1086 RAINNCV=RAINNCV, &
1087 SNOWNC=SNOWNC, &
1088 SNOWNCV=SNOWNCV, &
1089 GRAUPELNC=GRAUPELNC, &
1090 GRAUPELNCV=GRAUPELNCV, &
1091 SR=SR, &
1092 #if ( WRF_CHEM == 1 )
1093 WETSCAV_ON=config_flags%wetscav_onoff == 1, &
1094 RAINPROD=rainprod, &
1095 EVAPPROD=evapprod, &
1096 #endif
1097 REFL_10CM=refl_10cm, &
1098 diagflag=diagflag, &
1099 ke_diag = ke_diag, &
1100 do_radar_ref=do_radar_ref, &
1101 re_cloud=re_cloud, &
1102 re_ice=re_ice, &
1103 re_snow=re_snow, &
1104 has_reqc=has_reqc, & ! G. Thompson
1105 has_reqi=has_reqi, & ! G. Thompson
1106 has_reqs=has_reqs, & ! G. Thompson
1107 IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde, &
1108 IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme, &
1109 ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte)
1111 if (pert_thom .and. multi_perturb == 1) then
1112 call Remove_multi_perturb_mp_perturbations (perts_qvapor, perts_qcloud, perts_qice, &
1113 perts_qsnow, perts_ni, pert_thom_qv, pert_thom_qc, pert_thom_qi, pert_thom_qs, &
1114 pert_thom_ni, qv_curr, qc_curr, qi_curr, qs_curr, qni_curr, qv_tmp, qc_tmp, qi_tmp, &
1115 qs_tmp, qni_tmp, its, ite, jts, jte, ims, ime, jms, jme, kms, kme, kts, kte)
1116 deallocate (qv_tmp)
1117 deallocate (qc_tmp)
1118 deallocate (qi_tmp)
1119 deallocate (qs_tmp)
1120 deallocate (qni_tmp)
1121 end if
1123 IF (config_flags%aer_fire_emit_opt.gt.0) then
1124 CALL wrf_debug ( 200 , ' call fire_emis_simple_plumerise' )
1125 CALL fire_emis_simple_plumerise (config_flags%wif_fire_inj, config_flags%aer_fire_emit_opt &
1126 ,z_at_mass, pblh, qnwfa_curr, qnbca_curr &
1127 ,qnocbb2d, qnbcbb2d, dt, ids, ide, jds, jde, kds, kde &
1128 ,ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
1129 ENDIF
1130 ELSE
1131 CALL wrf_error_fatal ( 'arguments not present for calling thompson_et_al' )
1132 ENDIF
1133 !
1134 CASE (THOMPSONGH)
1135 CALL wrf_debug ( 100 , 'microphysics_driver: calling thompsongh' )
1136 IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND. &
1137 PRESENT( QR_CURR ) .AND. PRESENT ( QI_CURR ) .AND. &
1138 PRESENT( QS_CURR ) .AND. PRESENT ( QG_CURR ) .AND. &
1139 PRESENT( QNR_CURR) .AND. PRESENT ( QNI_CURR) .AND. &
1140 PRESENT( QNG_CURR) .AND. PRESENT ( QVOLG_CURR) .AND. &
1141 PRESENT( QNC_CURR) .AND. PRESENT ( QNWFA_CURR) .AND. &
1142 PRESENT( QNIFA_CURR).AND.PRESENT ( QNWFA2D) .AND. &
1143 PRESENT( QNIFA2D) .AND. &
1144 PRESENT( SNOWNC) .AND. PRESENT ( SNOWNCV) .AND. &
1145 PRESENT( GRAUPELNC).AND. PRESENT ( GRAUPELNCV) .AND. &
1146 PRESENT( RAINNC ) .AND. PRESENT ( RAINNCV ) ) THEN
1147 #if ( WRF_CHEM == 1 )
1148 qv_b4mp(its:ite,kts:kte,jts:jte) = qv_curr(its:ite,kts:kte,jts:jte)
1149 qc_b4mp(its:ite,kts:kte,jts:jte) = qc_curr(its:ite,kts:kte,jts:jte)
1150 qi_b4mp(its:ite,kts:kte,jts:jte) = qi_curr(its:ite,kts:kte,jts:jte)
1151 qs_b4mp(its:ite,kts:kte,jts:jte) = qs_curr(its:ite,kts:kte,jts:jte)
1152 #endif
1153 CALL mp_gt_driver( &
1154 QV=qv_curr, &
1155 QC=qc_curr, &
1156 QR=qr_curr, &
1157 QI=qi_curr, &
1158 QS=qs_curr, &
1159 QG=qg_curr, &
1160 QB=qvolg_curr, &
1161 NI=qni_curr, &
1162 NR=qnr_curr, &
1163 NC=qnc_curr, &
1164 NG=qng_curr, &
1165 NWFA=qnwfa_curr, &
1166 NIFA=qnifa_curr, &
1167 NBCA=qnbca_curr, &
1168 NWFA2D=qnwfa2d, &
1169 NIFA2D=qnifa2d, &
1170 NBCA2D=qnbca2d, &
1171 aer_init_opt=config_flags%aer_init_opt, &
1172 wif_input_opt=config_flags%wif_input_opt, &
1173 TH=th, &
1174 PII=pi_phy, &
1175 P=p, &
1176 W=w, &
1177 DZ=dz8w, &
1178 DT_IN=dt, &
1179 ITIMESTEP=itimestep, &
1180 RAINNC=RAINNC, &
1181 RAINNCV=RAINNCV, &
1182 SNOWNC=SNOWNC, &
1183 SNOWNCV=SNOWNCV, &
1184 GRAUPELNC=GRAUPELNC, &
1185 GRAUPELNCV=GRAUPELNCV, &
1186 SR=SR, &
1187 #if ( WRF_CHEM == 1 )
1188 WETSCAV_ON=config_flags%wetscav_onoff == 1, &
1189 RAINPROD=rainprod, &
1190 EVAPPROD=evapprod, &
1191 #endif
1192 REFL_10CM=refl_10cm, &
1193 diagflag=diagflag, &
1194 ke_diag = ke_diag, &
1195 do_radar_ref=do_radar_ref, &
1196 re_cloud=re_cloud, &
1197 re_ice=re_ice, &
1198 re_snow=re_snow, &
1199 has_reqc=has_reqc, & ! G. Thompson
1200 has_reqi=has_reqi, & ! G. Thompson
1201 has_reqs=has_reqs, & ! G. Thompson
1202 IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde, &
1203 IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme, &
1204 ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte)
1205 ELSE
1206 CALL wrf_error_fatal ( 'arguments not present for calling thompson_et_al' )
1207 ENDIF
1208 !
1209 CASE (THOMPSON)
1210 CALL wrf_debug ( 100 , 'microphysics_driver: calling thompson' )
1211 IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND. &
1212 PRESENT( QR_CURR ) .AND. PRESENT ( QI_CURR ) .AND. &
1213 PRESENT( QS_CURR ) .AND. PRESENT ( QG_CURR ) .AND. &
1214 PRESENT( QNR_CURR) .AND. PRESENT ( QNI_CURR) .AND. &
1215 ! PRESENT( SNOWNC) .AND. PRESENT ( SNOWNCV) .AND. &
1216 ! PRESENT( GRAUPELNC) .AND. PRESENT ( GRAUPELNCV) .AND. &
1217 PRESENT( RAINNC ) .AND. PRESENT ( RAINNCV ) ) THEN
1218 #if ( WRF_CHEM == 1 )
1219 qv_b4mp(its:ite,kts:kte,jts:jte) = qv_curr(its:ite,kts:kte,jts:jte)
1220 qc_b4mp(its:ite,kts:kte,jts:jte) = qc_curr(its:ite,kts:kte,jts:jte)
1221 qi_b4mp(its:ite,kts:kte,jts:jte) = qi_curr(its:ite,kts:kte,jts:jte)
1222 qs_b4mp(its:ite,kts:kte,jts:jte) = qs_curr(its:ite,kts:kte,jts:jte)
1223 #endif
1224 if (pert_thom .and. multi_perturb == 1) then
1225 allocate (qv_tmp(its:ite, kts:kte, jts:jte))
1226 allocate (qc_tmp(its:ite, kts:kte, jts:jte))
1227 allocate (qi_tmp(its:ite, kts:kte, jts:jte))
1228 allocate (qs_tmp(its:ite, kts:kte, jts:jte))
1229 allocate (qni_tmp(its:ite, kts:kte, jts:jte))
1231 call Add_multi_perturb_mp_perturbations (perts_qvapor, perts_qcloud, perts_qice, &
1232 perts_qsnow, perts_ni, pert_thom_qv, pert_thom_qc, pert_thom_qi, pert_thom_qs, &
1233 pert_thom_ni, qv_curr, qc_curr, qi_curr, qs_curr, qni_curr, qv_tmp, qc_tmp, qi_tmp, &
1234 qs_tmp, qni_tmp, its, ite, jts, jte, ims, ime, jms, jme, kms, kme, kts, kte)
1235 end if
1237 CALL mp_gt_driver( &
1238 QV=qv_curr, &
1239 QC=qc_curr, &
1240 QR=qr_curr, &
1241 QI=qi_curr, &
1242 QS=qs_curr, &
1243 QG=qg_curr, &
1244 NI=qni_curr, &
1245 NR=qnr_curr, &
1246 TH=th, &
1247 PII=pi_phy, &
1248 P=p, &
1249 W=w, &
1250 DZ=dz8w, &
1251 DT_IN=dt, &
1252 ITIMESTEP=itimestep, &
1253 RAINNC=RAINNC, &
1254 RAINNCV=RAINNCV, &
1255 SNOWNC=SNOWNC, &
1256 SNOWNCV=SNOWNCV, &
1257 GRAUPELNC=GRAUPELNC, &
1258 GRAUPELNCV=GRAUPELNCV, &
1259 SR=SR, &
1260 #if ( WRF_CHEM == 1 )
1261 WETSCAV_ON=config_flags%wetscav_onoff == 1, &
1262 RAINPROD=rainprod, &
1263 EVAPPROD=evapprod, &
1264 #endif
1265 REFL_10CM=refl_10cm, &
1266 diagflag=diagflag, &
1267 ke_diag = ke_diag, &
1268 do_radar_ref=do_radar_ref, &
1269 re_cloud=re_cloud, & ! G. Thompson
1270 re_ice=re_ice, & ! G. Thompson
1271 re_snow=re_snow, & ! G. Thompson
1272 has_reqc=has_reqc, & ! G. Thompson
1273 has_reqi=has_reqi, & ! G. Thompson
1274 has_reqs=has_reqs, & ! G. Thompson
1275 IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde, &
1276 IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme, &
1277 ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte)
1279 if (pert_thom .and. multi_perturb == 1) then
1280 call Remove_multi_perturb_mp_perturbations (perts_qvapor, perts_qcloud, perts_qice, &
1281 perts_qsnow, perts_ni, pert_thom_qv, pert_thom_qc, pert_thom_qi, pert_thom_qs, &
1282 pert_thom_ni, qv_curr, qc_curr, qi_curr, qs_curr, qni_curr, qv_tmp, qc_tmp, qi_tmp, &
1283 qs_tmp, qni_tmp, its, ite, jts, jte, ims, ime, jms, jme, kms, kme, kts, kte)
1284 deallocate (qv_tmp)
1285 deallocate (qc_tmp)
1286 deallocate (qi_tmp)
1287 deallocate (qs_tmp)
1288 deallocate (qni_tmp)
1289 end if
1291 ELSE
1292 CALL wrf_error_fatal ( 'arguments not present for calling thompson_et_al' )
1293 ENDIF
1294 #if (EM_CORE==1)
1295 CASE (NTU)
1296 CALL wrf_debug(100, 'microphysics_driver: calling ntu')
1297 IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND. &
1298 PRESENT( QR_CURR ) .AND. PRESENT ( QI_CURR ) .AND. &
1299 PRESENT( QS_CURR ) .AND. PRESENT ( QG_CURR ) .AND. &
1300 PRESENT( RAINNC ) .AND. PRESENT ( RAINNCV )) THEN ! ....
1301 CALL mp_ntu(ITIMESTEP=itimestep,TH=th,P=p,DZ=dz8w, &
1302 W=w,PII=pi_phy,DT_MP=dt,SR=sr,QV=qv_curr, &
1303 QC=qc_curr,QR=qr_curr,QI=qi_curr,QS=qs_curr, &
1304 QG=qg_curr,QH=qh_curr,NC=qnc_curr,NR=qnr_curr, &
1305 NI=qni_curr,NS=qns_curr,NG=qng_curr, &
1306 NH=qnh_curr,QDCN=qdcn_curr,QTCN=qtcn_curr, &
1307 QCCN=qccn_curr,QRCN=qrcn_curr,QNIN=qnin_curr, &
1308 FI=fi_curr,FS=fs_curr,VI=vi_curr,VS=vs_curr, &
1309 VG=vg_curr,AI=ai_curr,AS=as_curr,AG=ag_curr, &
1310 AH=ah_curr,I3M=i3m_curr,RAINNC=rainnc, &
1311 RAINNCV=rainncv,SNOWNC=snownc,SNOWNCV=snowncv, &
1312 GRAPNC=graupelnc,GRAPNCV=graupelncv, &
1313 HAILNC=hailnc,HAILNCV=hailncv, &
1314 IDS=ids,IDE=ide,JDS=jds,JDE=jde,KDS=kds,KDE=kde, &
1315 IMS=ims,IME=ime,JMS=jms,JME=jme,KMS=kms,KME=kme, &
1316 ITS=its,ITE=ite,JTS=jts,JTE=jte,KTS=kts,KTE=kte)
1317 ELSE
1318 Call wrf_error_fatal( 'arguments not present for calling ntu')
1319 ENDIF
1320 #endif
1321 #if (EM_CORE==1)
1322 # if ( BUILD_SBM_FAST == 1 )
1323 CASE (FAST_KHAIN_LYNN_SHPUND)
1324 CALL wrf_debug ( 100 , 'microphysics_driver: calling sbm' )
1325 CALL fast_sbm(W=w,U=u,V=v,TH_OLD=th_old &
1326 ,CHEM_new=scalar,N_CHEM=num_scalar &
1327 ,ITIMESTEP=itimestep,DT=dt,DX=dx,DY=dy &
1328 ,DZ8W=dz8w,RHO_PHY=rho,P_PHY=p &
1329 ,PI_PHY=pi_phy,TH_PHY=th &
1330 ,xland=xland,domain_id=id &
1331 ,ivgtyp=ivgtyp &
1332 ,xlat=xlat &
1333 ,xlong=xlong &
1334 ,QV=qv_curr &
1335 ,QC=qc_curr &
1336 ,QR=qr_curr &
1337 ,QI=qi_curr &
1338 ,QS=qs_curr &
1339 ,QG=qg_curr &
1340 ,QV_OLD=qv_old &
1341 ,QNC=qnc_curr &
1342 ,QNR=qnr_curr &
1343 ,QNI=qni_curr &
1344 ,QNS=qns_curr &
1345 ,QNG=qng_curr &
1346 ,QNA=qnn_curr &
1347 ,sbmradar=sbmradar,num_sbmradar=num_sbmradar &
1348 ,sbm_diagnostics=sbm_diagnostics &
1349 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
1350 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
1351 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
1352 ,diagflag=diagflag & ! added for radar reflectivity
1353 ,RAINNC=rainnc &
1354 ,RAINNCV=rainncv &
1355 ,SNOWNC=snownc &
1356 ,SNOWNCV=snowncv &
1357 ,GRAUPELNC=graupelnc &
1358 ,GRAUPELNCV=graupelncv &
1359 ,SR=sr &
1360 )
1361 # endif
1363 !
1364 CASE (FULL_KHAIN_LYNN)
1365 CALL wrf_debug ( 100 , 'microphysics_driver: calling sbm' )
1366 CALL sbm(W=w,U=u,V=v,TH_OLD=th_old &
1367 ,CHEM_new=scalar,N_CHEM=num_scalar &
1368 ,ITIMESTEP=itimestep,DT=dt,DX=dx,DY=dy &
1369 ,DZ8W=dz8w,RHO_PHY=rho,P_PHY=p,PI_PHY=pi_phy,TH_PHY=th &
1370 ,xland=xland &
1371 ,ivgtyp=ivgtyp &
1372 ,xlat=xlat &
1373 ,xlong=xlong &
1374 ,QV=qv_curr &
1375 ,QC=qc_curr &
1376 ,QR=qr_curr &
1377 ,QIP=qip_curr &
1378 ,QIC=qic_curr &
1379 ,QID=qid_curr &
1380 ,QS=qs_curr &
1381 ,QG=qg_curr &
1382 ,QH=qh_curr &
1383 ,QV_OLD=qv_old &
1384 ,QNC=qnc_curr &
1385 ,QNR=qnr_curr &
1386 ,QNIP=qnip_curr &
1387 ,QNIC=qnic_curr &
1388 ,QNID=qnid_curr &
1389 ,QNS=qns_curr &
1390 ,QNG=qng_curr &
1391 ,QNH=qng_curr &
1392 ,QNA=qnn_curr &
1393 ,EFFR=effr_curr &
1394 ,ICE_EFFR=ice_effr_curr &
1395 ,TOT_EFFR=tot_effr_curr &
1396 ,QIC_EFFR=qic_effr_curr &
1397 ,QIP_EFFR=qip_effr_curr &
1398 ,QID_EFFR=qid_effr_curr &
1399 ,height=height &
1400 ,tempc=tempc &
1401 ,kext_ql=kext_ql &
1402 ,kext_qs=kext_qs &
1403 ,kext_qg=kext_qg &
1404 ,kext_qh=kext_qh &
1405 ,kext_qa=kext_qa &
1406 ,kext_qic=kext_qic &
1407 ,kext_qip=kext_qip &
1408 ,kext_qid=kext_qid &
1409 ,kext_ft_qic=kext_ft_qic &
1410 ,kext_ft_qip=kext_ft_qip &
1411 ,kext_ft_qid=kext_ft_qid &
1412 ,kext_ft_qs=kext_ft_qs &
1413 ,kext_ft_qg=kext_ft_qg &
1414 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
1415 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
1416 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
1417 ,REFL_10CM=refl_10cm & ! added for radar reflectivity
1418 ,diagflag=diagflag & ! added for radar reflectivity
1419 ,do_radar_ref=do_radar_ref & ! added for radar reflectivity
1420 ,RAINNC=rainnc &
1421 ,RAINNCV=rainncv &
1422 ,SNOWNC=snownc &
1423 ,SNOWNCV=snowncv &
1424 ,GRAUPELNC=graupelnc &
1425 ,GRAUPELNCV=graupelncv &
1426 ,HAILNC=hailnc &
1427 ,HAILNCV=hailncv &
1428 ,SR=sr &
1429 )
1430 #endif
1432 !
1433 CASE (JENSEN_ISHMAEL)
1434 CALL wrf_debug(100, 'microphysics_driver: jensen_ishmael ')
1435 IF (PRESENT (QV_CURR) .AND. PRESENT (QC_CURR) .AND. &
1436 PRESENT (QR_CURR) .AND. PRESENT (QNR_CURR) .AND. &
1437 PRESENT (QI_CURR).AND. PRESENT (QNI_CURR) .AND. &
1438 PRESENT (QVOLI_CURR) .AND. PRESENT (QAOLI_CURR) .AND. &
1439 PRESENT (QI2_CURR).AND. PRESENT (QNI2_CURR) .AND. &
1440 PRESENT (QVOLI2_CURR) .AND. PRESENT (QAOLI2_CURR) .AND. &
1441 PRESENT (QI3_CURR).AND. PRESENT (QNI3_CURR) .AND. &
1442 PRESENT (QVOLI3_CURR).AND. PRESENT (QAOLI3_CURR)) THEN
1443 CALL mp_jensen_ishmael( &
1444 ITIMESTEP=itimestep, & !*
1445 DT_IN=dt, & !*
1446 P=p, & !*
1447 DZ=dz8w, & !* !
1448 TH=th, & !*
1449 QV=qv_curr, & !*
1450 QC=qc_curr, & !*
1451 QR=qr_curr, & !*
1452 NR=qnr_curr, & !* !
1453 QI1=qi_curr, & !*
1454 NI1=qni_curr, & !*
1455 AI1=qvoli_curr, & !*
1456 CI1=qaoli_curr, & !*
1457 QI2=qi2_curr, & !*
1458 NI2=qni2_curr, & !*
1459 AI2=qvoli2_curr, & !*
1460 CI2=qaoli2_curr, & !*
1461 QI3=qi3_curr, & !*
1462 NI3=qni3_curr, & !*
1463 AI3=qvoli3_curr, & !*
1464 CI3=qaoli3_curr, & !*
1465 IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde, &
1466 IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme, &
1467 ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte, &
1468 RAINNC=RAINNC, &
1469 RAINNCV=RAINNCV, &
1470 SNOWNC=SNOWNC, &
1471 SNOWNCV=SNOWNCV, &
1472 diag_effc3d=re_cloud, &
1473 diag_effi3d=re_ice, &
1474 diag_dbz3d=refl_10cm, &
1475 diag_vmi3d_1=vmi3d, &
1476 diag_di3d_1=di3d, &
1477 diag_rhopo3d_1=rhopo3d, &
1478 diag_phii3d_1=phii3d, &
1479 diag_vmi3d_2=vmi3d_2, &
1480 diag_di3d_2=di3d_2, &
1481 diag_rhopo3d_2=rhopo3d_2, &
1482 diag_phii3d_2=phii3d_2, &
1483 diag_vmi3d_3=vmi3d_3, &
1484 diag_di3d_3=di3d_3, &
1485 diag_rhopo3d_3=rhopo3d_3, &
1486 diag_phii3d_3=phii3d_3, &
1487 diag_itype_1=itype, &
1488 diag_itype_2=itype_2, &
1489 diag_itype_3=itype_3 &
1490 )
1491 ELSE
1492 Call wrf_error_fatal( 'arguments not present for calling jensen_ishamel')
1493 ENDIF
1495 CASE (MORR_TWO_MOMENT)
1496 CALL wrf_debug(100, 'microphysics_driver: calling morrison two moment')
1497 IF (PRESENT (QV_CURR) .AND. PRESENT (QC_CURR) .AND. &
1498 PRESENT (QR_CURR) .AND. PRESENT (QI_CURR) .AND. &
1499 PRESENT (QS_CURR) .AND. PRESENT (QG_CURR) .AND. &
1500 PRESENT (QR_CURR) .AND. PRESENT (QI_CURR) .AND. &
1501 PRESENT (QNS_CURR) .AND. PRESENT (QNI_CURR).AND. &
1502 PRESENT (QNR_CURR) .AND. PRESENT (QNG_CURR).AND. &
1503 PRESENT (QSCUTEN).AND. &
1504 PRESENT (QRCUTEN) .AND. PRESENT (QICUTEN).AND. &
1505 PRESENT (RAINNC ) .AND. PRESENT (RAINNCV) .AND. &
1506 PRESENT ( W ) ) THEN
1507 CALL mp_morr_two_moment( &
1508 ITIMESTEP=itimestep, & !*
1509 TH=th, & !*
1510 QV=qv_curr, & !*
1511 QC=qc_curr, & !*
1512 QR=qr_curr, & !*
1513 QI=qi_curr, & !*
1514 QS=qs_curr, & !*
1515 QG=qg_curr, & !*
1516 NI=qni_curr, & !*
1517 NS=qns_curr, & !* ! VVT
1518 NR=qnr_curr, & !* ! VVT
1519 NG=qng_curr, & !* ! VVT
1520 RHO=rho, & !*
1521 PII=pi_phy, & !*
1522 P=p, & !*
1523 DT_IN=dt, & !*
1524 DZ=dz8w, & !* !hm
1525 HT=ht, & !*
1526 W=w & !*
1527 ,RAINNC=RAINNC & !*
1528 ,RAINNCV=RAINNCV & !*
1529 ,SNOWNC=SNOWNC & !*
1530 ,SNOWNCV=SNOWNCV & !*
1531 ,GRAUPELNC=GRAUPELNC & !*
1532 ,GRAUPELNCV=GRAUPELNCV & !*
1533 ,SR=SR & !* !hm
1534 ,REFL_10CM=refl_10cm & ! added for radar reflectivity
1535 ,diagflag=diagflag & ! added for radar reflectivity
1536 ,do_radar_ref=do_radar_ref & ! added for radar reflectivity
1537 ,qrcuten=qrcuten & ! hm
1538 ,qscuten=qscuten & ! hm
1539 ,qicuten=qicuten & ! hm
1540 ,F_QNDROP=f_qndrop & ! hm for wrf-chem
1541 ,QNDROP=qndrop_curr & ! hm for wrf-chem
1542 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
1543 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
1544 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
1545 ,QLSINK=qlsink & ! jdf for wrf-chem
1546 #if ( WRF_CHEM == 1 )
1547 ,WETSCAV_ON=config_flags%wetscav_onoff == 1 &
1548 ,EVAPPROD=evapprod,RAINPROD=rainprod &
1549 #endif
1550 ,PRECR=precr,PRECI=preci,PRECS=precs,PRECG=precg & ! jdf for wrf-chem
1551 )
1552 ELSE
1553 Call wrf_error_fatal( 'arguments not present for calling morrison two moment')
1554 ENDIF
1556 #if (EM_CORE==1)
1557 CASE (P3_1CATEGORY)
1558 CALL wrf_debug(100, 'microphysics_driver: calling p3 one category')
1559 ! IF (PRESENT (QV_CURR) .AND. PRESENT (QC_CURR) .AND. &
1560 ! PRESENT (QR_CURR) .AND. PRESENT (QI_CURR) .AND. &
1561 ! PRESENT (QNG_CURR) .AND. &
1562 ! PRESENT (QNC_CURR) .AND. PRESENT (QNI_CURR).AND. &
1563 ! PRESENT (QNR_CURR) .AND. &
1564 ! PRESENT (QSCUTEN).AND. &
1565 ! PRESENT (QRCUTEN) .AND. PRESENT (QICUTEN).AND. &
1566 ! PRESENT (RAINNC ) .AND. PRESENT (RAINNCV) .AND. &
1567 ! PRESENT (Z ) .AND.PRESENT ( W ) ) THEN
1569 CALL mp_p3_wrapper_wrf( &
1570 ITIMESTEP=itimestep, &
1571 TH_3d=th, &
1572 QV_3d=qv_curr, &
1573 QC_3d=qc_curr, &
1574 QR_3d=qr_curr, &
1575 QNR_3d=qnr_curr, &
1576 QI1_3d=qi_curr, &
1577 QIR1_3d=qir_curr, &
1578 QNI1_3d=qni_curr, &
1579 QIB1_3d=qib_curr, &
1580 th_old_3d=th_old, &
1581 qv_old_3d=qv_old, &
1582 PII=pi_phy, &
1583 P=p, &
1584 DT=dt, &
1585 DZ=dz8w, &
1586 W=w &
1587 ,RAINNC=RAINNC &
1588 ,RAINNCV=RAINNCV &
1589 ,SR=SR &
1590 ,SNOWNC=SNOWNC &
1591 ,SNOWNCV=SNOWNCV &
1592 ,N_ICECAT=1 &
1593 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
1594 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
1595 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
1596 ,diag_zdbz_3d=refl_10cm, &
1597 diag_effc_3d=re_cloud, &
1598 diag_effi_3d=re_ice &
1599 ,diag_vmi_3d=vmi3d &
1600 ,diag_di_3d=di3d &
1601 ,diag_rhopo_3d=rhopo3d &
1602 )
1603 ! ELSE
1604 ! Call wrf_error_fatal( 'arguments not present for calling p3 one category')
1605 ! ENDIF
1607 CASE (P3_1CATEGORY_NC)
1608 CALL wrf_debug(100, 'microphysics_driver: calling p3 one category')
1609 ! IF (PRESENT (QV_CURR) .AND. PRESENT (QC_CURR) .AND. &
1610 ! PRESENT (QR_CURR) .AND. PRESENT (QI_CURR) .AND. &
1611 ! PRESENT (QNG_CURR) .AND. &
1612 ! PRESENT (QNC_CURR) .AND. PRESENT (QNI_CURR).AND. &
1613 ! PRESENT (QNR_CURR) .AND. &
1614 ! PRESENT (QSCUTEN).AND. &
1615 ! PRESENT (QRCUTEN) .AND. PRESENT (QICUTEN).AND. &
1616 ! PRESENT (RAINNC ) .AND. PRESENT (RAINNCV) .AND. &
1617 ! PRESENT (Z ) .AND.PRESENT ( W ) ) THEN
1619 CALL mp_p3_wrapper_wrf( &
1620 ITIMESTEP=itimestep, &
1621 TH_3d=th, &
1622 QV_3d=qv_curr, &
1623 QC_3d=qc_curr, &
1624 QR_3d=qr_curr, &
1625 QNR_3d=qnr_curr, &
1626 QI1_3d=qi_curr, &
1627 QIR1_3d=qir_curr, &
1628 QNI1_3d=qni_curr, &
1629 QIB1_3d=qib_curr, &
1630 th_old_3d=th_old, &
1631 qv_old_3d=qv_old, &
1632 nc_3d=qnc_curr, &
1633 PII=pi_phy, &
1634 P=p, &
1635 DT=dt, &
1636 DZ=dz8w, &
1637 W=w &
1638 ,RAINNC=RAINNC &
1639 ,RAINNCV=RAINNCV &
1640 ,SR=SR &
1641 ,SNOWNC=SNOWNC &
1642 ,SNOWNCV=SNOWNCV &
1643 ,N_ICECAT=1 &
1644 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
1645 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
1646 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
1647 ,diag_zdbz_3d=refl_10cm, &
1648 diag_effc_3d=re_cloud, &
1649 diag_effi_3d=re_ice &
1650 ,diag_vmi_3d=vmi3d &
1651 ,diag_di_3d=di3d &
1652 ,diag_rhopo_3d=rhopo3d &
1653 )
1654 CASE (P3_2CATEGORY)
1655 CALL wrf_debug(100, 'microphysics_driver: calling p3 one category')
1656 ! IF (PRESENT (QV_CURR) .AND. PRESENT (QC_CURR) .AND. &
1657 ! PRESENT (QR_CURR) .AND. PRESENT (QI_CURR) .AND. &
1658 ! PRESENT (QNG_CURR) .AND. &
1659 ! PRESENT (QNC_CURR) .AND. PRESENT (QNI_CURR).AND. &
1660 ! PRESENT (QNR_CURR) .AND. &
1661 ! PRESENT (QSCUTEN).AND. &
1662 ! PRESENT (QRCUTEN) .AND. PRESENT (QICUTEN).AND. &
1663 ! PRESENT (RAINNC ) .AND. PRESENT (RAINNCV) .AND. &
1664 ! PRESENT (Z ) .AND.PRESENT ( W ) ) THEN
1666 CALL mp_p3_wrapper_wrf_2cat( &
1667 ITIMESTEP=itimestep, &
1668 TH_3d=th, &
1669 QV_3d=qv_curr, &
1670 QC_3d=qc_curr, &
1671 QR_3d=qr_curr, &
1672 QNR_3d=qnr_curr, &
1673 QI1_3d=qi_curr, &
1674 QIR1_3d=qir_curr, &
1675 QNI1_3d=qni_curr, &
1676 QIB1_3d=qib_curr, &
1677 QI2_3d=qi2_curr, &
1678 QIR2_3d=qir2_curr, &
1679 QNI2_3d=qni2_curr, &
1680 QIB2_3d=qib2_curr, &
1681 th_old_3d=th_old, &
1682 qv_old_3d=qv_old, &
1683 nc_3d=qnc_curr, &
1684 PII=pi_phy, &
1685 P=p, &
1686 DT=dt, &
1687 DZ=dz8w, &
1688 W=w &
1689 ,RAINNC=RAINNC &
1690 ,RAINNCV=RAINNCV &
1691 ,SR=SR &
1692 ,SNOWNC=SNOWNC &
1693 ,SNOWNCV=SNOWNCV &
1694 ,N_ICECAT=2 &
1695 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
1696 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
1697 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
1698 ,diag_zdbz_3d=refl_10cm, &
1699 diag_effc_3d=re_cloud, &
1700 diag_effi_3d=re_ice &
1701 ,diag_vmi_3d=vmi3d &
1702 ,diag_di_3d=di3d &
1703 ,diag_rhopo_3d=rhopo3d &
1704 ,diag_vmi2_3d=vmi3d_2 &
1705 ,diag_di2_3d=di3d_2 &
1706 ,diag_rhopo2_3d=rhopo3d_2 &
1707 )
1709 CASE (P3_1CAT_3MOM)
1710 CALL wrf_debug(100, 'microphysics_driver: calling p3 one category 3 moment')
1712 CALL mp_p3_wrapper_wrf( &
1713 ITIMESTEP=itimestep, &
1714 TH_3d=th, &
1715 QV_3d=qv_curr, &
1716 QC_3d=qc_curr, &
1717 QR_3d=qr_curr, &
1718 QNR_3d=qnr_curr, &
1719 QI1_3d=qi_curr, &
1720 QIR1_3d=qir_curr, &
1721 QNI1_3d=qni_curr, &
1722 QIB1_3d=qib_curr, &
1723 th_old_3d=th_old, &
1724 qv_old_3d=qv_old, &
1725 nc_3d=qnc_curr, &
1726 PII=pi_phy, &
1727 P=p, &
1728 DT=dt, &
1729 DZ=dz8w, &
1730 W=w &
1731 ,RAINNC=RAINNC &
1732 ,RAINNCV=RAINNCV &
1733 ,SR=SR &
1734 ,SNOWNC=SNOWNC &
1735 ,SNOWNCV=SNOWNCV &
1736 ,N_ICECAT=1 &
1737 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
1738 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
1739 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
1740 ,diag_zdbz_3d=refl_10cm, &
1741 diag_effc_3d=re_cloud, &
1742 diag_effi_3d=re_ice &
1743 ,diag_vmi_3d=vmi3d &
1744 ,diag_di_3d=di3d &
1745 ,diag_rhopo_3d=rhopo3d &
1746 ,QZI1_3d=qzi_curr &
1747 ! not currently output
1748 ! ,diag_dhmax_3d=dhmax3d &
1749 ! ,diag_lami_3d=lami3d &
1750 ! ,diag_mui_3d=mui3d &
1751 )
1753 #endif
1756 # if (EM_CORE == 1)
1757 CASE (MORR_TM_AERO)
1758 CALL wrf_debug(100, 'microphysics_driver: calling morrison two moment')
1759 CALL mp_morr_two_moment_aero( &
1760 ITIMESTEP=itimestep, & !*
1761 TH=th, & !*
1762 QV=qv_curr, & !*
1763 QC=qc_curr, & !*
1764 QR=qr_curr, & !*
1765 QI=qi_curr, & !*
1766 QS=qs_curr, & !*
1767 QG=qg_curr, & !*
1768 NI=qni_curr, & !*
1769 NS=qns_curr, & !* ! VVT
1770 NR=qnr_curr, & !* ! VVT
1771 NG=qng_curr, & !* ! VVT
1772 NC=qnc_curr, & ! TWG/amy added nc
1773 KZH=exch_h, & ! TWG/amy add
1774 RHO=rho, & !*
1775 PII=pi_phy, & !*
1776 P=p, & !*
1777 DT_IN=dt, & !*
1778 DZ=dz8w, & !* !hm
1779 HT=ht, & !*
1780 W=w & !*
1781 ,RAINNC=RAINNC & !*
1782 ,RAINNCV=RAINNCV & !*
1783 ,SNOWNC=SNOWNC & !*
1784 ,SNOWNCV=SNOWNCV & !*
1785 ,GRAUPELNC=GRAUPELNC & !*
1786 ,GRAUPELNCV=GRAUPELNCV & !*
1787 ,SR=SR & !* !hm
1788 ,REFL_10CM=refl_10cm & ! added for radar reflectivity
1789 ,MSKF_REFL_10CM=MSKF_REFL_10CM & ! addef for radar reflectivity TWG 2017
1790 ,diagflag=diagflag & ! added for radar reflectivity
1791 ,do_radar_ref=do_radar_ref & ! added for radar reflectivity
1792 ,qrcuten=qrcuten & ! hm
1793 ,qscuten=qscuten & ! hm
1794 ,qicuten=qicuten & ! hm
1795 ,F_QNDROP=f_qndrop & ! hm for wrf-chem
1796 ,QNDROP=qndrop_curr & ! hm for wrf-chem
1797 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
1798 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
1799 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
1800 ,PBL=PBL & ! TWG/amy add
1801 ,aerocu=aerocu & ! TWG add
1802 ,aercu_opt=aercu_opt & ! TWG add
1803 ,aercu_fct=aercu_fct & ! TWG add
1804 ,no_src_types_cu=no_src_types_cu & ! TWG add
1805 ,EFCG=EFCG & ! TWG add
1806 ,EFIG=EFIG & ! TWG add
1807 ,EFSG=EFSG & ! TWG add
1808 ,WACT=WACT & ! TWG add
1809 ,CCN1_GS=CCN1_GS & ! TWG add
1810 ,CCN2_GS=CCN2_GS & ! TWG add
1811 ,CCN3_GS=CCN3_GS & ! TWG add
1812 ,CCN4_GS=CCN4_GS & ! TWG add
1813 ,CCN5_GS=CCN5_GS & ! TWG add
1814 ,CCN6_GS=CCN6_GS & ! TWG add
1815 ,CCN7_GS=CCN7_GS & ! TWG add
1816 ,NR_CU=NR_CU & ! TWG add
1817 ,QR_CU=QR_CU & ! TWG add
1818 ,NS_CU=NS_CU & ! TWG add
1819 ,QS_CU=QS_CU & ! TWG add
1820 ,CU_UAF=CU_UAF & ! TWG add
1821 ,QLSINK=qlsink & ! jdf for wrf-chem
1822 #if ( WRF_CHEM == 1 )
1823 ,WETSCAV_ON=config_flags%wetscav_onoff == 1 &
1824 ,EVAPPROD=evapprod,RAINPROD=rainprod &
1825 #endif
1826 ,PRECR=precr,PRECI=preci,PRECS=precs,PRECG=precg & ! jdf for wrf-chem
1827 )
1828 #endif
1830 CASE (MILBRANDT2MOM)
1831 CALL wrf_debug(100, 'microphysics_driver: calling milbrandt2mom')
1832 IF (PRESENT (QV_CURR) .AND. &
1833 PRESENT (QC_CURR) .AND. PRESENT (QNC_CURR) .AND. &
1834 PRESENT (QR_CURR) .AND. PRESENT (QNR_CURR) .AND. &
1835 PRESENT (QI_CURR) .AND. PRESENT (QNI_CURR) .AND. &
1836 PRESENT (QS_CURR) .AND. PRESENT (QNS_CURR) .AND. &
1837 PRESENT (QG_CURR) .AND. PRESENT (QNG_CURR) .AND. &
1838 PRESENT (QH_CURR) .AND. PRESENT (QNH_CURR) .AND. &
1839 PRESENT (RAINNC ) .AND. PRESENT (RAINNCV) .AND. &
1840 PRESENT (SNOWNC ) .AND. PRESENT (SNOWNCV) .AND. &
1841 PRESENT (HAILNC ) .AND. PRESENT (HAILNCV) .AND. &
1842 PRESENT (GRAUPELNC).AND.PRESENT (GRAUPELNCV).AND. &
1843 PRESENT ( W ) ) THEN
1844 ! PRESENT (ccntype) &
1846 CALL mp_milbrandt2mom_driver( &
1847 ITIMESTEP=itimestep, &
1848 p8w=p8w, &
1849 TH=th, &
1850 QV=qv_curr, &
1851 QC=qc_curr, &
1852 QR=qr_curr, &
1853 QI=qi_curr, &
1854 QS=qs_curr, &
1855 QG=qg_curr, &
1856 QH=qh_curr, &
1857 NC=qnc_curr, &
1858 NR=qnr_curr, &
1859 NI=qni_curr, &
1860 NS=qns_curr, &
1861 NG=qng_curr, &
1862 NH=qnh_curr, &
1863 PII=pi_phy, &
1864 P=p, &
1865 DT_IN=dt, &
1866 DZ=dz8w, &
1867 W=w, &
1868 RAINNC = RAINNC, &
1869 RAINNCV = RAINNCV, &
1870 SNOWNC = SNOWNC, &
1871 SNOWNCV = SNOWNCV, &
1872 HAILNC = HAILNC, &
1873 HAILNCV = HAILNCV, &
1874 GRPLNC = GRAUPELNC, &
1875 GRPLNCV = GRAUPELNCV, &
1876 SR=SR, &
1877 ! ccntype = ccntype, &
1878 Zet = refl_10cm, & ! HM, 9/22/09 for refl
1879 IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde, &
1880 IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme, &
1881 ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
1882 )
1883 ELSE
1884 Call wrf_error_fatal( 'arguments not present for calling milbrandt2mom')
1885 ENDIF
1888 ! CASE (MILBRANDT3MOM)
1889 ! CALL wrf_debug(100, 'microphysics_driver: calling milbrandt3mom')
1890 ! IF (PRESENT (QV_CURR) .AND. &
1891 ! PRESENT (QC_CURR) .AND. PRESENT (QNC_CURR) .AND. &
1892 ! PRESENT (QR_CURR) .AND. PRESENT (QNR_CURR) .AND. PRESENT (QZR_CURR) .AND. &
1893 ! PRESENT (QI_CURR) .AND. PRESENT (QNI_CURR) .AND. PRESENT (QZI_CURR) .AND. &
1894 ! PRESENT (QS_CURR) .AND. PRESENT (QNS_CURR) .AND. PRESENT (QZS_CURR) .AND. &
1895 ! PRESENT (QG_CURR) .AND. PRESENT (QNG_CURR) .AND. PRESENT (QZG_CURR) .AND. &
1896 ! PRESENT (QH_CURR) .AND. PRESENT (QNH_CURR) .AND. PRESENT (QZH_CURR) .AND. &
1897 ! PRESENT (RAINNC ) .AND. PRESENT (RAINNCV) .AND. &
1898 ! PRESENT ( W ) ) THEN
1899 ! CALL mp_milbrandt3mom_driver( &
1900 ! ITIMESTEP=itimestep, & !*
1901 ! TH=th, & !*
1902 ! QV=qv_curr, & !*
1903 ! QC=qc_curr, & !*
1904 ! QR=qr_curr, & !*
1905 ! QI=qi_curr, & !*
1906 ! QS=qs_curr, & !*
1907 ! QG=qg_curr, & !*
1908 ! QH=qh_curr, & !*
1909 ! NC=qnc_curr, & !*
1910 ! NR=qnr_curr, & !*
1911 ! NI=qni_curr, & !*
1912 ! NS=qns_curr, & !*
1913 ! NG=qng_curr, & !*
1914 ! NH=qnh_curr, & !*
1915 ! ZR=qzr_curr, & !*
1916 ! ZI=qzi_curr, & !*
1917 ! ZS=qzs_curr, & !*
1918 ! ZG=qzg_curr, & !*
1919 ! ZH=qzh_curr, & !*
1920 ! PII=pi_phy, & !*
1921 ! P=p, & !*
1922 ! DT_IN=dt, & !*
1923 ! DZ=dz8w, & !* ! h
1924 ! W=w & !*
1925 ! ,RAINNC=RAINNC & !*
1926 ! ,RAINNCV=RAINNCV & !*
1927 ! ,SR=SR & !* !hm
1928 ! ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
1929 ! ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
1930 ! ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
1931 ! )
1932 ! ELSE
1933 ! Call wrf_error_fatal( 'arguments not present for calling milbrandt3mom')
1934 ! ENDIF
1938 CASE (NSSL_2MOM)
1939 #if (WRFPLUS != 1) & !defined( VAR4D )
1940 ! For all 1,2,3-moment options
1941 CALL wrf_debug(100, 'microphysics_driver: calling nssl2mom')
1942 IF (PRESENT (QV_CURR) .AND. &
1943 PRESENT (RAINNC ) .AND. PRESENT (RAINNCV) .AND. &
1944 #if (EM_CORE==1)
1945 PRESENT (SNOWNC ) .AND. PRESENT (SNOWNCV) .AND. &
1946 PRESENT (HAILNC ) .AND. PRESENT (HAILNCV) .AND. &
1947 PRESENT (GRAUPELNC).AND.PRESENT (GRAUPELNCV).AND. &
1948 #endif
1949 PRESENT ( W ) ) THEN
1952 CALL nssl_2mom_driver( &
1953 ITIMESTEP=itimestep, &
1954 TH=th, &
1955 QV=qv_curr, &
1956 QC=qc_curr, &
1957 QR=qr_curr, &
1958 QI=qi_curr, &
1959 QS=qs_curr, &
1960 QH=qg_curr, &
1961 QHL=qh_curr, &
1962 ! CCW=qnc_curr, &
1963 CCW=qndrop_curr, &
1964 CRW=qnr_curr, &
1965 CCI=qni_curr, &
1966 CSW=qns_curr, &
1967 CHW=qng_curr, &
1968 CHL=qnh_curr, &
1969 VHW=qvolg_curr, f_vhw=F_QVOLG, &
1970 VHL=qvolh_curr, f_vhl=F_QVOLH, &
1971 ZRW=qzr_curr, f_zrw = f_qzr, &
1972 ZHW=qzg_curr, f_zhw = f_qzg, &
1973 ZHL=qzh_curr, f_zhl = f_qzh, &
1974 cn=qnn_curr, f_cn=f_qnn, &
1975 PII=pi_phy, &
1976 P=p, &
1977 W=w, &
1978 DZ=dz8w, &
1979 DTP=dt, &
1980 DN=rho, &
1981 RAINNC = RAINNC, &
1982 RAINNCV = RAINNCV, &
1983 SNOWNC = SNOWNC, &
1984 SNOWNCV = SNOWNCV, &
1985 HAILNC = HAILNC, &
1986 HAILNCV = HAILNCV, &
1987 GRPLNC = GRAUPELNC, &
1988 GRPLNCV = GRAUPELNCV, &
1989 SR=SR, &
1990 dbz = refl_10cm, &
1991 #if ( WRF_CHEM == 1 )
1992 WETSCAV_ON = config_flags%wetscav_onoff == 1, &
1993 EVAPPROD=evapprod,RAINPROD=rainprod, &
1994 #endif
1995 nssl_progn=nssl_progn, &
1996 diagflag = diagflag, &
1997 ke_diag = ke_diag, &
1998 cu_used=cu_used, &
1999 qrcuten=qrcuten, & ! hm
2000 qscuten=qscuten, & ! hm
2001 qicuten=qicuten, & ! hm
2002 qccuten=qccuten, & ! hm
2003 re_cloud=re_cloud, &
2004 re_ice=re_ice, &
2005 re_snow=re_snow, &
2006 has_reqc=has_reqc, & ! ala G. Thompson
2007 has_reqi=has_reqi, & ! ala G. Thompson
2008 has_reqs=has_reqs, & ! ala G. Thompson
2009 hail_maxk1=hail_maxk1, &
2010 hail_max2d=hail_max2d, &
2011 nwp_diagnostics=config_flags%nwp_diagnostics, &
2012 IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde, &
2013 IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme, &
2014 ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
2015 )
2017 ELSE
2018 Call wrf_error_fatal( 'arguments not present for calling nssl_2mom')
2019 ENDIF
2020 #endif
2021 !
2022 CASE (GSFCGCESCHEME)
2023 CALL wrf_debug ( 100 , 'microphysics_driver: calling GSFCGCE' )
2024 IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND. &
2025 PRESENT( QR_CURR ) .AND. PRESENT ( QI_CURR ) .AND. &
2026 PRESENT( QS_CURR ) .AND. &
2027 PRESENT( RAINNC ) .AND. PRESENT ( RAINNCV ) .AND. &
2028 PRESENT( HAIL ) .AND. PRESENT ( ICE2 ) .AND. &
2029 PRESENT( Z ) .AND. PRESENT ( W ) ) THEN
2030 CALL gsfcgce( &
2031 TH=th &
2032 ,QV=qv_curr &
2033 ,QL=qc_curr &
2034 ,QR=qr_curr &
2035 ,QI=qi_curr &
2036 ,QS=qs_curr &
2037 ,RHO=rho, PII=pi_phy, P=p, DT_IN=dt, Z=z &
2038 ,HT=ht, DZ8W=dz8w, GRAV=G &
2039 ,RHOWATER=rhowater, RHOSNOW=rhosnow &
2040 ,ITIMESTEP=itimestep &
2041 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
2042 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
2043 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
2044 ,RAINNC=rainnc, RAINNCV=rainncv &
2045 ,SNOWNC=snownc, SNOWNCV=snowncv ,SR=sr &
2046 ,GRAUPELNC=graupelnc ,GRAUPELNCV=graupelncv &
2047 ,REFL_10CM=refl_10cm & ! added for radar reflectivity
2048 ,diagflag=diagflag & ! added for radar reflectivity
2049 ,do_radar_ref=do_radar_ref & ! added for radar reflectivity
2050 ,F_QG=f_qg &
2051 ,QG=qg_curr &
2052 ,IHAIL=hail, ICE2=ice2 &
2053 )
2054 ! HAIL = 1, run gsfcgce with hail option
2055 ! 0, run gsfcgce with graupel option <---- default
2056 ! note: no effect if ice2 = 1
2057 ! ICE2 = 1, run gsfcgce with only snow, ice
2058 ! 2, run gsfcgce with only graupel, ice
2059 ! 0, run gsfcgce with snow, ice and hail/graupel <---- default
2061 ELSE
2062 CALL wrf_error_fatal ( 'arguments not present for calling GSFCGCE' )
2063 ENDIF
2065 CASE (NUWRF4ICESCHEME)
2066 CALL wrf_debug ( 100 , 'microphysics_driver: calling NUWRF4ICE' )
2067 IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND. &
2068 PRESENT( QR_CURR ) .AND. PRESENT ( QI_CURR ) .AND. &
2069 PRESENT( QS_CURR ) .AND. PRESENT ( QG_CURR ) .AND. &
2070 PRESENT( QH_CURR ) .AND. &
2071 PRESENT( RAINNC ) .AND. PRESENT ( RAINNCV ) .AND. &
2072 PRESENT( HAIL ) .AND. PRESENT ( ICE2 ) .AND. &
2073 PRESENT( Z ) .AND. PRESENT ( W ) ) THEN
2074 CALL gsfcgce_4ice_nuwrf( &
2075 TH=th &
2076 ,QV=qv_curr &
2077 ,QL=qc_curr &
2078 ,QR=qr_curr &
2079 ,QI=qi_curr &
2080 ,QS=qs_curr &
2081 ,QH=qh_curr &
2082 ,RHO=rho, PII=pi_phy, P=p, DT_IN=dt, Z=z &
2083 ,HT=ht, DZ8W=dz8w, GRAV=G, W=w &
2084 ,RHOWATER=rhowater, RHOSNOW=rhosnow &
2085 ,ITIMESTEP=itimestep, XLAND=xland, DX=dx &
2086 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
2087 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
2088 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
2089 ,RAINNC=rainnc, RAINNCV=rainncv &
2090 ,SNOWNC=snownc, SNOWNCV=snowncv ,SR=sr &
2091 ,GRAUPELNC=graupelnc ,GRAUPELNCV=graupelncv &
2092 ,HAILNC=hailnc, HAILNCV=hailncv &
2093 ,REFL_10CM=refl_10cm & ! added for radar reflectivity
2094 ,diagflag=diagflag & ! added for radar reflectivity
2095 ,do_radar_ref=do_radar_ref & ! added for radar reflectivity
2096 ,F_QG=f_qg &
2097 ,QG=qg_curr &
2098 ! ,IHAIL=hail, ICE4=ice2 & ! hardcoded in the 4ice scheme
2099 ! ihail = 0, ice4=4
2100 !NUWRF JJS 20110525 vvvvv
2101 ,PHYSC=physc, PHYSE=physe, PHYSD=physd &
2102 ,PHYSS=physs, PHYSM=physm, PHYSF=physf &
2103 ,ACPHYSC=acphysc, ACPHYSE=acphyse, ACPHYSD=acphysd &
2104 ,ACPHYSS=acphyss, ACPHYSM=acphysm, ACPHYSF=acphysf &
2105 ,RE_CLOUD_GSFC=re_cloud_gsfc &
2106 ,RE_RAIN_GSFC=re_rain_gsfc &
2107 ,RE_ICE_GSFC=re_ice_gsfc &
2108 ,RE_SNOW_GSFC=re_snow_gsfc &
2109 ,RE_GRAUPEL_GSFC=re_graupel_gsfc &
2110 ,RE_HAIL_GSFC=re_hail_gsfc &
2111 ,PRECR3D=precr3d,PRECI3D=preci3d,PRECS3D=precs3d &
2112 ,PRECG3D=precg3d,PRECH3D=prech3d &
2113 #if ( WRF_CHEM == 1)
2114 ,AERO=aero &
2115 ,ICN_DIAG=icn_diag, NC_DIAG=nc_diag, GID=ID &
2116 ,CHEM_OPT=chem_opt &
2117 ,GSFCGCE_GOCART_COUPLING=gsfcgce_gocart_coupling &
2118 #endif
2119 !NUWRF JJS 20110525 ^^^^^
2120 )
2122 do j=jts,jte
2123 do k=kts,kte
2124 do i=its,ite
2125 ! Snapshot total latent heating rate [K/s]
2126 phys_tot(i,k,j) = physc(i,k,j) + physe(i,k,j) + &
2127 physd(i,k,j) + physs(i,k,j) + physm(i,k,j) + &
2128 physf(i,k,j)
2129 ! Accumulated total latent heating [K]
2130 acphys_tot(i,k,j) = acphysc(i,k,j) + acphyse(i,k,j) + &
2131 acphysd(i,k,j) + acphyss(i,k,j) + acphysm(i,k,j) + &
2132 acphysf(i,k,j)
2134 end do
2135 end do
2136 end do
2138 ELSE
2139 CALL wrf_error_fatal ( 'arguments not present for calling NUWRF4ICESFCGCE' )
2140 ENDIF
2142 CASE (LINSCHEME)
2143 CALL wrf_debug ( 100 , 'microphysics_driver: calling lin_et_al' )
2144 IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND. &
2145 PRESENT( QR_CURR ) .AND. PRESENT ( QI_CURR ) .AND. &
2146 PRESENT( QS_CURR ) .AND. &
2147 PRESENT( RAINNC ) .AND. PRESENT ( RAINNCV ) .AND. &
2148 PRESENT( Z ) ) THEN
2149 CALL lin_et_al( &
2150 TH=th &
2151 ,QV=qv_curr &
2152 ,QL=qc_curr &
2153 ,QR=qr_curr &
2154 ,QI=qi_curr &
2155 ,QS=qs_curr &
2156 ,QLSINK=qlsink &
2157 ,RHO=rho, PII=pi_phy, P=p, DT_IN=dt, Z=z &
2158 ,HT=ht, DZ8W=dz8w, GRAV=G, CP=cp &
2159 ,RAIR=r_d, RVAPOR=R_v &
2160 ,XLS=xls, XLV=xlv, XLF=xlf &
2161 ,RHOWATER=rhowater, RHOSNOW=rhosnow &
2162 ,EP2=ep_2,SVP1=svp1,SVP2=svp2 &
2163 ,SVP3=svp3,SVPT0=svpt0 &
2164 ,RAINNC=rainnc, RAINNCV=rainncv &
2165 ,SNOWNC=snownc, SNOWNCV=snowncv &
2166 ,GRAUPELNC=graupelnc, GRAUPELNCV=graupelncv, SR=sr &
2167 ,REFL_10CM=refl_10cm & ! added for radar reflectivity
2168 ,diagflag=diagflag & ! added for radar reflectivity
2169 ,do_radar_ref=do_radar_ref & ! added for radar reflectivity
2170 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
2171 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
2172 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
2173 ,PRECR=precr,PRECI=preci,PRECS=precs,PRECG=precg &
2174 ,F_QG=f_qg, F_QNDROP=f_qndrop &
2175 ,QG=qg_curr &
2176 ,QNDROP=qndrop_curr &
2177 )
2178 ELSE
2179 CALL wrf_error_fatal ( 'arguments not present for calling lin_et_al' )
2180 ENDIF
2182 CASE (SBU_YLINSCHEME)
2183 CALL wrf_debug ( 100 , 'microphysics_driver: calling sbu_ylin' )
2184 IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND. &
2185 PRESENT( QR_CURR ) .AND. PRESENT ( QI_CURR ) .AND. &
2186 PRESENT( QS_CURR ) .AND. &
2187 PRESENT( RI_CURR ) .AND. &
2188 PRESENT( RAINNC ) .AND. PRESENT ( RAINNCV ) .AND. &
2189 PRESENT( Z ) ) THEN
2190 CALL sbu_ylin( &
2191 TH=th &
2192 ,QV=qv_curr &
2193 ,QL=qc_curr &
2194 ,QR=qr_curr &
2195 ,QI=qi_curr &
2196 ,QS=qs_curr &
2197 ,RI3D=ri_curr &
2198 ! ,QLSINK=qlsink &
2199 ,RHO=rho, PII=pi_phy, P=p, DT_IN=dt, Z=z &
2200 ,HT=ht, DZ8W=dz8w &
2201 ! , GRAV=G, CP=cp &
2202 ! ,RAIR=r_d, RVAPOR=R_v &
2203 ! ,XLS=xls, XLV=xlv, XLF=xlf &
2204 ! ,RHOWATER=rhowater, RHOSNOW=rhosnow &
2205 ! ,EP2=ep_2,SVP1=svp1,SVP2=svp2 &
2206 ! ,SVP3=svp3,SVPT0=svpt0 &
2207 ,RAINNC=rainnc, RAINNCV=rainncv &
2208 ! ,SNOWNC=snownc, SNOWNCV=snowncv &
2209 ! ,GRAUPELNC=graupelnc, GRAUPELNCV=graupelncv, SR=sr &
2210 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
2211 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
2212 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
2213 ! ,PRECR=precr,PRECI=preci,PRECS=precs,PRECG=precg &
2214 ! ,F_QG=f_qg &
2215 ! ,F_QNDROP=f_qndrop &
2216 ! ,QG=qg_curr &
2217 ! ,QNDROP=qndrop_curr &
2218 )
2219 ELSE
2220 CALL wrf_error_fatal ( 'arguments not present for calling sbu_ylin' )
2221 ENDIF
2224 CASE (WSM3SCHEME)
2225 CALL wrf_debug ( 100 , 'microphysics_driver: calling wsm3' )
2226 IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND. &
2227 PRESENT( QR_CURR ) .AND. &
2228 PRESENT( RAINNC ) .AND. PRESENT ( RAINNCV ) .AND. &
2229 PRESENT( W ) ) THEN
2230 CALL wsm3( &
2231 TH=th &
2232 ,Q=qv_curr &
2233 ,QCI=qc_curr &
2234 ,QRS=qr_curr &
2235 ,W=w,DEN=rho,PII=pi_phy,P=p,DELZ=dz8w &
2236 ,DELT=dt,G=g,CPD=cp,CPV=cpv &
2237 ,RD=r_d,RV=r_v,T0C=svpt0 &
2238 ,EP1=ep_1, EP2=ep_2, QMIN=epsilon &
2239 ,XLS=xls, XLV0=xlv, XLF0=xlf &
2240 ,DEN0=rhoair0, DENR=rhowater &
2241 ,CLIQ=cliq,CICE=cice,PSAT=psat &
2242 ,RAIN=rainnc ,RAINNCV=rainncv &
2243 ,SNOW=snownc ,SNOWNCV=snowncv &
2244 ,SR=sr &
2245 # ifndef _ACCEL
2246 ,has_reqc=has_reqc & ! for radiation +
2247 ,has_reqi=has_reqi &
2248 ,has_reqs=has_reqs &
2249 ,re_cloud=re_cloud &
2250 ,re_ice=re_ice &
2251 ,re_snow=re_snow & ! for radiation -
2252 # endif
2253 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
2254 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
2255 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
2256 )
2257 ELSE
2258 CALL wrf_error_fatal ( 'arguments not present for calling wsm3' )
2259 ENDIF
2261 #ifndef XEON_OPTIMIZED_WSM5
2262 CASE (WSM5SCHEME)
2263 CALL wrf_debug ( 100 , 'microphysics_driver: calling wsm5' )
2264 IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND. &
2265 PRESENT( QR_CURR ) .AND. PRESENT ( QI_CURR ) .AND. &
2266 PRESENT( QS_CURR ) .AND. &
2267 PRESENT( RAINNC ) .AND. PRESENT ( RAINNCV ) ) THEN
2268 CALL wsm5( &
2269 TH=th &
2270 ,Q=qv_curr &
2271 ,QC=qc_curr &
2272 ,QR=qr_curr &
2273 ,QI=qi_curr &
2274 ,QS=qs_curr &
2275 ,DEN=rho,PII=pi_phy,P=p,DELZ=dz8w &
2276 ,DELT=dt,G=g,CPD=cp,CPV=cpv &
2277 ,RD=r_d,RV=r_v,T0C=svpt0 &
2278 ,EP1=ep_1, EP2=ep_2, QMIN=epsilon &
2279 ,XLS=xls, XLV0=xlv, XLF0=xlf &
2280 ,DEN0=rhoair0, DENR=rhowater &
2281 ,CLIQ=cliq,CICE=cice,PSAT=psat &
2282 ,RAIN=rainnc ,RAINNCV=rainncv &
2283 ,SNOW=snownc ,SNOWNCV=snowncv &
2284 ,SR=sr &
2285 # ifndef _ACCEL
2286 ,REFL_10CM=refl_10cm & ! added for radar reflectivity
2287 ,diagflag=diagflag & ! added for radar reflectivity
2288 ,do_radar_ref=do_radar_ref & ! added for radar reflectivity
2289 ,has_reqc=has_reqc & ! for radiation +
2290 ,has_reqi=has_reqi &
2291 ,has_reqs=has_reqs &
2292 ,re_cloud=re_cloud &
2293 ,re_ice=re_ice &
2294 ,re_snow=re_snow & ! for radiation -
2295 # endif
2296 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
2297 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
2298 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
2299 )
2300 ELSE
2301 CALL wrf_error_fatal ( 'arguments not present for calling wsm5' )
2302 ENDIF
2303 #endif
2305 CASE (WSM6SCHEME)
2306 CALL wrf_debug ( 100 , 'microphysics_driver: calling wsm6' )
2307 IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND. &
2308 PRESENT( QR_CURR ) .AND. PRESENT ( QI_CURR ) .AND. &
2309 PRESENT( QS_CURR ) .AND. PRESENT ( QG_CURR ) .AND. &
2310 PRESENT( RAINNC ) .AND. PRESENT ( RAINNCV ) ) THEN
2311 CALL wsm6( &
2312 TH=th &
2313 ,Q=qv_curr &
2314 ,QC=qc_curr &
2315 ,QR=qr_curr &
2316 ,QI=qi_curr &
2317 ,QS=qs_curr &
2318 ,QG=qg_curr &
2319 ,DEN=rho,PII=pi_phy,P=p,DELZ=dz8w &
2320 ,DELT=dt,G=g,CPD=cp,CPV=cpv &
2321 ,RD=r_d,RV=r_v,T0C=svpt0 &
2322 ,EP1=ep_1, EP2=ep_2, QMIN=epsilon &
2323 ,XLS=xls, XLV0=xlv, XLF0=xlf &
2324 ,DEN0=rhoair0, DENR=rhowater &
2325 ,CLIQ=cliq,CICE=cice,PSAT=psat &
2326 ,RAIN=rainnc ,RAINNCV=rainncv &
2327 ,SNOW=snownc ,SNOWNCV=snowncv &
2328 ,SR=sr &
2329 ,REFL_10CM=refl_10cm & ! added for radar reflectivity
2330 ,diagflag=diagflag & ! added for radar reflectivity
2331 ,do_radar_ref=do_radar_ref & ! added for radar reflectivity
2332 ,GRAUPEL=graupelnc ,GRAUPELNCV=graupelncv &
2333 ,has_reqc=has_reqc & ! for radiation +
2334 ,has_reqi=has_reqi &
2335 ,has_reqs=has_reqs &
2336 ,re_qc_bg=re_qc_bg,re_qi_bg=re_qi_bg &
2337 ,re_qs_bg=re_qs_bg &
2338 ,re_qc_max=re_qc_max,re_qi_max=re_qi_max &
2339 ,re_qs_max=re_qs_max &
2340 ,re_cloud=re_cloud &
2341 ,re_ice=re_ice &
2342 ,re_snow=re_snow & ! for radiation -
2343 ,errmsg=errmsg, errflg=errflg &
2344 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
2345 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
2346 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
2347 #if ( WRF_CHEM == 1 )
2348 ,WETSCAV_ON=config_flags%wetscav_onoff==1 &
2349 ,EVAPPROD=evapprod,RAINPROD=rainprod &
2350 #endif
2351 )
2352 ELSE
2353 CALL wrf_error_fatal ( 'arguments not present for calling wsm6' )
2354 ENDIF
2356 CASE (WSM6RSCHEME)
2357 CALL wrf_debug ( 100 , 'microphysics_driver: calling wsm6r' )
2358 IF ( PRESENT( QV_CURR ) .AND. PRESENT( QR_CURR ) .AND. &
2359 PRESENT( QC_CURR ) .AND. PRESENT( QS_CURR ) .AND. &
2360 PRESENT( QI_CURR ) .AND. PRESENT( QG_CURR ) .AND. &
2361 PRESENT( RAINNC ) .AND. PRESENT( RAINNCV )) THEN
2362 CALL wsm6r( &
2363 TH=th &
2364 ,Q =qv_curr,Qc=qc_curr,Qi=qi_curr &
2365 ,Qr=qr_curr,Qs=qs_curr,Qg=qg_curr &
2366 ,DEN=rho, PII=pi_phy &
2367 ,P=p &
2368 ,DELZ=dz8w, DELT=dt &
2369 ,RAIN=rainnc,RAINNCV=rainncv &
2370 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
2371 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
2372 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
2373 )
2374 ELSE
2375 CALL wrf_error_fatal ( 'arguments not present for calling wsm6r' )
2376 ENDIF
2378 CASE (WSM7SCHEME)
2379 CALL wrf_debug ( 100 , 'microphysics_driver: calling wsm7' )
2380 IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND. &
2381 PRESENT( QR_CURR ) .AND. PRESENT ( QI_CURR ) .AND. &
2382 PRESENT( QS_CURR ) .AND. PRESENT ( QG_CURR ) .AND. &
2383 PRESENT( QH_CURR ) .AND. &
2384 PRESENT( RAINNC ) .AND. PRESENT ( RAINNCV ) ) THEN
2385 CALL wsm7( &
2386 TH=th &
2387 ,Q=qv_curr &
2388 ,QC=qc_curr &
2389 ,QR=qr_curr &
2390 ,QI=qi_curr &
2391 ,QS=qs_curr &
2392 ,QG=qg_curr &
2393 ,QH=qh_curr &
2394 ,DEN=rho,PII=pi_phy,P=p,DELZ=dz8w &
2395 ,DELT=dt,G=g,CPD=cp,CPV=cpv &
2396 ,RD=r_d,RV=r_v,T0C=svpt0 &
2397 ,EP1=ep_1, EP2=ep_2, QMIN=epsilon &
2398 ,XLS=xls, XLV0=xlv, XLF0=xlf &
2399 ,DEN0=rhoair0, DENR=rhowater &
2400 ,CLIQ=cliq,CICE=cice,PSAT=psat &
2401 ,RAIN=rainnc ,RAINNCV=rainncv &
2402 ,SNOW=snownc ,SNOWNCV=snowncv &
2403 ,SR=sr &
2404 ,REFL_10CM=refl_10cm & ! added for radar reflectivity
2405 ,diagflag=diagflag & ! added for radar reflectivity
2406 ,do_radar_ref=do_radar_ref & ! added for radar reflectivity
2407 ,GRAUPEL=graupelnc ,GRAUPELNCV=graupelncv &
2408 ,HAIL=hailnc ,HAILNCV=hailncv &
2409 ,has_reqc=has_reqc & ! for radiation +
2410 ,has_reqi=has_reqi &
2411 ,has_reqs=has_reqs &
2412 ,re_cloud=re_cloud &
2413 ,re_ice=re_ice &
2414 ,re_snow=re_snow & ! for radiation -
2415 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
2416 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
2417 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
2418 )
2419 ELSE
2420 CALL wrf_error_fatal ( 'arguments not present for calling wsm7' )
2421 ENDIF
2423 CASE (WDM5SCHEME)
2424 CALL wrf_debug ( 100 , 'microphysics_driver: calling wdm5' )
2425 IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND. &
2426 PRESENT( QR_CURR ) .AND. PRESENT ( QI_CURR ) .AND. &
2427 PRESENT( QS_CURR ) .AND. PRESENT( QNN_CURR ) .AND. &
2428 PRESENT ( QNC_CURR ) .AND. PRESENT( QNR_CURR ).AND. &
2429 PRESENT( RAINNC ) .AND. PRESENT ( RAINNCV ) ) THEN
2430 CALL wdm5( &
2431 TH=th &
2432 ,Q=qv_curr &
2433 ,QC=qc_curr &
2434 ,QR=qr_curr &
2435 ,QI=qi_curr &
2436 ,QS=qs_curr &
2437 ,NN=qnn_curr &
2438 ,NC=qnc_curr &
2439 ,NR=qnr_curr &
2440 ,DEN=rho,PII=pi_phy,P=p,DELZ=dz8w &
2441 ,DELT=dt,G=g,CPD=cp,CPV=cpv,CCN0=ccn_conc & ! RAS
2442 ,RD=r_d,RV=r_v,T0C=svpt0 &
2443 ,EP1=ep_1, EP2=ep_2, QMIN=epsilon &
2444 ,XLS=xls, XLV0=xlv, XLF0=xlf &
2445 ,DEN0=rhoair0, DENR=rhowater &
2446 ,CLIQ=cliq,CICE=cice,PSAT=psat &
2447 ,RAIN=rainnc ,RAINNCV=rainncv &
2448 ,SNOW=snownc ,SNOWNCV=snowncv &
2449 ,SR=sr &
2450 ,REFL_10CM=refl_10cm & ! added for radar reflectivity
2451 ,diagflag=diagflag & ! added for radar reflectivity
2452 ,do_radar_ref=do_radar_ref & ! added for radar reflectivity
2453 ,has_reqc=has_reqc & ! for radiation +
2454 ,has_reqi=has_reqi &
2455 ,has_reqs=has_reqs &
2456 ,re_cloud=re_cloud &
2457 ,re_ice=re_ice &
2458 ,re_snow=re_snow & ! for radiation -
2459 ,ITIMESTEP=itimestep &
2460 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
2461 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
2462 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
2463 )
2464 ELSE
2465 CALL wrf_error_fatal ( 'arguments not present for calling wdm5')
2466 ENDIF
2468 CASE (WDM6SCHEME)
2469 CALL wrf_debug ( 100 , 'microphysics_driver: calling wdm6' )
2470 IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND. &
2471 PRESENT( QR_CURR ) .AND. PRESENT ( QI_CURR ) .AND. &
2472 PRESENT( QS_CURR ) .AND. PRESENT ( QG_CURR ) .AND. &
2473 PRESENT( QNN_CURR ) .AND. PRESENT ( QNC_CURR ) .AND. &
2474 PRESENT( QNR_CURR ).AND. &
2475 PRESENT( RAINNC ) .AND. PRESENT ( RAINNCV ) ) THEN
2476 CALL wdm6( &
2477 TH=th &
2478 ,Q=qv_curr &
2479 ,QC=qc_curr &
2480 ,QR=qr_curr &
2481 ,QI=qi_curr &
2482 ,QS=qs_curr &
2483 ,QG=qg_curr &
2484 ,NN=qnn_curr &
2485 ,NC=qnc_curr &
2486 ,NR=qnr_curr &
2487 ,DEN=rho,PII=pi_phy,P=p,DELZ=dz8w &
2488 ,DELT=dt,G=g,CPD=cp,CPV=cpv,CCN0=ccn_conc & ! RAS
2489 ,RD=r_d,RV=r_v,T0C=svpt0 &
2490 ,EP1=ep_1, EP2=ep_2, QMIN=epsilon &
2491 ,XLS=xls, XLV0=xlv, XLF0=xlf &
2492 ,DEN0=rhoair0, DENR=rhowater &
2493 ,CLIQ=cliq,CICE=cice,PSAT=psat &
2494 ,xland=xland & ! land mask, 1: land, 2: water
2495 ,RAIN=rainnc ,RAINNCV=rainncv &
2496 ,SNOW=snownc ,SNOWNCV=snowncv &
2497 ,SR=sr &
2498 ,REFL_10CM=refl_10cm & ! added for radar reflectivity
2499 ,diagflag=diagflag & ! added for radar reflectivity
2500 ,do_radar_ref=do_radar_ref & ! added for radar reflectivity
2501 ,GRAUPEL=graupelnc ,GRAUPELNCV=graupelncv &
2502 ,ITIMESTEP=itimestep &
2503 ,has_reqc=has_reqc & ! for radiation +
2504 ,has_reqi=has_reqi &
2505 ,has_reqs=has_reqs &
2506 ,re_cloud=re_cloud &
2507 ,re_ice=re_ice &
2508 ,re_snow=re_snow & ! for radiation -
2509 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
2510 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
2511 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
2512 )
2513 ELSE
2514 CALL wrf_error_fatal ( 'arguments not present for calling wdm6')
2515 ENDIF
2517 CASE (WDM7SCHEME)
2518 CALL wrf_debug ( 100 , 'microphysics_driver: calling wdm7' )
2519 IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND. &
2520 PRESENT( QR_CURR ) .AND. PRESENT ( QI_CURR ) .AND. &
2521 PRESENT( QS_CURR ) .AND. PRESENT ( QG_CURR ) .AND. &
2522 PRESENT( QH_CURR ) .AND. &
2523 PRESENT( QNN_CURR ) .AND. PRESENT ( QNC_CURR ) .AND. &
2524 PRESENT( QNR_CURR ).AND. &
2525 PRESENT( RAINNC ) .AND. PRESENT ( RAINNCV ) ) THEN
2526 CALL wdm7( &
2527 TH=th &
2528 ,Q=qv_curr &
2529 ,QC=qc_curr &
2530 ,QR=qr_curr &
2531 ,QI=qi_curr &
2532 ,QS=qs_curr &
2533 ,QG=qg_curr &
2534 ,QH=qh_curr &
2535 ,NN=qnn_curr &
2536 ,NC=qnc_curr &
2537 ,NR=qnr_curr &
2538 ,DEN=rho,PII=pi_phy,P=p,DELZ=dz8w &
2539 ,DELT=dt,G=g,CPD=cp,CPV=cpv,CCN0=ccn_conc & ! RAS
2540 ,RD=r_d,RV=r_v,T0C=svpt0 &
2541 ,EP1=ep_1, EP2=ep_2, QMIN=epsilon &
2542 ,XLS=xls, XLV0=xlv, XLF0=xlf &
2543 ,DEN0=rhoair0, DENR=rhowater &
2544 ,CLIQ=cliq,CICE=cice,PSAT=psat &
2545 ,xland=xland & ! land mask, 1: land, 2: water
2546 ,RAIN=rainnc ,RAINNCV=rainncv &
2547 ,SNOW=snownc ,SNOWNCV=snowncv &
2548 ,SR=sr &
2549 ,REFL_10CM=refl_10cm & ! added for radar reflectivity
2550 ,diagflag=diagflag & ! added for radar reflectivity
2551 ,do_radar_ref=do_radar_ref & ! added for radar reflectivity
2552 ,GRAUPEL=graupelnc ,GRAUPELNCV=graupelncv &
2553 ,HAIL=hailnc ,HAILNCV=hailncv &
2554 ,ITIMESTEP=itimestep &
2555 ,has_reqc=has_reqc & ! for radiation +
2556 ,has_reqi=has_reqi &
2557 ,has_reqs=has_reqs &
2558 ,re_cloud=re_cloud &
2559 ,re_ice=re_ice &
2560 ,re_snow=re_snow & ! for radiation -
2561 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
2562 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
2563 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
2564 )
2565 ELSE
2566 CALL wrf_error_fatal ( 'arguments not present for calling wdm7')
2567 ENDIF
2569 CASE (ETAMPNEW) !-- Operational 4-km High-Resolution Window (HRW) version
2570 CALL wrf_debug ( 100 , 'microphysics_driver: calling etampnew')
2572 IF ( PRESENT( qv_curr ) .AND. PRESENT( qt_curr ) .AND. &
2573 PRESENT( RAINNC ) .AND. PRESENT ( RAINNCV ) .AND. &
2574 PRESENT( mp_restart_state ) .AND. &
2575 PRESENT( tbpvs_state ) .AND. &
2576 PRESENT( tbpvs0_state ) ) THEN
2577 CALL ETAMP_NEW( &
2578 ITIMESTEP=itimestep,DT=dt,DX=dx,DY=dy &
2579 ,DZ8W=dz8w,RHO_PHY=rho,P_PHY=p,PI_PHY=pi_phy,TH_PHY=th &
2580 ,QV=qv_curr &
2581 ,QC=qc_curr &
2582 ,QS=qs_curr &
2583 ,QR=qr_curr &
2584 ,QT=qt_curr &
2585 ,LOWLYR=LOWLYR,SR=SR &
2586 ,F_ICE_PHY=F_ICE_PHY,F_RAIN_PHY=F_RAIN_PHY &
2587 ,F_RIMEF_PHY=F_RIMEF_PHY &
2588 ,RAINNC=rainnc,RAINNCV=rainncv &
2589 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
2590 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
2591 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
2592 ,MP_RESTART_STATE=mp_restart_state &
2593 ,TBPVS_STATE=tbpvs_state,TBPVS0_STATE=tbpvs0_state &
2594 )
2595 ELSE
2596 CALL wrf_error_fatal ( 'arguments not present for calling etampnew' )
2597 ENDIF
2598 CASE (FER_MP_HIRES) !-- Operational Ferrier-Aligo High-Resolution Window(HRW) version
2599 ! (2014/2 version) added by Weiguo Wang on
2600 ! 2014-11-19
2601 CALL wrf_debug ( 100 , 'microphysics_driver: calling etampnew')
2603 IF ( PRESENT( qv_curr ) .AND. PRESENT( qt_curr ) .AND. &
2604 PRESENT( RAINNC ) .AND. PRESENT ( RAINNCV ) .AND. &
2605 PRESENT( mp_restart_state ) .AND. &
2606 PRESENT( tbpvs_state ) .AND. &
2607 PRESENT( tbpvs0_state ) ) THEN
2609 ! write(0,*)',f_qv,f_qc,f_qr,f_qi,f_qs,f_qg',f_qv,f_qc,f_qr,f_qi,f_qs,f_qg
2610 ! write(0,*)'max qi=',maxval(qi_curr(its:ite,kts:kte,jts:jte))
2611 ! write(0,*)'max qs=',maxval(qs_curr(its:ite,kts:kte,jts:jte))
2613 CALL FER_HIRES( &
2614 ITIMESTEP=itimestep,DT=dt,DX=dx,DY=dy, GID=id &
2615 ,RAINNC=rainnc,RAINNCV=rainncv &
2616 ,DZ8W=dz8w,RHO_PHY=rho,P_PHY=p,PI_PHY=pi_phy,TH_PHY=th &
2617 ,QV=qv_curr &
2618 ,QT=qt_curr &
2619 ,LOWLYR=LOWLYR,SR=SR &
2620 ,F_ICE_PHY=F_ICE_PHY,F_RAIN_PHY=F_RAIN_PHY &
2621 ,F_RIMEF_PHY=F_RIMEF_PHY &
2622 ,QC=qc_curr,QR=Qr_curr,QI=Qi_curr &
2623 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
2624 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
2625 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
2626 )
2627 ELSE
2628 CALL wrf_error_fatal ( 'arguments not present for calling fer_hires' )
2629 ENDIF
2631 CASE (FER_MP_HIRES_ADVECT) !-- Operational Ferrier-Aligo High-Resolution Window(HRW) version
2632 ! (2014/2 version) added by Weiguo Wang on
2633 ! 2014-11-19
2634 ! Modified for advection, Sam Trahan, August 2015
2635 CALL wrf_debug ( 100 , 'microphysics_driver: calling etampnew')
2637 IF ( PRESENT( qv_curr ) .AND. PRESENT( qi_curr ) .AND. &
2638 PRESENT( qc_curr ) .and. PRESENT(qrimef_curr) .AND. &
2639 PRESENT( RAINNC ) .AND. PRESENT ( RAINNCV ) .AND. &
2640 PRESENT( mp_restart_state ) .AND. &
2641 PRESENT( tbpvs_state ) .AND. &
2642 PRESENT( tbpvs0_state ) ) THEN
2644 ! write(0,*)',f_qv,f_qc,f_qr,f_qi,f_qs,f_qg',f_qv,f_qc,f_qr,f_qi,f_qs,f_qg
2645 ! write(0,*)'max qi=',maxval(qi_curr(its:ite,kts:kte,jts:jte))
2646 ! write(0,*)'max qs=',maxval(qs_curr(its:ite,kts:kte,jts:jte))
2648 CALL FER_HIRES_ADVECT( &
2649 ITIMESTEP=itimestep,DT=dt,DX=dx,DY=dy, GID=id &
2650 ,RAINNC=rainnc,RAINNCV=rainncv &
2651 ,DZ8W=dz8w,RHO_PHY=rho,P_PHY=p,PI_PHY=pi_phy,TH_PHY=th &
2652 ,QV=qv_curr &
2653 ,LOWLYR=LOWLYR,SR=SR &
2654 ,QC=qc_curr,QR=Qr_curr,QI=Qi_curr,QRIMEF=qrimef_curr &
2655 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
2656 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
2657 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
2658 )
2659 ELSE
2660 CALL wrf_error_fatal ( 'arguments not present for calling fer_hires' )
2661 ENDIF
2663 #if(EM_CORE==1)
2664 CASE (CAMMGMPSCHEME)
2665 CALL wrf_debug ( 100 , 'microphysics_driver: calling CAMMGMPSCHEME')
2666 IF ( PRESENT( z ) .AND. PRESENT( ht ) .AND. &
2667 PRESENT( qs_curr ) .AND. &
2668 PRESENT( qv_curr ) .AND. PRESENT( qc_curr ) .AND. &
2669 PRESENT( qi_curr ) .AND. PRESENT( f_qc ) .AND. &
2670 PRESENT( qr_curr ) .AND. PRESENT( qndrop_curr ) .AND. &
2671 PRESENT( f_qi ) .AND. PRESENT( qnc_curr ) .AND. &
2672 PRESENT( RAINNCV ) .AND. PRESENT( SNOWNCV ) .AND. &
2673 PRESENT( qns_curr ) .AND. PRESENT( qnr_curr ) .AND. &
2674 #if ( WRF_CHEM == 1 )
2675 PRESENT( chem ) .AND. PRESENT(dgnum4D ) .AND. &
2676 PRESENT( dgnumwet4D ) .AND. &
2677 #endif
2678 PRESENT( qni_curr ) .AND. PRESENT( RAINNC ) ) THEN
2679 #if ( WRF_CHEM == 1 )
2680 qv_b4mp(its:ite,kts:kte,jts:jte) = qv_curr(its:ite,kts:kte,jts:jte)
2681 qc_b4mp(its:ite,kts:kte,jts:jte) = qc_curr(its:ite,kts:kte,jts:jte)
2682 qi_b4mp(its:ite,kts:kte,jts:jte) = qi_curr(its:ite,kts:kte,jts:jte)
2683 qs_b4mp(its:ite,kts:kte,jts:jte) = qs_curr(its:ite,kts:kte,jts:jte)
2684 #endif
2686 CALL CAMMGMP(ITIMESTEP=itimestep,DT=dt,P8W=p8w_hyd,P_HYD=p_hyd &
2687 ,T_PHY=t_phy,PI_PHY=pi_phy,Z_AT_W=z_at_w,QFX=qfx &
2688 ,TKE_PBL=tke_pbl,TURBTYPE3D=turbtype3d,SMAW3D=smaw3d &
2689 ,DLF3D=dlf,DLF2_3D=dlf2,RLIQ2D=rliq,Z_SEA_LEVEL=z &
2690 ,KVH3D=exch_h,HT=ht,ALT=alt,ACCUM_MODE=accum_mode &
2691 ,AITKEN_MODE=aitken_mode,COARSE_MODE=coarse_mode &
2692 ,ICWMRSH3D=icwmrsh3d,ICWMRDP3D=icwmrdp3d,SHFRC3D=shfrc3d &
2693 ,CMFMC3D=cmfmc3d,CMFMC2_3D=cmfmc2_3d &
2694 ,CONFIG_FLAGS=config_flags,F_ICE_PHY=f_ice_phy &
2695 ,F_RAIN_PHY=f_rain_phy &
2696 #if ( WRF_CHEM == 1 )
2697 ,DGNUM4D=dgnum4D,DGNUMWET4D=dgnumwet4D &
2698 #endif
2699 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
2700 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
2701 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
2702 !Output variables from CAMMGMP
2703 ,TH=th,CLDFRA_OLD_MP=cldfra_old_mp,CLDFRA_MP=cldfra_mp &
2704 ,CLDFRA_MP_ALL=cldfra_mp_all,lradius=lradius,iradius=iradius &
2705 ,CLDFRAI=cldfrai,CLDFRAL=cldfral &
2706 ,CLDFRA_CONV=cldfra_conv,WSEDL3D=wsedl3d &
2707 ,RAINNC=rainnc,RAINNCV=rainncv,SNOWNC=snownc,SNOWNCV=snowncv &
2708 ,SR=sr,QV_CURR=qv_curr,QC_CURR=qc_curr,QI_CURR=qi_curr &
2709 ,QS_CURR=qs_curr,QR_CURR=qr_curr,NC3D=qnc_curr &
2710 ,NI3D=qni_curr,NS3D=qns_curr,NR3D=qnr_curr,QNDROP=qndrop_curr&
2711 ,RH_OLD_MP=rh_old_mp,LCD_OLD_MP=lcd_old_mp &
2712 #if ( WRF_CHEM == 1 )
2713 ,CHEM=chem &
2714 ,QME3D=qme3d,PRAIN3D=prain3d,NEVAPR3D=nevapr3d &
2715 ,RATE1ORD_CW2PR_ST3D=rate1ord_cw2pr_st3d &
2716 #endif
2717 ,XLAND=XLAND,SNOWH=SNOWH &
2718 )
2719 ELSE
2720 CALL wrf_error_fatal ( 'arguments not present for calling CAMMGMP SCHEME' )
2721 ENDIF
2723 ! Added by Zhuxiao, lscond (simplified Large-scale condensation scheme by Jimy )
2724 #if ( WRFPLUS == 1 )
2725 CASE (LSCONDSCHEME)
2726 CALL wrf_debug ( 100 , 'microphysics_driver: calling lscond' )
2727 IF ( PRESENT( QV_CURR ) .AND. &
2728 PRESENT( RAINNC ) .AND. PRESENT ( RAINNCV )) THEN
2730 CALL lscond( &
2731 TH=th &
2732 ,P=p &
2733 ,QV=qv_curr &
2734 ,RHO=rho, PII=pi_phy, XLV=xlv, CP=cp &
2735 ,EP2=ep_2,SVP1=svp1,SVP2=svp2 &
2736 ,SVP3=svp3,SVPT0=svpt0 &
2737 ,R_V= R_v & ! added
2738 ,DZ8W=dz8w &
2739 ,RAINNC=rainnc,RAINNCV=rainncv &
2740 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
2741 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
2742 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
2743 )
2744 ELSE
2745 CALL wrf_error_fatal ( 'arguments not present for calling lscond' )
2746 ENDIF
2747 #endif
2748 #endif
2750 CASE (MADWRF_MP)
2751 CALL wrf_debug ( 100 , 'microphysics_driver: case MADWRF_MP')
2753 CASE DEFAULT
2755 WRITE( wrf_err_message , * ) 'The microphysics option does not exist: mp_physics = ', mp_physics
2756 CALL wrf_error_fatal ( wrf_err_message )
2758 END SELECT micro_select
2760 ENDDO
2761 !$OMP END PARALLEL DO
2763 #ifdef XEON_OPTIMIZED_WSM5
2764 ENDIF
2765 #endif
2767 ! by ZCX
2768 ! IF ( PRESENT (LWP) ) THEN
2769 ! DO ij = 1 , num_tiles
2770 ! its = i_start(ij)
2771 ! ite = i_end(ij)
2772 ! jts = j_start(ij)
2773 ! jte = j_end(ij)
2774 ! DO j=jts,jte
2775 ! DO i=its,ite
2776 ! lwp(i,j) = 0.0
2777 ! do k=kts,kte
2778 ! lwp(i,j)=lwp(i,j)+qc_curr(i,k,j)*rho(i,k,j)*dz8w(i,k,j)
2779 ! end do
2780 ! ENDDO
2781 ! ENDDO
2782 ! ENDDO
2783 ! ENDIF
2784 ! ZCX
2786 CALL wrf_debug ( 200 , 'microphysics_driver: returning from' )
2788 RETURN
2790 END SUBROUTINE microphysics_driver
2792 subroutine Add_multi_perturb_mp_perturbations (perts_qvapor, perts_qcloud, perts_qice, &
2793 perts_qsnow, perts_ni, pert_thom_qv, pert_thom_qc, pert_thom_qi, pert_thom_qs, &
2794 pert_thom_ni, qv_curr, qc_curr, qi_curr, qs_curr, qni_curr, qv_tmp, qc_tmp, qi_tmp, &
2795 qs_tmp, qni_tmp, its, ite, jts, jte, ims, ime, jms, jme, kms, kme, kts, kte)
2797 implicit none
2799 integer, intent(in) :: its, ite, jts, jte, ims, ime, jms, jme, kms, kme, kts, kte
2800 real, intent(in) :: pert_thom_qv, pert_thom_qc, pert_thom_qi, pert_thom_qs, pert_thom_ni
2801 real, dimension(ims:ime, kms:kme, jms:jme), optional, intent (in) :: perts_qvapor, perts_qcloud, perts_qice, &
2802 perts_qsnow, perts_ni
2803 real, dimension(ims:ime, kms:kme, jms:jme), intent (inout) :: qv_curr, qc_curr, qi_curr, qs_curr, qni_curr
2804 real, dimension (its:ite, kts:kte, jts:jte), intent (out) :: qv_tmp, qc_tmp, qi_tmp, qs_tmp, qni_tmp
2806 integer :: i, j, k
2809 do j = jts, jte
2810 do k = kts, kte
2811 do i = its, ite
2812 qv_tmp(i, k, j) = qv_curr(i, k, j)
2813 qv_curr(i, k, j) = max (QX_MIN, (1.0 + perts_qvapor(i, k, j) * pert_thom_qv) * qv_curr(i, k, j))
2814 qc_tmp(i, k, j) = qc_curr(i, k, j)
2815 qc_curr(i, k, j) = max (QX_MIN, (1.0 + perts_qcloud(i, k, j) * pert_thom_qc) * qc_curr(i, k, j))
2816 qi_tmp(i, k, j) = qi_curr(i, k, j)
2817 qi_curr(i, k, j) = max (QX_MIN, (1.0 + perts_qice(i, k, j) * pert_thom_qi) * qi_curr(i, k, j))
2818 qs_tmp(i, k, j) = qs_curr(i, k, j)
2819 qs_curr(i, k, j) = max (QX_MIN, (1.0 + perts_qsnow(i, k, j) * pert_thom_qs) * qs_curr(i, k, j))
2820 qni_tmp(i, k, j) = qni_curr(i, k, j)
2821 qni_curr(i, k, j) = max (NI_MIN, (1.0 + perts_ni(i, k, j) * pert_thom_ni) * qni_curr(i, k, j))
2822 end do
2823 end do
2824 end do
2826 end subroutine Add_multi_perturb_mp_perturbations
2828 subroutine Remove_multi_perturb_mp_perturbations (perts_qvapor, perts_qcloud, perts_qice, &
2829 perts_qsnow, perts_ni, pert_thom_qv, pert_thom_qc, pert_thom_qi, pert_thom_qs, &
2830 pert_thom_ni, qv_curr, qc_curr, qi_curr, qs_curr, qni_curr, qv_tmp, qc_tmp, qi_tmp, &
2831 qs_tmp, qni_tmp, its, ite, jts, jte, ims, ime, jms, jme, kms, kme, kts, kte)
2833 implicit none
2835 integer, intent(in) :: its, ite, jts, jte, ims, ime, jms, jme, kms, kme, kts, kte
2836 real, intent(in) :: pert_thom_qv, pert_thom_qc, pert_thom_qi, pert_thom_qs, pert_thom_ni
2837 real, dimension(ims:ime, kms:kme, jms:jme), optional, intent (in) :: perts_qvapor, perts_qcloud, perts_qice, &
2838 perts_qsnow, perts_ni
2839 real, dimension(ims:ime, kms:kme, jms:jme), intent (inout) :: qv_curr, qc_curr, qi_curr, qs_curr, qni_curr
2840 real, dimension (its:ite, kts:kte, jts:jte), intent (in) :: qv_tmp, qc_tmp, qi_tmp, qs_tmp, qni_tmp
2842 integer :: i, j, k
2845 do j = jts, jte
2846 do k = kts, kte
2847 do i = its, ite
2848 qv_curr(i, k, j) = max (QX_MIN, qv_curr(i, k, j) - perts_qvapor(i, k, j) * pert_thom_qv * qv_tmp(i, k, j))
2849 qc_curr(i, k, j) = max (QX_MIN, qc_curr(i, k, j) - perts_qcloud(i, k, j) * pert_thom_qc * qc_tmp(i, k, j))
2850 qi_curr(i, k, j) = max (QX_MIN, qi_curr(i, k, j) - perts_qice(i, k, j) * pert_thom_qi * qi_tmp(i, k, j))
2851 qs_curr(i, k, j) = max (QX_MIN, qs_curr(i, k, j) - perts_qsnow(i, k, j) * pert_thom_qs * qs_tmp(i, k, j))
2852 qni_curr(i, k, j) = max (NI_MIN, qni_curr(i, k, j) - perts_ni(i, k, j) * pert_thom_ni * qni_tmp(i, k, j))
2853 end do
2854 end do
2855 end do
2857 end subroutine Remove_multi_perturb_mp_perturbations
2859 END MODULE module_microphysics_driver