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.

Sign up for GitHub

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

update GF/C3 for SRW3.0 release #249

Open
wants to merge 1 commit into
base: ufs/dev
Choose a base branch
from
Open

update GF/C3 for SRW3.0 release #249

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
132 changes: 111 additions & 21 deletions physics/CONV/C3/cu_c3_deep.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -153,7 +153,7 @@ subroutine cu_c3_deep_run( &
!! betwee -1 and +1
,do_capsuppress,cap_suppress_j & !
,k22 & !
,jmin,tropics) !
,jmin,mc_thresh) !

implicit none

Expand Down Expand Up @@ -198,16 +198,16 @@ subroutine cu_c3_deep_run( &
!$acc declare copy(cnvwt,outu,outv,outt,outq,outqc,cupclw,frh_out,pre,xmb_out)
real(kind=kind_phys), dimension (its:) &
,intent (in ) :: &
hfx,qfx,xmbm_in,xmbs_in
!$acc declare copyin(hfx,qfx,xmbm_in,xmbs_in)
mc_thresh,hfx,qfx,xmbm_in,xmbs_in
!$acc declare copyin(mc_thresh,hfx,qfx,xmbm_in,xmbs_in)
integer, dimension (its:) &
,intent (inout ) :: &
kbcon,ktop
!$acc declare copy(kbcon,ktop)
integer, dimension (its:) &
,intent (in ) :: &
kpbl,tropics
!$acc declare copyin(kpbl,tropics)
kpbl
!$acc declare copyin(kpbl)
!
! basic environmental input includes moisture convergence (mconv)
! omega (omeg), windspeed (us,vs), and a flag (ierr) to turn off
Expand Down Expand Up @@ -448,10 +448,19 @@ subroutine cu_c3_deep_run( &
!---meltglac-------------------------------------------------

real(kind=kind_phys), dimension (its:ite,kts:kte) :: p_liq_ice,melting_layer,melting
!$acc declare create(p_liq_ice,melting_layer,melting)
! icoldpool
integer, parameter :: icoldpool=0
real(kind=kind_phys), parameter :: Kfr = 0.9, epsx = 1.e2, alpha_dd=45., pi=3.1416
real(kind=kind_phys), dimension (its:ite) :: beta_x, vcpool, wlpool,umcl,vmcl,slope_pool
real(kind=kind_phys), dimension (its:ite,kts:kte) :: buoysrc,dellat_d
real(kind=kind_phys) :: aux,mcl_speed,total_dz,mx_buoy2,h_env,dpsum

integer :: itemp
!$acc declare create(p_liq_ice,melting_layer,melting,buoysrc,beta_x,vcpool,wlpool,umcl,vmcl)



mx_buoy2 = cp*10.
!---meltglac-------------------------------------------------
!$acc kernels
melting_layer(:,:)=0.
Expand Down Expand Up @@ -586,9 +595,8 @@ subroutine cu_c3_deep_run( &
!$acc loop private(radius,frh)
do i=its,ite
c1d(i,:)= 0. !c1 ! 0. ! c1 ! max(.003,c1+float(csum(i))*.0001)
entr_rate(i)=7.e-5 - min(20.,float(csum(i))) * 3.e-6
if(xland1(i) == 0)entr_rate(i)=7.e-5
if(dx(i)<dx_thresh) entr_rate(i)=2.e-4
!entr_rate(i)=7.e-5 !- min(20.,float(csum(i))) * 3.e-6
entr_rate(i)=1.e-4
if(imid.eq.1)entr_rate(i)=3.e-4
radius=.2/entr_rate(i)
frh=min(1.,3.14*radius*radius/dx(i)/dx(i))
Expand All @@ -600,7 +608,7 @@ subroutine cu_c3_deep_run( &
sig(i)=(1.-frh)**2
!frh_out(i) = frh
if(forcing(i,7).eq.0.)sig(i)=1.
frh_out(i) = frh*sig(i)
frh_out(i) = frh !*sig(i)
enddo
!$acc end kernels
sig_thresh = (1.-frh_thresh)**2
Expand Down Expand Up @@ -645,7 +653,7 @@ subroutine cu_c3_deep_run( &
!--- minimum depth (m), clouds must have
!
depth_min=3000.
if(dx(its)<dx_thresh)depth_min=5000.
!if(dx(its)<dx_thresh)depth_min=5000.
if(imid.eq.1)depth_min=2500.
!
!--- maximum depth (mb) of capping
Expand Down Expand Up @@ -1093,14 +1101,14 @@ subroutine cu_c3_deep_run( &
if(imid.eq.1)then
call cup_up_moisture('mid',ierr,zo_cup,qco,qrco,pwo,pwavo, &
p_cup,kbcon,ktop,dbyo,clw_all,xland1, &
qo,gammao_cup,zuo,qeso_cup,k22,qo_cup,c0, &
qo,gammao_cup,zuo,qeso_cup,k22,qo_cup,c0,jmin, &
zqexec,ccn,ccnclean,rho,c1d,tn_cup,autoconv,up_massentr,up_massdetr,psum,psumh, &
1,itf,ktf, &
its,ite, kts,kte)
else
call cup_up_moisture('deep',ierr,zo_cup,qco,qrco,pwo,pwavo, &
p_cup,kbcon,ktop,dbyo,clw_all,xland1, &
qo,gammao_cup,zuo,qeso_cup,k22,qo_cup,c0, &
qo,gammao_cup,zuo,qeso_cup,k22,qo_cup,c0,jmin, &
zqexec,ccn,ccnclean,rho,c1d,tn_cup,autoconv,up_massentr,up_massdetr,psum,psumh, &
1,itf,ktf, &
its,ite, kts,kte)
Expand Down Expand Up @@ -1599,6 +1607,7 @@ subroutine cu_c3_deep_run( &
dellv (i,k)=0.
dellah (i,k)=0.
dellat (i,k)=0.
dellat_d (i,k)=0.
dellaq (i,k)=0.
dellaqc(i,k)=0.
enddo
Expand Down Expand Up @@ -1723,6 +1732,7 @@ subroutine cu_c3_deep_run( &
g_rain= 0.5*(pwo (i,1)+pwo (i,2))*g/dp
e_dn = -0.5*(pwdo(i,1)+pwdo(i,2))*g/dp*edto(i) ! pwdo < 0 and e_dn must > 0
dellaq(i,1) = dellaq(i,1)+ e_dn-g_rain
dellat_d(i,1)=zdo(i,2)*edto(i)*(hcdo(i,2)-heo_cup(i,2))*g/dp

!--- conservation check
!- water mass balance
Expand Down Expand Up @@ -1780,6 +1790,12 @@ subroutine cu_c3_deep_run( &
! trash= trash+ (dellaq(i,k)+dellaqc(i,k)+ g_rain-e_dn)*dp/g

enddo ! k
do k=2,jmin(i)-1
dp=100.*(po_cup(i,k)-po_cup(i,k+1))
dellat_d(i,k)= &
edto(i)*dd_massdetro(i,k)*(.5*(hcdo(i,k+1)+hcdo(i,k))-heo(i,k))*g/dp
enddo ! k

endif

enddo
Expand Down Expand Up @@ -1991,6 +2007,7 @@ subroutine cu_c3_deep_run( &
!$acc atomic update
mconv(i)=mconv(i)+omeg(i,k)*dq/g
enddo
if ((mconv(i) < mc_thresh(i)) .and. (xland1(i) == 0)) ierr(i)=2242
enddo

!> - From Bengtsson et al. (2022) \cite Bengtsson_2022 prognostic closure scheme,
Expand Down Expand Up @@ -2088,6 +2105,34 @@ subroutine cu_c3_deep_run( &
ichoice,imid,ipr,itf,ktf, &
its,ite, kts,kte,dx,sigmab, &
dicycle,xf_dicycle,xf_progsigma)
!
!
if (icoldpool > 0 .and. imid ==0) then
buoysrc(:,:)=0.
do i=its,itf
vcpool(i)=0.
wlpool(i)=0.
total_dz=0.
beta_x(i)=0.
if(ierr(i).gt.0)cycle ! exit loopI
do k = kts,jmin(i)-1
buoysrc(i,k)=beta_x(i)-dellat_d(i,k)*xmb(i)*dtime !/sig(i)*cp
if(buoysrc(i,k) < epsx .or. total_dz .gt. z_detr ) cycle
H_env = heo(i,k)
dz = zo(i,k+1)-zo(i,k)
total_dz = total_dz + dz
vcpool(i) = vcpool(i) + (g*dz*min(mx_buoy2,buoysrc(i,k))/H_env)
wlpool(i) = wlpool(i) + (g*dz*min(mx_buoy2,buoysrc(i,k))/H_env )
end do
do k = kts,jmin(i)-1
buoysrc(i,k)=-dellat_d(i,k)*xmb(i)*dtime
end do
vcpool(i) = min(20., Kfr *sqrt(vcpool(i)))
slope_pool(i) = alpha_dd
wlpool(i) = min(10., Kfr *sin( slope_pool(i)*pi/180. )* sqrt(wlpool(i)))
enddo ! i-loop
endif ! icoldpool


!> - Call rain_evap_below_cloudbase() to calculate evaporation below cloud base

Expand Down Expand Up @@ -2116,6 +2161,48 @@ subroutine cu_c3_deep_run( &
endif
enddo
!$acc end kernels
if (icoldpool > 0 .and. icoldpool /= 2 .and. imid ==0) then
! --- adding the gust front horizontal speed to the 2-d MCL wind
! --- only magnitude is augmented, direction is kept the same
do i=its,itf
umcl(i)=0.
vmcl(i)=0.
dpsum=0.
if(ierr(i) > 0 ) cycle
do k=kts+1,ktop(i)-1
trash =-(po_cup(i,k)-po_cup(i,kts))
if(trash.gt.300..and. trash.lt.600.)then
dp=100.*(po_cup(i,k)-po_cup(i,k+1))
umcl(i)=umcl(i)+us(i,k)*dp
vmcl(i)=vmcl(i)+us(i,k)*dp
dpsum=dpsum+dp
endif
enddo
if(dpsum > 0.) then
umcl(i)=umcl(i)/dpsum
vmcl(i)=vmcl(i)/dpsum
MCL_speed= sqrt( umcl(i)**2 + vmcl(i)**2 )
aux = (MCL_speed + vcpool(i))/(MCL_speed+1.e-6)
umcl(i) = aux * umcl(i)
vmcl(i) = aux * vmcl(i)
endif
enddo
! --- gust front momentum impact
do i=its,itf
if(ierr(i) > 0 .or. vcpool(i) .le.0.) cycle
k=kts
dp=100.*(po_cup(i,k)-po_cup(i,k+1))
outu(i,k) = outu(i,k) + edto(i)*zdo(i,k+1)*umcl(i)*g/dp*xmb(i)
outv(i,k) = outv(i,k) + edto(i)*zdo(i,k+1)*vmcl(i)*g/dp*xmb(i)
do k=kts+1,kdet(i)
dp=100.*(po_cup(i,k)-po_cup(i,k+1))
outu(i,k) = outu(i,k) + edto(i)*dd_massdetro(i,k)*umcl(i)*g/dp*xmb(i)
outv(i,k) = outv(i,k) + edto(i)*dd_massdetro(i,k)*vmcl(i)*g/dp*xmb(i)
enddo
enddo
endif ! icoldpool
if(icoldpool == 1)vcpool(:)=0.

! rain evaporation as in sas
!
if(irainevap.eq.1)then
Expand All @@ -2142,6 +2229,8 @@ subroutine cu_c3_deep_run( &
if(ierr(i).eq.0)then
evef = edt(i) * evfact * sig(i)**2
if(xland(i).gt.0.5 .and. xland(i).lt.1.5) evef = edt(i) * evfactl * sig(i)**2
!evef=.09
!evef=.9
!$acc loop seq
do k = ktop(i), 1, -1
rain = pwo(i,k) + edto(i) * pwdo(i,k)
Expand Down Expand Up @@ -4228,7 +4317,7 @@ end subroutine cup_output_ens_3d
!> Calculates moisture properties of the updraft.
subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, &
p_cup,kbcon,ktop,dby,clw_all,xland1, &
q,gamma_cup,zu,qes_cup,k22,qe_cup,c0, &
q,gamma_cup,zu,qes_cup,k22,qe_cup,c0,jmin, &
zqexec,ccn,ccnclean,rho,c1d,t,autoconv, &
up_massentr,up_massdetr,psum,psumh, &
itest,itf,ktf, &
Expand Down Expand Up @@ -4267,7 +4356,7 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, &
! entr= entrainment rate
integer, dimension (its:) &
,intent (in ) :: &
kbcon,ktop,k22,xland1
kbcon,ktop,k22,xland1,jmin
!$acc declare copyin(p_cup,rho,q,zu,gamma_cup,qe_cup,up_massentr,up_massdetr,dby,qes_cup,z_cup,zqexec,c0,kbcon,ktop,k22,xland1)
real(kind=kind_phys), intent (in ) :: & ! HCB
ccnclean
Expand Down Expand Up @@ -4490,16 +4579,17 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, &
clw_allh(i,k)=max(0.,qch(i,k)-qrch)
qrcb(i,k)=max(0.,(qch(i,k)-qrch)) ! /(1.+c0(i)*dz*zu(i,k))
if(is_deep)then
clwdet=0.1 !0.02 ! 05/11/2021
!if(k.lt.kklev(i)) clwdet=0. ! 05/05/2021
clwdet=1.2 !0.1 !0.02
else
clwdet=0.1 !0.02 ! 05/05/2021
!if(k.lt.kklev(i)) clwdet=0. ! 05/25/2021
clwdet=1.2 !0.1 !0.02
endif
if (k.gt.jmin(i))then
clwdet=2.
endif
if(k.gt.kbcon(i)+1)c1d(i,k)=clwdet*up_massdetr(i,k-1)
if(k.gt.kbcon(i)+1)c1d_b(i,k)=clwdet*up_massdetr(i,k-1)
c1d(i,k)=0.005
c1d_b(i,k)=0.005
!c1d(i,k)=0.005
!c1d_b(i,k)=0.005

if(autoconv.eq.2) then
!
Expand Down
9 changes: 5 additions & 4 deletions physics/CONV/C3/cu_c3_driver.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -228,10 +228,10 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,&
real(kind=kind_phys), dimension (im,km) :: qcheck,zo,t2d,q2d,po,p2d,rhoi,clw_ten
real(kind=kind_phys), dimension (im,km) :: tn,qo,tshall,qshall,dz8w,omeg
real(kind=kind_phys), dimension (im) :: z1,psur,cuten,cutens,cutenm
real(kind=kind_phys), dimension (im) :: umean,vmean,pmean
real(kind=kind_phys), dimension (im) :: umean,vmean,pmean,mc_thresh
real(kind=kind_phys), dimension (im) :: xmbs,xmbs2,xmb,xmbm,xmb_dumm,mconv
!$acc declare create(qcheck,zo,t2d,q2d,po,p2d,rhoi,clw_ten,tn,qo,tshall,qshall,dz8w,omeg, &
!$acc z1,psur,cuten,cutens,cutenm,umean,vmean,pmean, &
!$acc z1,psur,cuten,cutens,cutenm,umean,vmean,pmean,mc_thresh, &
!$acc xmbs,xmbs2,xmb,xmbm,xmb_dumm,mconv)

integer :: i,j,k,icldck,ipr,jpr,jpr_deep,ipr_deep,uidx,vidx,tidx,qidx
Expand Down Expand Up @@ -603,6 +603,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))
mc_thresh(i)=3.25/dx(i)
enddo

do i=its,itf
Expand Down Expand Up @@ -788,7 +789,7 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,&
! betwee -1 and +1
,do_cap_suppress_here,cap_suppress_j &
,k22m &
,jminm,tropics)
,jminm,mc_thresh)
!$acc kernels
do i=its,itf
do k=kts,ktf
Expand Down Expand Up @@ -882,7 +883,7 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,&
! betwee -1 and +1
,do_cap_suppress_here,cap_suppress_j &
,k22 &
,jmin,tropics)
,jmin,mc_thresh)
jpr=0
ipr=0
!$acc kernels
Expand Down
Loading