Skip to content

Commit

Permalink
addressing some review comments
Browse files Browse the repository at this point in the history
  • Loading branch information
@lisa-bengtsson
lisa-bengtsson committed Apr 22, 2022
1 parent 89eaad9 commit fc7e7a0
Show file tree
Hide file tree
Showing 8 changed files with 95 additions and 90 deletions.
16 changes: 9 additions & 7 deletions physics/GFS_MP_generic.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -95,7 +95,7 @@ subroutine GFS_MP_generic_post_run(
drain_cpl, dsnow_cpl, lsm, lsm_ruc, lsm_noahmp, raincprv, rainncprv, iceprv, snowprv, &
graupelprv, draincprv, drainncprv, diceprv, dsnowprv, dgraupelprv, dtp, dfi_radar_max_intervals, &
dtend, dtidx, index_of_temperature, index_of_process_mp,ldiag3d, qdiag3d,dqdt_qmicro, lssav, num_dfi_radar, &
fh_dfi_radar,index_of_process_dfi_radar, ix_dfi_radar, dfi_radar_tten, radar_tten_limits, fhour, qgrs_dsave, &
fh_dfi_radar,index_of_process_dfi_radar, ix_dfi_radar, dfi_radar_tten, radar_tten_limits, fhour, prevsq, &
errmsg, errflg)
!
use machine, only: kind_phys
Expand Down Expand Up @@ -150,7 +150,7 @@ subroutine GFS_MP_generic_post_run(
real(kind=kind_phys), dimension(:), intent(inout) :: dsnowprv
real(kind=kind_phys), dimension(:), intent(inout) :: dgraupelprv
real(kind=kind_phys), dimension(:,:), intent(out) :: dqdt_qmicro
real(kind=kind_phys), dimension(:,:), intent(out) :: qgrs_dsave
real(kind=kind_phys), dimension(:,:), intent(out) :: prevsq
real(kind=kind_phys), intent(in) :: dtp

! CCPP error handling
Expand Down Expand Up @@ -466,11 +466,13 @@ subroutine GFS_MP_generic_post_run(
pwat(i) = pwat(i) * onebg
enddo

do k = 1, levs
do i=1, im
qgrs_dsave(i,k) = gq0(i,k,1)
enddo
enddo
if(progsigma)then
do k = 1, levs
do i=1, im
prevsq(i,k) = gq0(i,k,1)
enddo
enddo
endif

end subroutine GFS_MP_generic_post_run
!> @}
Expand Down
12 changes: 6 additions & 6 deletions physics/GFS_MP_generic.meta
View file
Original file line number Diff line number Diff line change
Expand Up @@ -249,8 +249,8 @@
type = logical
intent = in
[progsigma]
standard_name = flag_for_prognostic_sigma
long_name = flag for prognostic sigma
standard_name = do_prognostic_updraft_area_fraction
long_name = flag for prognostic sigma in cumulus scheme
units = flag
dimensions = ()
type = logical
Expand Down Expand Up @@ -852,16 +852,16 @@
type = logical
intent = in
[dqdt_qmicro]
standard_name = instantaneous_moisture_tendency_due_to_microphysics
standard_name = instantaneous_tendency_of_specific_humidity_due_to_microphysics
long_name = moisture tendency due to microphysics
units = kg kg-1 s-1
dimensions = (horizontal_loop_extent,vertical_layer_dimension)
type = real
kind = kind_phys
intent = out
[qgrs_dsave]
standard_name = tracer_concentration_dsave
long_name = model layer mean tracer concentration dsave
[prevsq]
standard_name = specific_humidity_on_previous_timestep
long_name = specific_humidity_on_previous_timestep
units = kg kg-1
dimensions = (horizontal_loop_extent,vertical_layer_dimension)
type = real
Expand Down
103 changes: 51 additions & 52 deletions physics/progsigma_calc.f90
View file
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
!>\file progsigma
!>\file progsigma_calc.f90
!! This file contains the subroutine that calculates the prognostic
!! updraft area fraction that is used for closure computations in
!! saSAS deep and shallow convection, based on a moisture budget
Expand All @@ -15,7 +15,7 @@

subroutine progsigma_calc (im,km,flag_init,flag_restart, &
flag_shallow,del,tmf,qmicro,dbyo1,zdqca,omega_u,zeta,hvap, &
delt,qgrs_dsave,q,kbcon1,ktcon,cnvflg,gdx, &
delt,prevsq,q,kbcon1,ktcon,cnvflg,gdx, &
sigmain,sigmaout,sigmab,errmsg,errflg)
!
!
Expand All @@ -27,7 +27,7 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart, &
! intent in
integer, intent(in) :: im,km,kbcon1(im),ktcon(im)
real, intent(in) :: hvap,delt
real, intent(in) :: qgrs_dsave(im,km), q(im,km),del(im,km), &
real, intent(in) :: prevsq(im,km), q(im,km),del(im,km), &
qmicro(im,km),tmf(im,km),dbyo1(im,km),zdqca(im,km), &
omega_u(im,km),zeta(im,km),gdx(im)
logical, intent(in) :: flag_init,flag_restart,cnvflg(im),flag_shallow
Expand All @@ -43,33 +43,32 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart, &
integer :: i,k,km1
real(kind=kind_phys) :: termA(im),termB(im),termC(im),termD(im), &
mcons(im),fdqa(im),form(im,km), &
qadv(im,km),sigmamax(im)
qadv(im,km),sigmamax(im),dp(im),inbu(im,km)


real(kind=kind_phys) :: gcvalmx,epsilon,ZZ,cvg,mcon,buy2, &
fdqb,dtdyn,dxlim,rmulacvg,dp,tem, &
alpha,DEN,betascu
integer :: inbu(im,km)
fdqb,dtdyn,dxlim,rmulacvg,tem, &
alpha,DEN,betascu,dp1

!Parameters
gcvalmx = 0.1
rmulacvg=10.
epsilon=1.E-11
km1=km-1
alpha=7000.
betascu = 3.0
gcvalmx = 0.1
rmulacvg=10.
epsilon=1.E-11
km1=km-1
alpha=7000.
betascu = 3.0

!Initialization 2D
do k = 1,km
do i = 1,im
sigmaout(i,k)=0.
inbu(i,k)=0
form(i,k)=0.
enddo
enddo
do k = 1,km
do i = 1,im
sigmaout(i,k)=0.
inbu(i,k)=0.
form(i,k)=0.
enddo
enddo

!Initialization 1D
do i=1,im
do i=1,im
sigmab(i)=0.
sigmamax(i)=0.95
termA(i)=0.
Expand All @@ -80,23 +79,32 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart, &
mcons(i)=0.
enddo

!Initial computations, place maximum sigmain in sigmab
do k = 2,km1
do i = 1,im
if(cnvflg(i))then
dp(i) = 1000. * del(i,k)
endif
enddo
enddo

do k=2,km
do i=1,im
if(flag_init .and. .not. flag_restart)then
!Initial computations, place maximum sigmain in sigmab
if(flag_init .and. .not. flag_restart)then
do i=1,im
if(cnvflg(i))then
sigmab(i)=0.03
endif
else
enddo
else
do i=1,im
if(cnvflg(i))then
if(sigmain(i,k)>sigmab(i))then
sigmab(i)=sigmain(i,k)
endif
do k=2,km
if(sigmain(i,k)>sigmab(i))then
sigmab(i)=sigmain(i,k)
endif
enddo
endif
endif
enddo
enddo
enddo
endif

do i=1,im
if(sigmab(i) < 1.E-5)then !after advection
Expand All @@ -116,7 +124,7 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart, &
if(flag_init .and. .not.flag_restart)then
qadv(i,k)=0.
else
qadv(i,k)=(q(i,k) - qgrs_dsave(i,k))/delt
qadv(i,k)=(q(i,k) - prevsq(i,k))/delt
endif
enddo
enddo
Expand All @@ -125,22 +133,21 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart, &
!buoyant layers with positive moisture convergence (accumulated from the surface).
!Lowest level:
do i = 1,im
dp = 1000. * del(i,1)
mcons(i)=(hvap*(qadv(i,1)+tmf(i,1)+qmicro(i,1))*dp)
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
do i = 1,im
dp = 1000. * del(i,k)
if(cnvflg(i))then
mcon = (hvap*(qadv(i,k)+tmf(i,k)+qmicro(i,k))*dp)
mcon = (hvap*(qadv(i,k)+tmf(i,k)+qmicro(i,k))*dp(i))
buy2 = termD(i)+mcon+mcons(i)
! Do the integral over buoyant layers with positive mcon acc from surface
if(k > kbcon1(i) .and. k < ktcon(i) .and. buy2 > 0.)then
inbu(i,k)=1
inbu(i,k)=1.
endif
inbu(i,k-1)=MAX(inbu(i,k-1),inbu(i,k))
termD(i) = termD(i) + float(inbu(i,k-1))*mcons(i)
termD(i) = termD(i) + inbu(i,k-1)*mcons(i)
mcons(i)=mcon
endif
enddo
Expand All @@ -149,9 +156,8 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart, &
!termA
do k = 2,km1
do i = 1,im
dp = 1000. * del(i,k)
if(cnvflg(i))then
tem=(sigmab(i)*zeta(i,k)*float(inbu(i,k))*dbyo1(i,k))*dp
tem=(sigmab(i)*zeta(i,k)*inbu(i,k)*dbyo1(i,k))*dp(i)
termA(i)=termA(i)+tem
endif
enddo
Expand All @@ -160,9 +166,8 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart, &
!termB
do k = 2,km1
do i = 1,im
dp = 1000. * del(i,k)
if(cnvflg(i))then
tem=(dbyo1(i,k)*float(inbu(i,k)))*dp
tem=(dbyo1(i,k)*inbu(i,k))*dp(i)
termB(i)=termB(i)+tem
endif
enddo
Expand All @@ -172,10 +177,9 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart, &
do k = 2,km1
do i = 1,im
if(cnvflg(i))then
dp = 1000. * del(i,k)
form(i,k)=-1.0*float(inbu(i,k))*(omega_u(i,k)*delt)
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)+(float(inbu(i,k))* &
termC(i)=termC(i)+inbu(i,k)* &
(fdqb+fdqa(i))*hvap*zeta(i,k))
fdqa(i)=fdqb
endif
Expand All @@ -185,22 +189,17 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart, &
!sigmab
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))


