Skip to content

Commit

Permalink
Merge pull request NCAR#207 from Qingfu-Liu/HR4-GWD-update
Browse files Browse the repository at this point in the history 
HR4 Gravity Wave Drag Update
  • Loading branch information
@grantfirl
grantfirl authored Jul 10, 2024
2 parents 16a1d88 + c6dec90 commit 8103e21
Show file tree
Hide file tree
Showing 6 changed files with 1,387 additions and 26 deletions.
1,245 changes: 1,235 additions & 10 deletions physics/GWD/drag_suite.F90
View file

Large diffs are not rendered by default.

8 changes: 8 additions & 0 deletions physics/GWD/drag_suite.meta
View file
Original file line number Diff line number Diff line change
Expand Up @@ -521,6 +521,14 @@
type = real
kind = kind_phys
intent = in
[alpha_fd]
standard_name = alpha_coefficient_for_turbulent_orographic_form_drag
long_name = alpha coefficient for Beljaars et al turbulent orographic form drag
units = 1
dimensions = ()
type = real
kind = kind_phys
intent = in
[me]
standard_name = mpi_rank
long_name = rank of the current MPI task
Expand Down
48 changes: 38 additions & 10 deletions physics/GWD/ugwpv1_gsldrag.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -44,7 +44,7 @@ module ugwpv1_gsldrag
use cires_ugwpv1_solv2, only: cires_ugwpv1_ngw_solv2
use cires_ugwpv1_oro, only: orogw_v1

use drag_suite, only: drag_suite_run
use drag_suite, only: drag_suite_run, drag_suite_psl

implicit none

