Skip to content

Commit

Permalink
updates in satmedmfvdifq (#120)
Browse files Browse the repository at this point in the history
  • Loading branch information
junwang-noaa authored May 21, 2020
1 parent 7ef610a commit 06f03d9
Show file tree
Hide file tree
Showing 2 changed files with 35 additions and 8 deletions.
4 changes: 2 additions & 2 deletions gfsphysics/GFS_layer/GFS_physics_driver.F90
Original file line number Diff line number Diff line change
Expand Up @@ -2398,7 +2398,7 @@ subroutine GFS_physics_driver &
call satmedmfvdifq(ix, im, levs, nvdiff, ntcw, ntiw, ntke, &
dvdt, dudt, dtdt, dqdt, &
Statein%ugrs, Statein%vgrs, Statein%tgrs, Statein%qgrs, &
Radtend%htrsw, Radtend%htrlw, xmu, garea, islmsk, &
Radtend%htrsw, Radtend%htrlw, xmu, garea, islmsk,snowd3, &
Statein%prsik(1,1), rb, Sfcprop%zorl, Diag%u10m, Diag%v10m, &
Sfcprop%ffmm, Sfcprop%ffhh, Sfcprop%tsfc, hflxq, evapq, &
stress, wind, kpbl, Statein%prsi, del, Statein%prsl, &
Expand Down Expand Up @@ -2651,7 +2651,7 @@ subroutine GFS_physics_driver &
call satmedmfvdifq(ix, im, levs, nvdiff, ntcw, ntiwx, ntkev, &
dvdt, dudt, dtdt, dvdftra, &
Statein%ugrs, Statein%vgrs, Statein%tgrs, vdftra, &
Radtend%htrsw, Radtend%htrlw, xmu, garea, islmsk, &
Radtend%htrsw, Radtend%htrlw, xmu, garea, islmsk,snowd3, &
Statein%prsik(1,1), rb, Sfcprop%zorl, Diag%u10m, Diag%v10m, &
Sfcprop%ffmm, Sfcprop%ffhh, Sfcprop%tsfc, hflxq, evapq, &
stress, wind, kpbl, Statein%prsi, del, Statein%prsl, &
Expand Down
39 changes: 33 additions & 6 deletions gfsphysics/physics/satmedmfvdifq.f
Original file line number Diff line number Diff line change
Expand Up @@ -19,7 +19,8 @@
!
!----------------------------------------------------------------------
subroutine satmedmfvdifq(ix,im,km,ntrac,ntcw,ntiw,ntke,
& dv,du,tdt,rtg,u1,v1,t1,q1,swh,hlw,xmu,garea,islimsk,
!wz & dv,du,tdt,rtg,u1,v1,t1,q1,swh,hlw,xmu,garea,
& dv,du,tdt,rtg,u1,v1,t1,q1,swh,hlw,xmu,garea,islimsk,snwdph,
& psk,rbsoil,zorl,u10m,v10m,fm,fh,
& tsea,heat,evap,stress,spd1,kpbl,
& prsi,del,prsl,prslk,phii,phil,delt,
Expand All @@ -37,7 +38,11 @@ subroutine satmedmfvdifq(ix,im,km,ntrac,ntcw,ntiw,ntke,
!
!----------------------------------------------------------------------
integer ix, im, km, ntrac, ntcw, ntiw, ntke
integer kpbl(im), kinver(im), islimsk(im)
integer kpbl(im), kinver(im)
!
!wz
integer islimsk(im)
real(kind=kind_phys), dimension(im,3), intent(in) :: snwdph
!
real(kind=kind_phys) delt, xkzm_m, xkzm_h, xkzm_s, dspfac,
& bl_upfr, bl_dnfr
Expand Down Expand Up @@ -156,6 +161,8 @@ subroutine satmedmfvdifq(ix,im,km,ntrac,ntcw,ntiw,ntke,
& zlup, zldn, bsum,
& tem, tem1, tem2,
& ptem, ptem0, ptem1, ptem2
!wz
real(kind=kind_phys) xkzm_mp, xkzm_hp
!
real(kind=kind_phys) ck0, ck1, ch0, ch1, ce0, rchck
!
Expand Down Expand Up @@ -254,17 +261,37 @@ subroutine satmedmfvdifq(ix,im,km,ntrac,ntcw,ntiw,ntke,
! xkzm_hx = 0.01 + (xkzm_h - 0.01)/(xkgdx-5.) * (gdx-5.)
! xkzm_mx = 0.01 + (xkzm_h - 0.01)/(xkgdx-5.) * (gdx-5.)
!
!wz
do i=1,im
xkzm_mp = xkzm_m
xkzm_hp = xkzm_h
!
if( islimsk(i) == 1 .and. snwdph(i,1) > 10.0 ) then ! over land
if (rbsoil(i) > 0. .and. rbsoil(i) <= 0.25) then
xkzm_mp = xkzm_m * (1.0 - rbsoil(i)/0.25)**2 +
& 0.1 * (1.0 - (1.0-rbsoil(i)/0.25)**2)
xkzm_hp = xkzm_h * (1.0 - rbsoil(i)/0.25)**2 +
& 0.1 * (1.0 - (1.0-rbsoil(i)/0.25)**2)
else if (rbsoil(i) > 0.25) then
xkzm_mp = 0.1
xkzm_hp = 0.1
endif
endif
!#
kx1(i) = 1
tx1(i) = 1.0 / prsi(i,1)
tx2(i) = tx1(i)
if(gdx(i) >= xkgdx) then
xkzm_hx(i) = xkzm_h
xkzm_mx(i) = xkzm_m
!wz xkzm_hx(i) = xkzm_h
!wz xkzm_mx(i) = xkzm_m
xkzm_hx(i) = xkzm_hp
xkzm_mx(i) = xkzm_mp
else
tem = 1. / (xkgdx - 5.)
tem1 = (xkzm_h - 0.01) * tem
tem2 = (xkzm_m - 0.01) * tem
!wz tem1 = (xkzm_h - 0.01) * tem
!wz tem2 = (xkzm_m - 0.01) * tem
tem1 = (xkzm_hp - 0.01) * tem
tem2 = (xkzm_mp - 0.01) * tem
ptem = gdx(i) - 5.
xkzm_hx(i) = 0.01 + tem1 * ptem
xkzm_mx(i) = 0.01 + tem2 * ptem
Expand Down

0 comments on commit 06f03d9

Please sign in to comment.