Skip to content

Commit

Permalink
modified prognostic updraft fraction (sigmab) calcultation
Browse files Browse the repository at this point in the history
  • Loading branch information
@rhaesung
rhaesung committed Oct 25, 2024
1 parent f3eeb34 commit 14c2f52
Showing 1 changed file with 66 additions and 60 deletions.
126 changes: 66 additions & 60 deletions physics/CONV/progsigma_calc.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -21,7 +21,7 @@ module progsigma
!!\section gen_progsigma progsigma_calc General Algorithm
subroutine progsigma_calc (im,km,flag_init,flag_restart,flag_shallow,&
flag_mid,del,tmf,qmicro,dbyo1,zdqca,omega_u,zeta,hvap, &
delt,qadv,kbcon1,ktcon,cnvflg,betascu,betamcu,betadcu, &
delt,qadv,kb,kbcon1,ktcon,cnvflg,betascu,betamcu,betadcu, &
sigmind,sigminm,sigmins,sigmain,sigmaout,sigmab)
!
!
Expand All @@ -31,7 +31,7 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart,flag_shallow,&
implicit none

! intent in
integer, intent(in) :: im,km,kbcon1(im),ktcon(im)
integer, intent(in) :: im,km,kb(im),kbcon1(im),ktcon(im)
real(kind=kind_phys), intent(in) :: hvap,delt,betascu,betamcu,betadcu, &
sigmind,sigminm,sigmins
real(kind=kind_phys), intent(in) :: qadv(im,km),del(im,km), &
Expand All @@ -48,13 +48,13 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart,flag_shallow,&
! Local variables
integer :: i,k,km1
real(kind=kind_phys) :: termA(im),termB(im),termC(im),termD(im)
real(kind=kind_phys) :: mcons(im),fdqa(im),form(im,km), &
real(kind=kind_phys) :: fdqa(im),form(im,km), &
dp(im,km),inbu(im,km)
real(kind=kind_phys) :: sumx(im)

real(kind=kind_phys) :: gcvalmx,epsilon,ZZ,cvg,mcon,buy2, &
fdqb,dtdyn,dxlim,rmulacvg,tem, &
DEN,dp1,invdelt
DEN,dp1,invdelt,sigmind_new

!Parameters
gcvalmx = 0.1
Expand All @@ -63,6 +63,12 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart,flag_shallow,&
km1=km-1
invdelt = 1./delt

if (flag_init) then
sigmind_new=0.0
else
sigmind_new=sigmind
end if

!Initialization 2D
do k = 1,km
do i = 1,im
Expand All @@ -80,7 +86,7 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart,flag_shallow,&
termC(i)=0.
termD(i)=0.
fdqa(i)=0.
mcons(i)=0.
sumx(i)=0.
enddo

do k = 2,km1
Expand All @@ -89,47 +95,49 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart,flag_shallow,&
dp(i,k) = 1000. * del(i,k)
endif
enddo
enddo
enddo

!Initial computations, place maximum sigmain in sigmab
do i=1,im
!compute sigmain averaged over cloud layers after advection and place it in sigmab
do k=2,km1
do i=1,im
if(cnvflg(i))then
do k=2,km
if(sigmain(i,k)>sigmab(i))then
sigmab(i)=sigmain(i,k)
endif
enddo
endif
enddo

do i=1,im
if(cnvflg(i))then
if(sigmab(i) < 1.E-5)then !after advection
sigmab(i)=0.
if(k > kbcon1(i) .and. k < ktcon(i)) then
sigmab(i) = sigmab(i) + sigmain(i,k) * dp(i,k)
sumx(i) = sumx(i) + dp(i,k)
endif
endif
endif
enddo
enddo
do i = 1, im
if(cnvflg(i)) then
if(sumx(i) == 0.) then
k = kbcon1(i)
sigmab(i) = sigmain(i,k)
else
sigmab(i) = sigmab(i) / sumx(i)
sigmab(i) = min(sigmab(i), 1.0)
if(sigmab(i) < 1.E-5) sigmab(i)=0.
endif
endif
enddo