Expand Down Expand Up @@ -305,11 +305,13 @@ end subroutine ugwpv1_gsldrag_finalize
!! @{
subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp, &
fhzero, kdt, ldiag3d, lssav, flag_for_gwd_generic_tend, do_gsl_drag_ls_bl, &
do_gsl_drag_ss, do_gsl_drag_tofd, do_ugwp_v1, do_ugwp_v1_orog_only, &
do_gsl_drag_ss, do_gsl_drag_tofd, &
do_gwd_opt_psl, psl_gwd_dx_factor, &
do_ugwp_v1, do_ugwp_v1_orog_only, &
do_ugwp_v1_w_gsldrag, gwd_opt, do_tofd, ldiag_ugwp, ugwp_seq_update, &
cdmbgwd, jdat, nmtvr, hprime, oc, theta, sigma, gamma, &
cdmbgwd, alpha_fd, jdat, nmtvr, hprime, oc, theta, sigma, gamma, &
elvmax, clx, oa4, varss,oc1ss,oa4ss,ol4ss, dx, xlat, xlat_d, sinlat, coslat, &
area, rain, br1, hpbl, kpbl, slmsk, &
area, rain, br1, hpbl,vtype, kpbl, slmsk, &
ugrs, vgrs, tgrs, q1, prsi, prsl, prslk, phii, phil, del, tau_amf, &
dudt_ogw, dvdt_ogw, du_ogwcol, dv_ogwcol, &
dudt_obl, dvdt_obl, du_oblcol, dv_oblcol, &
Expand Down Expand Up @@ -367,11 +369,13 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp,
real(kind=kind_phys), intent(in) :: dtp, fhzero
real(kind=kind_phys), intent(in) :: ak(:), bk(:)
integer, intent(in) :: kdt, jdat(:)

! option for psl gwd
logical, intent(in) :: do_gwd_opt_psl ! option for psl gravity wave drag
real(kind=kind_phys), intent(in) :: psl_gwd_dx_factor !
! SSO parameters and variables
integer, intent(in) :: gwd_opt !gwd_opt and nmtvr are "redundant" controls
integer, intent(in) :: nmtvr
real(kind=kind_phys), intent(in) :: cdmbgwd(:) ! for gsl_drag
real(kind=kind_phys), intent(in) :: cdmbgwd(:), alpha_fd ! for gsl_drag

real(kind=kind_phys), intent(in), dimension(:) :: hprime, oc, theta, sigma, gamma

Expand All @@ -397,10 +401,10 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp,
real(kind=kind_phys), intent(in), dimension(:,:) :: prsi, phii
real(kind=kind_phys), intent(in), dimension(:,:) :: q1
integer, intent(in), dimension(:) :: kpbl
integer, intent(in), dimension(:) :: vtype

real(kind=kind_phys), intent(in), dimension(:) :: rain
real(kind=kind_phys), intent(in), dimension(:) :: br1, slmsk
real(kind=kind_phys), intent(in), dimension(:) :: hpbl
real(kind=kind_phys), intent(in), dimension(:) :: br1, hpbl, slmsk
!
! moved to GFS_phys_time_vary
! real(kind=kind_phys), intent(in), dimension(:) :: ddy_j1tau, ddy_j2tau
Expand Down Expand Up @@ -545,6 +549,28 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp,
! dusfcg, dvsfcg
!
!
if (do_gwd_opt_psl) then
call drag_suite_psl(im, levs, Pdvdt, Pdudt, Pdtdt, &
ugrs,vgrs,tgrs,q1, &
kpbl,prsi,del,prsl,prslk,phii,phil,dtp, &
kdt,hprime,oc,oa4,clx,varss,oc1ss,oa4ss, &
ol4ss,theta,sigma,gamma,elvmax, &
dudt_ogw, dvdt_ogw, dudt_obl, dvdt_obl, &
dudt_oss, dvdt_oss, dudt_ofd, dvdt_ofd, &
dusfcg, dvsfcg, &
du_ogwcol, dv_ogwcol, du_oblcol, dv_oblcol, &
du_osscol, dv_osscol, du_ofdcol, dv_ofdcol, &
slmsk,br1,hpbl,vtype,con_g,con_cp,con_rd,con_rv, &
con_fv, con_pi, lonr, &
cdmbgwd(1:2),alpha_fd,me,master, &
lprnt,ipr,rdxzb,dx,gwd_opt, &
do_gsl_drag_ls_bl,do_gsl_drag_ss,do_gsl_drag_tofd, &
psl_gwd_dx_factor, &
dtend, dtidx, index_of_process_orographic_gwd, &
index_of_temperature, index_of_x_wind, &
index_of_y_wind, ldiag3d, ldiag_ugwp, &
ugwp_seq_update, spp_wts_gwd, spp_gwd, errmsg, errflg)
else
call drag_suite_run(im, levs, Pdvdt, Pdudt, Pdtdt, &
ugrs,vgrs,tgrs,q1, &
kpbl,prsi,del,prsl,prslk,phii,phil,dtp, &
Expand All @@ -555,14 +581,16 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp,
dusfcg, dvsfcg, &
du_ogwcol, dv_ogwcol, du_oblcol, dv_oblcol, &
du_osscol, dv_osscol, du_ofdcol, dv_ofdcol, &
slmsk,br1,hpbl, con_g,con_cp,con_rd,con_rv, &
slmsk,br1,hpbl,con_g,con_cp,con_rd,con_rv, &
con_fv, con_pi, lonr, &
cdmbgwd(1:2),me,master,lprnt,ipr,rdxzb,dx,gwd_opt, &
cdmbgwd(1:2),alpha_fd,me,master, &
lprnt,ipr,rdxzb,dx,gwd_opt, &
do_gsl_drag_ls_bl,do_gsl_drag_ss,do_gsl_drag_tofd, &
dtend, dtidx, index_of_process_orographic_gwd, &
index_of_temperature, index_of_x_wind, &
index_of_y_wind, ldiag3d, ldiag_ugwp, &
ugwp_seq_update, spp_wts_gwd, spp_gwd, errmsg, errflg)
endif
!
! dusfcg = du_ogwcol + du_oblcol + du_osscol + du_ofdcol
!
Expand Down
30 changes: 30 additions & 0 deletions physics/GWD/ugwpv1_gsldrag.meta
View file
Original file line number Diff line number Diff line change
Expand Up @@ -402,6 +402,21 @@
dimensions = ()
type = logical
intent = in
[do_gwd_opt_psl]
standard_name = do_gsl_drag_suite_with_psl_gwd_option
long_name = flag to activate PSL drag suite - mesoscale GWD and blocking
units = flag
dimensions = ()
type = logical
intent = in
[psl_gwd_dx_factor]
standard_name = effective_grid_spacing_of_psl_gwd_suite
long_name = multiplication of grid spacing
units = 1
dimensions = ()
type = real
kind = kind_phys
intent = in
[do_ugwp_v1]
standard_name = flag_for_ugwp_version_1
long_name = flag to activate ver 1 CIRES UGWP
Expand Down Expand Up @@ -459,6 +474,14 @@
type = real
kind = kind_phys
intent = in
[alpha_fd]
standard_name = alpha_coefficient_for_turbulent_orographic_form_drag
long_name = alpha coefficient for Beljaars et al turbulent orographic form drag
units = 1
dimensions = ()
type = real
kind = kind_phys
intent = in
[jdat]
standard_name = date_and_time_of_forecast_in_united_states_order
long_name = current forecast date and time
Expand Down Expand Up @@ -645,6 +668,13 @@
type = real
kind = kind_phys
intent = in
[vtype]
standard_name = vegetation_type_classification
long_name = vegetation type for lsm
units = index
dimensions = (horizontal_loop_extent)
type = integer
intent = in
[kpbl]
standard_name = vertical_index_at_top_of_atmosphere_boundary_layer
long_name = vertical index at top atmospheric boundary layer
Expand Down
52 changes: 46 additions & 6 deletions physics/GWD/unified_ugwp.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -40,7 +40,7 @@ module unified_ugwp
use gwdps, only: gwdps_run
use cires_ugwp_triggers
use ugwp_driver_v0
use drag_suite, only: drag_suite_run
use drag_suite, only: drag_suite_run, drag_suite_psl

implicit none

Expand Down Expand Up @@ -249,8 +249,8 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, fhzero, kdt
varss,oc1ss,oa4ss,ol4ss,dx,dusfc_ms,dvsfc_ms,dusfc_bl,dvsfc_bl,dusfc_ss, &
dvsfc_ss,dusfc_fd,dvsfc_fd,dtaux2d_ms,dtauy2d_ms,dtaux2d_bl,dtauy2d_bl, &
dtaux2d_ss,dtauy2d_ss,dtaux2d_fd,dtauy2d_fd,dudt_ngw,dvdt_ngw,dtdt_ngw, &
br1,hpbl,slmsk, do_tofd, ldiag_ugwp, ugwp_seq_update, &
cdmbgwd, jdat, xlat, xlat_d, sinlat, coslat, area, &
br1,hpbl,vtype,slmsk, do_tofd, ldiag_ugwp, ugwp_seq_update, &
cdmbgwd, alpha_fd, jdat, xlat, xlat_d, sinlat, coslat, area, &
ugrs, vgrs, tgrs, q1, prsi, prsl, prslk, phii, phil, &
del, kpbl, dusfcg, dvsfcg, gw_dudt, gw_dvdt, gw_dtdt, gw_kdis, &
tau_tofd, tau_mtb, tau_ogw, tau_ngw, &
Expand All @@ -262,6 +262,7 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, fhzero, kdt
index_of_process_nonorographic_gwd, &
lssav, flag_for_gwd_generic_tend, do_ugwp_v0, do_ugwp_v0_orog_only, &
do_ugwp_v0_nst_only, do_gsl_drag_ls_bl, do_gsl_drag_ss, do_gsl_drag_tofd, &
do_gwd_opt_psl, psl_gwd_dx_factor, &
gwd_opt, spp_wts_gwd, spp_gwd, errmsg, errflg)

