Skip to content

Commit

Permalink
P8C updates: the TKE-EDMF PBL scheme and the saSAS cumulus scheme
Browse files Browse the repository at this point in the history
  • Loading branch information
@ChunxiZhang-NOAA
ChunxiZhang-NOAA committed Mar 15, 2022
1 parent 979324a commit 54a57ba
Show file tree
Hide file tree
Showing 5 changed files with 253 additions and 52 deletions.
28 changes: 19 additions & 9 deletions physics/mfpbltq.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -11,7 +11,7 @@
subroutine mfpbltq(im,ix,km,kmpbl,ntcw,ntrac1,delt,
& cnvflg,zl,zm,q1,t1,u1,v1,plyr,pix,thlx,thvx,
& gdx,hpbl,kpbl,vpert,buo,xmf,
& tcko,qcko,ucko,vcko,xlamue,a1)
& tcko,qcko,ucko,vcko,xlamueq,a1)
!
use machine , only : kind_phys
use funcphys , only : fpvs
Expand All @@ -35,14 +35,15 @@ subroutine mfpbltq(im,ix,km,kmpbl,ntcw,ntrac1,delt,
& buo(im,km), xmf(im,km),
& tcko(im,km),qcko(im,km,ntrac1),
& ucko(im,km),vcko(im,km),
& xlamue(im,km-1)
& xlamueq(im,km-1)
!
c local variables and arrays
!
integer i, j, k, n, ndc
integer kpblx(im), kpbly(im)
!
real(kind=kind_phys) dt2, dz, ce0, cm,
real(kind=kind_phys) dt2, dz, ce0,
& cm, cq,
& factor, gocp,
& g, b1, f1,
& bb1, bb2,
Expand All @@ -56,7 +57,7 @@ subroutine mfpbltq(im,ix,km,kmpbl,ntcw,ntrac1,delt,
& thup, thvu, dq
!
real(kind=kind_phys) rbdn(im), rbup(im), hpblx(im),
& xlamuem(im,km-1)
& xlamue(im,km-1), xlamuem(im,km-1)
real(kind=kind_phys) delz(im), xlamax(im)
!
real(kind=kind_phys) wu2(im,km), thlu(im,km),
Expand All @@ -71,7 +72,7 @@ subroutine mfpbltq(im,ix,km,kmpbl,ntcw,ntrac1,delt,
parameter(g=grav)
parameter(gocp=g/cp)
parameter(elocp=hvap/cp,el2orc=hvap*hvap/(rv*cp))
parameter(ce0=0.4,cm=1.0)
parameter(ce0=0.4,cm=1.0,cq=1.3)
parameter(qmin=1.e-8,qlmin=1.e-12)
parameter(alp=1.5,vpertmax=3.0,pgcon=0.55)
parameter(b1=0.5,f1=0.15)
Expand Down Expand Up @@ -132,6 +133,7 @@ subroutine mfpbltq(im,ix,km,kmpbl,ntcw,ntrac1,delt,
xlamue(i,k) = xlamax(i)
endif
!
xlamueq(i,k) = cq * xlamue(i,k)
xlamuem(i,k) = cm * xlamue(i,k)
endif
enddo
Expand All @@ -148,6 +150,9 @@ subroutine mfpbltq(im,ix,km,kmpbl,ntcw,ntrac1,delt,
!
thlu(i,k) = ((1.-tem)*thlu(i,k-1)+tem*
& (thlx(i,k-1)+thlx(i,k)))/factor
!
tem = 0.5 * xlamueq(i,k-1) * dz
factor = 1. + tem
qtu(i,k) = ((1.-tem)*qtu(i,k-1)+tem*
& (qtx(i,k-1)+qtx(i,k)))/factor
!
Expand Down Expand Up @@ -282,6 +287,7 @@ subroutine mfpbltq(im,ix,km,kmpbl,ntcw,ntrac1,delt,
xlamue(i,k) = xlamax(i)
endif
!
xlamueq(i,k) = cq * xlamue(i,k)
xlamuem(i,k) = cm * xlamue(i,k)
endif
enddo
Expand Down Expand Up @@ -313,7 +319,7 @@ subroutine mfpbltq(im,ix,km,kmpbl,ntcw,ntrac1,delt,
do k = 1, kmpbl
do i = 1, im
if (cnvflg(i) .and. k < kpbl(i)) then
xmf(i,k) = a1 * sqrt(wu2(i,k))
xmf(i,k) = sqrt(wu2(i,k))
endif
enddo
enddo
Expand Down Expand Up @@ -350,7 +356,8 @@ subroutine mfpbltq(im,ix,km,kmpbl,ntcw,ntrac1,delt,
do k = 1, kmpbl
do i = 1, im
if (cnvflg(i) .and. k < kpbl(i)) then
xmf(i,k) = scaldfunc(i) * xmf(i,k)
tem = max(a1, sigma(i))
xmf(i,k) = scaldfunc(i) * tem * xmf(i,k)
dz = zl(i,k+1) - zl(i,k)
xmmx = dz / dt2
xmf(i,k) = min(xmf(i,k),xmmx)
Expand Down Expand Up @@ -384,6 +391,9 @@ subroutine mfpbltq(im,ix,km,kmpbl,ntcw,ntrac1,delt,
!
thlu(i,k) = ((1.-tem)*thlu(i,k-1)+tem*
& (thlx(i,k-1)+thlx(i,k)))/factor
!
tem = 0.5 * xlamueq(i,k-1) * dz
factor = 1. + tem
qtu(i,k) = ((1.-tem)*qtu(i,k-1)+tem*
& (qtx(i,k-1)+qtx(i,k)))/factor
!
Expand Down Expand Up @@ -432,7 +442,7 @@ subroutine mfpbltq(im,ix,km,kmpbl,ntcw,ntrac1,delt,
do i = 1, im
if (cnvflg(i) .and. k <= kpbl(i)) then
dz = zl(i,k) - zl(i,k-1)
tem = 0.5 * xlamue(i,k-1) * dz
tem = 0.5 * xlamueq(i,k-1) * dz
factor = 1. + tem
!
qcko(i,k,n) = ((1.-tem)*qcko(i,k-1,n)+tem*
Expand All @@ -453,7 +463,7 @@ subroutine mfpbltq(im,ix,km,kmpbl,ntcw,ntrac1,delt,
do i = 1, im
if (cnvflg(i) .and. k <= kpbl(i)) then
dz = zl(i,k) - zl(i,k-1)
tem = 0.5 * xlamue(i,k-1) * dz
tem = 0.5 * xlamueq(i,k-1) * dz
factor = 1. + tem
!
qcko(i,k,n) = ((1.-tem)*qcko(i,k-1,n)+tem*
Expand Down
28 changes: 19 additions & 9 deletions physics/mfscuq.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -11,7 +11,7 @@ subroutine mfscuq(im,ix,km,kmscu,ntcw,ntrac1,delt,
& cnvflg,zl,zm,q1,t1,u1,v1,plyr,pix,
& thlx,thvx,thlvx,gdx,thetae,
& krad,mrad,radmin,buo,xmfd,
& tcdo,qcdo,ucdo,vcdo,xlamde,a1)
& tcdo,qcdo,ucdo,vcdo,xlamdeq,a1)
!
use machine , only : kind_phys
use funcphys , only : fpvs
Expand Down Expand Up @@ -39,15 +39,16 @@ subroutine mfscuq(im,ix,km,kmscu,ntcw,ntrac1,delt,
& buo(im,km), xmfd(im,km),
& tcdo(im,km), qcdo(im,km,ntrac1),
& ucdo(im,km), vcdo(im,km),
& xlamde(im,km-1)
& xlamdeq(im,km-1)
!
! local variables and arrays
!
!
integer i,j,indx, k, n, kk, ndc
integer krad1(im)
!
real(kind=kind_phys) dt2, dz, ce0, cm,
real(kind=kind_phys) dt2, dz, ce0,
& cm, cq,
& gocp, factor, g, tau,
& b1, f1, bb1, bb2,
& a1, a2,
Expand All @@ -62,7 +63,7 @@ subroutine mfscuq(im,ix,km,kmscu,ntcw,ntrac1,delt,
!
real(kind=kind_phys) wd2(im,km), thld(im,km),
& qtx(im,km), qtd(im,km),
& thlvd(im), hrad(im),
& thlvd(im), hrad(im), xlamde(im,km-1),
& xlamdem(im,km-1), ra1(im)
real(kind=kind_phys) delz(im), xlamax(im)
!
Expand All @@ -77,7 +78,7 @@ subroutine mfscuq(im,ix,km,kmscu,ntcw,ntrac1,delt,
parameter(g=grav)
parameter(gocp=g/cp)
parameter(elocp=hvap/cp,el2orc=hvap*hvap/(rv*cp))
parameter(ce0=0.4,cm=1.0,pgcon=0.55)
parameter(ce0=0.4,cm=1.0,cq=1.3,pgcon=0.55)
parameter(qmin=1.e-8,qlmin=1.e-12)
parameter(b1=0.45,f1=0.15)
parameter(a2=0.5)
Expand Down Expand Up @@ -208,6 +209,7 @@ subroutine mfscuq(im,ix,km,kmscu,ntcw,ntrac1,delt,
xlamde(i,k) = xlamax(i)
endif
!
xlamdeq(i,k) = cq * xlamde(i,k)
xlamdem(i,k) = cm * xlamde(i,k)
endif
enddo
Expand All @@ -224,6 +226,9 @@ subroutine mfscuq(im,ix,km,kmscu,ntcw,ntrac1,delt,
!
thld(i,k) = ((1.-tem)*thld(i,k+1)+tem*
& (thlx(i,k)+thlx(i,k+1)))/factor
!
tem = 0.5 * xlamdeq(i,k) * dz
factor = 1. + tem
qtd(i,k) = ((1.-tem)*qtd(i,k+1)+tem*
& (qtx(i,k)+qtx(i,k+1)))/factor
!
Expand Down Expand Up @@ -347,6 +352,7 @@ subroutine mfscuq(im,ix,km,kmscu,ntcw,ntrac1,delt,
xlamde(i,k) = xlamax(i)
endif
!
xlamdeq(i,k) = cq * xlamde(i,k)
xlamdem(i,k) = cm * xlamde(i,k)
endif
enddo
Expand Down Expand Up @@ -380,7 +386,7 @@ subroutine mfscuq(im,ix,km,kmscu,ntcw,ntrac1,delt,
do i = 1, im
if(cnvflg(i) .and.
& (k >= mrad(i) .and. k < krad(i))) then
xmfd(i,k) = ra1(i) * sqrt(wd2(i,k))
xmfd(i,k) = sqrt(wd2(i,k))
endif
enddo
enddo
Expand Down Expand Up @@ -418,7 +424,8 @@ subroutine mfscuq(im,ix,km,kmscu,ntcw,ntrac1,delt,
do i = 1, im
if(cnvflg(i) .and.
& (k >= mrad(i) .and. k < krad(i))) then
xmfd(i,k) = scaldfunc(i) * xmfd(i,k)
tem = max(ra1(i), sigma(i))
xmfd(i,k) = scaldfunc(i) * tem * xmfd(i,k)
dz = zl(i,k+1) - zl(i,k)
xmmx = dz / dt2
xmfd(i,k) = min(xmfd(i,k),xmmx)
Expand Down Expand Up @@ -457,6 +464,9 @@ subroutine mfscuq(im,ix,km,kmscu,ntcw,ntrac1,delt,
!
thld(i,k) = ((1.-tem)*thld(i,k+1)+tem*
& (thlx(i,k)+thlx(i,k+1)))/factor
!
tem = 0.5 * xlamdeq(i,k) * dz
factor = 1. + tem
qtd(i,k) = ((1.-tem)*qtd(i,k+1)+tem*
& (qtx(i,k)+qtx(i,k+1)))/factor
!
Expand Down Expand Up @@ -509,7 +519,7 @@ subroutine mfscuq(im,ix,km,kmscu,ntcw,ntrac1,delt,
if (cnvflg(i) .and. k < krad(i)) then
if(k >= mrad(i)) then
dz = zl(i,k+1) - zl(i,k)
tem = 0.5 * xlamde(i,k) * dz
tem = 0.5 * xlamdeq(i,k) * dz
factor = 1. + tem
!
qcdo(i,k,n) = ((1.-tem)*qcdo(i,k+1,n)+tem*
Expand All @@ -532,7 +542,7 @@ subroutine mfscuq(im,ix,km,kmscu,ntcw,ntrac1,delt,
if (cnvflg(i) .and. k < krad(i)) then
if(k >= mrad(i)) then
dz = zl(i,k+1) - zl(i,k)
tem = 0.5 * xlamde(i,k) * dz
tem = 0.5 * xlamdeq(i,k) * dz
factor = 1. + tem
!
qcdo(i,k,n) = ((1.-tem)*qcdo(i,k+1,n)+tem*
Expand Down
Loading

0 comments on commit 54a57ba

Please sign in to comment.