!WRF:MODEL_LAYER:PHYSICS
!
!------------------------------------------------------------------
SUBROUTINE pbl_driver(itimestep,dt,u_frame,v_frame, & 1,23
RUBLTEN,RVBLTEN,RTHBLTEN, &
RQVBLTEN,RQCBLTEN,RQIBLTEN, &
RAINCV,RAINNCV,RAINBL, &
GLW,GSW,EMISS,TSK,TMN,XLAND,ZNT,HT,MAVAIL, &
UST,HOL,MOL,PBLH,CAPG,THC, &
SNOWC,HFX,QFX,REGIME, &
SMSTAV,SMSTOT,SFCRUNOFF,UDRUNOFF, &
IVGTYP,ISLTYP,VEGFRA,SFCEVP,GRDFLX, &
SFCEXC,ACSNOW,ACSNOM,ALB,XICE, &
th2,t2,q2,SMOIS,SNOW,CANWAT, &
u_phy,v_phy,th_phy,rho,moist, &
p_phy,pi_phy,p8w,t_phy,dz8w,z, &
TKE_MYJ,AKHS,AKMS, &
THZ0,QZ0,UZ0,VZ0,QSFC, &
LOWLYR, &
config_flags,DX,n_moist,TSLB,ZS,DZS, & !TSLB (STEMP)
num_soil_layers,STEPBL,IFSNOW,ISFFLX,warm_rain, &
u10,v10,tshltr,th10,qshltr,q10, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte )
!------------------------------------------------------------------
USE module_bc
USE module_state_description
USE module_model_constants
! *** add new modules of schemes here
USE module_bl_sfclay
USE module_bl_myjsfc
USE module_bl_slab
USE module_bl_lsm
USE module_bl_mrf
USE module_bl_myjpbl
! This driver calls subroutines for the PBL parameterizations.
!
! surface layer: (between surface and pbl)
! 1. sfclay
! 2. myjsfc
! surface: ground temp/lsm scheme:
! 1. slab
! 2. OSU LSM
! pbl scheme:
! 1. mrf
! 2. myjpbl
!
!------------------------------------------------------------------
IMPLICIT NONE
!======================================================================
! Grid structure in physics part of WRF
!----------------------------------------------------------------------
! The horizontal velocities used in the physics are unstaggered
! relative to temperature/moisture variables. All predicted
! variables are carried at half levels except w, which is at full
! levels. Some arrays with names (*8w) are at w (full) levels.
!
!----------------------------------------------------------------------
! In WRF, kms (smallest number) is the bottom level and kme (largest
! number) is the top level. In your scheme, if 1 is at the top level,
! then you have to reverse the order in the k direction.
!
! kme - half level (no data at this level)
! kme ----- full level
! kme-1 - half level
! kme-1 ----- full level
! .
! .
! .
! kms+2 - half level
! kms+2 ----- full level
! kms+1 - half level
! kms+1 ----- full level
! kms - half level
! kms ----- full level
!
!======================================================================
! Definitions
!-----------
! Rho_d dry density (kg/m^3)
! Theta_m moist potential temperature (K)
! Qv water vapor mixing ratio (kg/kg)
! Qc cloud water mixing ratio (kg/kg)
! Qr rain water mixing ratio (kg/kg)
! Qi cloud ice mixing ratio (kg/kg)
! Qs snow mixing ratio (kg/kg)
!-----------------------------------------------------------------
!-- RUBLTEN Rho_dU tendency due to
! PBL parameterization (kg/m^3 . m/s)
!-- RVBLTEN Rho_dV tendency due to
! PBL parameterization (kg/m^3 . m/s)
!-- RTHBLTEN Rho_dTheta_m tendency due to
! PBL parameterization (kg/m^3 . K)
!-- RQVBLTEN Rho_dQv tendency due to
! PBL parameterization (kg/m^3 . kg/kg)
!-- RQCBLTEN Rho_dQc tendency due to
! PBL parameterization (kg/m^3 . kg/kg)
!-- RQIBLTEN Rho_dQi tendency due to
! PBL parameterization (kg/m^3 . kg/kg)
!-- itimestep number of time steps
!-- GLW downward long wave flux at ground surface (W/m^2)
!-- GSW downward short wave flux at ground surface (W/m^2)
!-- EMISS surface emissivity (between 0 and 1)
!-- TSK surface temperature (K)
!-- TMN soil temperature at lower boundary (K)
!-- XLAND land mask (1 for land, 2 for water)
!-- ZNT roughness length (m)
!-- MAVAIL surface moisture availability (between 0 and 1)
!-- UST u* in similarity theory (m/s)
!-- MOL q* (similarity theory) (kg/kg)
!-- HOL PBL height over Monin-Obukhov length
!-- PBLH PBL height (m)
!-- CAPG heat capacity for soil (J/K/m^3)
!-- THC thermal inertia (Cal/cm/K/s^0.5)
!-- SNOWC flag indicating snow coverage (1 for snow cover)
!-- HFX upward heat flux at the surface (W/m^2)
!-- QFX upward moisture flux at the surface (kg/m^2/s)
!-- REGIME flag indicating PBL regime (stable, unstable, etc.)
!-- tke_myj turbulence kinetic energy from Mellor-Yamada-Janjic (MYJ) (m^2/s^2)
!-- akhs sfc exchange coefficient of heat/moisture from MYJ
!-- akms sfc exchange coefficient of momentum from MYJ
!-- thz0 potential temperature at roughness length (K)
!-- uz0 u wind component at roughness length (m/s)
!-- vz0 v wind component at roughness length (m/s)
!-- qsfc specific humidity at lower boundary (kg/kg)
!-- u10 diagnostic 10-m u component from surface layer
!-- v10 diagnostic 10-m v component from surface layer
!-- th2 diagnostic 2-m theta from surface layer and lsm
!-- t2 diagnostic 2-m temperature from surface layer and lsm
!-- q2 diagnostic 2-m mixing ratio from surface layer and lsm
!-- tshltr diagnostic 2-m theta from MYJ
!-- th10 diagnostic 10-m theta from MYJ
!-- qshltr diagnostic 2-m specific humidity from MYJ
!-- q10 diagnostic 10-m specific humidity from MYJ
!-- lowlyr index of lowest model layer above ground
!-- rr dry air density (kg/m^3)
!-- u_phy u-velocity interpolated to theta points (m/s)
!-- v_phy v-velocity interpolated to theta points (m/s)
!-- th_phy potential temperature (K)
!-- moist moisture array (4D - last index is species) (kg/kg)
!-- p_phy pressure (Pa)
!-- pi_phy exner function (dimensionless)
!-- p8w pressure at full levels (Pa)
!-- t_phy temperature (K)
!-- dz8w dz between full levels (m)
!-- z height above sea level (m)
!-- config_flags
!-- DX horizontal space interval (m)
!-- DT time step (second)
!-- n_moist number of moisture species
!-- PSFC pressure at the surface (Pa)
!-- TSLB
!-- ZS
!-- DZS
!-- num_soil_layers number of soil layer
!-- IFSNOW ifsnow=1 for snow-cover effects
!
!-- P_QV species index for water vapor
!-- P_QC species index for cloud water
!-- P_QR species index for rain water
!-- P_QI species index for cloud ice
!-- P_QS species index for snow
!-- P_QG species index for graupel
!-- ids start index for i in domain
!-- ide end index for i in domain
!-- jds start index for j in domain
!-- jde end index for j in domain
!-- kds start index for k in domain
!-- kde end index for k in domain
!-- ims start index for i in memory
!-- ime end index for i in memory
!-- jms start index for j in memory
!-- jme end index for j in memory
!-- kms start index for k in memory
!-- kme end index for k in memory
!-- its start index for i in tile
!-- ite end index for i in tile
!-- jts start index for j in tile
!-- jte end index for j in tile
!-- kts start index for k in tile
!-- kte end index for k in tile
!
!******************************************************************
!------------------------------------------------------------------
TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
!
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte, &
n_moist
INTEGER, INTENT(IN ) :: num_soil_layers
INTEGER, INTENT(IN ) :: itimestep,STEPBL,IFSNOW,ISFFLX
INTEGER, DIMENSION( ims:ime , jms:jme ), &
INTENT(IN ) :: LOWLYR
!
LOGICAL, INTENT(IN ) :: warm_rain
!
REAL, INTENT(IN ) :: DT,DX
REAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), &
INTENT(INOUT) :: SMOIS,TSLB
REAL, DIMENSION(1:num_soil_layers), INTENT(IN):: ZS,DZS
!
REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
INTENT(IN ) :: p_phy, &
pi_phy, &
p8w, &
rho, &
t_phy, &
u_phy, &
v_phy, &
dz8w, &
z, &
th_phy
!
REAL, DIMENSION( ims:ime, kms:kme, jms:jme, n_moist ), &
INTENT(IN ) :: moist
!
INTEGER, DIMENSION( ims:ime , jms:jme ), &
INTENT(IN ) :: IVGTYP, &
ISLTYP
!
REAL, DIMENSION( ims:ime , jms:jme ), &
INTENT(IN ) :: EMISS, &
TMN, &
GLW, &
GSW, &
THC, &
MAVAIL, &
XLAND, &
XICE, &
VEGFRA, &
HT, &
RAINCV, &
RAINNCV
!
REAL, DIMENSION( ims:ime, jms:jme ) , &
INTENT(INOUT) :: TSK, &
UST, &
HOL, &
MOL, &
PBLH, &
CAPG, &
HFX, &
QFX, &
REGIME, &
ZNT, &
RAINBL, &
QSFC, &
AKHS, &
AKMS, &
QZ0, &
THZ0, &
UZ0, &
VZ0, &
SNOW, & !new
ALB, &
SNOWC, &
CANWAT, & ! new
SMSTAV, &
SMSTOT, &
SFCRUNOFF, &
UDRUNOFF, &
SFCEVP, &
GRDFLX, &
ACSNOW, &
ACSNOM, &
Q2, &
TH2, &
T2, &
SFCEXC
!
REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
INTENT(INOUT) :: RUBLTEN, &
RVBLTEN, &
RTHBLTEN, &
RQVBLTEN, &
RQCBLTEN, &
RQIBLTEN, &
TKE_MYJ
REAL , INTENT(IN ) :: u_frame, &
v_frame
REAL, DIMENSION( ims:ime, jms:jme ), &
INTENT(OUT) :: TSHLTR, &
TH10, &
QSHLTR, &
Q10, &
U10, &
V10
!
! LOCAL VAR
REAL, DIMENSION( its:ite, kts:kte, jts:jte ) ::v_phytmp
REAL, DIMENSION( its:ite, kts:kte, jts:jte ) ::u_phytmp
REAL, DIMENSION( its:ite, jts:jte ) :: TSKOLD, &
USTOLD, &
ZNTOLD, &
ZOL, &
PSFC
!
REAL, DIMENSION( its:ite, jts:jte ) :: FLHC, &
FLQC, &
QGH, &
PSIM, &
PSIH, &
GZ1OZ0, &
WSPD, &
BR, &
CHS, &
CPM, &
CHS2, &
CHKLOWQ
REAL :: DTMIN,DTBL
!
INTEGER :: i,J,K,NK,jj
LOGICAL :: radiation
!
!------------------------------------------------------------------
!
chklowq = 0.
if (config_flags%bl_pbl_physics .eq. 0) return
! RAINBL in mm (Accumulation between PBL calls)
DO j=jts,jte
DO i=its,ite
RAINBL(i,j) = RAINBL(i,j) + RAINCV(i,j) + RAINNCV(i,j)
ENDDO
ENDDO
IF (itimestep .eq. 1 .or. mod(itimestep,STEPBL) .eq. 0) THEN
radiation = .false.
IF (config_flags%ra_lw_physics .gt. 0) radiation = .true.
!----
! CALCULATE CONSTANT
DTMIN=DT/60.
! Surface schemes need PBL time step for updates and accumulations
! Assume these schemes provide no tendencies
DTBL=DT*STEPBL
! SAVE OLD VALUES
DO j=jts,jte
DO i=its,ite
TSKOLD(i,j)=TSK(i,j)
USTOLD(i,j)=UST(i,j)
ZNTOLD(i,j)=ZNT(i,j)
ENDDO
ENDDO
! REVERSE ORDER IN THE VERTICAL DIRECTION
! testing change later
DO j=jts,jte
DO k=kts,kte
DO i=its,ite
v_phytmp(i,k,j)=v_phy(i,k,j)+v_frame
u_phytmp(i,k,j)=u_phy(i,k,j)+u_frame
ENDDO
ENDDO
ENDDO
! PSFC : in Pa
DO j=jts,jte
DO i=its,ite
PSFC(I,J)=p8w(I,kms,J)
ENDDO
ENDDO
DO j=jts,jte
DO k=kts,min(kte+1,kde)
DO i=its,ite
RTHBLTEN(I,K,J)=0.
RUBLTEN(I,K,J)=0.
RVBLTEN(I,K,J)=0.
RQCBLTEN(I,K,J)=0.
RQVBLTEN(I,K,J)=0.
ENDDO
ENDDO
ENDDO
IF (P_QI .ge. PARAM_FIRST_SCALAR) THEN
DO j=jts,jte
DO k=kts,min(kte+1,kde)
DO i=its,ite
RQIBLTEN(I,K,J)=0.
ENDDO
ENDDO
ENDDO
ENDIF
sfclay_select: SELECT CASE(config_flags%bl_sfclay_physics)
CASE (SFCLAYSCHEME)
CALL wrf_debug( 100, 'in SFCLAY' )
CALL SFCLAY(u_phytmp,v_phytmp,t_phy,moist(ims,kms,jms,P_QV),&
p_phy,dz8w,CP,G,RCP,R_d,PSFC,CHS,CHS2,CPM, &
ZNTOLD,USTOLD,MAVAIL,ZOL,MOL,REGIME,PSIM,PSIH, &
XLAND,HFX,QFX,TSK,FLHC,FLQC,QGH,U10,V10,TH2,T2,Q2, &
GZ1OZ0,WSPD,BR,ISFFLX, &
SVP1,SVP2,SVP3,SVPT0,EP_1,EP_2,KARMAN,EOMEG,STBOLT, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte )
CASE (MYJSFCSCHEME)
CALL wrf_debug(100,'in MYJSFC')
CALL MYJSFC(ht,dz8w, &
p_phy,p8w,th_phy,t_phy, &
moist(ims,kms,jms,P_QV),u_phy,v_phy,rho, &
TSK,QSFC,THZ0,QZ0,UZ0,VZ0, &
LOWLYR, &
XLAND, &
UST,ZNT,PBLH,MAVAIL, &
AKHS,AKMS, &
CHS,CHS2,HFX,QFX,FLHC,FLQC,QGH,CPM, &
U10,V10,TH2,T2,Q2,TSHLTR,TH10,QSHLTR,Q10, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
CASE DEFAULT
CALL wrf_message('The surface layer scheme does not exist')
END SELECT sfclay_select
!
IF (ISFFLX.EQ.0 ) GOTO 430
sfc_select: SELECT CASE(config_flags%bl_surface_physics)
CASE (SLABSCHEME)
CALL wrf_debug(100,'in SLAB')
CALL SLAB(t_phy,moist(ims,kms,jms,P_QV),p_phy,FLHC,FLQC, &
PSFC,XLAND,TMN,HFX,QFX,TSK,QSFC,CHKLOWQ, &
GSW,GLW,CAPG,THC,SNOWC,EMISS,MAVAIL, &
DTBL,RCP,XLV,DTMIN,IFSNOW, &
SVP1,SVP2,SVP3,SVPT0,EP_2,KARMAN,EOMEG,STBOLT, &
TSLB,ZS,DZS,num_soil_layers,radiation, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte )
CASE (LSMSCHEME)
CALL wrf_debug(100,'in LSM')
CALL lsm(dz8w,moist(ims,kms,jms,P_QV),p8w,rho, &
t_phy,th_phy,TSK,CHS, &
HFX,QFX,QGH,GSW,GLW,SMSTAV,SMSTOT,SFCRUNOFF, &
UDRUNOFF,IVGTYP,ISLTYP,VEGFRA,SFCEVP,GRDFLX, &
SFCEXC,ACSNOW,ACSNOM,ALB,TMN,XLAND,XICE, &
th2,t2,q2,SNOWC,CHS2,QSFC,CHKLOWQ,RAINBL, &
num_soil_layers,DTBL,DZS,itimestep, &
SMOIS,TSLB,SNOW,CANWAT,CPM,RCP, & !TSLB
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte )
CASE DEFAULT
CALL wrf_debug(100,'The surface scheme does not exist')
END SELECT sfc_select
430 CONTINUE
! Reset RAINBL in mm (Accumulation between PBL calls)
DO j=jts,jte
DO i=its,ite
RAINBL(i,j) = 0.
ENDDO
ENDDO
!
pbl_select: SELECT CASE(config_flags%bl_pbl_physics)
CASE (MRFSCHEME)
CALL wrf_debug(100,'in MRF')
CALL MRF(u_phytmp,v_phytmp,th_phy,t_phy, &
moist(ims,kms,jms,P_QV),moist(ims,kms,jms,P_QC), &
moist(ims,kms,jms,P_QI),p_phy,pi_phy, &
RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN,RQCBLTEN,RQIBLTEN, &
CP,G,RCP,R_d,ROVG,P_QI,PARAM_FIRST_SCALAR, &
dz8w,z,XLV,R_v,PSFC, &
ZNT,UST,ZOL,HOL,PBLH,REGIME,PSIM,PSIH, &
XLAND,HFX,QFX,TSKOLD,GZ1OZ0,WSPD,BR, &
DT,DTMIN, &
SVP1,SVP2,SVP3,SVPT0,EP_1,EP_2,KARMAN,EOMEG,STBOLT, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte )
CASE (MYJPBLSCHEME)
CALL wrf_debug(100,'in MYJPBL')
CALL MYJPBL(DT,STEPBL,ht,dz8w, &
p_phy,p8w,th_phy,t_phy,pi_phy, &
moist(ims,kms,jms,P_QV),u_phy,v_phy,rho, &
TSK,QSFC,CHKLOWQ,THZ0,QZ0,UZ0,VZ0, &
LOWLYR, &
XLAND, &
TKE_MYJ,UST,ZNT,PBLH, &
AKHS,AKMS, &
RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
CASE DEFAULT
CALL wrf_message('The pbl scheme does not exist')
END SELECT pbl_select
ENDIF
!
END SUBROUTINE pbl_driver