implicit none
Expand All @@ -270,6 +271,7 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, fhzero, kdt
integer, intent(in) :: me, master, im, levs, ntrac, kdt, lonr, nmtvr
integer, intent(in) :: gwd_opt
integer, intent(in), dimension(:) :: kpbl
integer, intent(in), dimension(:) :: vtype
real(kind=kind_phys), intent(in), dimension(:) :: ak, bk
real(kind=kind_phys), intent(in), dimension(:) :: oro, oro_uf, hprime, oc, theta, sigma, gamma
real(kind=kind_phys), intent(in), dimension(:), optional :: varss,oc1ss
Expand All @@ -288,7 +290,7 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, fhzero, kdt
real(kind=kind_phys), intent(in), dimension(:,:) :: del, ugrs, vgrs, tgrs, prsl, prslk, phil
real(kind=kind_phys), intent(in), dimension(:,:) :: prsi, phii
real(kind=kind_phys), intent(in), dimension(:,:) :: q1
real(kind=kind_phys), intent(in) :: dtp, fhzero, cdmbgwd(:)
real(kind=kind_phys), intent(in) :: dtp, fhzero, cdmbgwd(:), alpha_fd
integer, intent(in) :: jdat(:)
logical, intent(in) :: do_tofd, ldiag_ugwp, ugwp_seq_update

Expand Down Expand Up @@ -346,6 +348,10 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, fhzero, kdt
real(kind=kind_phys), intent(in), optional :: spp_wts_gwd(:,:)
integer, intent(in) :: spp_gwd

! option for psl gwd
logical, intent(in) :: do_gwd_opt_psl ! option for psl gravity wave drag
real(kind=kind_phys), intent(in) :: psl_gwd_dx_factor !

character(len=*), intent(out) :: errmsg
integer, intent(out) :: errflg

Expand Down Expand Up @@ -379,6 +385,18 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, fhzero, kdt
errflg = 0


! Initialize intent(out) variables in case they are not set below
dusfcg(:) = 0.0
dvsfcg(:) = 0.0
rdxzb(:) = 0.0
tau_ngw(:) = 0.0
gw_dudt(:,:) = 0.0
gw_dvdt(:,:) = 0.0
gw_dtdt(:,:) = 0.0
gw_kdis(:,:) = 0.0
dudt_mtb(:,:) = 0.0
dudt_tms(:,:) = 0.0

! 1) ORO stationary GWs
! ------------------

Expand Down Expand Up @@ -488,7 +506,27 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, fhzero, kdt
! Note: In case of GSL drag_suite, this includes ss and tofd

