Skip to content

Commit

Permalink
address some review comments, fix decomposition error, correct bug in…
Browse files Browse the repository at this point in the history
… initialization
  • Loading branch information
lisa-bengtsson committed May 18, 2022
1 parent 3dec4e6 commit 6f38cc6
Show file tree
Hide file tree
Showing 6 changed files with 162 additions and 91 deletions.
37 changes: 32 additions & 5 deletions physics/GFS_suite_interstitial_3.F90
Original file line number Diff line number Diff line change
Expand Up @@ -9,10 +9,13 @@ module GFS_suite_interstitial_3
!! \htmlinclude GFS_suite_interstitial_3_run.html
!!
subroutine GFS_suite_interstitial_3_run (otsptflag, &
im, levs, nn, cscnv, &
im, levs, nn, cscnv,imfshalcnv, imfdeepcnv, &
imfshalcnv_samf, imfdeepcnv_samf,progsigma, &
first_time_step, restart, &
satmedmf, trans_trac, do_shoc, ltaerosol, ntrac, ntcw, &
ntiw, ntclamt, ntrw, ntsw, ntrnc, ntsnc, ntgl, ntgnc, &
xlon, xlat, gt0, gq0, imp_physics, imp_physics_mg, &
xlon, xlat, gt0, gq0, sigmain,sigmaout,qmicro, &
imp_physics, imp_physics_mg, &
imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, &
imp_physics_gfdl, imp_physics_thompson, dtidx, ntlnc, &
imp_physics_wsm6, imp_physics_fer_hires, prsi, ntinc, &
Expand All @@ -33,8 +36,9 @@ subroutine GFS_suite_interstitial_3_run (otsptflag, &
imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6,imp_physics_fer_hires, &
imp_physics_nssl, me, index_of_process_conv_trans
integer, intent(in ), dimension(:) :: islmsk, kpbl, kinver
logical, intent(in ) :: cscnv, satmedmf, trans_trac, do_shoc, ltaerosol, ras

logical, intent(in ) :: cscnv, satmedmf, trans_trac, do_shoc, ltaerosol, ras, progsigma
logical, intent(in ) :: first_time_step, restart
integer, intent(in ) :: imfshalcnv, imfdeepcnv, imfshalcnv_samf,imfdeepcnv_samf
integer, intent(in) :: ntinc, ntlnc
logical, intent(in) :: ldiag3d, qdiag3d
integer, dimension(:,:), intent(in) :: dtidx
Expand All @@ -48,6 +52,8 @@ subroutine GFS_suite_interstitial_3_run (otsptflag, &
real(kind=kind_phys), intent(in ), dimension(:,:) :: gt0
real(kind=kind_phys), intent(in ), dimension(:,:,:) :: gq0

real(kind=kind_phys), intent(out ), dimension(:,:) :: sigmain
real(kind=kind_phys), intent(out ), dimension(:,:) :: sigmaout,qmicro
real(kind=kind_phys), intent(inout), dimension(:,:) :: rhc, save_qc
! save_qi is not allocated for Zhao-Carr MP
real(kind=kind_phys), intent(inout), dimension(:,:) :: save_qi
Expand All @@ -73,6 +79,27 @@ subroutine GFS_suite_interstitial_3_run (otsptflag, &
errmsg = ''
errflg = 0

! In case of using prognostic updraf area fraction, initialize area fraction here
! since progsigma_calc is called from both deep and shallow schemes.
if(((imfshalcnv == imfshalcnv_samf) .or. (imfdeepcnv == imfdeepcnv_samf)) &
.and. progsigma)then
if(first_time_step .and. .not. restart)then
do k=1,levs
do i=1,im
sigmain(i,k)=0.0
sigmaout(i,k)=0.0
qmicro(i,k)=0.0
enddo
enddo
endif
do k=1,levs
do i=1,im
sigmaout(i,k)=0.0
enddo
enddo
endif


if (cscnv .or. satmedmf .or. trans_trac .or. ras) then
tracers = 2
do n=2,ntrac
Expand Down Expand Up @@ -192,4 +219,4 @@ subroutine GFS_suite_interstitial_3_run (otsptflag, &

end subroutine GFS_suite_interstitial_3_run

end module GFS_suite_interstitial_3
end module GFS_suite_interstitial_3
73 changes: 73 additions & 0 deletions physics/GFS_suite_interstitial_3.meta
Original file line number Diff line number Diff line change
Expand Up @@ -43,6 +43,55 @@
dimensions = ()
type = logical
intent = in
[imfdeepcnv]
standard_name = control_for_deep_convection_scheme
long_name = flag for mass-flux deep convection scheme
units = flag
dimensions = ()
type = integer
intent = in
[imfdeepcnv_samf]
standard_name = identifer_for_scale_aware_mass_flux_deep_convection
long_name = flag for SAMF deep convection scheme
units = flag
dimensions = ()
type = integer
intent = in
[imfshalcnv]
standard_name = control_for_shallow_convection_scheme
long_name = flag for mass-flux shallow convection scheme
units = flag
dimensions = ()
type = integer
intent = in
[imfshalcnv_samf]
standard_name = identifier_for_scale_aware_mass_flux_shallow_convection
long_name = flag for SAMF shallow convection scheme
units = flag
dimensions = ()
type = integer
intent = in
[progsigma]
standard_name = do_prognostic_updraft_area_fraction
long_name = flag for prognostic sigma in cumuls scheme
units = flag
dimensions = ()
type = logical
intent = in
[first_time_step]
standard_name = flag_for_first_timestep
long_name = flag for first time step for time integration loop (cold/warmstart)
units = flag
dimensions = ()
type = logical
intent = in
[restart]
standard_name = flag_for_restart
long_name = flag for restart (warmstart) or coldstart
units = flag
dimensions = ()
type = logical
intent = in
[satmedmf]
standard_name = flag_for_scale_aware_TKE_moist_EDMF_PBL
long_name = flag for scale-aware TKE moist EDMF PBL scheme
Expand Down Expand Up @@ -173,6 +222,30 @@
type = real
kind = kind_phys
intent = in
[sigmain]
standard_name = prognostic_updraft_area_fraction_in_convection
long_name = convective updraft area fraction
units = frac
dimensions = (horizontal_loop_extent,vertical_layer_dimension)
type = real
kind = kind_phys
intent = out
[sigmaout]
standard_name = updraft_area_fraction_updated_by_physics
long_name = convective updraft area fraction updated by physics
units = frac
dimensions = (horizontal_loop_extent,vertical_layer_dimension)
type = real
kind = kind_phys
intent = out
[qmicro]
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
[imp_physics]
standard_name = control_for_microphysics_scheme
long_name = choice of microphysics scheme
Expand Down
93 changes: 40 additions & 53 deletions physics/progsigma_calc.f90
Original file line number Diff line number Diff line change
Expand Up @@ -14,9 +14,9 @@
!> @{

subroutine progsigma_calc (im,km,flag_init,flag_restart, &
flag_shallow,del,tmf,qmicro,dbyo1,zdqca,omega_u,zeta,hvap, &
delt,prevsq,q,kbcon1,ktcon,cnvflg,gdx, &
sigmain,sigmaout,sigmab,errmsg,errflg)
del,tmf,qmicro,dbyo1,zdqca,omega_u,zeta,hvap, &
delt,prevsq,q,kbcon1,ktcon,cnvflg,sigmain,sigmaout, &
sigmab,errmsg,errflg)
!
!
use machine, only : kind_phys
Expand All @@ -29,8 +29,8 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart, &
real(kind=kind_phys), intent(in) :: hvap,delt
real(kind=kind_phys), 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
omega_u(im,km),zeta(im,km)
logical, intent(in) :: flag_init,flag_restart,cnvflg(im)
real(kind=kind_phys), intent(in) :: sigmain(im,km)

! intent out
Expand All @@ -41,21 +41,20 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart, &

! Local variables
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),dp(im,km),inbu(im,km)
real(kind=kind_phys) :: termA(im),termB(im),termC(im),termD(im)
real(kind=kind_phys) :: mcons(im),fdqa(im),form(im,km), &
qadv(im,km),dp(im,km),inbu(im,km)


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

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

Expand All @@ -70,10 +69,7 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart, &

!Initialization 1D
do i=1,im
if(cnvflg(i))then
sigmab(i)=0.
endif
sigmamax(i)=0.95
sigmab(i)=0.
termA(i)=0.
termB(i)=0.
termC(i)=0.
Expand All @@ -82,6 +78,21 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart, &
mcons(i)=0.
enddo

!Initial computations, dynamic q-tendency
if(flag_init .and. .not.flag_restart)then
do k = 1,km
do i = 1,im
qadv(i,k)=0.
enddo
enddo
else
do k = 1,km
do i = 1,im
qadv(i,k)=(q(i,k) - prevsq(i,k))*invdelt
enddo
enddo
endif

do k = 2,km1
do i = 1,im
if(cnvflg(i))then
Expand All @@ -102,33 +113,13 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart, &
enddo

do i=1,im
if(sigmab(i) < 1.E-5)then !after advection
sigmab(i)=0.
if(cnvflg(i))then
if(sigmab(i) < 1.E-5)then !after advection
sigmab(i)=0.
endif
endif
enddo

!Initial computations, sigmamax
do i=1,im
sigmamax(i)=alpha/gdx(i)
sigmamax(i)=MIN(0.95,sigmamax(i))
enddo

!Initial computations, dynamic q-tendency
if(flag_init .and. .not.flag_restart)then
do k = 1,km
do i = 1,im
qadv(i,k)=0.
enddo
enddo
else
do k = 1,km
do i = 1,im
qadv(i,k)=(q(i,k) - prevsq(i,k))*invdelt
enddo
enddo
endif



!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:
Expand Down Expand Up @@ -194,7 +185,7 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart, &
endif
enddo
else
do i = 1,im
do i = 1,im
if(cnvflg(i))then
DEN=MIN(termC(i)+termB(i),1.E8)
cvg=termD(i)*delt
Expand All @@ -204,7 +195,7 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart, &
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),sigmamax(i))
sigmab(i)=MIN(sigmab(i),0.95)
sigmab(i)=MAX(sigmab(i),0.01)
endif
endif!cnvflg
Expand All @@ -218,19 +209,15 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart, &
endif
enddo
enddo


!Since updraft velocity is much lower in shallow cu region, termC becomes small in shallow cu application, thus the area fraction
!in this regime becomes too large compared with the deep cu region. To address this simply apply a scaling factor for shallow cu
!before computing the massflux to reduce the total strength of the SC MF:

if(flag_shallow)then
do i= 1, im
if(cnvflg(i)) then
sigmab(i)=sigmab(i)/betascu
endif
enddo
endif
!Reduce area fraction before coupling back to mass-flux computation.
!This tuning could be addressed in updraft velocity equation instead.
do i= 1, im
if(cnvflg(i)) then
sigmab(i)=sigmab(i)/betascu
endif
enddo



end subroutine progsigma_calc
Expand Down
22 changes: 5 additions & 17 deletions physics/samfdeepcnv.f
Original file line number Diff line number Diff line change
Expand Up @@ -86,7 +86,7 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, &
& CNV_DQLDT,CLCN,CNV_FICE,CNV_NDROP,CNV_NICE,mp_phys,mp_phys_mg,&
& clam,c0s,c1,betal,betas,evef,pgcon,asolfac, &
& do_ca, ca_closure, ca_entr, ca_trigger, nthresh,ca_deep, &
& ca_micro, rainevap, sigmain, sigmaout, errmsg,errflg)
& rainevap,sigmain, sigmaout, errmsg,errflg)
!
use machine , only : kind_phys
use funcphys , only : fpvs
Expand All @@ -107,7 +107,7 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, &
real(kind=kind_phys), intent(in) :: ca_deep(:)
real(kind=kind_phys), intent(in) :: sigmain(:,:),qmicro(:,:), &
& tmf(:,:),q(:,:), prevsq(:,:)
real(kind=kind_phys), intent(out) :: rainevap(:), ca_micro(:)
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 @@ -214,8 +214,7 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, &
!
! parameters for prognostic sigma closure
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
& omegac(im),zeta(im,km),dbyo1(im,km),sigmab(im)
real(kind=kind_phys) gravinv
c physical parameters
! parameter(grav=grav,asolfac=0.958)
Expand Down Expand Up @@ -2884,25 +2883,14 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, &