!compute termD "The vertical integral of the latent heat convergence is limited to the
!buoyant layers with positive moisture convergence (accumulated from the surface).
!Lowest level:
do i = 1,im
dp1 = 1000. * del(i,1)
mcons(i)=(hvap*(qadv(i,1)+tmf(i,1)+qmicro(i,1))*dp1)
enddo
!Levels above:
do k = 2,km1
! layers with positive moisture convergence (accumulated from the updraft starting level).
do k = 1,km1
do i = 1,im
if(cnvflg(i))then
mcon = (hvap*(qadv(i,k)+tmf(i,k)+qmicro(i,k))*dp(i,k))
buy2 = termD(i)+mcon+mcons(i)
! Do the integral over buoyant layers with positive mcon acc from surface
if(dbyo1(i,k)>0 .and. buy2 > 0.)then
if(k >= kb(i) .and. k < ktcon(i)) then
mcon = (hvap*(qadv(i,k)+tmf(i,k)+qmicro(i,k))*dp(i,k))
buy2 = termD(i)+mcon
!
! Do the integral over buoyant layers with positive mcon acc from
! updraft starting level
!
if(buy2 > 0.)then
inbu(i,k)=1.
endif
inbu(i,k-1)=MAX(inbu(i,k-1),inbu(i,k))
termD(i) = termD(i) + inbu(i,k-1)*mcons(i)
mcons(i)=mcon
termD(i) = termD(i) + mcon
endif
endif
endif
enddo
enddo
Expand All @@ -138,8 +146,10 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart,flag_shallow,&
do k = 2,km1
do i = 1,im
if(cnvflg(i))then
if(k >= kbcon1(i) .and. k < ktcon(i)) then
tem=sigmab(i)*zeta(i,k)*inbu(i,k)*dbyo1(i,k)*dp(i,k)
termA(i)=termA(i)+tem
endif
endif
enddo
enddo
Expand All @@ -148,8 +158,10 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart,flag_shallow,&
do k = 2,km1
do i = 1,im
if(cnvflg(i))then
if(k >= kbcon1(i) .and. k < ktcon(i)) then
tem=zeta(i,k)*dbyo1(i,k)*inbu(i,k)*dp(i,k)
termB(i)=termB(i)+tem
endif
endif
enddo
enddo
Expand All @@ -158,39 +170,33 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart,flag_shallow,&
do k = 2,km1
do i = 1,im
if(cnvflg(i))then
if(k >= kbcon1(i) .and. k < ktcon(i)) then
form(i,k)=-1.0*inbu(i,k)*(omega_u(i,k)*delt)
fdqb=0.5*((form(i,k)*zdqca(i,k)))
termC(i)=termC(i)+inbu(i,k)* &
(fdqb+fdqa(i))*hvap*zeta(i,k)
fdqa(i)=fdqb
endif
endif
enddo
enddo

!sigmab
if(flag_init .and. .not. flag_restart)then
do i = 1,im
if(cnvflg(i))then
sigmab(i)=0.03
do i = 1,im
if(cnvflg(i))then
DEN=MIN(termC(i)+termB(i),1.E8)
cvg=termD(i)*delt
ZZ=MAX(0.0,SIGN(1.0,termA(i))) &
*MAX(0.0,SIGN(1.0,termB(i))) &
*MAX(0.0,SIGN(1.0,termC(i)-epsilon))
cvg=MAX(0.0,cvg)
sigmab(i)=(ZZ*(termA(i)+cvg))/(DEN+(1.0-ZZ))
if(sigmab(i)>0.)then
sigmab(i)=MIN(sigmab(i),0.95)
sigmab(i)=MAX(sigmab(i),sigmind_new)
endif
enddo
else
do i = 1,im
if(cnvflg(i))then
DEN=MIN(termC(i)+termB(i),1.E8)
cvg=termD(i)*delt
ZZ=MAX(0.0,SIGN(1.0,termA(i))) &
*MAX(0.0,SIGN(1.0,termB(i))) &
*MAX(0.0,SIGN(1.0,termC(i)-epsilon))
cvg=MAX(0.0,cvg)
sigmab(i)=(ZZ*(termA(i)+cvg))/(DEN+(1.0-ZZ))
if(sigmab(i)>0.)then
sigmab(i)=MIN(sigmab(i),0.95)
sigmab(i)=MAX(sigmab(i),0.01)
endif
endif!cnvflg
enddo
endif
endif!cnvflg
enddo

do k=1,km
do i=1,im
Expand Down

0 comments on commit 14c2f52

Please sign in to comment.