!WRF:MEDIATION_LAYER:PHYSICS ! MODULE module_pbl_driver CONTAINS !------------------------------------------------------------------ SUBROUTINE pbl_driver( & itimestep,dt,u_frame,v_frame & ,rublten,rvblten,rthblten & ,tsk,xland,znt,ht & ,ust,pblh,hfx,qfx,grdflx & ,u_phy,v_phy,th_phy,rho & ,p_phy,pi_phy,p8w,t_phy,dz8w,z & ,tke_myj,el_myj,exch_h,akhs,akms & ,thz0,qz0,uz0,vz0,qsfc & ,lowlyr & ,psim,psih,gz1oz0, wspd,br,chklowq & ,bl_pbl_physics, ra_lw_physics, dx & ,stepbl,warm_rain & ,kpbl,ct,lh,snow,xice & ,ids,ide, jds,jde, kds,kde & ,ims,ime, jms,jme, kms,kme & ,i_start,i_end, j_start,j_end, kts,kte, num_tiles & ! Optional ,hol, mol, regime & ! Optional moisture tracers ,qv_curr, qc_curr, qr_curr & ,qi_curr, qs_curr, qg_curr & ,rqvblten,rqcblten,rqiblten & ,rqrblten,rqsblten,rqgblten & ! Optional moisture tracer flags ,f_qv,f_qc,f_qr & ,f_qi,f_qs,f_qg & ) !------------------------------------------------------------------ USE module_state_description, ONLY : & YSUSCHEME,MRFSCHEME,GFSSCHEME,MYJPBLSCHEME USE module_model_constants ! *** add new modules of schemes here USE module_bl_myjpbl USE module_bl_ysu USE module_bl_mrf USE module_bl_gfs ! This driver calls subroutines for the PBL parameterizations. ! ! pbl scheme: ! 1. ysupbl ! 2. myjpbl ! 99. mrfpbl ! !------------------------------------------------------------------ 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 U tendency due to ! PBL parameterization (m/s^2) !-- RVBLTEN V tendency due to ! PBL parameterization (m/s^2) !-- RTHBLTEN Theta tendency due to ! PBL parameterization (K/s) !-- RQVBLTEN Qv tendency due to ! PBL parameterization (kg/kg/s) !-- RQCBLTEN Qc tendency due to ! PBL parameterization (kg/kg/s) !-- RQIBLTEN Qi tendency due to ! PBL parameterization (kg/kg/s) !-- 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 T* (similarity theory) (K) !-- 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) !-- el_myj mixing length from Mellor-Yamada-Janjic (MYJ) (m) !-- 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) !-- 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 !-- 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) !-- 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) !-- 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 !-- 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 ! !****************************************************************** !------------------------------------------------------------------ ! INTEGER, INTENT(IN ) :: bl_pbl_physics, ra_lw_physics INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & kts,kte, num_tiles INTEGER, DIMENSION(num_tiles), INTENT(IN) :: & & i_start,i_end,j_start,j_end INTEGER, INTENT(IN ) :: itimestep,STEPBL INTEGER, DIMENSION( ims:ime , jms:jme ), & INTENT(IN ) :: LOWLYR ! LOGICAL, INTENT(IN ) :: warm_rain ! REAL, INTENT(IN ) :: DT,DX ! 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 , jms:jme ), & INTENT(IN ) :: XLAND, & HT, & PSIM, & PSIH, & GZ1OZ0, & BR, & CHKLOWQ ! REAL, DIMENSION( ims:ime, jms:jme ) , & INTENT(INOUT) :: TSK, & UST, & PBLH, & HFX, & QFX, & ZNT, & QSFC, & AKHS, & AKMS, & QZ0, & THZ0, & UZ0, & VZ0, & CT, & GRDFLX , & WSPD ! REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), & INTENT(INOUT) :: RUBLTEN, & RVBLTEN, & RTHBLTEN, & EXCH_H,TKE_MYJ ! REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), & INTENT(OUT) :: EL_MYJ REAL , INTENT(IN ) :: u_frame, & v_frame ! INTEGER, DIMENSION( ims:ime , jms:jme ), & INTENT(INOUT) :: KPBL REAL, DIMENSION( ims:ime , jms:jme ), & INTENT(IN) :: XICE, SNOW, LH ! ! Optional ! ! ! Flags relating to the optional tendency arrays declared above ! Models that carry the optional tendencies will provdide the ! optional arguments at compile time; these flags all the model ! to determine at run-time whether a particular tracer is in ! use or not. ! LOGICAL, INTENT(IN), OPTIONAL :: & f_qv & ,f_qc & ,f_qr & ,f_qi & ,f_qs & ,f_qg REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), & OPTIONAL, INTENT(INOUT) :: & ! optional moisture tracers ! 2 time levels; if only one then use CURR qv_curr, qc_curr, qr_curr & ,qi_curr, qs_curr, qg_curr & ,rqvblten,rqcblten,rqrblten & ,rqiblten,rqsblten,rqgblten REAL, DIMENSION( ims:ime, jms:jme ) , & OPTIONAL , & INTENT(INOUT) :: HOL, & MOL, & REGIME ! LOCAL VAR REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) ::v_phytmp REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) ::u_phytmp REAL, DIMENSION( ims:ime, jms:jme ) :: TSKOLD, & USTOLD, & ZNTOLD, & ZOL, & PSFC ! REAL :: DTMIN,DTBL ! INTEGER :: i,J,K,NK,jj,ij,its,ite,jts,jte LOGICAL :: radiation LOGICAL :: flag_qv, flag_qc, flag_qr, flag_qi, flag_qs, flag_qg CHARACTER*256 :: message !------------------------------------------------------------------ ! flag_qv = .FALSE. ; IF ( PRESENT( F_QV ) ) flag_qv = F_QV flag_qc = .FALSE. ; IF ( PRESENT( F_QC ) ) flag_qv = F_QC flag_qr = .FALSE. ; IF ( PRESENT( F_QR ) ) flag_qv = F_QR flag_qi = .FALSE. ; IF ( PRESENT( F_QI ) ) flag_qv = F_QI flag_qs = .FALSE. ; IF ( PRESENT( F_QS ) ) flag_qv = F_QS flag_qg = .FALSE. ; IF ( PRESENT( F_QG ) ) flag_qv = F_QG if (bl_pbl_physics .eq. 0) return ! RAINBL in mm (Accumulation between PBL calls) IF (itimestep .eq. 1 .or. mod(itimestep,STEPBL) .eq. 0) THEN radiation = .false. IF (ra_lw_physics .gt. 0) radiation = .true. !---- ! CALCULATE CONSTANT DTMIN=DT/60. ! PBL schemes need PBL time step for updates DTBL=DT*STEPBL ! SAVE OLD VALUES !$OMP PARALLEL DO & !$OMP PRIVATE ( ij,i,j,k ) DO ij = 1 , num_tiles DO j=j_start(ij),j_end(ij) DO i=i_start(ij),i_end(ij) TSKOLD(i,j)=TSK(i,j) USTOLD(i,j)=UST(i,j) ZNTOLD(i,j)=ZNT(i,j) ! REVERSE ORDER IN THE VERTICAL DIRECTION ! testing change later DO k=kts,kte 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 ! PSFC : in Pa PSFC(I,J)=p8w(I,kms,J) DO k=kts,min(kte+1,kde) RTHBLTEN(I,K,J)=0. RUBLTEN(I,K,J)=0. RVBLTEN(I,K,J)=0. IF ( PRESENT( RQCBLTEN )) RQCBLTEN(I,K,J)=0. IF ( PRESENT( RQVBLTEN )) RQVBLTEN(I,K,J)=0. ENDDO IF (flag_QI .AND. PRESENT(RQIBLTEN) ) THEN DO k=kts,min(kte+1,kde) RQIBLTEN(I,K,J)=0. ENDDO ENDIF ENDDO ENDDO ENDDO !$OMP END PARALLEL DO ! !$OMP PARALLEL DO & !$OMP PRIVATE ( ij, i,j,k, its, ite, jts, jte ) DO ij = 1 , num_tiles its = i_start(ij) ite = i_end(ij) jts = j_start(ij) jte = j_end(ij) pbl_select: SELECT CASE(bl_pbl_physics) CASE (YSUSCHEME) CALL wrf_debug(100,'in YSU PBL') IF ( PRESENT( qv_curr ) .AND. PRESENT( qc_curr ) .AND. & PRESENT( qi_curr ) .AND. & PRESENT( rqvblten ) .AND. PRESENT( rqcblten ) .AND. & PRESENT( rqiblten ) .AND. & PRESENT( hol ) .AND. & .TRUE. ) THEN CALL ysu( & U3D=u_phytmp,V3D=v_phytmp,TH3D=th_phy,T3D=t_phy & ,QV3D=qv_curr,QC3D=qc_curr,QI3D=qi_curr & ,P3D=p_phy,PI3D=pi_phy & ,RUBLTEN=rublten,RVBLTEN=rvblten & ,RTHBLTEN=rthblten,RQVBLTEN=rqvblten & ,RQCBLTEN=rqcblten,RQIBLTEN=rqiblten & ,CP=cp,G=g,ROVCP=rcp,RD=r_D,ROVG=rovg & ,DZ8W=dz8w,Z=z,XLV=XLV,RV=r_v,PSFC=PSFC & ,ZNT=znt,UST=ust,ZOL=zol,HOL=hol,HPBL=pblh & ,PSIM=psim,PSIH=psih,XLAND=xland & ,HFX=hfx,QFX=qfx,TSK=tskold,GZ1OZ0=gz1oz0 & ,WSPD=wspd,BR=br,DT=dtbl,DTMIN=dtmin,KPBL2D=kpbl & ,SVP1=svp1,SVP2=svp2,SVP3=svp3,SVPT0=svpt0 & ,EP1=ep_1,EP2=ep_2,KARMAN=karman,EOMEG=eomeg & ,STBOLT=stbolt,EXCH_H=exch_h,REGIME=regime & ,IDS=ids,IDE=ide,JDS=jds,JDE=jde,KDS=kds,KDE=kde & ,IMS=ims,IME=ime,JMS=jms,JME=jme,KMS=kms,KME=kme & ,ITS=its,ITE=ite,JTS=jts,JTE=jte,KTS=kts,KTE=kte & ) ELSE CALL wrf_error_fatal('Lack arguments to call YSU pbl') ENDIF CASE (MRFSCHEME) IF ( PRESENT( qv_curr ) .AND. PRESENT( qc_curr ) .AND. & PRESENT( rqvblten ) .AND. PRESENT( rqcblten ) .AND. & PRESENT( hol ) .AND. & .TRUE. ) THEN CALL wrf_debug(100,'in MRF') CALL mrf( & U3D=u_phytmp,V3D=v_phytmp,TH3D=th_phy,T3D=t_phy & ,QV3D=qv_curr & ,QC3D=qc_curr & ,QI3D=qi_curr & ,P3D=p_phy,PI3D=pi_phy & ,RUBLTEN=rublten,RVBLTEN=rvblten & ,RTHBLTEN=rthblten,RQVBLTEN=rqvblten & ,RQCBLTEN=rqcblten,RQIBLTEN=rqiblten & ,CP=cp,G=g,ROVCP=rcp,R=r_d,ROVG=rovg & ,DZ8W=dz8w,Z=z,XLV=xlv,RV=r_v,PSFC=psfc & ,ZNT=znt,UST=ust,ZOL=zol,HOL=hol & ,PBL=pblh,PSIM=psim,PSIH=psih & ,XLAND=xland,HFX=hfx,QFX=qfx,TSK=tskold & ,GZ1OZ0=gz1oz0,WSPD=wspd,BR=br & ,DT=dtbl,DTMIN=dtmin,KPBL2D=kpbl & ,SVP1=svp1,SVP2=svp2,SVP3=svp3,SVPT0=svpt0 & ,EP1=ep_1,EP2=ep_2,KARMAN=karman,EOMEG=eomeg & ,STBOLT=stbolt,REGIME=regime & ,FLAG_QI=flag_qi & ,IDS=ids,IDE=ide,JDS=jds,JDE=jde,KDS=kds,KDE=kde & ,IMS=ims,IME=ime,JMS=jms,JME=jme,KMS=kms,KME=kme & ,ITS=its,ITE=ite,JTS=jts,JTE=jte,KTS=kts,KTE=kte & ) ELSE CALL wrf_error_fatal('Lack arguments to call MRF pbl') ENDIF CASE (GFSSCHEME) IF ( PRESENT( qv_curr ) .AND. PRESENT( qc_curr ) .AND. & PRESENT( rqvblten ) .AND. PRESENT( rqcblten ) .AND. & .TRUE. ) THEN CALL wrf_debug(100,'in GFS') CALL bl_gfs( & U3D=u_phytmp,V3D=v_phytmp & ,TH3D=th_phy,T3D=t_phy & ,QV3D=qv_curr,QC3D=qc_curr,QI3D=qi_curr & ,P3D=p_phy,PI3D=pi_phy & ,RUBLTEN=rublten,RVBLTEN=rvblten,RTHBLTEN=rthblten & ,RQVBLTEN=rqvblten,RQCBLTEN=rqcblten & ,RQIBLTEN=rqiblten & ,CP=cp,G=g,ROVCP=rcp,R=r_d,ROVG=rovg,FLAG_QI=flag_qi & ,DZ8W=dz8w,z=z,PSFC=psfc & ,UST=ust,PBL=pblh,PSIM=psim,PSIH=psih & ,HFX=hfx,QFX=qfx,TSK=tskold,GZ1OZ0=gz1oz0 & ,WSPD=wspd,BR=br & ,DT=dtbl,KPBL2D=kpbl,EP1=ep_1,KARMAN=karman & ,IDS=ids,IDE=ide,JDS=jds,JDE=jde,KDS=kds,KDE=kde & ,IMS=ims,IME=ime,JMS=jms,JME=jme,KMS=kms,KME=kme & ,ITS=its,ITE=ite,JTS=jts,JTE=jte,KTS=kts,KTE=kte & ) ELSE CALL wrf_error_fatal('Lack arguments to call GFS pbl') ENDIF CASE (MYJPBLSCHEME) IF ( PRESENT( qv_curr ) .AND. PRESENT( qc_curr ) .AND. & PRESENT( rqvblten ) .AND. PRESENT( rqcblten ) .AND. & .TRUE. ) THEN CALL wrf_debug(100,'in MYJPBL') CALL myjpbl( & DT=dt,STEPBL=stepbl,HT=ht,DZ=dz8w & ,PMID=p_phy,PINT=p8w,TH=th_phy,T=t_phy,EXNER=pi_phy & ,QV=qv_curr, CWM=qc_curr & ,U=u_phy,V=v_phy,RHO=rho & ,TSK=tsk,QSFC=qsfc,CHKLOWQ=chklowq,THZ0=thz0 & ,QZ0=qz0,UZ0=uz0,VZ0=vz0 & ,LOWLYR=lowlyr & ,XLAND=xland,SICE=xice,SNOW=snow & ,TKE_MYJ=tke_myj,EXCH_H=exch_h,USTAR=ust,ZNT=znt & ,EL_MYJ=el_myj,PBLH=pblh,KPBL=kpbl,CT=ct & ,AKHS=akhs,AKMS=akms,ELFLX=lh & ,RUBLTEN=rublten,RVBLTEN=rvblten,RTHBLTEN=rthblten & ,RQVBLTEN=rqvblten,RQCBLTEN=rqcblten & ,IDS=ids,IDE=ide,JDS=jds,JDE=jde,KDS=kds,KDE=kde & ,IMS=ims,IME=ime,JMS=jms,JME=jme,KMS=kms,KME=kme & ,ITS=its,ITE=ite,JTS=jts,JTE=jte,KTS=kts,KTE=kte & ) ELSE CALL wrf_error_fatal('Lack arguments to call MYJ pbl') ENDIF CASE DEFAULT WRITE( message , * ) 'The pbl option does not exist: bl_pbl_physics = ', bl_pbl_physics CALL wrf_error_fatal ( message ) END SELECT pbl_select ENDDO !$OMP END PARALLEL DO ENDIF ! END SUBROUTINE pbl_driver END MODULE module_pbl_driver