| [2759] | 1 | !WRF:MEDIATION_LAYER:PHYSICS |
|---|
| 2 | ! |
|---|
| 3 | |
|---|
| 4 | MODULE module_pbl_driver |
|---|
| 5 | CONTAINS |
|---|
| 6 | |
|---|
| 7 | !------------------------------------------------------------------ |
|---|
| 8 | SUBROUTINE pbl_driver( & |
|---|
| 9 | itimestep,dt,u_frame,v_frame & |
|---|
| 10 | ,bldt,curr_secs,adapt_step_flag & |
|---|
| 11 | ,rublten,rvblten,rthblten & |
|---|
| 12 | ,tsk,xland,znt,ht & |
|---|
| 13 | ,ust,pblh,hfx,qfx,grdflx & |
|---|
| 14 | ,u_phy,v_phy,th_phy,rho & |
|---|
| 15 | ,p_phy,pi_phy,p8w,t_phy,dz8w,z & |
|---|
| 16 | ,tke_myj,el_myj,exch_h,akhs,akms & |
|---|
| 17 | ,thz0,qz0,uz0,vz0,qsfc & |
|---|
| 18 | ,lowlyr,u10,v10 & |
|---|
| 19 | ,psim,psih,gz1oz0, wspd,br,chklowq & |
|---|
| 20 | ,bl_pbl_physics, ra_lw_physics, dx & |
|---|
| 21 | ,stepbl,warm_rain & |
|---|
| 22 | ,kpbl,ct,lh,snow,xice & |
|---|
| 23 | ,znu, znw, mut, p_top & |
|---|
| 24 | ,ids,ide, jds,jde, kds,kde & |
|---|
| 25 | ,ims,ime, jms,jme, kms,kme & |
|---|
| 26 | ,i_start,i_end, j_start,j_end, kts,kte, num_tiles & |
|---|
| 27 | ! Optional |
|---|
| 28 | ,hol, mol, regime & |
|---|
| 29 | ! Optional moisture tracers |
|---|
| 30 | ,qv_curr, qc_curr, qr_curr & |
|---|
| 31 | ,qi_curr, qs_curr, qg_curr & |
|---|
| 32 | ,rqvblten,rqcblten,rqiblten & |
|---|
| 33 | ,rqrblten,rqsblten,rqgblten & |
|---|
| 34 | ! Optional moisture tracer flags |
|---|
| 35 | ,f_qv,f_qc,f_qr & |
|---|
| 36 | ,f_qi,f_qs,f_qg & |
|---|
| 37 | ) |
|---|
| 38 | !------------------------------------------------------------------ |
|---|
| 39 | USE module_state_description, ONLY : & |
|---|
| 40 | YSUSCHEME,MRFSCHEME,GFSSCHEME,MYJPBLSCHEME,ACMPBLSCHEME |
|---|
| 41 | |
|---|
| 42 | USE module_model_constants |
|---|
| 43 | |
|---|
| 44 | ! *** add new modules of schemes here |
|---|
| 45 | |
|---|
| 46 | USE module_bl_myjpbl |
|---|
| 47 | USE module_bl_ysu |
|---|
| 48 | USE module_bl_mrf |
|---|
| 49 | USE module_bl_gfs |
|---|
| 50 | USE module_bl_acm |
|---|
| 51 | |
|---|
| 52 | ! This driver calls subroutines for the PBL parameterizations. |
|---|
| 53 | ! |
|---|
| 54 | ! pbl scheme: |
|---|
| 55 | ! 1. ysupbl |
|---|
| 56 | ! 2. myjpbl |
|---|
| 57 | ! 7. acmpbl |
|---|
| 58 | ! 99. mrfpbl |
|---|
| 59 | ! |
|---|
| 60 | !------------------------------------------------------------------ |
|---|
| 61 | IMPLICIT NONE |
|---|
| 62 | !====================================================================== |
|---|
| 63 | ! Grid structure in physics part of WRF |
|---|
| 64 | !---------------------------------------------------------------------- |
|---|
| 65 | ! The horizontal velocities used in the physics are unstaggered |
|---|
| 66 | ! relative to temperature/moisture variables. All predicted |
|---|
| 67 | ! variables are carried at half levels except w, which is at full |
|---|
| 68 | ! levels. Some arrays with names (*8w) are at w (full) levels. |
|---|
| 69 | ! |
|---|
| 70 | !---------------------------------------------------------------------- |
|---|
| 71 | ! In WRF, kms (smallest number) is the bottom level and kme (largest |
|---|
| 72 | ! number) is the top level. In your scheme, if 1 is at the top level, |
|---|
| 73 | ! then you have to reverse the order in the k direction. |
|---|
| 74 | ! |
|---|
| 75 | ! kme - half level (no data at this level) |
|---|
| 76 | ! kme ----- full level |
|---|
| 77 | ! kme-1 - half level |
|---|
| 78 | ! kme-1 ----- full level |
|---|
| 79 | ! . |
|---|
| 80 | ! . |
|---|
| 81 | ! . |
|---|
| 82 | ! kms+2 - half level |
|---|
| 83 | ! kms+2 ----- full level |
|---|
| 84 | ! kms+1 - half level |
|---|
| 85 | ! kms+1 ----- full level |
|---|
| 86 | ! kms - half level |
|---|
| 87 | ! kms ----- full level |
|---|
| 88 | ! |
|---|
| 89 | !====================================================================== |
|---|
| 90 | ! Definitions |
|---|
| 91 | !----------- |
|---|
| 92 | ! Rho_d dry density (kg/m^3) |
|---|
| 93 | ! Theta_m moist potential temperature (K) |
|---|
| 94 | ! Qv water vapor mixing ratio (kg/kg) |
|---|
| 95 | ! Qc cloud water mixing ratio (kg/kg) |
|---|
| 96 | ! Qr rain water mixing ratio (kg/kg) |
|---|
| 97 | ! Qi cloud ice mixing ratio (kg/kg) |
|---|
| 98 | ! Qs snow mixing ratio (kg/kg) |
|---|
| 99 | !----------------------------------------------------------------- |
|---|
| 100 | !-- RUBLTEN U tendency due to |
|---|
| 101 | ! PBL parameterization (m/s^2) |
|---|
| 102 | !-- RVBLTEN V tendency due to |
|---|
| 103 | ! PBL parameterization (m/s^2) |
|---|
| 104 | !-- RTHBLTEN Theta tendency due to |
|---|
| 105 | ! PBL parameterization (K/s) |
|---|
| 106 | !-- RQVBLTEN Qv tendency due to |
|---|
| 107 | ! PBL parameterization (kg/kg/s) |
|---|
| 108 | !-- RQCBLTEN Qc tendency due to |
|---|
| 109 | ! PBL parameterization (kg/kg/s) |
|---|
| 110 | !-- RQIBLTEN Qi tendency due to |
|---|
| 111 | ! PBL parameterization (kg/kg/s) |
|---|
| 112 | !-- itimestep number of time steps |
|---|
| 113 | !-- GLW downward long wave flux at ground surface (W/m^2) |
|---|
| 114 | !-- GSW downward short wave flux at ground surface (W/m^2) |
|---|
| 115 | !-- EMISS surface emissivity (between 0 and 1) |
|---|
| 116 | !-- TSK surface temperature (K) |
|---|
| 117 | !-- TMN soil temperature at lower boundary (K) |
|---|
| 118 | !-- XLAND land mask (1 for land, 2 for water) |
|---|
| 119 | !-- ZNT roughness length (m) |
|---|
| 120 | !-- MAVAIL surface moisture availability (between 0 and 1) |
|---|
| 121 | !-- UST u* in similarity theory (m/s) |
|---|
| 122 | !-- MOL T* (similarity theory) (K) |
|---|
| 123 | !-- HOL PBL height over Monin-Obukhov length |
|---|
| 124 | !-- PBLH PBL height (m) |
|---|
| 125 | !-- CAPG heat capacity for soil (J/K/m^3) |
|---|
| 126 | !-- THC thermal inertia (Cal/cm/K/s^0.5) |
|---|
| 127 | !-- SNOWC flag indicating snow coverage (1 for snow cover) |
|---|
| 128 | !-- HFX upward heat flux at the surface (W/m^2) |
|---|
| 129 | !-- QFX upward moisture flux at the surface (kg/m^2/s) |
|---|
| 130 | !-- REGIME flag indicating PBL regime (stable, unstable, etc.) |
|---|
| 131 | !-- tke_myj turbulence kinetic energy from Mellor-Yamada-Janjic (MYJ) (m^2/s^2) |
|---|
| 132 | !-- el_myj mixing length from Mellor-Yamada-Janjic (MYJ) (m) |
|---|
| 133 | !-- akhs sfc exchange coefficient of heat/moisture from MYJ |
|---|
| 134 | !-- akms sfc exchange coefficient of momentum from MYJ |
|---|
| 135 | !-- thz0 potential temperature at roughness length (K) |
|---|
| 136 | !-- uz0 u wind component at roughness length (m/s) |
|---|
| 137 | !-- vz0 v wind component at roughness length (m/s) |
|---|
| 138 | !-- qsfc specific humidity at lower boundary (kg/kg) |
|---|
| 139 | !-- th2 diagnostic 2-m theta from surface layer and lsm |
|---|
| 140 | !-- t2 diagnostic 2-m temperature from surface layer and lsm |
|---|
| 141 | !-- q2 diagnostic 2-m mixing ratio from surface layer and lsm |
|---|
| 142 | !-- lowlyr index of lowest model layer above ground |
|---|
| 143 | !-- rr dry air density (kg/m^3) |
|---|
| 144 | !-- u_phy u-velocity interpolated to theta points (m/s) |
|---|
| 145 | !-- v_phy v-velocity interpolated to theta points (m/s) |
|---|
| 146 | !-- th_phy potential temperature (K) |
|---|
| 147 | !-- p_phy pressure (Pa) |
|---|
| 148 | !-- pi_phy exner function (dimensionless) |
|---|
| 149 | !-- p8w pressure at full levels (Pa) |
|---|
| 150 | !-- t_phy temperature (K) |
|---|
| 151 | !-- dz8w dz between full levels (m) |
|---|
| 152 | !-- z height above sea level (m) |
|---|
| 153 | !-- DX horizontal space interval (m) |
|---|
| 154 | !-- DT time step (second) |
|---|
| 155 | !-- n_moist number of moisture species |
|---|
| 156 | !-- PSFC pressure at the surface (Pa) |
|---|
| 157 | !-- TSLB |
|---|
| 158 | !-- ZS |
|---|
| 159 | !-- DZS |
|---|
| 160 | !-- num_soil_layers number of soil layer |
|---|
| 161 | !-- IFSNOW ifsnow=1 for snow-cover effects |
|---|
| 162 | ! |
|---|
| 163 | !-- P_QV species index for water vapor |
|---|
| 164 | !-- P_QC species index for cloud water |
|---|
| 165 | !-- P_QR species index for rain water |
|---|
| 166 | !-- P_QI species index for cloud ice |
|---|
| 167 | !-- P_QS species index for snow |
|---|
| 168 | !-- P_QG species index for graupel |
|---|
| 169 | !-- ids start index for i in domain |
|---|
| 170 | !-- ide end index for i in domain |
|---|
| 171 | !-- jds start index for j in domain |
|---|
| 172 | !-- jde end index for j in domain |
|---|
| 173 | !-- kds start index for k in domain |
|---|
| 174 | !-- kde end index for k in domain |
|---|
| 175 | !-- ims start index for i in memory |
|---|
| 176 | !-- ime end index for i in memory |
|---|
| 177 | !-- jms start index for j in memory |
|---|
| 178 | !-- jme end index for j in memory |
|---|
| 179 | !-- kms start index for k in memory |
|---|
| 180 | !-- kme end index for k in memory |
|---|
| 181 | !-- jts start index for j in tile |
|---|
| 182 | !-- jte end index for j in tile |
|---|
| 183 | !-- kts start index for k in tile |
|---|
| 184 | !-- kte end index for k in tile |
|---|
| 185 | ! |
|---|
| 186 | !****************************************************************** |
|---|
| 187 | !------------------------------------------------------------------ |
|---|
| 188 | ! |
|---|
| 189 | |
|---|
| 190 | |
|---|
| 191 | INTEGER, INTENT(IN ) :: bl_pbl_physics, ra_lw_physics |
|---|
| 192 | |
|---|
| 193 | INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, & |
|---|
| 194 | ims,ime, jms,jme, kms,kme, & |
|---|
| 195 | kts,kte, num_tiles |
|---|
| 196 | |
|---|
| 197 | INTEGER, DIMENSION(num_tiles), INTENT(IN) :: & |
|---|
| 198 | & i_start,i_end,j_start,j_end |
|---|
| 199 | |
|---|
| 200 | INTEGER, INTENT(IN ) :: itimestep,STEPBL |
|---|
| 201 | INTEGER, DIMENSION( ims:ime , jms:jme ), & |
|---|
| 202 | INTENT(IN ) :: LOWLYR |
|---|
| 203 | ! |
|---|
| 204 | LOGICAL, INTENT(IN ) :: warm_rain |
|---|
| 205 | |
|---|
| 206 | REAL, DIMENSION( kms:kme ), & |
|---|
| 207 | OPTIONAL, INTENT(IN ) :: znu, & |
|---|
| 208 | znw |
|---|
| 209 | ! |
|---|
| 210 | REAL, INTENT(IN ) :: DT,DX |
|---|
| 211 | REAL, INTENT(IN ),OPTIONAL :: bldt |
|---|
| 212 | REAL, INTENT(IN ),OPTIONAL :: curr_secs |
|---|
| 213 | LOGICAL, INTENT(IN ),OPTIONAL :: adapt_step_flag |
|---|
| 214 | |
|---|
| 215 | ! |
|---|
| 216 | REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), & |
|---|
| 217 | INTENT(IN ) :: p_phy, & |
|---|
| 218 | pi_phy, & |
|---|
| 219 | p8w, & |
|---|
| 220 | rho, & |
|---|
| 221 | t_phy, & |
|---|
| 222 | u_phy, & |
|---|
| 223 | v_phy, & |
|---|
| 224 | dz8w, & |
|---|
| 225 | z, & |
|---|
| 226 | th_phy |
|---|
| 227 | ! |
|---|
| 228 | ! |
|---|
| 229 | REAL, DIMENSION( ims:ime , jms:jme ), & |
|---|
| 230 | INTENT(IN ) :: XLAND, & |
|---|
| 231 | HT, & |
|---|
| 232 | PSIM, & |
|---|
| 233 | PSIH, & |
|---|
| 234 | GZ1OZ0, & |
|---|
| 235 | BR, & |
|---|
| 236 | CHKLOWQ |
|---|
| 237 | ! |
|---|
| 238 | REAL, DIMENSION( ims:ime, jms:jme ) , & |
|---|
| 239 | INTENT(INOUT) :: TSK, & |
|---|
| 240 | UST, & |
|---|
| 241 | PBLH, & |
|---|
| 242 | HFX, & |
|---|
| 243 | QFX, & |
|---|
| 244 | ZNT, & |
|---|
| 245 | QSFC, & |
|---|
| 246 | AKHS, & |
|---|
| 247 | AKMS, & |
|---|
| 248 | QZ0, & |
|---|
| 249 | THZ0, & |
|---|
| 250 | UZ0, & |
|---|
| 251 | VZ0, & |
|---|
| 252 | CT, & |
|---|
| 253 | GRDFLX, & |
|---|
| 254 | U10, & |
|---|
| 255 | V10, & |
|---|
| 256 | WSPD |
|---|
| 257 | |
|---|
| 258 | ! |
|---|
| 259 | REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), & |
|---|
| 260 | INTENT(INOUT) :: RUBLTEN, & |
|---|
| 261 | RVBLTEN, & |
|---|
| 262 | RTHBLTEN, & |
|---|
| 263 | EXCH_H,TKE_MYJ |
|---|
| 264 | ! |
|---|
| 265 | REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), & |
|---|
| 266 | INTENT(OUT) :: EL_MYJ |
|---|
| 267 | |
|---|
| 268 | REAL , INTENT(IN ) :: u_frame, & |
|---|
| 269 | v_frame |
|---|
| 270 | ! |
|---|
| 271 | |
|---|
| 272 | INTEGER, DIMENSION( ims:ime , jms:jme ), & |
|---|
| 273 | INTENT(INOUT) :: KPBL |
|---|
| 274 | |
|---|
| 275 | REAL, DIMENSION( ims:ime , jms:jme ), & |
|---|
| 276 | INTENT(IN) :: XICE, SNOW, LH |
|---|
| 277 | |
|---|
| 278 | ! |
|---|
| 279 | ! Optional |
|---|
| 280 | ! |
|---|
| 281 | ! |
|---|
| 282 | ! Flags relating to the optional tendency arrays declared above |
|---|
| 283 | ! Models that carry the optional tendencies will provdide the |
|---|
| 284 | ! optional arguments at compile time; these flags all the model |
|---|
| 285 | ! to determine at run-time whether a particular tracer is in |
|---|
| 286 | ! use or not. |
|---|
| 287 | ! |
|---|
| 288 | LOGICAL, INTENT(IN), OPTIONAL :: & |
|---|
| 289 | f_qv & |
|---|
| 290 | ,f_qc & |
|---|
| 291 | ,f_qr & |
|---|
| 292 | ,f_qi & |
|---|
| 293 | ,f_qs & |
|---|
| 294 | ,f_qg |
|---|
| 295 | |
|---|
| 296 | REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), & |
|---|
| 297 | OPTIONAL, INTENT(INOUT) :: & |
|---|
| 298 | ! optional moisture tracers |
|---|
| 299 | ! 2 time levels; if only one then use CURR |
|---|
| 300 | qv_curr, qc_curr, qr_curr & |
|---|
| 301 | ,qi_curr, qs_curr, qg_curr & |
|---|
| 302 | ,rqvblten,rqcblten,rqrblten & |
|---|
| 303 | ,rqiblten,rqsblten,rqgblten |
|---|
| 304 | |
|---|
| 305 | REAL, DIMENSION( ims:ime, jms:jme ) , & |
|---|
| 306 | OPTIONAL , & |
|---|
| 307 | INTENT(INOUT) :: HOL, & |
|---|
| 308 | MOL, & |
|---|
| 309 | REGIME |
|---|
| 310 | REAL, DIMENSION( ims:ime, jms:jme ) , & |
|---|
| 311 | OPTIONAL , & |
|---|
| 312 | INTENT(IN) :: mut |
|---|
| 313 | ! |
|---|
| 314 | REAL, OPTIONAL, INTENT(IN) :: p_top |
|---|
| 315 | |
|---|
| 316 | ! LOCAL VAR |
|---|
| 317 | |
|---|
| 318 | REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) ::v_phytmp |
|---|
| 319 | REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) ::u_phytmp |
|---|
| 320 | |
|---|
| 321 | REAL, DIMENSION( ims:ime, jms:jme ) :: TSKOLD, & |
|---|
| 322 | USTOLD, & |
|---|
| 323 | ZNTOLD, & |
|---|
| 324 | ZOL, & |
|---|
| 325 | PSFC |
|---|
| 326 | |
|---|
| 327 | ! |
|---|
| 328 | |
|---|
| 329 | REAL :: DTMIN,DTBL |
|---|
| 330 | ! |
|---|
| 331 | INTEGER :: i,J,K,NK,jj,ij,its,ite,jts,jte |
|---|
| 332 | LOGICAL :: radiation |
|---|
| 333 | LOGICAL :: flag_qv, flag_qc, flag_qr, flag_qi, flag_qs, flag_qg |
|---|
| 334 | CHARACTER*256 :: message |
|---|
| 335 | REAL :: next_bl_time |
|---|
| 336 | LOGICAL :: run_param |
|---|
| 337 | LOGICAL :: do_adapt |
|---|
| 338 | |
|---|
| 339 | !------------------------------------------------------------------ |
|---|
| 340 | ! |
|---|
| 341 | |
|---|
| 342 | flag_qv = .FALSE. ; IF ( PRESENT( F_QV ) ) flag_qv = F_QV |
|---|
| 343 | flag_qc = .FALSE. ; IF ( PRESENT( F_QC ) ) flag_qc = F_QC |
|---|
| 344 | flag_qr = .FALSE. ; IF ( PRESENT( F_QR ) ) flag_qr = F_QR |
|---|
| 345 | flag_qi = .FALSE. ; IF ( PRESENT( F_QI ) ) flag_qi = F_QI |
|---|
| 346 | flag_qs = .FALSE. ; IF ( PRESENT( F_QS ) ) flag_qs = F_QS |
|---|
| 347 | flag_qg = .FALSE. ; IF ( PRESENT( F_QG ) ) flag_qg = F_QG |
|---|
| 348 | |
|---|
| 349 | !print *,flag_qv, flag_qc, flag_qr, flag_qi, flag_qs, flag_qg,' flag_qv, flag_qc, flag_qr, flag_qi, flag_qs, flag_qg' |
|---|
| 350 | !print *,f_qv, f_qc, f_qr, f_qi, f_qs, f_qg,' f_qv, f_qc, f_qr, f_qi, f_qs, f_qg' |
|---|
| 351 | |
|---|
| 352 | if (bl_pbl_physics .eq. 0) return |
|---|
| 353 | ! RAINBL in mm (Accumulation between PBL calls) |
|---|
| 354 | |
|---|
| 355 | |
|---|
| 356 | ! |
|---|
| 357 | ! Modified for adaptive time step |
|---|
| 358 | ! |
|---|
| 359 | IF ( (itimestep .EQ. 1) .OR. (MOD(itimestep,STEPBL) .EQ. 0) ) THEN |
|---|
| 360 | run_param = .TRUE. |
|---|
| 361 | ELSE |
|---|
| 362 | run_param = .FALSE. |
|---|
| 363 | ENDIF |
|---|
| 364 | |
|---|
| 365 | IF (PRESENT(adapt_step_flag)) THEN |
|---|
| 366 | IF ((adapt_step_flag)) THEN |
|---|
| 367 | IF ( (itimestep .EQ. 1) .OR. (bldt .EQ. 0) .OR. & |
|---|
| 368 | ( CURR_SECS + dt >= ( INT( CURR_SECS / ( bldt * 60 ) + 1 ) * bldt * 60) ) ) THEN |
|---|
| 369 | run_param = .TRUE. |
|---|
| 370 | ELSE |
|---|
| 371 | run_param = .FALSE. |
|---|
| 372 | ENDIF |
|---|
| 373 | ENDIF |
|---|
| 374 | ENDIF |
|---|
| 375 | |
|---|
| 376 | IF (run_param) THEN |
|---|
| 377 | radiation = .false. |
|---|
| 378 | IF (ra_lw_physics .gt. 0) radiation = .true. |
|---|
| 379 | |
|---|
| 380 | !---- |
|---|
| 381 | ! CALCULATE CONSTANT |
|---|
| 382 | |
|---|
| 383 | DTMIN=DT/60. |
|---|
| 384 | ! PBL schemes need PBL time step for updates |
|---|
| 385 | |
|---|
| 386 | if (PRESENT(adapt_step_flag)) then |
|---|
| 387 | if (adapt_step_flag) then |
|---|
| 388 | do_adapt = .TRUE. |
|---|
| 389 | else |
|---|
| 390 | do_adapt = .FALSE. |
|---|
| 391 | endif |
|---|
| 392 | else |
|---|
| 393 | do_adapt = .FALSE. |
|---|
| 394 | endif |
|---|
| 395 | |
|---|
| 396 | if (PRESENT(BLDT)) then |
|---|
| 397 | if (bldt .eq. 0) then |
|---|
| 398 | DTBL = dt |
|---|
| 399 | ELSE |
|---|
| 400 | if (do_adapt) then |
|---|
| 401 | call wrf_message("WARNING: When using an adaptive time-step the boundary layer"// & |
|---|
| 402 | " time-step should be 0 (i.e., equivalent to model time-step). "// & |
|---|
| 403 | "In order to proceed, for boundary layer calculations, the "// & |
|---|
| 404 | "boundary layer time-step"// & |
|---|
| 405 | " will be rounded to the nearest minute, possibly resulting in"// & |
|---|
| 406 | " innacurate results.") |
|---|
| 407 | DTBL=bldt*60 |
|---|
| 408 | else |
|---|
| 409 | DTBL=DT*STEPBL |
|---|
| 410 | endif |
|---|
| 411 | endif |
|---|
| 412 | else |
|---|
| 413 | DTBL=DT*STEPBL |
|---|
| 414 | endif |
|---|
| 415 | |
|---|
| 416 | |
|---|
| 417 | ! SAVE OLD VALUES |
|---|
| 418 | |
|---|
| 419 | !$OMP PARALLEL DO & |
|---|
| 420 | !$OMP PRIVATE ( ij,i,j,k ) |
|---|
| 421 | DO ij = 1 , num_tiles |
|---|
| 422 | DO j=j_start(ij),j_end(ij) |
|---|
| 423 | DO i=i_start(ij),i_end(ij) |
|---|
| 424 | TSKOLD(i,j)=TSK(i,j) |
|---|
| 425 | USTOLD(i,j)=UST(i,j) |
|---|
| 426 | ZNTOLD(i,j)=ZNT(i,j) |
|---|
| 427 | |
|---|
| 428 | ! REVERSE ORDER IN THE VERTICAL DIRECTION |
|---|
| 429 | |
|---|
| 430 | ! testing change later |
|---|
| 431 | |
|---|
| 432 | DO k=kts,kte |
|---|
| 433 | v_phytmp(i,k,j)=v_phy(i,k,j)+v_frame |
|---|
| 434 | u_phytmp(i,k,j)=u_phy(i,k,j)+u_frame |
|---|
| 435 | ENDDO |
|---|
| 436 | |
|---|
| 437 | ! PSFC : in Pa |
|---|
| 438 | |
|---|
| 439 | PSFC(I,J)=p8w(I,kms,J) |
|---|
| 440 | |
|---|
| 441 | DO k=kts,min(kte+1,kde) |
|---|
| 442 | RTHBLTEN(I,K,J)=0. |
|---|
| 443 | RUBLTEN(I,K,J)=0. |
|---|
| 444 | RVBLTEN(I,K,J)=0. |
|---|
| 445 | IF ( PRESENT( RQCBLTEN )) RQCBLTEN(I,K,J)=0. |
|---|
| 446 | IF ( PRESENT( RQVBLTEN )) RQVBLTEN(I,K,J)=0. |
|---|
| 447 | ENDDO |
|---|
| 448 | |
|---|
| 449 | IF (flag_QI .AND. PRESENT(RQIBLTEN) ) THEN |
|---|
| 450 | DO k=kts,min(kte+1,kde) |
|---|
| 451 | RQIBLTEN(I,K,J)=0. |
|---|
| 452 | ENDDO |
|---|
| 453 | ENDIF |
|---|
| 454 | ENDDO |
|---|
| 455 | ENDDO |
|---|
| 456 | |
|---|
| 457 | ENDDO |
|---|
| 458 | !$OMP END PARALLEL DO |
|---|
| 459 | ! |
|---|
| 460 | !$OMP PARALLEL DO & |
|---|
| 461 | !$OMP PRIVATE ( ij, i,j,k, its, ite, jts, jte ) |
|---|
| 462 | DO ij = 1 , num_tiles |
|---|
| 463 | |
|---|
| 464 | its = i_start(ij) |
|---|
| 465 | ite = i_end(ij) |
|---|
| 466 | jts = j_start(ij) |
|---|
| 467 | jte = j_end(ij) |
|---|
| 468 | |
|---|
| 469 | pbl_select: SELECT CASE(bl_pbl_physics) |
|---|
| 470 | |
|---|
| 471 | CASE (YSUSCHEME) |
|---|
| 472 | CALL wrf_debug(100,'in YSU PBL') |
|---|
| 473 | IF ( PRESENT( qv_curr ) .AND. PRESENT( qc_curr ) .AND. & |
|---|
| 474 | PRESENT( qi_curr ) .AND. & |
|---|
| 475 | PRESENT( rqvblten ) .AND. PRESENT( rqcblten ) .AND. & |
|---|
| 476 | PRESENT( rqiblten ) .AND. & |
|---|
| 477 | PRESENT( hol ) ) THEN |
|---|
| 478 | CALL ysu( & |
|---|
| 479 | U3D=u_phytmp,V3D=v_phytmp,TH3D=th_phy,T3D=t_phy & |
|---|
| 480 | ,QV3D=qv_curr,QC3D=qc_curr,QI3D=qi_curr & |
|---|
| 481 | ,P3D=p_phy,P3DI=p8w,PI3D=pi_phy & |
|---|
| 482 | ,RUBLTEN=rublten,RVBLTEN=rvblten & |
|---|
| 483 | ,RTHBLTEN=rthblten,RQVBLTEN=rqvblten & |
|---|
| 484 | ,RQCBLTEN=rqcblten,RQIBLTEN=rqiblten & |
|---|
| 485 | ,FLAG_QI=flag_qi & |
|---|
| 486 | ,CP=cp,G=g,ROVCP=rcp,RD=r_D,ROVG=rovg & |
|---|
| 487 | ,DZ8W=dz8w,Z=z,XLV=XLV,RV=r_v,PSFC=PSFC & |
|---|
| 488 | ,ZNU=znu,ZNW=znw,MUT=mut,P_TOP=p_top & |
|---|
| 489 | ,ZNT=znt,UST=ust,ZOL=zol,HOL=hol,HPBL=pblh & |
|---|
| 490 | ,PSIM=psim,PSIH=psih,XLAND=xland & |
|---|
| 491 | ,HFX=hfx,QFX=qfx,TSK=tskold,GZ1OZ0=gz1oz0 & |
|---|
| 492 | ,U10=u10,V10=v10 & |
|---|
| 493 | ,WSPD=wspd,BR=br,DT=dtbl,DTMIN=dtmin,KPBL2D=kpbl & |
|---|
| 494 | ,SVP1=svp1,SVP2=svp2,SVP3=svp3,SVPT0=svpt0 & |
|---|
| 495 | ,EP1=ep_1,EP2=ep_2,KARMAN=karman,EOMEG=eomeg & |
|---|
| 496 | ,STBOLT=stbolt,EXCH_H=exch_h,REGIME=regime & |
|---|
| 497 | ,IDS=ids,IDE=ide,JDS=jds,JDE=jde,KDS=kds,KDE=kde & |
|---|
| 498 | ,IMS=ims,IME=ime,JMS=jms,JME=jme,KMS=kms,KME=kme & |
|---|
| 499 | ,ITS=its,ITE=ite,JTS=jts,JTE=jte,KTS=kts,KTE=kte & |
|---|
| 500 | ) |
|---|
| 501 | ELSE |
|---|
| 502 | CALL wrf_error_fatal('Lack arguments to call YSU pbl') |
|---|
| 503 | ENDIF |
|---|
| 504 | |
|---|
| 505 | CASE (MRFSCHEME) |
|---|
| 506 | IF ( PRESENT( qv_curr ) .AND. PRESENT( qc_curr ) .AND. & |
|---|
| 507 | PRESENT( rqvblten ) .AND. PRESENT( rqcblten ) .AND. & |
|---|
| 508 | PRESENT( hol ) .AND. & |
|---|
| 509 | .TRUE. ) THEN |
|---|
| 510 | |
|---|
| 511 | CALL wrf_debug(100,'in MRF') |
|---|
| 512 | CALL mrf( & |
|---|
| 513 | U3D=u_phytmp,V3D=v_phytmp,TH3D=th_phy,T3D=t_phy & |
|---|
| 514 | ,QV3D=qv_curr & |
|---|
| 515 | ,QC3D=qc_curr & |
|---|
| 516 | ,QI3D=qi_curr & |
|---|
| 517 | ,P3D=p_phy,PI3D=pi_phy & |
|---|
| 518 | ,RUBLTEN=rublten,RVBLTEN=rvblten & |
|---|
| 519 | ,RTHBLTEN=rthblten,RQVBLTEN=rqvblten & |
|---|
| 520 | ,RQCBLTEN=rqcblten,RQIBLTEN=rqiblten & |
|---|
| 521 | ,CP=cp,G=g,ROVCP=rcp,R=r_d,ROVG=rovg & |
|---|
| 522 | ,DZ8W=dz8w,Z=z,XLV=xlv,RV=r_v,PSFC=psfc & |
|---|
| 523 | ,P1000MB=p1000mb & |
|---|
| 524 | ,ZNT=znt,UST=ust,ZOL=zol,HOL=hol & |
|---|
| 525 | ,PBL=pblh,PSIM=psim,PSIH=psih & |
|---|
| 526 | ,XLAND=xland,HFX=hfx,QFX=qfx,TSK=tskold & |
|---|
| 527 | ,GZ1OZ0=gz1oz0,WSPD=wspd,BR=br & |
|---|
| 528 | ,DT=dtbl,DTMIN=dtmin,KPBL2D=kpbl & |
|---|
| 529 | ,SVP1=svp1,SVP2=svp2,SVP3=svp3,SVPT0=svpt0 & |
|---|
| 530 | ,EP1=ep_1,EP2=ep_2,KARMAN=karman,EOMEG=eomeg & |
|---|
| 531 | ,STBOLT=stbolt,REGIME=regime & |
|---|
| 532 | ,FLAG_QI=flag_qi & |
|---|
| 533 | ,IDS=ids,IDE=ide,JDS=jds,JDE=jde,KDS=kds,KDE=kde & |
|---|
| 534 | ,IMS=ims,IME=ime,JMS=jms,JME=jme,KMS=kms,KME=kme & |
|---|
| 535 | ,ITS=its,ITE=ite,JTS=jts,JTE=jte,KTS=kts,KTE=kte & |
|---|
| 536 | ) |
|---|
| 537 | ELSE |
|---|
| 538 | CALL wrf_error_fatal('Lack arguments to call MRF pbl') |
|---|
| 539 | ENDIF |
|---|
| 540 | |
|---|
| 541 | CASE (GFSSCHEME) |
|---|
| 542 | IF ( PRESENT( qv_curr ) .AND. PRESENT( qc_curr ) .AND. & |
|---|
| 543 | PRESENT( rqvblten ) .AND. PRESENT( rqcblten ) .AND. & |
|---|
| 544 | .TRUE. ) THEN |
|---|
| 545 | CALL wrf_debug(100,'in GFS') |
|---|
| 546 | CALL bl_gfs( & |
|---|
| 547 | U3D=u_phytmp,V3D=v_phytmp & |
|---|
| 548 | ,TH3D=th_phy,T3D=t_phy & |
|---|
| 549 | ,QV3D=qv_curr,QC3D=qc_curr,QI3D=qi_curr & |
|---|
| 550 | ,P3D=p_phy,PI3D=pi_phy & |
|---|
| 551 | ,RUBLTEN=rublten,RVBLTEN=rvblten,RTHBLTEN=rthblten & |
|---|
| 552 | ,RQVBLTEN=rqvblten,RQCBLTEN=rqcblten & |
|---|
| 553 | ,RQIBLTEN=rqiblten & |
|---|
| 554 | ,CP=cp,G=g,ROVCP=rcp,R=r_d,ROVG=rovg,FLAG_QI=flag_qi & |
|---|
| 555 | ,DZ8W=dz8w,z=z,PSFC=psfc & |
|---|
| 556 | ,UST=ust,PBL=pblh,PSIM=psim,PSIH=psih & |
|---|
| 557 | ,HFX=hfx,QFX=qfx,TSK=tskold,GZ1OZ0=gz1oz0 & |
|---|
| 558 | ,WSPD=wspd,BR=br & |
|---|
| 559 | ,DT=dtbl,KPBL2D=kpbl,EP1=ep_1,KARMAN=karman & |
|---|
| 560 | ,IDS=ids,IDE=ide,JDS=jds,JDE=jde,KDS=kds,KDE=kde & |
|---|
| 561 | ,IMS=ims,IME=ime,JMS=jms,JME=jme,KMS=kms,KME=kme & |
|---|
| 562 | ,ITS=its,ITE=ite,JTS=jts,JTE=jte,KTS=kts,KTE=kte & |
|---|
| 563 | ) |
|---|
| 564 | ELSE |
|---|
| 565 | CALL wrf_error_fatal('Lack arguments to call GFS pbl') |
|---|
| 566 | ENDIF |
|---|
| 567 | |
|---|
| 568 | CASE (MYJPBLSCHEME) |
|---|
| 569 | IF ( PRESENT( qv_curr ) .AND. PRESENT( qc_curr ) .AND. & |
|---|
| 570 | PRESENT( rqvblten ) .AND. PRESENT( rqcblten ) .AND. & |
|---|
| 571 | .TRUE. ) THEN |
|---|
| 572 | |
|---|
| 573 | CALL wrf_debug(100,'in MYJPBL') |
|---|
| 574 | CALL myjpbl( & |
|---|
| 575 | DT=dt,STEPBL=stepbl,HT=ht,DZ=dz8w & |
|---|
| 576 | ,PMID=p_phy,PINT=p8w,TH=th_phy,T=t_phy,EXNER=pi_phy & |
|---|
| 577 | ,QV=qv_curr, CWM=qc_curr & |
|---|
| 578 | ,U=u_phy,V=v_phy,RHO=rho & |
|---|
| 579 | ,TSK=tsk,QSFC=qsfc,CHKLOWQ=chklowq,THZ0=thz0 & |
|---|
| 580 | ,QZ0=qz0,UZ0=uz0,VZ0=vz0 & |
|---|
| 581 | ,LOWLYR=lowlyr & |
|---|
| 582 | ,XLAND=xland,SICE=xice,SNOW=snow & |
|---|
| 583 | ,TKE_MYJ=tke_myj,EXCH_H=exch_h,USTAR=ust,ZNT=znt & |
|---|
| 584 | ,EL_MYJ=el_myj,PBLH=pblh,KPBL=kpbl,CT=ct & |
|---|
| 585 | ,AKHS=akhs,AKMS=akms,ELFLX=lh & |
|---|
| 586 | ,RUBLTEN=rublten,RVBLTEN=rvblten,RTHBLTEN=rthblten & |
|---|
| 587 | ,RQVBLTEN=rqvblten,RQCBLTEN=rqcblten & |
|---|
| 588 | ,IDS=ids,IDE=ide,JDS=jds,JDE=jde,KDS=kds,KDE=kde & |
|---|
| 589 | ,IMS=ims,IME=ime,JMS=jms,JME=jme,KMS=kms,KME=kme & |
|---|
| 590 | ,ITS=its,ITE=ite,JTS=jts,JTE=jte,KTS=kts,KTE=kte & |
|---|
| 591 | ) |
|---|
| 592 | ELSE |
|---|
| 593 | CALL wrf_error_fatal('Lack arguments to call MYJ pbl') |
|---|
| 594 | ENDIF |
|---|
| 595 | |
|---|
| 596 | CASE (ACMPBLSCHEME) |
|---|
| 597 | |
|---|
| 598 | !! These are values that are not supplied to pbl driver, but are required by ACM |
|---|
| 599 | IF ( PRESENT( qv_curr ) .AND. PRESENT( qc_curr ) .AND. & |
|---|
| 600 | PRESENT( rqvblten ) .AND. PRESENT( rqcblten ) .AND. & |
|---|
| 601 | .TRUE. ) THEN |
|---|
| 602 | CALL wrf_debug(100,'in ACM PBL') |
|---|
| 603 | |
|---|
| 604 | CALL ACMPBL( & |
|---|
| 605 | XTIME=itimestep, DTPBL=dtbl, ZNW=znw, SIGMAH=znu & |
|---|
| 606 | ,U3D=u_phytmp, V3D=v_phytmp, PP3D=p_phy, DZ8W=dz8w, TH3D=th_phy, T3D=t_phy & |
|---|
| 607 | ,QV3D=qv_curr, QC3D=qc_curr, QI3D=qi_curr, RR3D=rho & |
|---|
| 608 | ,UST=UST, HFX=HFX, QFX=QFX, TSK=tsk & |
|---|
| 609 | ,PSFC=PSFC, EP1=EP_1, G=g, ROVCP=rcp,RD=r_D,CPD=cp & |
|---|
| 610 | ,PBLH=pblh, KPBL2D=kpbl, REGIME=regime & |
|---|
| 611 | ,GZ1OZ0=gz1oz0,WSPD=wspd,PSIM=psim, MUT=mut & |
|---|
| 612 | ,RUBLTEN=rublten,RVBLTEN=rvblten,RTHBLTEN=rthblten & |
|---|
| 613 | ,RQVBLTEN=rqvblten,RQCBLTEN=rqcblten,RQIBLTEN=rqiblten & |
|---|
| 614 | ,IDS=ids,IDE=ide,JDS=jds,JDE=jde,KDS=kds,KDE=kde & |
|---|
| 615 | ,IMS=ims,IME=ime,JMS=jms,JME=jme,KMS=kms,KME=kme & |
|---|
| 616 | ,ITS=its,ITE=ite,JTS=jts,JTE=jte,KTS=kts,KTE=kte & |
|---|
| 617 | ) |
|---|
| 618 | ELSE |
|---|
| 619 | CALL wrf_error_fatal('Lack arguments to call ACM2 pbl') |
|---|
| 620 | ENDIF |
|---|
| 621 | |
|---|
| 622 | |
|---|
| 623 | CASE DEFAULT |
|---|
| 624 | |
|---|
| 625 | WRITE( message , * ) 'The pbl option does not exist: bl_pbl_physics = ', bl_pbl_physics |
|---|
| 626 | CALL wrf_error_fatal ( message ) |
|---|
| 627 | |
|---|
| 628 | END SELECT pbl_select |
|---|
| 629 | |
|---|
| 630 | ENDDO |
|---|
| 631 | !$OMP END PARALLEL DO |
|---|
| 632 | |
|---|
| 633 | ENDIF |
|---|
| 634 | ! |
|---|
| 635 | END SUBROUTINE pbl_driver |
|---|
| 636 | END MODULE module_pbl_driver |
|---|
