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

Updated GSL orographic drag suite to enable use of custom orographic … #2

Closed
wants to merge 1 commit into from
Closed

Updated GSL orographic drag suite to enable use of custom orographic … #2

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
25 changes: 23 additions & 2 deletions gfsphysics/GFS_layer/GFS_typedefs.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -821,7 +821,8 @@ module GFS_typedefs
integer :: isatmedmf_vdifq = 1 !< flag for updated version of satmedmf (as of May 2019)
#endif
integer :: nmtvr !< number of topographic variables such as variance etc
!< used in the GWD parameterization
!< used in the GWD parameterization - 10 more added for
!< small-scale GSD orographic drag schemes
integer :: jcap !< number of spectral wave trancation used only by sascnv shalcnv
real(kind=kind_phys) :: cs_parm(10) !< tunable parameters for Chikira-Sugiyama convection
real(kind=kind_phys) :: flgmin(2) !< [in] ice fraction bounds
Expand Down Expand Up @@ -1900,6 +1901,11 @@ module GFS_typedefs
real (kind=kind_phys), pointer :: qs_r(:,:) => null() !<
real (kind=kind_phys), pointer :: qg_r(:,:) => null() !<

!-- GSD drag suite
real (kind=kind_phys), pointer :: varss(:) => null() !<
real (kind=kind_phys), pointer :: ocss(:) => null() !<
real (kind=kind_phys), pointer :: oa4ss(:,:) => null() !<
real (kind=kind_phys), pointer :: clxss(:,:) => null() !<