*MAX(0.0,SIGN(1.0,termC(i)-epsilon))
cvg=MAX(0.0,cvg)

if(flag_init .and. .not. flag_restart)then
sigmab(i)=0.03
else
sigmab(i)=(ZZ*(termA(i)+cvg))/(DEN+(1.0-ZZ))
endif

if(sigmab(i)>0.)then
sigmab(i)=MIN(sigmab(i),sigmamax(i))
sigmab(i)=MAX(sigmab(i),0.01)
Expand Down
10 changes: 6 additions & 4 deletions physics/samfdeepcnv.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -79,7 +79,7 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, &
& tmf,qmicro,itc,ntc,cliq,cp,cvap, &
& eps,epsm1,fv,grav,hvap,rd,rv, &
& t0c,delt,ntk,ntr,delp, &
& prslp,psp,phil,qtr,qgrs_dsave,q,q1,t1,u1,v1,fscav, &
& prslp,psp,phil,qtr,prevsq,q,q1,t1,u1,v1,fscav, &
& hwrf_samfdeep,progsigma,wclosureflg,cldwrk,rn,kbot,ktop,kcnv, &
& islimsk,garea,dot,ncloud,hpbl,ud_mf,dd_mf,dt_mf,cnvw,cnvc, &
& QLCN, QICN, w_upi, cf_upi, CNV_MFD, &
Expand Down Expand Up @@ -107,7 +107,7 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, &
real(kind=kind_phys), intent(in) :: nthresh
real(kind=kind_phys), intent(in) :: ca_deep(:)
real(kind=kind_phys), intent(in) :: sigmain(:,:),qmicro(:,:), &
& tmf(:,:),q(:,:), qgrs_dsave(:,:)
& tmf(:,:),q(:,:), prevsq(:,:)
real(kind=kind_phys), intent(out) :: rainevap(:)
real(kind=kind_phys), intent(out) :: sigmaout(:,:)
logical, intent(in) :: do_ca,ca_closure,ca_entr,ca_trigger
Expand Down Expand Up @@ -217,6 +217,7 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, &
real(kind=kind_phys) omega_u(im,km),zdqca(im,km),qlks(im,km),
& omegac(im),zeta(im,km),dbyo1(im,km),sigmab(im)
logical flag_shallow
real(kind=kind_phys) gravinv
c physical parameters
! parameter(grav=grav,asolfac=0.958)
! parameter(elocp=hvap/cp,el2orc=hvap*hvap/(rv*cp))
Expand Down Expand Up @@ -309,6 +310,7 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, &
errmsg = ''
errflg = 0