!> - From Bengtsson et al. (2022) Prognostic closure scheme, equation 8, compute updraft area fraction based on a moisture budget
if(progsigma)then
flag_shallow = .false.
call progsigma_calc(im,km,first_time_step,restart,flag_shallow,
call progsigma_calc(im,km,first_time_step,restart,
& del,tmf,qmicro,dbyo1,zdqca,omega_u,zeta,hvap,delt,
& prevsq,q,kbcon1,ktcon,cnvflg,gdx,
& prevsq,q,kbcon1,ktcon,cnvflg,
& sigmain,sigmaout,sigmab,errmsg,errflg)
endif

!> - From Han et al.'s (2017) \cite han_et_al_2017 equation 6, calculate cloud base mass flux as a function of the mean updraft velcoity for the grid sizes where the quasi-equilibrium assumption of Arakawa-Schubert is not valid any longer.
!! As discussed in Han et al. (2017) \cite han_et_al_2017 , when dtconv is larger than tauadv, the convective mixing is not fully conducted before the cumulus cloud is advected out of the grid cell. In this case, therefore, the cloud base mass flux is further reduced in proportion to the ratio of tauadv to dtconv.
do i=1,im
ca_micro(i)=0.
enddo
do i=1,im
if(cnvflg(i))then
ca_micro(i)=sigmab(i)
endif
enddo
do i= 1, im
if(cnvflg(i) .and. .not.asqecflg(i)) then
Expand Down
8 changes: 0 additions & 8 deletions physics/samfdeepcnv.meta
Original file line number Diff line number Diff line change
Expand Up @@ -652,14 +652,6 @@
type = real
kind = kind_phys
intent = in
[ca_micro]
standard_name = output_prognostic_sigma_two
long_name = output of prognostic area fraction two
units = frac
dimensions = (horizontal_loop_extent)
type = real
kind = kind_phys
intent = out
[rainevap]
standard_name = physics_field_for_coupling
long_name = physics_field_for_coupling
Expand Down
Loading

0 comments on commit 6f38cc6

Please sign in to comment.