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