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

Updates to C3 and SAS convection schemes #122

Merged
merged 10 commits into from
Nov 15, 2023
24 changes: 17 additions & 7 deletions physics/cu_c3_deep.F90
Original file line number Diff line number Diff line change
Expand Up @@ -97,6 +97,9 @@ subroutine cu_c3_deep_run( &
,tmf & ! instantanious tendency from turbulence
,qmicro & ! instantanious tendency from microphysics
,forceqv_spechum & !instantanious tendency from dynamics
,betascu & ! Tuning parameter for shallow clouds
,betamcu & ! Tuning parameter for mid-level clouds
,betadcu & ! Tuning parameter for deep clouds
,sigmain & ! input area fraction after advection
,sigmaout & ! updated prognostic area fraction
,z1 & ! terrain
Expand Down Expand Up @@ -233,8 +236,8 @@ subroutine cu_c3_deep_run( &


real(kind=kind_phys) &
,intent (in ) :: &
dtime,ccnclean,fv,r_d
,intent (in ) :: &
dtime,ccnclean,fv,r_d,betascu,betamcu,betadcu


!
Expand Down Expand Up @@ -386,13 +389,16 @@ subroutine cu_c3_deep_run( &
real(kind=kind_phys), dimension (its:ite) :: pefc
real(kind=kind_phys) entdo,dp,subin,detdo,entup, &
detup,subdown,entdoj,entupk,detupk,totmas
real(kind=kind_phys) :: &
sigmind,sigminm,sigmins
parameter(sigmind=0.005,sigmins=0.03,sigminm=0.01)

real(kind=kind_phys), dimension (its:ite) :: lambau,flux_tun,zws,ztexec,zqexec
!$acc declare create(lambau,flux_tun,zws,ztexec,zqexec)

integer :: jprnt,jmini,start_k22
logical :: keep_going,flg(its:ite),cnvflg(its:ite)
logical :: flag_shallow
logical :: flag_shallow,flag_mid

!$acc declare create(flg)

Expand Down Expand Up @@ -1988,7 +1994,11 @@ subroutine cu_c3_deep_run( &
! equation 8, call progsigma_calc() to compute updraft area fraction based on a moisture budget

if(progsigma)then
flag_mid = .false.
flag_shallow = .false.
if(imid.eq.1)then
flag_mid = .true.
endif
do k=kts,ktf
do i=its,itf
del(i,k) = delp(i,k)*0.001
Expand All @@ -2003,9 +2013,9 @@ subroutine cu_c3_deep_run( &
endif
enddo
call progsigma_calc(itf,ktf,flag_init,flag_restart,flag_shallow, &
del,tmf,qmicro,dbyo1,zdqca,omega_u,zeta,xlv,dtime, &
forceqv_spechum,kbcon,ktop,cnvflg, &
sigmain,sigmaout,sigmab)
flag_mid,del,tmf,qmicro,dbyo1,zdqca,omega_u,zeta,xlv,dtime, &
forceqv_spechum,kbcon,ktop,cnvflg,betascu,betamcu,betadcu, &
sigmind,sigminm,sigmins,sigmain,sigmaout,sigmab)
endif

!$acc end kernels
Expand Down Expand Up @@ -3147,7 +3157,7 @@ subroutine cup_forcing_ens_3d(closure_n,xland,aa0,aa1,xaa0,mbdt,dtime,ierr,ierr2
! pcrit,acrit,acritt
integer, dimension (its:ite) :: kloc
real(kind=kind_phys) :: &
a1,a_ave,xff0,xomg,gravinv!,aclim1,aclim2,aclim3,aclim4
a1,a_ave,xff0,xomg,gravinv

real(kind=kind_phys), dimension (its:ite) :: ens_adj
!$acc declare create(kloc,ens_adj)
Expand Down
32 changes: 24 additions & 8 deletions physics/cu_c3_driver.F90
Original file line number Diff line number Diff line change
Expand Up @@ -58,9 +58,10 @@ end subroutine cu_c3_driver_init
!!
!>\section gen_c3_driver Grell-Freitas Cumulus Scheme Driver General Algorithm
subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,&
do_ca,progsigma,cactiv,cactiv_m,g,cp,fv,r_d,xlv,r_v,forcet, &
do_ca,progsigma,cnx,cactiv,cactiv_m,g,cp,fv,r_d,xlv,r_v,forcet, &
forceqv_spechum,phil,delp,raincv,tmf,qmicro,sigmain, &
qv_spechum,t,cld1d,us,vs,t2di,w,qv2di_spechum,p2di,psuri, &
betascu,betamcu,betadcu,qv_spechum,t,cld1d,us,vs,t2di,w, &
qv2di_spechum,p2di,psuri, &
hbot,htop,kcnv,xland,hfx2,qfx2,aod_gf,cliw,clcw,ca_deep,rainevap,&
pbl,ud_mf,dd_mf,dt_mf,cnvw_moist,cnvc,imfshalcnv, &
flag_for_scnv_generic_tend,flag_for_dcnv_generic_tend, &
Expand Down Expand Up @@ -92,14 +93,14 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,&
integer :: ishallow_g3 ! depend on imfshalcnv
!-------------------------------------------------------------
integer :: its,ite, jts,jte, kts,kte
integer, intent(in ) :: im,km,ntracer
integer, intent(in ) :: im,km,ntracer,cnx
integer, intent(in ) :: ichoice_in,ichoicem_in,ichoice_s_in
logical, intent(in ) :: flag_init, flag_restart, do_mynnedmf
logical, intent(in ) :: flag_for_scnv_generic_tend,flag_for_dcnv_generic_tend, &
do_ca,progsigma
real (kind=kind_phys), intent(in) :: g,cp,fv,r_d,xlv,r_v
do_ca
real (kind=kind_phys), intent(in) :: g,cp,fv,r_d,xlv,r_v,betascu,betamcu,betadcu
logical, intent(in ) :: ldiag3d

logical, intent(inout) :: progsigma
dustinswales marked this conversation as resolved.
Show resolved Hide resolved
real(kind=kind_phys), intent(inout) :: dtend(:,:,:)
!$acc declare copy(dtend)
integer, intent(in) :: dtidx(:,:), &
Expand Down Expand Up @@ -279,6 +280,14 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,&
!$acc end kernels
endif


if(progsigma)then
lisa-bengtsson marked this conversation as resolved.
Show resolved Hide resolved
if(cnx < 384)then
progsigma=.false.
write(*,*)'Forcing prognostic closure to .false. due to coarse resolution'
endif
endif

if(ldiag3d) then
if(flag_for_dcnv_generic_tend) then
cliw_deep_idx=0
Expand Down Expand Up @@ -587,7 +596,7 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,&
hfx(i)=hfx2(i)*cp*rhoi(i,1)
qfx(i)=qfx2(i)*xlv*rhoi(i,1)
dx(i) = sqrt(garea(i))
enddo
enddo

do i=its,itf
do k=kts,kpbli(i)
Expand Down Expand Up @@ -669,7 +678,8 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,&
zus,xmbs,kbcons,ktops,k22s,ierrs,ierrcs, &
! Prog closure
flag_init, flag_restart,fv,r_d,delp,tmfq,qmicro, &
forceqv_spechum,sigmain,sigmaout,progsigma,dx, &
forceqv_spechum,betascu,betamcu,betadcu,sigmain, &
sigmaout,progsigma,dx, &
! output tendencies
outts,outqs,outqcs,outus,outvs,cnvwt,prets,cupclws, &
! dimesnional variables
Expand Down Expand Up @@ -714,6 +724,9 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,&
,tmfq &
,qmicro &
,forceqv_spechum &
,betascu &
,betamcu &
,betadcu &
,sigmain &
,sigmaout &
,ter11 &
Expand Down Expand Up @@ -805,6 +818,9 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,&
,tmfq &
,qmicro &
,forceqv_spechum &
,betascu &
,betamcu &
,betadcu &
,sigmain &
,sigmaout &
,ter11 &
Expand Down
30 changes: 30 additions & 0 deletions physics/cu_c3_driver.meta
Original file line number Diff line number Diff line change
Expand Up @@ -133,6 +133,13 @@
units = flag
dimensions = ()
type = logical
intent = inout
[cnx]
standard_name = number_of_x_points_for_current_cubed_sphere_tile
long_name = number of points in x direction for this cubed sphere face
units = count
dimensions = ()
type = integer
intent = in
[cactiv]
standard_name = counter_for_grell_freitas_convection
Expand Down Expand Up @@ -244,6 +251,29 @@
type = real
kind = kind_phys
intent = out
[betascu]
standard_name = tuning_param_for_shallow_cu
long_name = tuning param for shallow cu in case prognostic closure is used
units = none
dimensions = ()
type = real
kind = kind_phys
intent = in
[betamcu]
standard_name = tuning_param_for_midlevel_cu
long_name = tuning param for midlevel cu in case prognostic closure is used
units = none
dimensions = ()
type = real
kind = kind_phys
intent = in
[betadcu]
standard_name = tuning_param_for_deep_cu
long_name = tuning param for deep cu in case prognostic closure is used
units = none
dimensions = ()
type = real
intent = in
[phil]
standard_name = geopotential
long_name = layer geopotential
Expand Down
23 changes: 14 additions & 9 deletions physics/cu_c3_sh.F90
Original file line number Diff line number Diff line change
Expand Up @@ -68,7 +68,8 @@ subroutine cu_c3_sh_run ( &
hfx,qfx,xland,ichoice,tcrit,dtime, &
zuo,xmb_out,kbcon,ktop,k22,ierr,ierrc, &
flag_init, flag_restart,fv,r_d,delp,tmf,qmicro, &
forceqv_spechum,sigmain,sigmaout,progsigma,dx, &
forceqv_spechum,betascu,betamcu,betadcu,sigmain,&
sigmaout,progsigma,dx, &
outt,outq,outqc,outu,outv,cnvwt,pre,cupclw, & ! output tendencies
itf,ktf,its,ite, kts,kte,ipr,tropics) ! dimesnional variables
!
Expand Down Expand Up @@ -131,7 +132,7 @@ subroutine cu_c3_sh_run ( &

real(kind=kind_phys) &
,intent (in ) :: &
dtime,tcrit,fv,r_d
dtime,tcrit,fv,r_d,betascu,betamcu,betadcu
!$acc declare sigmaout
real(kind=kind_phys), dimension (its:,kts:) &
,intent (out) :: &
Expand Down Expand Up @@ -234,15 +235,18 @@ subroutine cu_c3_sh_run ( &
!$acc cap_max_increment,lambau, &
!$acc kstabi,xland1,kbmax,ktopx)

logical :: flag_shallow
logical :: flag_shallow,flag_mid
logical, dimension(its:ite) :: cnvflg
integer :: &
kstart,i,k,ki
real(kind=kind_phys) :: &
real(kind=kind_phys) :: &
dz,mbdt,zkbmax, &
cap_maxs,trash,trash2,frh,el2orc,gravinv

real(kind=kind_phys) buo_flux,pgeoh,dp,entup,detup,totmas
real(kind=kind_phys) buo_flux,pgeoh,dp,entup,detup,totmas
real(kind=kind_phys) :: &
sigmind,sigminm,sigmins
parameter(sigmind=0.005,sigmins=0.03,sigminm=0.01)

real(kind=kind_phys) xff_shal(3),blqe,xkshal
character*50 :: ierrc(its:)
Expand Down Expand Up @@ -672,13 +676,13 @@ subroutine cu_c3_sh_run ( &
dz=z_cup(i,k)-z_cup(i,k-1)
! cloud liquid water
c1d(i,k)=c1_shal! 0. !.02*up_massdetr(i,k-1)
clw_all(i,k)=max(0.,qco(i,k)-trash)
lisa-bengtsson marked this conversation as resolved.
Show resolved Hide resolved
qrco(i,k)= (qco(i,k)-trash)/(1.+(c0_shal+c1d(i,k))*dz)
if(qrco(i,k).lt.0.)then ! hli new test 02/12/19
qrco(i,k)=0.
!c1d(i,k)=0.
endif
pwo(i,k)=c0_shal*dz*qrco(i,k)*zuo(i,k)
clw_all(i,k)=qco(i,k)-trash !LB total cloud before rain and detrain
! cloud water vapor
qco (i,k)= trash+qrco(i,k)

Expand Down Expand Up @@ -960,6 +964,7 @@ subroutine cu_c3_sh_run ( &
! equation 8, call progsigma_calc() to compute updraft area fraction based on a moisture budget
if(progsigma)then
flag_shallow = .true.
flag_mid = .false.
do k=kts,ktf
do i=its,itf
del(i,k) = delp(i,k)*0.001
Expand All @@ -974,9 +979,9 @@ subroutine cu_c3_sh_run ( &
endif
enddo
call progsigma_calc(itf,ktf,flag_init,flag_restart,flag_shallow, &
del,tmf,qmicro,dbyo,zdqca,omega_u,zeta,xlv,dtime, &
forceqv_spechum,kbcon,ktop,cnvflg, &
sigmain,sigmaout,sigmab)
flag_mid,del,tmf,qmicro,dbyo,zdqca,omega_u,zeta,xlv,dtime, &
forceqv_spechum,kbcon,ktop,cnvflg,betascu,betamcu,betadcu, &
sigmind,sigminm,sigmins,sigmain,sigmaout,sigmab)

endif

Expand Down
31 changes: 20 additions & 11 deletions physics/progsigma_calc.f90
Original file line number Diff line number Diff line change
Expand Up @@ -19,10 +19,10 @@ module progsigma
!! This subroutine computes a prognostic updraft area fracftion
!! used in the closure computations in the samfshalcnv. scheme
!!\section gen_progsigma progsigma_calc General Algorithm
subroutine progsigma_calc (im,km,flag_init,flag_restart, &
flag_shallow,del,tmf,qmicro,dbyo1,zdqca,omega_u,zeta,hvap, &
delt,qadv,kbcon1,ktcon,cnvflg,sigmain,sigmaout, &
sigmab)
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, &
sigmind,sigminm,sigmins,sigmain,sigmaout,sigmab)
!
!
use machine, only : kind_phys
Expand All @@ -32,11 +32,12 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart, &

! intent in
integer, intent(in) :: im,km,kbcon1(im),ktcon(im)
real(kind=kind_phys), intent(in) :: hvap,delt
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), &
qmicro(im,km),tmf(im,km),dbyo1(im,km),zdqca(im,km), &
omega_u(im,km),zeta(im,km)
logical, intent(in) :: flag_init,flag_restart,cnvflg(im),flag_shallow
logical, intent(in) :: flag_init,flag_restart,cnvflg(im),flag_shallow,flag_mid
real(kind=kind_phys), intent(in) :: sigmain(im,km)

! intent out
Expand All @@ -53,15 +54,13 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart, &

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

!Parameters
gcvalmx = 0.1
rmulacvg=10.
epsilon=1.E-11
km1=km-1
betadcu = 2.0
betascu = 8.0
invdelt = 1./delt

!Initialization 2D
Expand Down Expand Up @@ -206,17 +205,27 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart, &
do i= 1, im
if(cnvflg(i)) then
sigmab(i)=sigmab(i)/betascu
sigmab(i)=MAX(0.03,sigmab(i))
sigmab(i)=MAX(sigmins,sigmab(i))
endif
enddo
elseif(flag_mid)then
do i= 1, im
if(cnvflg(i)) then
sigmab(i)=sigmab(i)/betamcu
sigmab(i)=MAX(sigminm,sigmab(i))
endif
enddo
else
do i= 1, im
if(cnvflg(i)) then
sigmab(i)=sigmab(i)/betadcu
sigmab(i)=MAX(0.01,sigmab(i))
sigmab(i)=MAX(sigmind,sigmab(i))
endif
enddo
endif
do i= 1, im
sigmab(i) = MIN(0.95,sigmab(i))
enddo

end subroutine progsigma_calc

Expand Down
Loading