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

UFS-dev PR#135 #1057

Merged
merged 10 commits into from
Mar 12, 2024
267 changes: 240 additions & 27 deletions physics/cu_gf_deep.F90

Large diffs are not rendered by default.

29 changes: 22 additions & 7 deletions physics/cu_gf_driver.F90
Original file line number Diff line number Diff line change
Expand Up @@ -67,8 +67,8 @@ 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)
spp_cu_deep,spp_wts_cu_deep,nchem,chem3d,fscav,wetdpc_deep, &
do_smoke_transport,errmsg,errflg)
!-------------------------------------------------------------
implicit none
integer, parameter :: maxiens=1
Expand All @@ -86,7 +86,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,&
& spp_wts_cu_deep
real(kind=kind_phys) :: spp_wts_cu_deep_tmp

logical, intent(in) :: do_cap_suppress
logical, intent(in) :: do_cap_suppress, do_smoke_transport
real(kind=kind_phys), parameter :: aodc0=0.14
real(kind=kind_phys), parameter :: aodreturn=30.
real(kind=kind_phys) :: dts,fpi,fp
Expand All @@ -95,7 +95,7 @@ subroutine cu_gf_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, nchem
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
Expand Down Expand Up @@ -154,7 +154,11 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,&

integer, intent(in ) :: imfshalcnv
integer, dimension(:), intent(inout) :: cactiv,cactiv_m
!$acc declare copy(cactiv,cactiv_m)
real(kind_phys), dimension(:), intent(in) :: fscav
!$acc declare copyin(fscav)
real(kind_phys), dimension(:,:,:), intent(inout) :: chem3d
real(kind_phys), dimension(:,:), intent(inout) :: wetdpc_deep
!$acc declare copy(cactiv,cactiv_m,chem3d,wetdpc_deep)

character(len=*), intent(out) :: errmsg
integer, intent(out) :: errflg
Expand All @@ -179,19 +183,20 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,&
real(kind=kind_phys), dimension (im) :: tau_ecmwf,edt,edtm,edtd,ter11,aa0,xlandi
real(kind=kind_phys), dimension (im) :: pret,prets,pretm,hexec
real(kind=kind_phys), dimension (im,10) :: forcing,forcing2
real(kind=kind_phys), dimension (im,nchem) :: wetdpc_mid

integer, dimension (im) :: kbcon, ktop,ierr,ierrs,ierrm,kpbli
integer, dimension (im) :: k22s,kbcons,ktops,k22,jmin,jminm
integer, dimension (im) :: kbconm,ktopm,k22m
!$acc declare create(k22_shallow,kbcon_shallow,ktop_shallow,rand_mom,rand_vmas, &
!$acc rand_clos,gdc,gdc2,ht,ccn_gf,ccn_m,dx,frhm,frhd, &
!$acc rand_clos,gdc,gdc2,ht,ccn_gf,ccn_m,dx,frhm,frhd,wetdpc_mid, &
!$acc outt,outq,outqc,phh,subm,cupclw,cupclws, &
!$acc dhdt,zu,zus,zd,phf,zum,zdm,outum,outvm, &
!$acc outts,outqs,outqcs,outu,outv,outus,outvs, &
!$acc outtm,outqm,outqcm,submm,cupclwm, &
!$acc cnvwt,cnvwts,cnvwtm,hco,hcdo,zdo,zdd,hcom,hcdom,zdom, &
!$acc tau_ecmwf,edt,edtm,edtd,ter11,aa0,xlandi, &
!$acc pret,prets,pretm,hexec,forcing,forcing2, &
!$acc pret,prets,pretm,hexec,forcing,forcing2,wetdpc_mid, &
!$acc kbcon, ktop,ierr,ierrs,ierrm,kpbli, &
!$acc k22s,kbcons,ktops,k22,jmin,jminm,kbconm,ktopm,k22m)