!-- Ferrier-Aligo MP scheme
real (kind=kind_phys), pointer :: f_rain (:,:) => null() !<
Expand Down Expand Up @@ -2918,7 +2924,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, &
logical :: do_myjsfc = .false. !< flag for MYJ surface layer scheme
logical :: do_myjpbl = .false. !< flag for MYJ PBL scheme
#endif
integer :: nmtvr = 14 !< number of topographic variables such as variance etc
integer :: nmtvr = 24 !< number of topographic variables such as variance etc
!< used in the GWD parameterization
integer :: jcap = 1 !< number of spectral wave trancation used only by sascnv shalcnv
! real(kind=kind_phys) :: cs_parm(10) = (/5.0,2.5,1.0e3,3.0e3,20.0,-999.,-999.,0.,0.,0./)
Expand Down Expand Up @@ -5924,6 +5930,11 @@ subroutine interstitial_create (Interstitial, IM, Model)
allocate (Interstitial%dudt_mtb (IM,Model%levs))
allocate (Interstitial%dudt_ogw (IM,Model%levs))
allocate (Interstitial%dudt_tms (IM,Model%levs))
!-- GSD drag suite
allocate (Interstitial%varss (IM))
allocate (Interstitial%ocss (IM))
allocate (Interstitial%oa4ss (IM,4))
allocate (Interstitial%clxss (IM,4))
!
! Allocate arrays that are conditional on physics choices
if (Model%imp_physics == Model%imp_physics_gfdl .or. Model%imp_physics == Model%imp_physics_thompson) then
Expand Down Expand Up @@ -6449,6 +6460,11 @@ subroutine interstitial_phys_reset (Interstitial, Model)
Interstitial%dudt_mtb = clear_val
Interstitial%dudt_ogw = clear_val
Interstitial%dudt_tms = clear_val
!-- GSD drag suite
Interstitial%varss = clear_val
Interstitial%ocss = clear_val
Interstitial%oa4ss = clear_val
Interstitial%clxss = clear_val
!
! Reset fields that are conditional on physics choices
if (Model%imp_physics == Model%imp_physics_gfdl .or. Model%imp_physics == Model%imp_physics_thompson) then
Expand Down Expand Up @@ -6787,6 +6803,11 @@ subroutine interstitial_print(Interstitial, Model, mpirank, omprank, blkno)
write (0,*) 'sum(Interstitial%dudt_mtb ) = ', sum(Interstitial%dudt_mtb )
write (0,*) 'sum(Interstitial%dudt_ogw ) = ', sum(Interstitial%dudt_ogw )
write (0,*) 'sum(Interstitial%dudt_tms ) = ', sum(Interstitial%dudt_tms )
!-- GSD drag suite
write (0,*) 'sum(Interstitial%varss ) = ', sum(Interstitial%varss)
write (0,*) 'sum(Interstitial%ocss ) = ', sum(Interstitial%ocss)
write (0,*) 'sum(Interstitial%oa4ss ) = ', sum(Interstitial%oa4ss)
write (0,*) 'sum(Interstitial%clxss ) = ', sum(Interstitial%clxss)
!
! Print arrays that are conditional on physics choices
if (Model%imp_physics == Model%imp_physics_gfdl .or. Model%imp_physics == Model%imp_physics_thompson) then
Expand Down
28 changes: 28 additions & 0 deletions gfsphysics/GFS_layer/GFS_typedefs.meta
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -6208,6 +6208,13 @@
dimensions = (horizontal_dimension,4)
type = real
kind = kind_phys
[clxss]
standard_name = fraction_of_grid_box_with_subgrid_orography_higher_than_critical_height_small_scale
long_name = frac. of grid box with by subgrid orography higher than critical height small scale
units = frac
dimensions = (horizontal_dimension,4)
type = real
kind = kind_phys
[cmm_ocean]
standard_name = surface_drag_wind_speed_for_momentum_in_air_over_ocean
long_name = momentum exchange coefficient over ocean
Expand Down Expand Up @@ -7380,13 +7387,34 @@
dimensions = (horizontal_dimension,4)
type = real
kind = kind_phys
[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
[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
[oc]
standard_name = convexity_of_subgrid_orography
long_name = convexity of subgrid orography
units = none
dimensions = (horizontal_dimension)
type = real
kind = kind_phys
[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
[olyr]
standard_name = ozone_concentration_at_layer_for_radiation
long_name = ozone concentration layer
Expand Down
117 changes: 116 additions & 1 deletion io/FV3GFS_io.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,3 +1,5 @@
#define NEW_ORO_STAT
#define NEW_ORO_STAT_INFO
module FV3GFS_io_mod

!-----------------------------------------------------------------------
Expand Down Expand Up @@ -70,15 +72,20 @@ module FV3GFS_io_mod

!--- GFDL filenames
character(len=32) :: fn_oro = 'oro_data.nc'
character(len=32) :: fn_oro_ls = 'oro_data_ls.nc'
character(len=32) :: fn_oro_ss = 'oro_data_ss.nc'
character(len=32) :: fn_srf = 'sfc_data.nc'
character(len=32) :: fn_phy = 'phy_data.nc'

!--- GFDL FMS netcdf restart data types
type(restart_file_type) :: Oro_restart, Sfc_restart, Phy_restart
type(restart_file_type) :: Oro_ls_restart, Oro_ss_restart

!--- GFDL FMS restart containers
character(len=32), allocatable, dimension(:) :: oro_name2, sfc_name2, sfc_name3
real(kind=kind_phys), allocatable, target, dimension(:,:,:) :: oro_var2, sfc_var2, phy_var2
character(len=32), allocatable, dimension(:) :: oro_ls_ss_name
real(kind=kind_phys), allocatable, target, dimension(:,:,:) :: oro_ls_var, oro_ss_var
real(kind=kind_phys), allocatable, target, dimension(:,:,:,:) :: sfc_var3, phy_var3
!--- Noah MP restart containers
real(kind=kind_phys), allocatable, target, dimension(:,:,:,:) :: sfc_var3sn,sfc_var3eq,sfc_var3zn
Expand Down Expand Up @@ -472,10 +479,11 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain)
logical, intent(in) :: warm_start
#endif
!--- local variables
integer :: i, j, k, ix, lsoil, num, nb
integer :: i, j, k, ix, lsoil, num, nb, i_start, j_start, i_end, j_end
integer :: isc, iec, jsc, jec, npz, nx, ny
integer :: id_restart
integer :: nvar_o2, nvar_s2m, nvar_s2o, nvar_s3
integer :: nvar_oro_ls_ss
integer :: nvar_s2mp, nvar_s3mp,isnow
#ifdef CCPP
integer :: nvar_s2r
Expand Down Expand Up @@ -509,6 +517,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain)
nvar_s2m = 32
endif
nvar_o2 = 19
nvar_oro_ls_ss = 10
nvar_s2o = 18
#ifdef CCPP
if (Model%lsm == Model%lsm_ruc .and. warm_start) then
Expand Down Expand Up @@ -634,6 +643,112 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain)
!--- deallocate containers and free restart container
deallocate(oro_name2, oro_var2)
call free_restart_type(Oro_restart)

#ifdef NEW_ORO_STAT
if (.not. allocated(oro_ls_ss_name)) then
!--- allocate the various containers needed for orography data
allocate(oro_ls_ss_name(nvar_oro_ls_ss))
allocate(oro_ls_var(nx,ny,nvar_oro_ls_ss))
allocate(oro_ss_var(nx,ny,nvar_oro_ls_ss))

oro_ls_ss_name(1) = 'stddev'
oro_ls_ss_name(2) = 'convexity'
oro_ls_ss_name(3) = 'oa1'
oro_ls_ss_name(4) = 'oa2'
oro_ls_ss_name(5) = 'oa3'
oro_ls_ss_name(6) = 'oa4'
oro_ls_ss_name(7) = 'ol1'
oro_ls_ss_name(8) = 'ol2'
oro_ls_ss_name(9) = 'ol3'
oro_ls_ss_name(10) = 'ol4'
!--- register the 2D fields
do num = 1,nvar_oro_ls_ss
var2_p => oro_ls_var(:,:,num)
id_restart = register_restart_field(Oro_ls_restart, fn_oro_ls, &
oro_ls_ss_name(num), var2_p, domain=fv_domain)
enddo
nullify(var2_p)
do num = 1,nvar_oro_ls_ss
var2_p => oro_ss_var(:,:,num)
id_restart = register_restart_field(Oro_ss_restart, fn_oro_ss, &
oro_ls_ss_name(num), var2_p, domain=fv_domain)
enddo
nullify(var2_p)
endif

