module_microphysics_driver.F
References to this file elsewhere.
1 !WRF:MEDIATION_LAYER:PHYSICS
2 ! *** add new modules of schemes here
3 !
4 MODULE module_microphysics_driver
5 CONTAINS
6
7 SUBROUTINE microphysics_driver( &
8 th, rho, pi_phy, p &
9 ,ht, dz8w, p8w, dt,dx,dy &
10 ,mp_physics, spec_zone &
11 ,specified, channel_switch &
12 ,warm_rain &
13 ,t8w &
14 ,chem_opt, progn &
15 ,cldfra, cldfra_old, exch_h, nsource &
16 ,qlsink, precr, preci, precs, precg &
17 ,xland,itimestep &
18 ,f_ice_phy,f_rain_phy,f_rimef_phy &
19 ,lowlyr,sr, id &
20 ,ids,ide, jds,jde, kds,kde &
21 ,ims,ime, jms,jme, kms,kme &
22 ,i_start,i_end,j_start,j_end,kts,kte &
23 ,num_tiles, naer &
24 ,qv_curr,qc_curr,qr_curr,qi_curr,qs_curr,qg_curr &
25 ,qndrop_curr,qni_curr &
26 ,qns_curr,qnr_curr,qng_curr &
27 ,f_qv,f_qc,f_qr,f_qi,f_qs,f_qg,f_qndrop,f_qni &
28 ,f_qns,f_qnr,f_qng &
29 ,qrcuten, qscuten, qicuten, mu &
30 ,qt_curr,f_qt &
31 ,mp_restart_state,tbpvs_state,tbpvs0_state & ! for etampnew
32 ,w ,z &
33 ,rainnc, rainncv &
34 ,snownc, snowncv &
35 ,graupelnc, graupelncv &
36 )
37 ! Framework
38 USE module_state_description, ONLY : &
39 KESSLERSCHEME, LINSCHEME, WSM3SCHEME, WSM5SCHEME &
40 ,WSM6SCHEME, ETAMPNEW, THOMPSON, MORR_TWO_MOMENT
41
42
43 ! Model Layer
44 USE module_model_constants
45 USE module_wrf_error
46
47 ! *** add new modules of schemes here
48
49 USE module_mp_kessler
50 USE module_mp_lin
51 USE module_mp_wsm3
52 USE module_mp_wsm5
53 USE module_mp_wsm6
54 USE module_mp_etanew
55 USE module_mp_thompson
56 USE module_mp_morr_two_moment
57
58 USE module_mixactivate, only: prescribe_aerosol_mixactivate
59
60 !----------------------------------------------------------------------
61 ! This driver calls subroutines for the microphys.
62 !
63 ! Schemes
64 !
65 ! Kessler scheme
66 ! Lin et al. (1983), Rutledge and Hobbs (1984)
67 ! WRF Single-Moment 3-class, Hong, Dudhia and Chen (2004)
68 ! WRF Single-Moment 5-class, Hong, Dudhia and Chen (2004)
69 ! WRF Single-Moment 6-class, Lim and Hong (2003 WRF workshop)
70 ! Eta Grid-scale Cloud and Precipitation scheme (EGCP01, Ferrier)
71 !
72 !----------------------------------------------------------------------
73 IMPLICIT NONE
74 !======================================================================
75 ! Grid structure in physics part of WRF
76 !----------------------------------------------------------------------
77 ! The horizontal velocities used in the physics are unstaggered
78 ! relative to temperature/moisture variables. All predicted
79 ! variables are carried at half levels except w, which is at full
80 ! levels. Some arrays with names (*8w) are at w (full) levels.
81 !
82 !----------------------------------------------------------------------
83 ! In WRF, kms (smallest number) is the bottom level and kme (largest
84 ! number) is the top level. In your scheme, if 1 is at the top level,
85 ! then you have to reverse the order in the k direction.
86 !
87 ! kme - half level (no data at this level)
88 ! kme ----- full level
89 ! kme-1 - half level
90 ! kme-1 ----- full level
91 ! .
92 ! .
93 ! .
94 ! kms+2 - half level
95 ! kms+2 ----- full level
96 ! kms+1 - half level
97 ! kms+1 ----- full level
98 ! kms - half level
99 ! kms ----- full level
100 !
101 !======================================================================
102 ! Definitions
103 !-----------
104 ! Rho_d dry density (kg/m^3)
105 ! Theta_m moist potential temperature (K)
106 ! Qv water vapor mixing ratio (kg/kg)
107 ! Qc cloud water mixing ratio (kg/kg)
108 ! Qr rain water mixing ratio (kg/kg)
109 ! Qi cloud ice mixing ratio (kg/kg)
110 ! Qs snow mixing ratio (kg/kg)
111 ! Qndrop droplet number mixing ratio (#/kg)
112 ! Qni cloud ice number concentration (#/kg)
113 ! Qns snow number concentration (#/kg),
114 ! Qnr rain number concentration (#/kg),
115 ! Qng graupel number concentration (#/kg),
116
117 !
118 !----------------------------------------------------------------------
119 !-- th potential temperature (K)
120 !-- moist_new updated moisture array (kg/kg)
121 !-- moist_old Old moisture array (kg/kg)
122 !-- rho density of air (kg/m^3)
123 !-- pi_phy exner function (dimensionless)
124 !-- p pressure (Pa)
125 !-- RAINNC grid scale precipitation (mm)
126 !-- RAINNCV one time step grid scale precipitation (mm/step)
127 !-- SNOWNC grid scale snow and ice (mm)
128 !-- SNOWNCV one time step grid scale snow and ice (mm/step)
129 !-- GRAUPELNC grid scale graupel (mm)
130 !-- GRAUPELNCV one time step grid scale graupel (mm/step)
131 !-- SR one time step mass ratio of snow to total precip
132 !-- z Height above sea level (m)
133 !-- dt Time step (s)
134 !-- G acceleration due to gravity (m/s^2)
135 !-- CP heat capacity at constant pressure for dry air (J/kg/K)
136 !-- R_d gas constant for dry air (J/kg/K)
137 !-- R_v gas constant for water vapor (J/kg/K)
138 !-- XLS latent heat of sublimation (J/kg)
139 !-- XLV latent heat of vaporization (J/kg)
140 !-- XLF latent heat of melting (J/kg)
141 !-- rhowater water density (kg/m^3)
142 !-- rhosnow snow density (kg/m^3)
143 !-- F_ICE_PHY Fraction of ice.
144 !-- F_RAIN_PHY Fraction of rain.
145 !-- F_RIMEF_PHY Mass ratio of rimed ice (rime factor)
146 !-- t8w temperature at layer interfaces
147 !-- cldfra, cldfra_old, current, previous cloud fraction
148 !-- exch_h vertical diffusivity (m2/s)
149 !-- qlsink Fractional cloud water sink (/s)
150 !-- precr rain precipitation rate at all levels (kg/m2/s)
151 !-- preci ice precipitation rate at all levels (kg/m2/s)
152 !-- precs snow precipitation rate at all levels (kg/m2/s)
153 !-- precg graupel precipitation rate at all levels (kg/m2/s) &
154 !-- P_QV species index for water vapor
155 !-- P_QC species index for cloud water
156 !-- P_QR species index for rain water
157 !-- P_QI species index for cloud ice
158 !-- P_QS species index for snow
159 !-- P_QG species index for graupel
160 !-- P_QNDROP species index for cloud drop mixing ratio
161 !-- P_QNI species index for cloud ice number concentration
162 !-- P_QNS species index for snow number concentration,
163 !-- P_QNR species index for rain number concentration,
164 !-- P_QNG species index for graupel number concentration,
165 !-- id grid id number
166 !-- ids start index for i in domain
167 !-- ide end index for i in domain
168 !-- jds start index for j in domain
169 !-- jde end index for j in domain
170 !-- kds start index for k in domain
171 !-- kde end index for k in domain
172 !-- ims start index for i in memory
173 !-- ime end index for i in memory
174 !-- jms start index for j in memory
175 !-- jme end index for j in memory
176 !-- kms start index for k in memory
177 !-- kme end index for k in memory
178 !-- i_start start indices for i in tile
179 !-- i_end end indices for i in tile
180 !-- j_start start indices for j in tile
181 !-- j_end end indices for j in tile
182 !-- its start index for i in tile
183 !-- ite end index for i in tile
184 !-- jts start index for j in tile
185 !-- jte end index for j in tile
186 !-- kts start index for k in tile
187 !-- kte end index for k in tile
188 !-- num_tiles number of tiles
189 !
190 !======================================================================
191
192 INTEGER, INTENT(IN ) :: mp_physics
193 LOGICAL, INTENT(IN ) :: specified
194 INTEGER, OPTIONAL, INTENT(IN ) :: chem_opt, progn
195 !
196 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
197 INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
198 INTEGER, INTENT(IN ) :: kts,kte
199 INTEGER, INTENT(IN ) :: itimestep,num_tiles,spec_zone
200 INTEGER, DIMENSION(num_tiles), INTENT(IN) :: &
201 & i_start,i_end,j_start,j_end
202
203 LOGICAL, INTENT(IN ) :: warm_rain
204 !
205 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), &
206 INTENT(INOUT) :: th
207 !
208
209 !
210 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), &
211 INTENT(IN ) :: &
212 rho, &
213 dz8w, &
214 p8w, &
215 pi_phy, &
216 p
217
218
219 REAL, INTENT(INOUT), DIMENSION(ims:ime, kms:kme, jms:jme ) :: &
220 F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY
221 !!$#ifdef WRF_CHEM
222 ! REAL, INTENT(OUT), DIMENSION(ims:ime, kms:kme, jms:jme ) :: &
223 REAL, OPTIONAL, INTENT(OUT), DIMENSION(ims:ime, kms:kme, jms:jme ) :: &
224 !!$#else
225 !!$ REAL, DIMENSION(ims:ime, kms:kme, jms:jme ) :: &
226 !!$#endif
227 qlsink, & ! cloud water sink (/s)
228 precr, & ! rain precipitation rate at all levels (kg/m2/s)
229 preci, & ! ice precipitation rate at all levels (kg/m2/s)
230 precs, & ! snow precipitation rate at all levels (kg/m2/s)
231 precg ! graupel precipitation rate at all levels (kg/m2/s)
232
233 !
234
235 REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN) :: XLAND
236
237 REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(OUT) :: SR
238
239 REAL, INTENT(IN ) :: dt,dx,dy
240
241 INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT) :: LOWLYR
242
243 !
244 ! Optional
245 !
246 LOGICAL, OPTIONAL, INTENT(IN ) :: channel_switch
247 REAL, OPTIONAL, INTENT(INOUT ) :: naer ! aerosol number concentration (/kg)
248 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
249 OPTIONAL, &
250 INTENT(INOUT ) :: &
251 w, z, t8w &
252 ,cldfra, cldfra_old, exch_h &
253 ,qv_curr,qc_curr,qr_curr,qi_curr,qs_curr,qg_curr &
254 ,qt_curr,qndrop_curr,qni_curr &
255 ,qns_curr,qnr_curr,qng_curr
256
257 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
258 OPTIONAL, &
259 INTENT(IN) :: qrcuten, qscuten, qicuten
260 REAL, DIMENSION( ims:ime, jms:jme ), &
261 OPTIONAL, &
262 INTENT(IN) :: mu
263
264
265 REAL, DIMENSION(ims:ime, kms:kme, jms:jme ), &
266 OPTIONAL, &
267 INTENT(OUT ) :: &
268 nsource
269
270 !
271 REAL, DIMENSION( ims:ime , jms:jme ), &
272 INTENT(INOUT), &
273 OPTIONAL :: &
274 RAINNC &
275 ,RAINNCV &
276 ,SNOWNC &
277 ,SNOWNCV &
278 ,GRAUPELNC &
279 ,GRAUPELNCV
280 INTEGER,OPTIONAL,INTENT(IN ) :: id
281
282 REAL , DIMENSION( ims:ime , jms:jme ) , OPTIONAL , &
283 INTENT(IN) :: ht
284
285 REAL, DIMENSION (:), OPTIONAL, INTENT(INOUT) :: mp_restart_state &
286 ,tbpvs_state,tbpvs0_state
287 !
288
289 LOGICAL, OPTIONAL :: f_qv,f_qc,f_qr,f_qi,f_qs,f_qg,f_qndrop,f_qni,f_qt &
290 ,f_qns,f_qnr,f_qng
291
292 ! LOCAL VAR
293
294 INTEGER :: i,j,k,its,ite,jts,jte,ij,sz,n
295 LOGICAL :: channel
296
297 !---------------------------------------------------------------------
298 ! check for microphysics type. We need a clean way to
299 ! specify these things!
300 !---------------------------------------------------------------------
301
302 channel = .FALSE.
303 IF ( PRESENT ( channel_switch ) ) channel = channel_switch
304
305 if (mp_physics .eq. 0) return
306 IF( specified ) THEN
307 sz = spec_zone
308 ELSE
309 sz = 0
310 ENDIF
311
312 !$OMP PARALLEL DO &
313 !$OMP PRIVATE ( ij, its, ite, jts, jte, i,j,k,n )
314
315 DO ij = 1 , num_tiles
316
317 IF (channel) THEN
318 its = max(i_start(ij),ids)
319 ite = min(i_end(ij),ide-1)
320 ELSE
321 its = max(i_start(ij),ids+sz)
322 ite = min(i_end(ij),ide-1-sz)
323 ENDIF
324 jts = max(j_start(ij),jds+sz)
325 jte = min(j_end(ij),jde-1-sz)
326
327 IF( PRESENT(qlsink) ) qlsink(its:ite,kts:kte,jts:jte) = 0.
328
329 !-----------
330 IF( PRESENT(chem_opt) .AND. PRESENT(progn) ) THEN
331 IF( chem_opt==0 .AND. progn==1 .AND. mp_physics==LINSCHEME ) THEN
332 IF( PRESENT( QNDROP_CURR ) ) THEN
333 CALL wrf_debug ( 100 , 'microphysics_driver: calling prescribe_aerosol_mixactivate' )
334 ! 06-nov-2005 rce - id & itimestep added to arg list
335 call prescribe_aerosol_mixactivate ( &
336 id, itimestep, dt, naer, &
337 rho, th, pi_phy, w, cldfra, cldfra_old, &
338 z, dz8w, p8w, t8w, exch_h, &
339 qv_curr, qc_curr, qi_curr, qndrop_curr, &
340 nsource, &
341 ids,ide, jds,jde, kds,kde, &
342 ims,ime, jms,jme, kms,kme, &
343 its,ite, jts,jte, kts,kte, &
344 F_QC=f_qc, F_QI=f_qi )
345 END IF
346 ELSE IF( progn==1 .AND. mp_physics/=LINSCHEME ) THEN
347 call wrf_error_fatal("SETTINGS ERROR: Prognostic cloud droplet number can only be used with the mp_physics=LINSCHEME.")
348 END IF
349 END IF
350
351 micro_select: SELECT CASE(mp_physics)
352
353 CASE (KESSLERSCHEME)
354 CALL wrf_debug ( 100 , 'microphysics_driver: calling kessler' )
355 IF ( PRESENT( QV_CURR ) .AND. PRESENT( QC_CURR ) .AND. &
356 PRESENT( QR_CURR ) .AND. &
357 PRESENT( RAINNC ) .AND. PRESENT ( RAINNCV ) .AND. &
358 PRESENT( Z )) THEN
359 CALL kessler( &
360 T=th &
361 ,QV=qv_curr &
362 ,QC=qc_curr &
363 ,QR=qr_curr &
364 ,RHO=rho, PII=pi_phy,DT_IN=dt, Z=z, XLV=xlv, CP=cp &
365 ,EP2=ep_2,SVP1=svp1,SVP2=svp2 &
366 ,SVP3=svp3,SVPT0=svpt0,RHOWATER=rhowater &
367 ,DZ8W=dz8w &
368 ,RAINNC=rainnc,RAINNCV=rainncv &
369 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
370 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
371 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
372 )
373 ELSE
374 CALL wrf_error_fatal ( 'arguments not present for calling kessler' )
375 ENDIF
376
377 !
378 CASE (THOMPSON)
379 CALL wrf_debug ( 100 , 'microphysics_driver: calling thompson et al' )
380 IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND. &
381 PRESENT( QR_CURR ) .AND. PRESENT ( QI_CURR ) .AND. &
382 PRESENT( QS_CURR ) .AND. PRESENT ( QG_CURR ) .AND. &
383 PRESENT ( QNI_CURR ).AND. &
384 PRESENT( RAINNC ) .AND. PRESENT ( RAINNCV ) ) THEN
385 CALL mp_gt_driver( &
386 QV=qv_curr, &
387 QC=qc_curr, &
388 QR=qr_curr, &
389 QI=qi_curr, &
390 QS=qs_curr, &
391 QG=qg_curr, &
392 NI=qni_curr, &
393 TH=th, &
394 PII=pi_phy, &
395 P=p, &
396 DZ=dz8w, &
397 DT_IN=dt, &
398 ITIMESTEP=itimestep, &
399 RAINNC=RAINNC, &
400 RAINNCV=RAINNCV, &
401 SR=SR &
402 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
403 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
404 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte)
405 ELSE
406 CALL wrf_error_fatal ( 'arguments not present for calling thompson_et_al' )
407 ENDIF
408 !
409
410 CASE (MORR_TWO_MOMENT)
411 CALL wrf_debug(100, 'microphysics_driver: calling morrison two moment')
412 IF (PRESENT (QV_CURR) .AND. PRESENT (QC_CURR) .AND. &
413 PRESENT (QR_CURR) .AND. PRESENT (QI_CURR) .AND. &
414 PRESENT (QS_CURR) .AND. PRESENT (QG_CURR) .AND. &
415 PRESENT (QR_CURR) .AND. PRESENT (QI_CURR) .AND. &
416 PRESENT (QNS_CURR) .AND. PRESENT (QNI_CURR).AND. &
417 PRESENT (QNR_CURR) .AND. PRESENT (QNG_CURR).AND. &
418 PRESENT (MU) .AND. PRESENT (QSCUTEN).AND. &
419 PRESENT (QRCUTEN) .AND. PRESENT (QICUTEN).AND. &
420 PRESENT (RAINNC ) .AND. PRESENT (RAINNCV) .AND. &
421 PRESENT (Z ) .AND.PRESENT ( W ) ) THEN
422 CALL mp_morr_two_moment( &
423 ITIMESTEP=itimestep, & !*
424 TH=th, & !*
425 QV=qv_curr, & !*
426 QC=qc_curr, & !*
427 QR=qr_curr, & !*
428 QI=qi_curr, & !*
429 QS=qs_curr, & !*
430 QG=qg_curr, & !*
431 NI=qni_curr, & !*
432 NS=qns_curr, & !* ! VVT
433 NR=qnr_curr, & !* ! VVT
434 NG=qng_curr, & !* ! VVT
435 RHO=rho, & !*
436 PII=pi_phy, & !*
437 P=p, & !*
438 DT_IN=dt, & !*
439 DZ=dz8w, & !* !hm
440 HT=ht, & !*
441 W=w & !*
442 ,RAINNC=RAINNC & !*
443 ,RAINNCV=RAINNCV & !*
444 ,SR=SR & !* !hm
445 ,qrcuten=qrcuten & ! hm
446 ,qscuten=qscuten & ! hm
447 ,qicuten=qicuten & ! hm
448 ,mu=mu & ! hm
449 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
450 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
451 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
452 )
453 ELSE
454 Call wrf_error_fatal( 'arguments not present for calling morrison two moment')
455 ENDIF
456
457 !
458
459 CASE (LINSCHEME)
460 CALL wrf_debug ( 100 , 'microphysics_driver: calling lin_et_al' )
461 IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND. &
462 PRESENT( QR_CURR ) .AND. PRESENT ( QI_CURR ) .AND. &
463 PRESENT( QS_CURR ) .AND. &
464 PRESENT( RAINNC ) .AND. PRESENT ( RAINNCV ) .AND. &
465 PRESENT( Z ) ) THEN
466 CALL lin_et_al( &
467 TH=th &
468 ,QV=qv_curr &
469 ,QL=qc_curr &
470 ,QR=qr_curr &
471 ,QI=qi_curr &
472 ,QS=qs_curr &
473 ,QLSINK=qlsink &
474 ,RHO=rho, PII=pi_phy, P=p, DT_IN=dt, Z=z &
475 ,HT=ht, DZ8W=dz8w, GRAV=G, CP=cp &
476 ,RAIR=r_d, RVAPOR=R_v &
477 ,XLS=xls, XLV=xlv, XLF=xlf &
478 ,RHOWATER=rhowater, RHOSNOW=rhosnow &
479 ,EP2=ep_2,SVP1=svp1,SVP2=svp2 &
480 ,SVP3=svp3,SVPT0=svpt0 &
481 ,RAINNC=rainnc, RAINNCV=rainncv &
482 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
483 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
484 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
485 ,PRECR=precr,PRECI=preci,PRECS=precs,PRECG=precg &
486 ,F_QG=f_qg, F_QNDROP=f_qndrop &
487 ,QG=qg_curr &
488 ,QNDROP=qndrop_curr &
489 )
490 ELSE
491 CALL wrf_error_fatal ( 'arguments not present for calling lin_et_al' )
492 ENDIF
493
494 CASE (WSM3SCHEME)
495 CALL wrf_debug ( 100 , 'microphysics_driver: calling wsm3' )
496 IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND. &
497 PRESENT( QR_CURR ) .AND. &
498 PRESENT( RAINNC ) .AND. PRESENT ( RAINNCV ) .AND. &
499 PRESENT( W ) ) THEN
500 CALL wsm3( &
501 TH=th &
502 ,Q=qv_curr &
503 ,QCI=qc_curr &
504 ,QRS=qr_curr &
505 ,W=w,DEN=rho,PII=pi_phy,P=p,DELZ=dz8w &
506 ,DELT=dt,G=g,CPD=cp,CPV=cpv &
507 ,RD=r_d,RV=r_v,T0C=svpt0 &
508 ,EP1=ep_1, EP2=ep_2, QMIN=epsilon &
509 ,XLS=xls, XLV0=xlv, XLF0=xlf &
510 ,DEN0=rhoair0, DENR=rhowater &
511 ,CLIQ=cliq,CICE=cice,PSAT=psat &
512 ,RAIN=rainnc ,RAINNCV=rainncv &
513 ,SNOW=snownc ,SNOWNCV=snowncv &
514 ,SR=sr &
515 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
516 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
517 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
518 )
519 ELSE
520 CALL wrf_error_fatal ( 'arguments not present for calling wsm3' )
521 ENDIF
522
523 CASE (WSM5SCHEME)
524 CALL wrf_debug ( 100 , 'microphysics_driver: calling wsm5' )
525 IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND. &
526 PRESENT( QR_CURR ) .AND. PRESENT ( QI_CURR ) .AND. &
527 PRESENT( QS_CURR ) .AND. &
528 PRESENT( RAINNC ) .AND. PRESENT ( RAINNCV ) ) THEN
529 CALL wsm5( &
530 TH=th &
531 ,Q=qv_curr &
532 ,QC=qc_curr &
533 ,QR=qr_curr &
534 ,QI=qi_curr &
535 ,QS=qs_curr &
536 ,DEN=rho,PII=pi_phy,P=p,DELZ=dz8w &
537 ,DELT=dt,G=g,CPD=cp,CPV=cpv &
538 ,RD=r_d,RV=r_v,T0C=svpt0 &
539 ,EP1=ep_1, EP2=ep_2, QMIN=epsilon &
540 ,XLS=xls, XLV0=xlv, XLF0=xlf &
541 ,DEN0=rhoair0, DENR=rhowater &
542 ,CLIQ=cliq,CICE=cice,PSAT=psat &
543 ,RAIN=rainnc ,RAINNCV=rainncv &
544 ,SNOW=snownc ,SNOWNCV=snowncv &
545 ,SR=sr &
546 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
547 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
548 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
549 )
550 ELSE
551 CALL wrf_error_fatal ( 'arguments not present for calling wsm5' )
552 ENDIF
553
554 CASE (WSM6SCHEME)
555 CALL wrf_debug ( 100 , 'microphysics_driver: calling wsm6' )
556 IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND. &
557 PRESENT( QR_CURR ) .AND. PRESENT ( QI_CURR ) .AND. &
558 PRESENT( QS_CURR ) .AND. PRESENT ( QG_CURR ) .AND. &
559 PRESENT( RAINNC ) .AND. PRESENT ( RAINNCV ) ) THEN
560 CALL wsm6( &
561 TH=th &
562 ,Q=qv_curr &
563 ,QC=qc_curr &
564 ,QR=qr_curr &
565 ,QI=qi_curr &
566 ,QS=qs_curr &
567 ,QG=qg_curr &
568 ,DEN=rho,PII=pi_phy,P=p,DELZ=dz8w &
569 ,DELT=dt,G=g,CPD=cp,CPV=cpv &
570 ,RD=r_d,RV=r_v,T0C=svpt0 &
571 ,EP1=ep_1, EP2=ep_2, QMIN=epsilon &
572 ,XLS=xls, XLV0=xlv, XLF0=xlf &
573 ,DEN0=rhoair0, DENR=rhowater &
574 ,CLIQ=cliq,CICE=cice,PSAT=psat &
575 ,RAIN=rainnc ,RAINNCV=rainncv &
576 ,SNOW=snownc ,SNOWNCV=snowncv &
577 ,SR=sr &
578 ,GRAUPEL=graupelnc ,GRAUPELNCV=graupelncv &
579 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
580 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
581 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
582 )
583 ELSE
584 CALL wrf_error_fatal ( 'arguments not present for calling wsm6' )
585 ENDIF
586
587 CASE (ETAMPNEW)
588 CALL wrf_debug ( 100 , 'microphysics_driver: calling etampnew')
589
590 IF ( PRESENT( qv_curr ) .AND. PRESENT( qt_curr ) .AND. &
591 PRESENT( RAINNC ) .AND. PRESENT ( RAINNCV ) .AND. &
592 PRESENT( mp_restart_state ) .AND. &
593 PRESENT( tbpvs_state ) .AND. &
594 PRESENT( tbpvs0_state ) ) THEN
595 CALL ETAMP_NEW( &
596 ITIMESTEP=itimestep,DT=dt,DX=dx,DY=dy &
597 ,DZ8W=dz8w,RHO_PHY=rho,P_PHY=p,PI_PHY=pi_phy,TH_PHY=th &
598 ,QV=qv_curr &
599 ,QC=qc_curr &
600 ,QS=qs_curr &
601 ,QR=qr_curr &
602 ,QT=qt_curr &
603 ,LOWLYR=LOWLYR,SR=SR &
604 ,F_ICE_PHY=F_ICE_PHY,F_RAIN_PHY=F_RAIN_PHY &
605 ,F_RIMEF_PHY=F_RIMEF_PHY &
606 ,RAINNC=rainnc,RAINNCV=rainncv &
607 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
608 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
609 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
610 ,MP_RESTART_STATE=mp_restart_state &
611 ,TBPVS_STATE=tbpvs_state,TBPVS0_STATE=tbpvs0_state &
612 )
613 ELSE
614 CALL wrf_error_fatal ( 'arguments not present for calling etampnew' )
615 ENDIF
616
617
618 CASE DEFAULT
619
620 WRITE( wrf_err_message , * ) 'The microphysics option does not exist: mp_physics = ', mp_physics
621 CALL wrf_error_fatal ( wrf_err_message )
622
623 END SELECT micro_select
624
625 ENDDO
626 !$OMP END PARALLEL DO
627
628 CALL wrf_debug ( 200 , 'microphysics_driver: returning from' )
629
630 RETURN
631
632 END SUBROUTINE microphysics_driver
633
634 END MODULE module_microphysics_driver
635