Expand Down Expand Up @@ -743,6 +748,11 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,&
,frhm &
,ierrm &
,ierrcm &
,nchem &
,fscav &
,chem3d &
,wetdpc_mid &
,do_smoke_transport &
! the following should be set to zero if not available
,rand_mom & ! for stochastics mom, if temporal and spatial patterns exist
,rand_vmas & ! for stochastics vertmass, if temporal and spatial patterns exist
Expand Down Expand Up @@ -825,6 +835,11 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,&
,frhd &
,ierr &
,ierrc &
,nchem &
,fscav &
,chem3d &
,wetdpc_deep &
,do_smoke_transport &
! the following should be set to zero if not available
,rand_mom & ! for stochastics mom, if temporal and spatial patterns exist
,rand_vmas & ! for stochastics vertmass, if temporal and spatial patterns exist
Expand Down
38 changes: 38 additions & 0 deletions physics/cu_gf_driver.meta
Original file line number Diff line number Diff line change
Expand Up @@ -612,6 +612,44 @@
dimensions = ()
type = integer
intent = in
[nchem]
standard_name = number_of_chemical_species_vertically_mixed
long_name = number of chemical species vertically mixed
units = count
dimensions = ()
type = integer
intent = in
[chem3d]
standard_name = chem3d_mynn_pbl_transport
long_name = mynn pbl transport of smoke and dust
units = various
dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_chemical_species_vertically_mixed)
type = real
kind = kind_phys
intent = inout
[fscav]
standard_name = smoke_dust_conv_wet_coef
long_name = smoke dust convetive wet scavanging coefficents
units = none
dimensions = (3)
type = real
kind = kind_phys
intent = in
[do_smoke_transport]
standard_name = do_smoke_conv_transport
long_name = flag for rrfs smoke convective transport
units = flag
dimensions = ()
type = logical
intent = in
[wetdpc_deep]
standard_name = conv_wet_deposition_smoke_dust
long_name = convective wet removal of smoke and dust
units = kg kg-1
dimensions = (horizontal_loop_extent,number_of_chemical_species_vertically_mixed)
type = real
kind = kind_phys
intent = inout
[errmsg]
standard_name = ccpp_error_message
long_name = error message for error handling in CCPP
Expand Down
13 changes: 11 additions & 2 deletions physics/cu_gf_driver_post.F90
Original file line number Diff line number Diff line change
Expand Up @@ -15,7 +15,7 @@ module cu_gf_driver_post
!> \section arg_table_cu_gf_driver_post_run Argument Table
!! \htmlinclude cu_gf_driver_post_run.html
!!
subroutine cu_gf_driver_post_run (im, km, t, q, prevst, prevsq, cactiv, cactiv_m, conv_act, conv_act_m, errmsg, errflg)
subroutine cu_gf_driver_post_run (im, km, t, q, prevst, prevsq, cactiv, cactiv_m, conv_act, conv_act_m, rrfs_sd, ntsmoke, ntdust, ntcoarsepm, chem3d, gq0, errmsg, errflg)

use machine, only: kind_phys

