Skip to content

Commit

Permalink
Merge branch 'ufs/dev' of https://github.com/ufs-community/ccpp-physics…
Browse files Browse the repository at this point in the history 
… into feature_reorg_physics
  • Loading branch information
@dustinswales
dustinswales committed Oct 18, 2023
2 parents 53eda4d + 69c9764 commit daf1799
Show file tree
Hide file tree
Showing 23 changed files with 893 additions and 561 deletions.
310 changes: 154 additions & 156 deletions physics/CONV/C3/cu_c3_deep.F90
View file

Large diffs are not rendered by default.

45 changes: 4 additions & 41 deletions physics/CONV/C3/cu_c3_driver.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -340,8 +340,8 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,&
!
!> - Set tuning constants for radiation coupling
!
tun_rad_shall(:)=.01
tun_rad_mid(:)=.3 !.02
tun_rad_shall(:)=.012
tun_rad_mid(:)=.15 !.02
tun_rad_deep(:)=.3 !.065
edt(:)=0.
edtm(:)=0.
Expand Down Expand Up @@ -644,7 +644,6 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,&
enddo
!$acc end kernels
if (dx(its)<6500.) then
ichoice=10
imid_gf=0
endif
!
Expand Down Expand Up @@ -680,10 +679,6 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,&
do i=its,itf
if(xmbs(i).gt.0.)then
cutens(i)=1.
if (dx(i)<6500.) then
ierrm(i)=555
ierr (i)=555
endif
endif
enddo
!$acc end kernels
Expand Down Expand Up @@ -954,38 +949,6 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,&
!gdc(i,k,8)=(outq(i,k))*86400.*xlv/cp
gdc(i,k,8)=(outqm(i,k)+outqs(i,k)+outq(i,k))*86400.*xlv/cp
gdc(i,k,9)=gdc(i,k,2)+gdc(i,k,3)+gdc(i,k,4)
!
!> - Calculate subsidence effect on clw
!
! dsubclw=0.
! dsubclwm=0.
! dsubclws=0.
! dp=100.*(p2d(i,k)-p2d(i,k+1))
! if (clcw(i,k) .gt. -999.0 .and. clcw(i,k+1) .gt. -999.0 )then
! clwtot = cliw(i,k) + clcw(i,k)
! clwtot1= cliw(i,k+1) + clcw(i,k+1)
! dsubclw=((-edt(i)*zd(i,k+1)+zu(i,k+1))*clwtot1 &
! -(-edt(i)*zd(i,k) +zu(i,k)) *clwtot )*g/dp
! dsubclwm=((-edtm(i)*zdm(i,k+1)+zum(i,k+1))*clwtot1 &
! -(-edtm(i)*zdm(i,k) +zum(i,k)) *clwtot )*g/dp
! dsubclws=(zus(i,k+1)*clwtot1-zus(i,k)*clwtot)*g/dp
! dsubclw=dsubclw+(zu(i,k+1)*clwtot1-zu(i,k)*clwtot)*g/dp
! dsubclwm=dsubclwm+(zum(i,k+1)*clwtot1-zum(i,k)*clwtot)*g/dp
! dsubclws=dsubclws+(zus(i,k+1)*clwtot1-zus(i,k)*clwtot)*g/dp
! endif
! tem = dt*(outqcs(i,k)*cutens(i)+outqc(i,k)*cuten(i) &
! +outqcm(i,k)*cutenm(i) &
! +dsubclw*xmb(i)+dsubclws*xmbs(i)+dsubclwm*xmbm(i) &
! )
! tem1 = max(0.0, min(1.0, (tcr-t(i,k))*tcrf))
! if (clcw(i,k) .gt. -999.0) then
! cliw(i,k) = max(0.,cliw(i,k) + tem * tem1) ! ice
! clcw(i,k) = max(0.,clcw(i,k) + tem *(1.0-tem1)) ! water
! else
! cliw(i,k) = max(0.,cliw(i,k) + tem)
! endif
!
! enddo

!> - FCT treats subsidence effect to cloud ice/water (begin)
dp=100.*(p2d(i,k)-p2d(i,k+1))
Expand Down Expand Up @@ -1041,8 +1004,8 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,&
gdc(i,16,10)=pret(i)*3600.

