wrfv2_fire/phys/module_pbl_driver.F

   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