Expand All @@ -31,8 +31,11 @@ subroutine cu_gf_driver_post_run (im, km, t, q, prevst, prevsq, cactiv, cactiv_m
integer, intent(in) :: cactiv_m(:)
real(kind_phys), intent(out) :: conv_act(:)
real(kind_phys), intent(out) :: conv_act_m(:)
logical, intent(in) :: rrfs_sd
integer, intent(in) :: ntsmoke, ntdust, ntcoarsepm
real(kind_phys), intent(inout) :: chem3d(:,:,:), gq0(:,:,:)
character(len=*), intent(out) :: errmsg
!$acc declare copyin(t,q,cactiv,cactiv_m) copyout(prevst,prevsq,conv_act,conv_act_m)
!$acc declare copyin(t,q,cactiv,cactiv_m) copyout(prevst,prevsq,conv_act,conv_act_m,chem3d,gq0)
integer, intent(out) :: errflg

! Local variables
Expand All @@ -58,6 +61,12 @@ subroutine cu_gf_driver_post_run (im, km, t, q, prevst, prevsq, cactiv, cactiv_m
conv_act_m(i)=0.0
endif
enddo

if (rrfs_sd) then
gq0(:,:,ntsmoke ) = chem3d(:,:,1)
gq0(:,:,ntdust ) = chem3d(:,:,2)
gq0(:,:,ntcoarsepm) = chem3d(:,:,3)
endif
!$acc end kernels

end subroutine cu_gf_driver_post_run
Expand Down
44 changes: 44 additions & 0 deletions physics/cu_gf_driver_post.meta
Original file line number Diff line number Diff line change
Expand Up @@ -83,6 +83,34 @@
type = real
kind = kind_phys
intent = out
[rrfs_sd]
standard_name = do_smoke_coupling
long_name = flag controlling rrfs_sd collection
units = flag
dimensions = ()
type = logical
intent = in
[ntsmoke]
standard_name = index_for_smoke_in_tracer_concentration_array
long_name = tracer index for smoke
units = index
dimensions = ()
type = integer
intent = in
[ntdust]
standard_name = index_for_dust_in_tracer_concentration_array
long_name = tracer index for dust
units = index
dimensions = ()
type = integer
intent = in
[ntcoarsepm]
standard_name = index_for_coarse_particulate_matter_in_tracer_concentration_array
long_name = tracer index for coarse particulate matter
units = index
dimensions = ()
type = integer
intent = in
[errmsg]
standard_name = ccpp_error_message
long_name = error message for error handling in CCPP
Expand All @@ -91,6 +119,22 @@
type = character
kind = len=*
intent = out
[chem3d]
standard_name = chem3d_mynn_pbl_transport
long_name = mynn pbl transport of smoke and dust
units = various
dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_chemical_species_vertically_mixed)
type = real
kind = kind_phys
intent = inout
[gq0]
standard_name = tracer_concentration_of_new_state
long_name = tracer concentration updated by physics
units = kg kg-1
dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers)
type = real
kind = kind_phys
intent = inout
[errflg]
standard_name = ccpp_error_code
long_name = error code for error handling in CCPP
Expand Down
12 changes: 11 additions & 1 deletion physics/cu_gf_driver_pre.F90
Original file line number Diff line number Diff line change
Expand Up @@ -17,6 +17,7 @@ module cu_gf_driver_pre
!!
subroutine cu_gf_driver_pre_run (flag_init, flag_restart, kdt, fhour, dtp, t, q, prevst, prevsq, &
forcet, forceq, cactiv, cactiv_m, conv_act, conv_act_m, &
rrfs_sd, ntsmoke, ntdust, ntcoarsepm, chem3d, gq0, &
errmsg, errflg)