maxupmf(i)=0.
if(forcing(i,6).gt.0.)then
maxupmf(i)=maxval(xmb(i)*zu(i,kts:ktf)/forcing(i,6))
if(forcing2(i,6).gt.0.)then
maxupmf(i)=maxval(xmb(i)*zu(i,kts:ktf)/forcing2(i,6))
endif

if(ktop(i).gt.2 .and.pret(i).gt.0.)dt_mf(i,ktop(i)-1)=ud_mf(i,ktop(i))
Expand Down
9 changes: 4 additions & 5 deletions physics/CONV/C3/cu_c3_driver_post.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -66,20 +66,19 @@ subroutine cu_c3_driver_post_run (im, km, t, q, prevst, prevsq, cactiv, cactiv_m
conv_act_m(i)=0.0
endif
! reflectivity parameterization for parameterized convection (reference:Unipost MDLFLD.f)
if(sqrt(garea(i)).lt.6500.)then
ze = 0.0
ze_conv = 0.0
dbz_sum = 0.0
cuprate = raincv(i) * 3600.0 / dt ! cu precip rate (mm/h)
ze_conv = 300.0 * cuprate**1.4
if (maxupmf(i).gt.0.05) then
cuprate = 1.e3*raincv(i) * 3600.0 / dt ! cu precip rate (mm/h)
if(cuprate .lt. 0.05) cuprate=0.
ze_conv = 300.0 * cuprate**1.5
if (maxupmf(i).gt.0.1 .and. cuprate.gt.0.) then
do k = 1, km
ze = 10._kind_phys ** (0.1 * refl_10cm(i,k))
dbz_sum = max(dbzmin, 10.0 * log10(ze + ze_conv))
refl_10cm(i,k) = dbz_sum
enddo
endif
endif
enddo
!$acc end kernels

Expand Down
32 changes: 17 additions & 15 deletions physics/CONV/C3/cu_c3_sh.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,12 +6,12 @@ module cu_c3_sh
use progsigma, only : progsigma_calc

!real(kind=kind_phys), parameter:: c1_shal=0.0015! .0005
real(kind=kind_phys), parameter:: c1_shal=0. !0.005! .0005
real(kind=kind_phys), parameter:: g =9.81
real(kind=kind_phys), parameter:: cp =1004.
real(kind=kind_phys), parameter:: xlv=2.5e6
real(kind=kind_phys), parameter:: r_v=461.
real(kind=kind_phys), parameter:: c0_shal=.001
real(kind=kind_phys) :: c0_shal=.004
real(kind=kind_phys) :: c1_shal=0. !0.005! .0005
real(kind=kind_phys), parameter:: fluxtune=1.5

contains
Expand Down Expand Up @@ -95,45 +95,45 @@ subroutine cu_c3_sh_run ( &
! outq = output q tendency (per s)
! outqc = output qc tendency (per s)
! pre = output precip
real(kind=kind_phys), dimension (its:ite,kts:kte) &
real(kind=kind_phys), dimension (its:,kts:) &
,intent (inout ) :: &
cnvwt,outt,outq,outqc,cupclw,zuo,outu,outv
!$acc declare copy(cnvwt,outt,outq,outqc,cupclw,zuo,outu,outv)
real(kind=kind_phys), dimension (its:ite,kts:kte) &
real(kind=kind_phys), dimension (its:,kts:) &
,intent (in ) :: &
tmf, qmicro, sigmain, forceqv_spechum
real(kind=kind_phys), dimension (its:ite) &
real(kind=kind_phys), dimension (its:) &
,intent (out ) :: &
xmb_out
integer, dimension (its:ite) &
integer, dimension (its:) &
,intent (inout ) :: &
ierr
integer, dimension (its:ite) &
integer, dimension (its:) &
,intent (out ) :: &
kbcon,ktop,k22
integer, dimension (its:ite) &
integer, dimension (its:) &
,intent (in ) :: &
kpbl,tropics
!$acc declare copyout(xmb_out,kbcon,ktop,k22) copyin(kpbl,tropics) copy(ierr)
!
! basic environmental input includes a flag (ierr) to turn off
! convection for this call only and at that particular gridpoint
!
real(kind=kind_phys), dimension (its:ite,kts:kte) &
real(kind=kind_phys), dimension (its:,kts:) &
,intent (in ) :: &
t,po,tn,dhdt,rho,us,vs,delp
real(kind=kind_phys), dimension (its:ite,kts:kte) &
real(kind=kind_phys), dimension (its:,kts:) &
,intent (inout) :: &
q,qo
real(kind=kind_phys), dimension (its:ite) &
real(kind=kind_phys), dimension (its:) &
,intent (in ) :: &
xland,z1,psur,hfx,qfx,dx

real(kind=kind_phys) &
,intent (in ) :: &
dtime,tcrit,fv,r_d
!$acc declare sigmaout
real(kind=kind_phys), dimension (its:ite,kts:kte) &
real(kind=kind_phys), dimension (its:,kts:) &
,intent (out) :: &
sigmaout

Expand Down Expand Up @@ -245,7 +245,7 @@ subroutine cu_c3_sh_run ( &
real(kind=kind_phys) buo_flux,pgeoh,dp,entup,detup,totmas

real(kind=kind_phys) xff_shal(3),blqe,xkshal
character*50 :: ierrc(its:ite)
character*50 :: ierrc(its:)
real(kind=kind_phys), dimension (its:ite,kts:kte) :: &
up_massentr,up_massdetr,up_massentro,up_massdetro,up_massentru,up_massdetru
!$acc declare create(up_massentr,up_massdetr,up_massentro,up_massdetro,up_massentru,up_massdetru)
Expand Down Expand Up @@ -274,6 +274,8 @@ subroutine cu_c3_sh_run ( &
ktopx(i)=0
if(xland(i).gt.1.5 .or. xland(i).lt.0.5)then
xland1(i)=0
c0_shal=.001
c1_shal=.001
! ierr(i)=100
endif
pre(i)=0.
Expand Down Expand Up @@ -669,11 +671,11 @@ subroutine cu_c3_sh_run ( &
if(qco(i,k)>=trash ) then
dz=z_cup(i,k)-z_cup(i,k-1)
! cloud liquid water
c1d(i,k)=.02*up_massdetr(i,k-1)
c1d(i,k)=c1_shal! 0. !.02*up_massdetr(i,k-1)
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.
!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
Expand Down
7 changes: 3 additions & 4 deletions physics/CONV/Grell_Freitas/cu_gf_deep.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4708,11 +4708,10 @@ subroutine get_zu_zd_pdf_fim(kklev,p,rand_vmas,zubeg,ipr,xland,zuh2,draft,ierr,k
if(draft == 1) then
lev_start=min(.9,.1+csum*.013)
kb_adj=max(kb,2)
tunning=max(p(kklev+1),.5*(p(kpbli)+p(kt)))
tunning=p(kklev)
! tunning=p(kklev+1) !p(kpbli+1) !p(kklev) !p(kt)+(p(kpbli)-p(kt))*lev_start
! tunning=.5*(p(kb_adj)+p(kt)) !p(kpbli+1) !p(kklev) !p(kt)+(p(kpbli)-p(kt))*lev_start
! trash is the depth of the cloud
trash=-p(kt)+p(kb_adj)
tunning=p(kklev)
if(rand_vmas.ne.0.) tunning=p(kklev-1)+.1*rand_vmas*trash
beta_deep=1.3 +(1.-trash/1200.)
tunning =min(0.95, (tunning-p(kb_adj))/(p(kt)-p(kb_adj))) !=.6
tunning =max(0.02, tunning)
Expand Down
61 changes: 21 additions & 40 deletions physics/CONV/Grell_Freitas/cu_gf_driver.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -67,6 +67,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,&
fhour,fh_dfi_radar,ix_dfi_radar,num_dfi_radar,cap_suppress, &
dfi_radar_max_intervals,ldiag3d,qci_conv,do_cap_suppress, &
maxupmf,maxMF,do_mynnedmf,ichoice_in,ichoicem_in,ichoice_s_in, &
spp_cu_deep,spp_wts_cu_deep, &
errmsg,errflg)
!-------------------------------------------------------------
implicit none
Expand All @@ -80,6 +81,10 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,&
integer :: ichoice=0 ! 0 2 5 13 8
integer :: ichoicem=13 ! 0 2 5 13
integer :: ichoice_s=3 ! 0 1 2 3
integer, intent(in) :: spp_cu_deep ! flag for using SPP perturbations
real(kind_phys), dimension(:,:), intent(in) :: &
& spp_wts_cu_deep
real(kind=kind_phys) :: spp_wts_cu_deep_tmp

logical, intent(in) :: do_cap_suppress
real(kind=kind_phys), parameter :: aodc0=0.14
Expand Down Expand Up @@ -313,9 +318,18 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,&
! these should be coming in from outside
!
! cactiv(:) = 0
rand_mom(:) = 0.
rand_vmas(:) = 0.
rand_clos(:,:) = 0.
if (spp_cu_deep == 0) then
rand_mom(:) = 0.
rand_vmas(:) = 0.
rand_clos(:,:) = 0.
else
do i=1,im
spp_wts_cu_deep_tmp=min(max(-1.0_kind_phys, spp_wts_cu_deep(i,1)),1.0_kind_phys)
rand_mom(i) = spp_wts_cu_deep_tmp
rand_vmas(i) = spp_wts_cu_deep_tmp
rand_clos(i,:) = spp_wts_cu_deep_tmp
end do
end if
!$acc end kernels
!
its=1
Expand Down Expand Up @@ -630,7 +644,6 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,&
enddo
!$acc end kernels
if (dx(its)<6500.) then
ichoice=10
imid_gf=0
endif
!
Expand Down Expand Up @@ -734,7 +747,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,&
,rand_mom & ! for stochastics mom, if temporal and spatial patterns exist
,rand_vmas & ! for stochastics vertmass, if temporal and spatial patterns exist
,rand_clos & ! for stochastics closures, if temporal and spatial patterns exist
,0 & ! flag to what you want perturbed
,spp_cu_deep & ! flag to what you want perturbed
! 1 = momentum transport
! 2 = normalized vertical mass flux profile
! 3 = closures
Expand Down Expand Up @@ -816,7 +829,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,&
,rand_mom & ! for stochastics mom, if temporal and spatial patterns exist
,rand_vmas & ! for stochastics vertmass, if temporal and spatial patterns exist
,rand_clos & ! for stochastics closures, if temporal and spatial patterns exist
,0 & ! flag to what you want perturbed
,spp_cu_deep & ! flag to what you want perturbed
! 1 = momentum transport
! 2 = normalized vertical mass flux profile
! 3 = closures
Expand Down Expand Up @@ -914,38 +927,6 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,&
!gdc(i,k,8)=(outq(i,k))*86400.*xlv/cp
gdc(i,k,8)=(outqm(i,k)+outqs(i,k)+outq(i,k))*86400.*xlv/cp
gdc(i,k,9)=gdc(i,k,2)+gdc(i,k,3)+gdc(i,k,4)
!
!> - Calculate subsidence effect on clw
!
! dsubclw=0.
! dsubclwm=0.
! dsubclws=0.
! dp=100.*(p2d(i,k)-p2d(i,k+1))
! if (clcw(i,k) .gt. -999.0 .and. clcw(i,k+1) .gt. -999.0 )then
! clwtot = cliw(i,k) + clcw(i,k)
! clwtot1= cliw(i,k+1) + clcw(i,k+1)
! dsubclw=((-edt(i)*zd(i,k+1)+zu(i,k+1))*clwtot1 &
! -(-edt(i)*zd(i,k) +zu(i,k)) *clwtot )*g/dp
! dsubclwm=((-edtm(i)*zdm(i,k+1)+zum(i,k+1))*clwtot1 &
! -(-edtm(i)*zdm(i,k) +zum(i,k)) *clwtot )*g/dp
! dsubclws=(zus(i,k+1)*clwtot1-zus(i,k)*clwtot)*g/dp
! dsubclw=dsubclw+(zu(i,k+1)*clwtot1-zu(i,k)*clwtot)*g/dp
! dsubclwm=dsubclwm+(zum(i,k+1)*clwtot1-zum(i,k)*clwtot)*g/dp
! dsubclws=dsubclws+(zus(i,k+1)*clwtot1-zus(i,k)*clwtot)*g/dp
! endif
! tem = dt*(outqcs(i,k)*cutens(i)+outqc(i,k)*cuten(i) &
! +outqcm(i,k)*cutenm(i) &
! +dsubclw*xmb(i)+dsubclws*xmbs(i)+dsubclwm*xmbm(i) &
! )
! tem1 = max(0.0, min(1.0, (tcr-t(i,k))*tcrf))
! if (clcw(i,k) .gt. -999.0) then
! cliw(i,k) = max(0.,cliw(i,k) + tem * tem1) ! ice
! clcw(i,k) = max(0.,clcw(i,k) + tem *(1.0-tem1)) ! water
! else
! cliw(i,k) = max(0.,cliw(i,k) + tem)
! endif
!
! enddo

!> - FCT treats subsidence effect to cloud ice/water (begin)
dp=100.*(p2d(i,k)-p2d(i,k+1))
Expand Down Expand Up @@ -1001,8 +982,8 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,&
gdc(i,16,10)=pret(i)*3600.

maxupmf(i)=0.
if(forcing(i,6).gt.0.)then
maxupmf(i)=maxval(xmb(i)*zu(i,kts:ktf)/forcing(i,6))
if(forcing2(i,6).gt.0.)then
maxupmf(i)=maxval(xmb(i)*zu(i,kts:ktf)/forcing2(i,6))
endif

if(ktop(i).gt.2 .and.pret(i).gt.0.)dt_mf(i,ktop(i)-1)=ud_mf(i,ktop(i))
Expand Down
15 changes: 15 additions & 0 deletions physics/CONV/Grell_Freitas/cu_gf_driver.meta
View file
Original file line number Diff line number Diff line change
Expand Up @@ -597,6 +597,21 @@
dimensions = ()
type = integer
intent = in
[spp_wts_cu_deep]
standard_name = spp_weights_for_cu_deep_scheme
long_name = spp weights for cu deep scheme
units = 1
dimensions = (horizontal_loop_extent,vertical_layer_dimension)
type = real
kind = kind_phys
intent = in
[spp_cu_deep]
standard_name = control_for_deep_convection_spp_perturbations
long_name = control for deep convection spp perturbations
units = count
dimensions = ()
type = integer
intent = in
[errmsg]
standard_name = ccpp_error_message
long_name = error message for error handling in CCPP
Expand Down
9 changes: 4 additions & 5 deletions physics/CONV/Grell_Freitas/cu_gf_driver_post.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -66,20 +66,19 @@ subroutine cu_gf_driver_post_run (im, km, t, q, prevst, prevsq, cactiv, cactiv_m
conv_act_m(i)=0.0
endif
! reflectivity parameterization for parameterized convection (reference:Unipost MDLFLD.f)
if(sqrt(garea(i)).lt.6500.)then
ze = 0.0
ze_conv = 0.0
dbz_sum = 0.0
cuprate = raincv(i) * 3600.0 / dt ! cu precip rate (mm/h)
ze_conv = 300.0 * cuprate**1.4
if (maxupmf(i).gt.0.05) then
cuprate = 1.e3*raincv(i) * 3600.0 / dt ! cu precip rate (mm/h)
if(cuprate .lt. 0.05) cuprate=0.
ze_conv = 300.0 * cuprate**1.5
if (maxupmf(i).gt.0.1 .and. cuprate.gt.0.) then
do k = 1, km
ze = 10._kind_phys ** (0.1 * refl_10cm(i,k))
dbz_sum = max(dbzmin, 10.0 * log10(ze + ze_conv))
refl_10cm(i,k) = dbz_sum
enddo
endif
endif
enddo
!$acc end kernels

Expand Down
Loading

0 comments on commit daf1799

Please sign in to comment.