Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

release/p8c: updated PBL and convection schemes plus a bug fix for the Thompson scheme #882

Merged
merged 4 commits into from
Apr 4, 2022
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
23 changes: 16 additions & 7 deletions physics/mfpbltq.f
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 @@ -384,6 +390,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 +441,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 +462,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
23 changes: 16 additions & 7 deletions physics/mfscuq.f
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 @@ -457,6 +463,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 +518,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 +541,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
9 changes: 8 additions & 1 deletion physics/module_mp_thompson.F90
Original file line number Diff line number Diff line change
Expand Up @@ -4067,7 +4067,14 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, &
do k = kte, kts, -1
vtg = 0.
if (rg(k).gt. R1) then
vtg = rhof(k)*av_g*cgg(6)*ogg3 * ilamg(k)**bv_g
ygra1 = alog10(max(1.E-9, rg(k)))
zans1 = 3.0 + 2./7.*(ygra1+8.) + rand1
N0_exp = 10.**(zans1)
N0_exp = MAX(DBLE(gonv_min), MIN(N0_exp, DBLE(gonv_max)))
lam_exp = (N0_exp*am_g*cgg(1)/rg(k))**oge1
lamg = lam_exp * (cgg(3)*ogg2*ogg1)**obmg

vtg = rhof(k)*av_g*cgg(6)*ogg3 * (1./lamg)**bv_g
if (temp(k).gt. T_0) then
vtgk(k) = MAX(vtg, vtrk(k))
else
Expand Down
Loading