use machine, only: kind_phys
Expand All @@ -25,6 +26,7 @@ subroutine cu_gf_driver_pre_run (flag_init, flag_restart, kdt, fhour, dtp, t, q,

logical, intent(in) :: flag_init
logical, intent(in) :: flag_restart
logical, intent(in) :: rrfs_sd
integer, intent(in) :: kdt
real(kind_phys), intent(in) :: fhour
real(kind_phys), intent(in) :: dtp
Expand All @@ -37,10 +39,12 @@ subroutine cu_gf_driver_pre_run (flag_init, flag_restart, kdt, fhour, dtp, t, q,
real(kind_phys), intent(out) :: forceq(:,:)
integer, intent(out) :: cactiv(:)
integer, intent(out) :: cactiv_m(:)
integer, intent(in) :: ntsmoke, ntdust, ntcoarsepm
!$acc declare copyout(forcet,forceq,cactiv,cactiv_m)
real(kind_phys), intent(in) :: conv_act(:)
real(kind_phys), intent(in) :: conv_act_m(:)
!$acc declare copyin(conv_act,conv_act_m)
real(kind_phys), intent(inout) :: chem3d(:,:,:), gq0(:,:,:)
!$acc declare copyin(conv_act,conv_act_m) copy(chem3d,gq0)
character(len=*), intent(out) :: errmsg
integer, intent(out) :: errflg

Expand Down Expand Up @@ -77,6 +81,12 @@ subroutine cu_gf_driver_pre_run (flag_init, flag_restart, kdt, fhour, dtp, t, q,
!$acc kernels
cactiv(:)=nint(conv_act(:))
cactiv_m(:)=nint(conv_act_m(:))

if (rrfs_sd) then
chem3d(:,:,1) = gq0(:,:,ntsmoke)
chem3d(:,:,2) = gq0(:,:,ntdust)
chem3d(:,:,3) = gq0(:,:,ntcoarsepm)
endif
!$acc end kernels

end subroutine cu_gf_driver_pre_run
Expand Down
44 changes: 44 additions & 0 deletions physics/cu_gf_driver_pre.meta
Original file line number Diff line number Diff line change
Expand Up @@ -122,6 +122,50 @@
type = real
kind = kind_phys
intent = in
[rrfs_sd]
standard_name = do_smoke_coupling
long_name = flag controlling rrfs_sd collection
units = flag
dimensions = ()
type = logical
intent = in
[ntsmoke]
standard_name = index_for_smoke_in_tracer_concentration_array
long_name = tracer index for smoke
units = index
dimensions = ()
type = integer
intent = in
[ntdust]
standard_name = index_for_dust_in_tracer_concentration_array
long_name = tracer index for dust
units = index
dimensions = ()
type = integer
intent = in
[ntcoarsepm]
standard_name = index_for_coarse_particulate_matter_in_tracer_concentration_array
long_name = tracer index for coarse particulate matter
units = index
dimensions = ()
type = integer
intent = in
[chem3d]
standard_name = chem3d_mynn_pbl_transport
long_name = mynn pbl transport of smoke and dust
units = various
dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_chemical_species_vertically_mixed)
type = real
kind = kind_phys
intent = inout
[gq0]
standard_name = tracer_concentration_of_new_state
long_name = tracer concentration updated by physics
units = kg kg-1
dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers)
type = real
kind = kind_phys
intent = inout
[errmsg]
standard_name = ccpp_error_message
long_name = error message for error handling in CCPP
Expand Down
11 changes: 5 additions & 6 deletions physics/smoke_dust/coarsepm_settling_mod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,7 @@ module coarsepm_settling_mod
CONTAINS


SUBROUTINE coarsepm_settling_driver(dt,t_phy,rel_hum, &
SUBROUTINE coarsepm_settling_driver(dt,t_phy, &
chem,rho_phy,dz8w,p8w,p_phy,sedim, &
area,g,num_chem, &
ids,ide, jds,jde, kds,kde, &
Expand All @@ -24,7 +24,7 @@ SUBROUTINE coarsepm_settling_driver(dt,t_phy,rel_hum, &
its,ite, jts,jte, kts,kte
REAL(kind_phys), DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ),INTENT(INOUT ) :: chem
REAL(kind_phys), DIMENSION( ims:ime , kms:kme , jms:jme ), &
INTENT(IN ) :: t_phy,p_phy,dz8w,p8w,rho_phy,rel_hum
INTENT(IN ) :: t_phy,p_phy,dz8w,p8w,rho_phy
REAL(kind_phys), DIMENSION( ims:ime , jms:jme ),INTENT(IN ) :: area
REAL(kind_phys), INTENT(IN ) :: dt,g

Expand Down Expand Up @@ -64,7 +64,6 @@ SUBROUTINE coarsepm_settling_driver(dt,t_phy,rel_hum, &
airmas(1,1,kk)=-(p8w(i,k+1,j)-p8w(i,k,j))*area(i,j)/g
airden(1,1,kk)=rho_phy(i,k,j)
tmp(1,1,kk)=t_phy(i,k,j)
rh(1,1,kk) = rel_hum(i,k,j) ! hli
do nv = 1, num_chem
chem_before(i,j,k,nv) = chem(i,k,j,nv)
enddo
Expand All @@ -82,7 +81,7 @@ SUBROUTINE coarsepm_settling_driver(dt,t_phy,rel_hum, &

call settling(1, 1, lmx, 1,g,dyn_visc, &
dust, tmp, p_mid, delz, airmas, &
den_dust, reff_dust, dt, bstl_dust, rh, idust, airden)
den_dust, reff_dust, dt, bstl_dust, idust, airden)

kk = 0
do k = kts,kte
Expand Down Expand Up @@ -111,7 +110,7 @@ END SUBROUTINE coarsepm_settling_driver

subroutine settling(imx,jmx, lmx, nmx,g0,dyn_visc, &
tc, tmp, p_mid, delz, airmas, &
den, reff, dt, bstl, rh, idust, airden)
den, reff, dt, bstl, idust, airden)
! ****************************************************************************
! * *
! * Calculate the loss by settling, using an implicit method *
Expand All @@ -131,7 +130,7 @@ subroutine settling(imx,jmx, lmx, nmx,g0,dyn_visc, &
INTEGER :: ntdt
REAL(kind_phys), INTENT(IN) :: dt,g0,dyn_visc
REAL(kind_phys), INTENT(IN) :: tmp(imx,jmx,lmx), delz(imx,jmx,lmx), &
airmas(imx,jmx,lmx), rh(imx,jmx,lmx), &
airmas(imx,jmx,lmx), &
den(nmx), reff(nmx),p_mid(imx,jmx,lmx),&
airden(imx,jmx,lmx)
REAL(kind_phys), INTENT(INOUT) :: tc(imx,jmx,lmx,nmx)
Expand Down
Loading
Loading