gravinv = 1./grav

elocp = hvap/cp
el2orc = hvap*hvap/(rv*cp)
Expand Down Expand Up @@ -2892,7 +2894,7 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, &
flag_shallow = .false.
call progsigma_calc(im,km,first_time_step,restart,flag_shallow,
& del,tmf,qmicro,dbyo1,zdqca,omega_u,zeta,hvap,delt,
& qgrs_dsave,q,kbcon1,ktcon,cnvflg,gdx,
& prevsq,q,kbcon1,ktcon,cnvflg,gdx,
& sigmain,sigmaout,sigmab,errmsg,errflg)
endif

Expand All @@ -2903,7 +2905,7 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, &
k = kbcon(i)
rho = po(i,k)*100. / (rd*to(i,k))
if(progsigma)then
xmb(i) = sigmab(i)*((-1.0*omegac(i))/grav)
xmb(i) = advfac(i)*sigmab(i)*((-1.0*omegac(i))*gravinv)
else
xmb(i) = advfac(i)*betaw*rho*wc(i)
endif
Expand Down
14 changes: 7 additions & 7 deletions physics/samfdeepcnv.meta
View file
Original file line number Diff line number Diff line change
Expand Up @@ -70,8 +70,8 @@
type = logical
intent = in
[tmf]
standard_name = turbulence_moisture_flux_for_coupling_to_convection
long_name = turbulence_moisture_flux_for_coupling_to_convection
standard_name = instantaneous_tendency_of_specific_humidity_due_to_PBL
long_name = instantaneous_tendency_of_specific_humidity_due_to_PBL
units = kg kg-1 s-1
dimensions = (horizontal_loop_extent,vertical_layer_dimension)
type = real
Expand Down Expand Up @@ -249,9 +249,9 @@
type = real
kind = kind_phys
intent = inout
[qgrs_dsave]
standard_name = tracer_concentration_dsave
long_name = model layer mean tracer concentration dsave
[prevsq]
standard_name = specific_humidity_on_previous_timestep
long_name = specific_humidity_on_previous_timestep
units = kg kg-1
dimensions = (horizontal_loop_extent,vertical_layer_dimension)
type = real
Expand Down Expand Up @@ -320,8 +320,8 @@
type = logical
intent = in
[progsigma]
standard_name = flag_for_prognostic_sigma
long_name = flag for prognostic sigma
standard_name = do_prognostic_updraft_area_fraction
long_name = flag for prognostic sigma in cumuls scheme
units = flag
dimensions = ()
type = logical
Expand Down
Loading

0 comments on commit fc7e7a0

Please sign in to comment.