if ( do_gsl_drag_ls_bl.or.do_gsl_drag_ss.or.do_gsl_drag_tofd ) then

!
if (do_gwd_opt_psl) then
call drag_suite_psl(im,levs,dvdt,dudt,dtdt,uwnd1,vwnd1, &
tgrs,q1,kpbl,prsi,del,prsl,prslk,phii,phil,dtp, &
kdt,hprime,oc,oa4,clx,varss,oc1ss,oa4ss, &
ol4ss,theta,sigma,gamma,elvmax,dtaux2d_ms, &
dtauy2d_ms,dtaux2d_bl,dtauy2d_bl,dtaux2d_ss, &
dtauy2d_ss,dtaux2d_fd,dtauy2d_fd,dusfcg, &
dvsfcg,dusfc_ms,dvsfc_ms,dusfc_bl,dvsfc_bl, &
dusfc_ss,dvsfc_ss,dusfc_fd,dvsfc_fd, &
slmsk,br1,hpbl,vtype,con_g,con_cp,con_rd,con_rv, &
con_fvirt,con_pi,lonr, &
cdmbgwd,alpha_fd,me,master, &
lprnt,ipr,rdxzb,dx,gwd_opt, &
do_gsl_drag_ls_bl,do_gsl_drag_ss,do_gsl_drag_tofd, &
psl_gwd_dx_factor, &
dtend, dtidx, index_of_process_orographic_gwd, &
index_of_temperature, index_of_x_wind, &
index_of_y_wind, ldiag3d, ldiag_ugwp, &
ugwp_seq_update, spp_wts_gwd, spp_gwd, errmsg, errflg)
else
call drag_suite_run(im,levs,dvdt,dudt,dtdt,uwnd1,vwnd1, &
tgrs,q1,kpbl,prsi,del,prsl,prslk,phii,phil,dtp, &
kdt,hprime,oc,oa4,clx,varss,oc1ss,oa4ss, &
Expand All @@ -499,12 +537,14 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, fhzero, kdt
dusfc_ss,dvsfc_ss,dusfc_fd,dvsfc_fd, &
slmsk,br1,hpbl,con_g,con_cp,con_rd,con_rv, &
con_fvirt,con_pi,lonr, &
cdmbgwd,me,master,lprnt,ipr,rdxzb,dx,gwd_opt, &
cdmbgwd,alpha_fd,me,master, &
lprnt,ipr,rdxzb,dx,gwd_opt, &
do_gsl_drag_ls_bl,do_gsl_drag_ss,do_gsl_drag_tofd, &
dtend, dtidx, index_of_process_orographic_gwd, &
index_of_temperature, index_of_x_wind, &
index_of_y_wind, ldiag3d, ldiag_ugwp, &
ugwp_seq_update, spp_wts_gwd, spp_gwd, errmsg, errflg)
endif
!
! put zeros due to xy GSL-drag style: dtaux2d_bl,dtauy2d_bl,dtaux2d_ss.......dusfc_ms,dvsfc_ms
!
Expand Down
30 changes: 30 additions & 0 deletions physics/GWD/unified_ugwp.meta
View file
Original file line number Diff line number Diff line change
Expand Up @@ -671,6 +671,13 @@
type = real
kind = kind_phys
intent = in
[vtype]
standard_name = vegetation_type_classification
long_name = vegetation type for lsm
units = index
dimensions = (horizontal_loop_extent)
type = integer
intent = in
[slmsk]
standard_name = area_type
long_name = landmask: sea/land/ice=0/1/2
Expand Down Expand Up @@ -708,6 +715,14 @@
type = real
kind = kind_phys
intent = in
[alpha_fd]
standard_name = alpha_coefficient_for_turbulent_orographic_form_drag
long_name = alpha coefficient for Beljaars et al turbulent orographic form drag
units = 1
dimensions = ()
type = real
kind = kind_phys
intent = in
[jdat]
standard_name = date_and_time_of_forecast_in_united_states_order
long_name = current forecast date and time
Expand Down Expand Up @@ -1221,6 +1236,21 @@
dimensions = ()
type = logical
intent = in
[do_gwd_opt_psl]
standard_name = do_gsl_drag_suite_with_psl_gwd_option
long_name = flag to activate PSL drag suite - mesoscale GWD and blocking
units = flag
dimensions = ()
type = logical
intent = in
[psl_gwd_dx_factor]
standard_name = effective_grid_spacing_of_psl_gwd_suite
long_name = multiplication of grid spacing
units = 1
dimensions = ()
type = real
kind = kind_phys
intent = in
[gwd_opt]
standard_name = control_for_drag_suite_gravity_wave_drag
long_name = flag to choose gwd scheme
Expand Down

0 comments on commit 8103e21

Please sign in to comment.