!--- read new GSD created orography restart/data
call mpp_error(NOTE,'reading topographic/orographic information from &
&INPUT/oro_data_ls.tile*.nc')
call restore_state(Oro_ls_restart)
call mpp_error(NOTE,'reading topographic/orographic information from &
&INPUT/oro_data_ss.tile*.nc')
call restore_state(Oro_ss_restart)

do nb = 1, Atm_block%nblks
!--- 2D variables
do ix = 1, Atm_block%blksz(nb)
i = Atm_block%index(nb)%ii(ix) - isc + 1
j = Atm_block%index(nb)%jj(ix) - jsc + 1
!--- assign hprime(1:10) and hprime(15:24) with new oro stat data
Sfcprop(nb)%hprime(ix,1) = oro_ls_var(i,j,1)
Sfcprop(nb)%hprime(ix,2) = oro_ls_var(i,j,2)
Sfcprop(nb)%hprime(ix,3) = oro_ls_var(i,j,3)
Sfcprop(nb)%hprime(ix,4) = oro_ls_var(i,j,4)
Sfcprop(nb)%hprime(ix,5) = oro_ls_var(i,j,5)
Sfcprop(nb)%hprime(ix,6) = oro_ls_var(i,j,6)
Sfcprop(nb)%hprime(ix,7) = oro_ls_var(i,j,7)
Sfcprop(nb)%hprime(ix,8) = oro_ls_var(i,j,8)
Sfcprop(nb)%hprime(ix,9) = oro_ls_var(i,j,9)
Sfcprop(nb)%hprime(ix,10) = oro_ls_var(i,j,10)
Sfcprop(nb)%hprime(ix,15) = oro_ss_var(i,j,1)
Sfcprop(nb)%hprime(ix,16) = oro_ss_var(i,j,2)
Sfcprop(nb)%hprime(ix,17) = oro_ss_var(i,j,3)
Sfcprop(nb)%hprime(ix,18) = oro_ss_var(i,j,4)
Sfcprop(nb)%hprime(ix,19) = oro_ss_var(i,j,5)
Sfcprop(nb)%hprime(ix,20) = oro_ss_var(i,j,6)
Sfcprop(nb)%hprime(ix,21) = oro_ss_var(i,j,7)
Sfcprop(nb)%hprime(ix,22) = oro_ss_var(i,j,8)
Sfcprop(nb)%hprime(ix,23) = oro_ss_var(i,j,9)
Sfcprop(nb)%hprime(ix,24) = oro_ss_var(i,j,10)

enddo
enddo

call free_restart_type(Oro_ls_restart)
call free_restart_type(Oro_ss_restart)
#endif

#ifdef NEW_ORO_STAT_INFO
! print diag info
if (Model%me == Model%master ) then
print*, 'isc, iec, jsc, jec =', isc, iec, jsc, jec
nb = 1
print*, 'Atm_block%blksz(1) =', Atm_block%blksz(nb)
i_start=Atm_block%index(nb)%ii(1) - isc + 1
j_start=Atm_block%index(nb)%jj(1) - jsc + 1
print*, 'i,j start=',i_start, j_start
num = Atm_block%blksz(nb)
i_end=Atm_block%index(nb)%ii(num) - isc + 1
j_end=Atm_block%index(nb)%jj(num) - jsc + 1
print*, 'i,j end=', i_end, j_end
do i = 1, 10
print*, 'min/max hprime(:,i) =', &
minval(Sfcprop(nb)%hprime(:,i)), maxval(Sfcprop(nb)%hprime(:,i)), i
print*, 'min/max oro_ls(:,:,i)=', &
minval(oro_ls_var(i_start:i_end,j_start:j_end,i)), &
maxval(oro_ls_var(i_start:i_end,j_start:j_end,i)), i
enddo
do i = 15, 24
print*, 'min/max of hprime(:,i) =', &
minval(Sfcprop(nb)%hprime(:,i)), maxval(Sfcprop(nb)%hprime(:,i)), i
print*, 'min/max of oro_ss(:,:,i) =', &
minval(oro_ss_var(i_start:i_end,j_start:j_end,i-14)), &
maxval(oro_ss_var(i_start:i_end,j_start:j_end,i-14)), i-14
enddo
endif

deallocate(oro_ls_ss_name, oro_ls_var, oro_ss_var)
#endif

!--- SURFACE FILE
if (.not. allocated(sfc_name2)) then
Expand Down