!WRF:MODEL_LAYER:PHYSICS ! MODULE module_sf_idealscmsfclay CONTAINS !------------------------------------------------------------------- SUBROUTINE idealscmsfclay(u3d,v3d,th3d,qv3d,p3d,pi3d,rho,z,ht, & cp,g,rovcp,r,xlv,psfc,chs,chs2,cqs2,cpm, & znt,ust,mavail,xland, & hfx,qfx,lh,tsk,flhc,flqc,qgh,qsfc, & u10,v10,th2,t2,q2, & svp1,svp2,svp3,svpt0,ep1,ep2, & karman,fCor,exch_temf, & hfx_force, lh_force, tsk_force, & hfx_force_tend, lh_force_tend, tsk_force_tend, & dt,itimestep, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte & ) !------------------------------------------------------------------- IMPLICIT NONE !------------------------------------------------------------------- !-- u3d 3D u-velocity interpolated to theta points (m/s) !-- v3d 3D v-velocity interpolated to theta points (m/s) !-- th3d potential temperature (K) !-- qv3d 3D water vapor mixing ratio (Kg/Kg) !-- p3d 3D pressure (Pa) !-- cp heat capacity at constant pressure for dry air (J/kg/K) !-- g acceleration due to gravity (m/s^2) !-- rovcp R/CP !-- r gas constant for dry air (J/kg/K) !-- xlv latent heat of vaporization for water (J/kg) !-- psfc surface pressure (Pa) !-- chs heat/moisture exchange coefficient for LSM (m/s) !-- chs2 !-- cqs2 !-- cpm !-- znt roughness length (m) !-- ust u* in similarity theory (m/s) !-- mavail surface moisture availability (between 0 and 1) !-- xland land mask (1 for land, 2 for water) !-- hfx upward heat flux at the surface (W/m^2) !-- qfx upward moisture flux at the surface (kg/m^2/s) !-- lh net upward latent heat flux at surface (W/m^2) !-- tsk surface temperature (K) !-- flhc exchange coefficient for heat (W/m^2/K) !-- flqc exchange coefficient for moisture (kg/m^2/s) !-- qgh lowest-level saturated mixing ratio !-- qsfc ground saturated mixing ratio !-- u10 diagnostic 10m u wind !-- v10 diagnostic 10m v wind !-- th2 diagnostic 2m theta (K) !-- t2 diagnostic 2m temperature (K) !-- q2 diagnostic 2m mixing ratio (kg/kg) !-- svp1 constant for saturation vapor pressure (kPa) !-- svp2 constant for saturation vapor pressure (dimensionless) !-- svp3 constant for saturation vapor pressure (K) !-- svpt0 constant for saturation vapor pressure (K) !-- ep1 constant for virtual temperature (R_v/R_d - 1) (dimensionless) !-- ep2 constant for specific humidity calculation ! (R_d/R_v) (dimensionless) !-- karman Von Karman constant !-- fCor Coriolis parameter !-- 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 !------------------------------------------------------------------- INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte ! REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , & INTENT(IN ) :: u3d, v3d, th3d, qv3d, p3d, pi3d, rho, z REAL, DIMENSION( ims:ime, jms:jme ) , & INTENT(IN ) :: mavail, xland, fCor, ht, psfc, znt REAL, DIMENSION( ims:ime, jms:jme ) , & INTENT(INOUT) :: hfx, qfx, lh, flhc, flqc, tsk REAL, DIMENSION( ims:ime, jms:jme ) , & INTENT(INOUT) :: ust, chs2, cqs2, chs, cpm, qgh, qsfc REAL, DIMENSION( ims:ime, jms:jme ) , & INTENT(OUT ) :: u10, v10, th2, t2, q2 REAL, DIMENSION( ims:ime, jms:jme ) , & INTENT( OUT) :: exch_temf REAL, INTENT(INOUT) :: hfx_force, lh_force, tsk_force REAL, INTENT(IN ) :: hfx_force_tend, lh_force_tend, tsk_force_tend REAL, INTENT(IN ) :: dt INTEGER, INTENT(IN ) :: itimestep REAL, INTENT(IN ) :: cp,g,rovcp,r,xlv REAL, INTENT(IN ) :: svp1,svp2,svp3,svpt0 REAL, INTENT(IN ) :: ep1,ep2,karman ! ! LOCAL VARS INTEGER :: J ! ! WA 1/6/10 This routine just populates HFX, QFX, and TSK ! with the suitable converted forcing values. ! Note that flhc,flqc are not populated, this will NOT WORK with ! an LSM. ! Update forcing fluxes to the current timestep hfx_force = hfx_force + dt*hfx_force_tend lh_force = lh_force + dt*lh_force_tend tsk_force = tsk_force + dt*tsk_force_tend DO J=jts,jte CALL idealscmsfclay1d(j,u1d=u3d(ims,kms,j),v1d=v3d(ims,kms,j), & th1d=th3d(ims,kms,j),qv1d=qv3d(ims,kms,j),p1d=p3d(ims,kms,j), & pi1d=pi3d(ims,kms,j),rho=rho(ims,kms,j),z=z(ims,kms,j),& zsrf=ht(ims,j), & cp=cp,g=g,rovcp=rovcp,r=r,xlv=xlv,psfc=psfc(ims,j), & chs=chs(ims,j),chs2=chs2(ims,j),cqs2=cqs2(ims,j), & cpm=cpm(ims,j),znt=znt(ims,j),ust=ust(ims,j), & mavail=mavail(ims,j),xland=xland(ims,j), & hfx=hfx(ims,j),qfx=qfx(ims,j),lh=lh(ims,j),tsk=tsk(ims,j), & flhc=flhc(ims,j),flqc=flqc(ims,j),qgh=qgh(ims,j), & qsfc=qsfc(ims,j),u10=u10(ims,j),v10=v10(ims,j), & th2=th2(ims,j),t2=t2(ims,j),q2=q2(ims,j), & svp1=svp1,svp2=svp2,svp3=svp3,svpt0=svpt0, & ep1=ep1,ep2=ep2,karman=karman,fCor=fCor(ims,j), & exch_temfx=exch_temf(ims,j), & hfx_force=hfx_force,lh_force=lh_force,tsk_force=tsk_force, & hfx_force_tend=hfx_force_tend, & lh_force_tend=lh_force_tend, & tsk_force_tend=tsk_force_tend, & dt=dt,itimestep=itimestep, & 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 & ) ENDDO END SUBROUTINE idealscmsfclay !------------------------------------------------------------------- SUBROUTINE idealscmsfclay1d(j,u1d,v1d,th1d,qv1d,p1d, & pi1d,rho,z,zsrf,cp,g,rovcp,r,xlv,psfc, & chs,chs2,cqs2,cpm,znt,ust, & mavail,xland,hfx,qfx,lh,tsk, & flhc,flqc,qgh,qsfc,u10,v10, & th2,t2,q2,svp1,svp2,svp3,svpt0, & ep1,ep2,karman,fCor, & exch_temfx, & hfx_force,lh_force,tsk_force, & hfx_force_tend,lh_force_tend,tsk_force_tend, & dt,itimestep, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte & ) !!------------------------------------------------------------------- IMPLICIT NONE !!------------------------------------------------------------------- INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte, & j REAL, DIMENSION( ims:ime ), INTENT(IN ) :: & u1d,v1d,qv1d,p1d,th1d,pi1d,rho,z,zsrf REAL, INTENT(IN ) :: cp,g,rovcp,r,xlv REAL, DIMENSION( ims:ime ), INTENT(IN ) :: psfc,znt REAL, DIMENSION( ims:ime ), INTENT(INOUT) :: & chs,chs2,cqs2,cpm,ust REAL, DIMENSION( ims:ime ), INTENT(IN ) :: mavail,xland REAL, DIMENSION( ims:ime ), INTENT(INOUT) :: & hfx,qfx,lh REAL, DIMENSION( ims:ime ), INTENT(INOUT) :: tsk REAL, DIMENSION( ims:ime ), INTENT( OUT) :: & flhc,flqc REAL, DIMENSION( ims:ime ), INTENT(INOUT) :: & qgh,qsfc REAL, DIMENSION( ims:ime ), INTENT( OUT) :: & u10,v10,th2,t2,q2 REAL, INTENT(IN ) :: svp1,svp2,svp3,svpt0 REAL, INTENT(IN ) :: ep1,ep2,karman REAL, DIMENSION( ims:ime ), INTENT(IN ) :: fCor REAL, DIMENSION( ims:ime ), INTENT( OUT) :: exch_temfx REAL, INTENT(INOUT) :: hfx_force,lh_force,tsk_force REAL, INTENT(IN ) :: hfx_force_tend,lh_force_tend,tsk_force_tend REAL, INTENT(IN ) :: dt INTEGER, INTENT(IN ) :: itimestep ! !! LOCAL VARS ! TE model constants logical, parameter :: MFopt = .true. ! Use mass flux or not real, parameter :: TEmin = 1e-3 real, parameter :: ftau0 = 0.17 real, parameter :: fth0 = 0.145 real, parameter :: Cf = 0.185 real, parameter :: CN = 2.0 ! real, parameter :: Ceps = ftau0**1.5 real, parameter :: Ceps = 0.070 real, parameter :: Cgamma = Ceps real, parameter :: Cphi = Ceps ! real, parameter :: PrT0 = Cphi/Ceps * ftau0**2. / 2 / fth0**2. real, parameter :: PrT0 = Cphi/Ceps * ftau0**2 / 2. / fth0**2 ! integer :: i real :: e1 real, dimension( its:ite) :: wstr, ang, wm real, dimension( its:ite) :: z0t real, dimension( its:ite) :: dthdz, dqtdz, dudz, dvdz real, dimension( its:ite) :: lepsmin real, dimension( its:ite) :: thetav real, dimension( its:ite) :: zt,zm real, dimension( its:ite) :: N2, S, Ri, beta, ftau, fth, ratio real, dimension( its:ite) :: TKE, TE2 real, dimension( its:ite) :: ustrtilde, linv, leps real, dimension( its:ite) :: km, kh real, dimension( its:ite) :: qsfc_air !!------------------------------------------------------------------- !!!!!!! ****** ! WA Known outages: None do i = its,ite ! Main loop ! WA 1/6/10 This routine just populates HFX, QFX, and TSK ! with the suitable converted forcing values. ! Surface fluxes ust(i) = sqrt(ftau(i)/ftau0) * sqrt(u1d(i)**2. + v1d(i)**2.) * leps(i) / log(zm(i)/znt(i)) / zt(i) ang(i) = atan2(v1d(i),u1d(i)) ! Populate surface heat and moisture fluxes hfx(i) = hfx_force lh(i) = lh_force qfx(i) = lh(i) / xlv tsk(i) = tsk_force ! Populate exchange coefficients flhc(i) = hfx(i) / (tsk(i) - th1d(i)*pi1d(i)) exch_temfx(i) = flhc(i) / (rho(i) * cp) ! flqc(i) = qfx(i) / (qsfc_air(i) - qv1d(i)) flqc(i) = exch_temfx(i) * mavail(i) end do ! Main loop END SUBROUTINE idealscmsfclay1d !==================================================================== SUBROUTINE idealscmsfclayinit( allowed_to_read ) LOGICAL , INTENT(IN) :: allowed_to_read END SUBROUTINE idealscmsfclayinit !------------------------------------------------------------------- END MODULE module_sf_idealscmsfclay