Skip to content

Commit

Permalink
Merge pull request #1045 from grantfirl/ufs-dev-PR122
Browse files Browse the repository at this point in the history 
UFS-dev PR#122
  • Loading branch information
@grantfirl
grantfirl authored Feb 14, 2024
2 parents 0339aa9 + cc2a974 commit 23f120a
Show file tree
Hide file tree
Showing 9 changed files with 201 additions and 51 deletions.
24 changes: 17 additions & 7 deletions physics/cu_c3_deep.F90
View file
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: 25 additions & 7 deletions physics/cu_c3_driver.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -30,21 +30,31 @@ module cu_c3_driver
!! \htmlinclude cu_c3_driver_init.html
!!
subroutine cu_c3_driver_init(imfshalcnv, imfshalcnv_c3, imfdeepcnv, &
imfdeepcnv_c3,mpirank, mpiroot, errmsg, errflg)
imfdeepcnv_c3,progsigma, cnx, mpirank, mpiroot, &
errmsg, errflg)

implicit none

integer, intent(in) :: imfshalcnv, imfshalcnv_c3
integer, intent(in) :: imfdeepcnv, imfdeepcnv_c3
integer, intent(in) :: mpirank
integer, intent(in) :: mpiroot
integer, intent(in) :: cnx
logical, intent(inout) :: progsigma
character(len=*), intent( out) :: errmsg
integer, intent( out) :: errflg

! initialize ccpp error handling variables
errmsg = ''
errflg = 0

if(progsigma)then
if(cnx < 384)then
progsigma=.false.
write(*,*)'Forcing prognostic closure to .false. due to coarse resolution'
endif
endif

end subroutine cu_c3_driver_init

!
Expand All @@ -60,7 +70,8 @@ end subroutine cu_c3_driver_init
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, &
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 @@ -96,10 +107,10 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,&
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(in ) :: progsigma
real(kind=kind_phys), intent(inout) :: dtend(:,:,:)
!$acc declare copy(dtend)
integer, intent(in) :: dtidx(:,:), &
Expand Down Expand Up @@ -587,7 +598,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 +680,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 +726,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 +820,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
37 changes: 37 additions & 0 deletions physics/cu_c3_driver.meta
View file
Original file line number Diff line number Diff line change
Expand Up @@ -49,6 +49,20 @@
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 = 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
[errmsg]
standard_name = ccpp_error_message
long_name = error message for error handling in CCPP
Expand Down Expand Up @@ -244,6 +258,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
View file
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._kind_phys,qco(i,k)-trash)
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
View file
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

0 comments on commit 23f120a

Please sign in to comment.