Skip to content

Commit

Permalink
Merge pull request #1 from NOAA-GSD/gsd/develop
Browse files Browse the repository at this point in the history 
updating fork
  • Loading branch information
@joeolson42
joeolson42 authored Jun 5, 2020
2 parents 8fd1674 + 3b0f7c2 commit 6b5bbfa
Show file tree
Hide file tree
Showing 6 changed files with 128 additions and 28 deletions.
22 changes: 22 additions & 0 deletions physics/GFS_GWD_generic.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -18,6 +18,7 @@ end subroutine GFS_GWD_generic_pre_init
subroutine GFS_GWD_generic_pre_run( &
& im, levs, nmtvr, mntvar, &
& oc, oa4, clx, theta, &
& varss, ocss, oa4ss, clxss, &
& sigma, gamma, elvmax, lssav, ldiag3d, &
& dudt, dvdt, dtdt, du3dt, dv3dt, dt3dt, dtf, &
& flag_for_gwd_generic_tend, errmsg, errflg)
Expand All @@ -30,6 +31,7 @@ subroutine GFS_GWD_generic_pre_run( &

real(kind=kind_phys), intent(out) :: &
& oc(im), oa4(im,4), clx(im,4), &
& varss(:), ocss(:), oa4ss(:,:), clxss(:,:), &
& theta(im), sigma(im), gamma(im), elvmax(im)

logical, intent(in) :: lssav, ldiag3d, flag_for_gwd_generic_tend
Expand Down Expand Up @@ -81,6 +83,26 @@ subroutine GFS_GWD_generic_pre_run( &
clx(:,2) = 0.0
clx(:,3) = 0.0
clx(:,4) = 0.0
elseif (nmtvr == 24) then ! GSD_drag_suite
oc(:) = mntvar(:,2)
oa4(:,1) = mntvar(:,3)
oa4(:,2) = mntvar(:,4)
oa4(:,3) = mntvar(:,5)
oa4(:,4) = mntvar(:,6)
clx(:,1) = mntvar(:,7)
clx(:,2) = mntvar(:,8)
clx(:,3) = mntvar(:,9)
clx(:,4) = mntvar(:,10)
varss(:) = mntvar(:,15)
ocss(:) = mntvar(:,16)
oa4ss(:,1) = mntvar(:,17)
oa4ss(:,2) = mntvar(:,18)
oa4ss(:,3) = mntvar(:,19)
oa4ss(:,4) = mntvar(:,20)
clxss(:,1) = mntvar(:,21)
clxss(:,2) = mntvar(:,22)
clxss(:,3) = mntvar(:,23)
clxss(:,4) = mntvar(:,24)
else
oc = 0
oa4 = 0
Expand Down
36 changes: 36 additions & 0 deletions physics/GFS_GWD_generic.meta
View file
Original file line number Diff line number Diff line change
Expand Up @@ -66,6 +66,42 @@
kind = kind_phys
intent = out
optional = F
[varss]
standard_name = standard_deviation_of_subgrid_orography_small_scale
long_name = standard deviation of subgrid orography small scale
units = m
dimensions = (horizontal_dimension)
type = real
kind = kind_phys
intent = in
optional = F
[ocss]
standard_name = convexity_of_subgrid_orography_small_scale
long_name = convexity of subgrid orography small scale
units = none
dimensions = (horizontal_dimension)
type = real
kind = kind_phys
intent = out
optional = F
[oa4ss]
standard_name = asymmetry_of_subgrid_orography_small_scale
long_name = asymmetry of subgrid orography small scale
units = none
dimensions = (horizontal_dimension,4)
type = real
kind = kind_phys
intent = out
optional = F
[clxss]
standard_name = fraction_of_grid_box_with_subgrid_orography_higher_than_critical_height_small_scale
long_name = horizontal fraction of grid box covered by subgrid orography higher than critical height small scale
units = frac
dimensions = (horizontal_dimension,4)
type = real
kind = kind_phys
intent = out
optional = F
[theta]
standard_name = angle_from_east_of_maximum_subgrid_orographic_variations
long_name = angle with_respect to east of maximum subgrid orographic variations
Expand Down
48 changes: 24 additions & 24 deletions physics/drag_suite.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -196,8 +196,8 @@ end subroutine drag_suite_init
subroutine drag_suite_run( &
& IM,KM,dvdt,dudt,dtdt,U1,V1,T1,Q1,KPBL, &
& PRSI,DEL,PRSL,PRSLK,PHII,PHIL,DELTIM,KDT, &
& VAR,oc1,oa4,ol4, &
! & varss,oc1ss,oa4ss,ol4ss, &
& var,oc1,oa4,ol4, &
& varss,oc1ss,oa4ss,ol4ss, &
& THETA,SIGMA,GAMMA,ELVMAX, &
& dtaux2d_ls,dtauy2d_ls,dtaux2d_bl,dtauy2d_bl, &
& dtaux2d_ss,dtauy2d_ss,dtaux2d_fd,dtauy2d_fd, &
Expand Down Expand Up @@ -307,9 +307,10 @@ subroutine drag_suite_run( &
real(kind=kind_phys) :: rcl, cdmb
real(kind=kind_phys) :: g_inv

real(kind=kind_phys), intent(out) :: &
real(kind=kind_phys), intent(inout) :: &
& dudt(im,km),dvdt(im,km), &
& dtdt(im,km), rdxzb(im)
& dtdt(im,km)
real(kind=kind_phys), intent(out) :: rdxzb(im)
real(kind=kind_phys), intent(in) :: &
& u1(im,km),v1(im,km), &
& t1(im,km),q1(im,km), &
Expand All @@ -320,8 +321,7 @@ subroutine drag_suite_run( &
real(kind=kind_phys), intent(in) :: var(im),oc1(im), &
& oa4(im,4),ol4(im,4), &
& dx(im)
!real(kind=kind_phys), intent(in) :: varss(im),oc1ss(im), &
real(kind=kind_phys) :: varss(im),oc1ss(im), &
real(kind=kind_phys), intent(in) :: varss(im),oc1ss(im), &
& oa4ss(im,4),ol4ss(im,4)
real(kind=kind_phys), intent(in) :: THETA(im),SIGMA(im), &
& GAMMA(im),ELVMAX(im)
Expand Down Expand Up @@ -474,7 +474,7 @@ subroutine drag_suite_run( &
errmsg = ''
errflg = 0

if (me==master) print *,"Running drag suite"

!--------------------------------------------------------------------
! SCALE-ADPTIVE PARAMETER FROM GFS GWD SCHEME
!--------------------------------------------------------------------
Expand Down Expand Up @@ -527,14 +527,14 @@ subroutine drag_suite_run( &
enddo

!temporary use of large-scale data:
do i=1,im
varss(i)=var(i)
oc1ss(i)=oc1(i)
do j=1,4
oa4ss(i,j)=oa4(i,j)
ol4ss(i,j)=ol4(i,j)
enddo
enddo
! do i=1,im
! varss(i)=var(i)
! oc1ss(i)=oc1(i)
! do j=1,4
! oa4ss(i,j)=oa4(i,j)
! ol4ss(i,j)=ol4(i,j)
! enddo
! enddo
!
!--- calculate scale-aware tapering factors
!NOTE: if dx(1) is not representative of most/all dx, this needs to change...
Expand All @@ -548,7 +548,7 @@ subroutine drag_suite_run( &
(dxmax_ls-dxmin_ls)) + 1. )
end if
end if
if (me==master) print *,"in Drag Suite, dx(1:2):",dx(1),dx(2)
! if (me==master) print *,"in Drag Suite, dx(1:2):",dx(1),dx(2)
if ( dx(1) .ge. dxmax_ss ) then
ss_taper = 1.
else
Expand All @@ -558,7 +558,7 @@ subroutine drag_suite_run( &
ss_taper = dxmax_ss * (1. - dxmin_ss/dx(1))/(dxmax_ss-dxmin_ss)
end if
end if
if (me==master) print *,"in Drag Suite, ss_taper:",ss_taper
! if (me==master) print *,"in Drag Suite, ss_taper:",ss_taper

!--- calculate length of grid for flow-blocking drag
!
Expand Down Expand Up @@ -907,7 +907,7 @@ subroutine drag_suite_run( &
vtendwave=0.
!
IF ( (gwd_opt_ss .EQ. 1).and.(ss_taper.GT.1.E-02) ) THEN
if (me==master) print *,"in Drag Suite: Running small-scale gravity wave drag"
! if (me==master) print *,"in Drag Suite: Running small-scale gravity wave drag"
!
! declaring potential temperature
!
Expand Down Expand Up @@ -943,11 +943,11 @@ subroutine drag_suite_run( &
enddo
if((xland(i)-1.5).le.0. .and. 2.*varss(i).le.hpbl(i))then
if(br1(i).gt.0. .and. thvx(i,kpbl2)-thvx(i,kts) > 0.)then
!WRF cleff_ss = sqrt(dxy(i)**2 + dxyp(i)**2)
cleff_ss = sqrt(dxy(i)**2 + dxyp(i)**2) ! WRF
! cleff_ss = 3. * max(dx(i),cleff_ss)
! cleff_ss = 10. * max(dxmax_ss,cleff_ss)
!WRF cleff_ss = 0.1 * max(dxmax_ss,cleff_ss)
cleff_ss = 0.1 * 12000.
cleff_ss = 0.1 * max(dxmax_ss,cleff_ss) ! WRF
! cleff_ss = 0.1 * 12000.
coefm_ss(i) = (1. + olss(i)) ** (oass(i)+1.)
xlinv(i) = coefm_ss(i) / cleff_ss
!govrth(i)=g/(0.5*(thvx(i,kpbl(i))+thvx(i,kts)))
Expand Down Expand Up @@ -1024,7 +1024,7 @@ subroutine drag_suite_run( &
! Topographic Form Drag from Beljaars et al. (2004, QJRMS, equ. 16):
!================================================================
IF ( (gwd_opt_fd .EQ. 1).and.(ss_taper.GT.1.E-02) ) THEN
if (me==master) print *,"in Drag Suite: Running form drag"
! if (me==master) print *,"in Drag Suite: Running form drag"

utendform=0.
vtendform=0.
Expand Down Expand Up @@ -1080,7 +1080,7 @@ subroutine drag_suite_run( &
!=======================================================
! More for the large-scale gwd component
IF ( (gwd_opt_ls .EQ. 1).and.(ls_taper.GT.1.E-02) ) THEN
if (me==master) print *,"in Drag Suite: Running large-scale gravity wave drag"
! if (me==master) print *,"in Drag Suite: Running large-scale gravity wave drag"
!
! now compute vertical structure of the stress.
do k = kts,kpblmax
Expand Down Expand Up @@ -1148,7 +1148,7 @@ subroutine drag_suite_run( &
!COMPUTE BLOCKING COMPONENT
!===============================================================
IF ( (gwd_opt_bl .EQ. 1) .and. (ls_taper .GT. 1.E-02) ) THEN
if (me==master) print *,"in Drag Suite: Running blocking drag"
! if (me==master) print *,"in Drag Suite: Running blocking drag"

do i = its,im
if(.not.ldrag(i)) then
Expand Down
36 changes: 36 additions & 0 deletions physics/drag_suite.meta
View file
Original file line number Diff line number Diff line change
Expand Up @@ -200,6 +200,42 @@
kind = kind_phys
intent = in
optional = F
[varss]
standard_name = standard_deviation_of_subgrid_orography_small_scale
long_name = standard deviation of subgrid orography small scale
units = m
dimensions = (horizontal_dimension)
type = real
kind = kind_phys
intent = in
optional = F
[oc1ss]
standard_name = convexity_of_subgrid_orography_small_scale
long_name = convexity of subgrid orography small scale
units = none
dimensions = (horizontal_dimension)
type = real
kind = kind_phys
intent = in
optional = F
[oa4ss]
standard_name = asymmetry_of_subgrid_orography_small_scale
long_name = asymmetry of subgrid orography small scale
units = none
dimensions = (horizontal_dimension,4)
type = real
kind = kind_phys
intent = in
optional = F
[ol4ss]
standard_name = fraction_of_grid_box_with_subgrid_orography_higher_than_critical_height_small_scale
long_name = horizontal fraction of grid box covered by subgrid orography higher than critical height small scale
units = frac
dimensions = (horizontal_dimension,4)
type = real
kind = kind_phys
intent = in
optional = F
[theta]
standard_name = angle_from_east_of_maximum_subgrid_orographic_variations
long_name = angle with respect to east of maximum subgrid orographic variations
Expand Down
4 changes: 2 additions & 2 deletions physics/module_SGSCloud_RadPre.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -20,7 +20,7 @@ end subroutine sgscloud_radpre_finalize
!> \ingroup sgscloud_radpre
!! This interstitial code adds the subgrid clouds to the resolved-scale clouds
!! if there is no resolved-scale clouds in that particular grid box. It can also
!! specify a cloud fraction for resolved-scale clouds, using Wu-Randall (1996),
!! specify a cloud fraction for resolved-scale clouds, using Xu-Randall (1996),
!! if desired.
!> \section arg_table_sgscloud_radpre_run Argument Table
!! \htmlinclude sgscloud_radpre_run.html
Expand Down Expand Up @@ -202,7 +202,7 @@ subroutine sgscloud_radpre_run( &

elseif (imp_physics /= imp_physics_gfdl) then

! Non-MYNN cloud fraction AND non-GFDL microphysics, since bith
! Non-MYNN cloud fraction AND non-GFDL microphysics, since both
! have their own cloud fractions. In this case, we resort to
! Xu-Randall (1996).
! cloud fraction =
Expand Down
10 changes: 8 additions & 2 deletions physics/mp_thompson_post.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -76,7 +76,9 @@ subroutine mp_thompson_post_run(ncol, nlev, tgrs_save, tgrs, prslk, dtp, ttendli
! Local variables
real(kind_phys), dimension(1:ncol,1:nlev) :: mp_tend
integer :: i, k
#ifdef DEBUG
integer :: events
#endif

! Initialize the CCPP error handling variables
errmsg = ''
Expand All @@ -95,26 +97,30 @@ subroutine mp_thompson_post_run(ncol, nlev, tgrs_save, tgrs, prslk, dtp, ttendli
! mp_tend and ttendlim are expressed in potential temperature
mp_tend = (tgrs - tgrs_save)/prslk

#ifdef DEBUG
events = 0
#endif
do k=1,nlev
do i=1,ncol
mp_tend(i,k) = max( -ttendlim*dtp, min( ttendlim*dtp, mp_tend(i,k) ) )

if (tgrs_save(i,k) + mp_tend(i,k)*prslk(i,k) .ne. tgrs(i,k)) then
#ifdef DEBUG
if (tgrs_save(i,k) + mp_tend(i,k)*prslk(i,k) .ne. tgrs(i,k)) then
write(0,'(a,3i6,3e16.7)') "mp_thompson_post_run mp_tend limiter: kdt, i, k, t_old, t_new, t_lim:", &
& kdt, i, k, tgrs_save(i,k), tgrs(i,k), tgrs_save(i,k) + mp_tend(i,k)*prslk(i,k)
#endif
events = events + 1
end if
#endif
tgrs(i,k) = tgrs_save(i,k) + mp_tend(i,k)*prslk(i,k)
end do
end do

#ifdef DEBUG
if (events > 0) then
write(0,'(a,i0,a,i0,a,i0)') "mp_thompson_post_run: ttendlim applied ", events, "/", nlev*ncol, &
& " times at timestep ", kdt
end if
#endif

end subroutine mp_thompson_post_run

Expand Down

0 comments on commit 6b5bbfa

Please sign in to comment.