Skip to content

Commit

Permalink
refactor data handling for oro drag
Browse files Browse the repository at this point in the history 
put data in pbuf rather than state and isolate orodrag register/init methods in od_common
  • Loading branch information
@whannah1
whannah1 committed Nov 15, 2024
1 parent af77aa1 commit 0c2508b
Show file tree
Hide file tree
Showing 8 changed files with 732 additions and 725 deletions.
43 changes: 0 additions & 43 deletions components/eam/src/control/startup_initialconds.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5,28 +5,16 @@ module startup_initialconds
!
!-----------------------------------------------------------------------

use pio, only: file_desc_t

implicit none
private
save

public :: initial_conds ! Read in initial conditions (dycore dependent)
!added for orographic drag
public topo_OD_file_get_id
public setup_initial_OD
public close_initial_file_OD
type(file_desc_t), pointer :: ncid_topo_OD

!=======================================================================
contains
!=======================================================================

function topo_OD_file_get_id()
type(file_desc_t), pointer :: topo_OD_file_get_id
topo_OD_file_get_id => ncid_topo_OD
end function topo_OD_file_get_id

subroutine initial_conds(dyn_in)

! This routine does some initializing of buffers that should move to a
Expand Down Expand Up @@ -72,35 +60,4 @@ subroutine initial_conds(dyn_in)

end subroutine initial_conds

!=======================================================================

subroutine setup_initial_OD()
use filenames, only: bnd_topo
use ioFileMod, only: getfil
use cam_pio_utils, only: cam_pio_openfile
use pio, only: pio_nowrite
!
! Input arguments
!
!-----------------------------------------------------------------------
include 'netcdf.inc'
!-----------------------------------------------------------------------
character(len=256) :: bnd_topo_loc ! filepath of topo file on local disk
allocate(ncid_topo_OD)
call getfil(bnd_topo, bnd_topo_loc)
call cam_pio_openfile(ncid_topo_OD, bnd_topo_loc, PIO_NOWRITE)
end subroutine setup_initial_OD

subroutine close_initial_file_OD
use pio, only: pio_closefile
call pio_closefile(ncid_topo_OD)
deallocate(ncid_topo_OD)
nullify(ncid_topo_OD)
end subroutine close_initial_file_OD
!=======================================================================





end module startup_initialconds
29 changes: 18 additions & 11 deletions components/eam/src/physics/cam/clubb_intr.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2139,14 +2139,14 @@ subroutine clubb_tend_cam( &
dum_core_rknd = real((ksrftms(i)*state1%v(i,pver)), kind = core_rknd)
vpwp_sfc = vpwp_sfc-(dum_core_rknd/rho_ds_zm(1))
endif
!----------------------------------------------------!
!Apply TOFD
!----------------------------------------------------!
!tendency is flipped already
if (use_od_fd) then
! ------------------------------------------------- !
! Apply TOFD
! ------------------------------------------------- !
! tendency is flipped already
if (use_od_fd) then
um_forcing(2:pverp)=dtaux3_fd(i,pver:1:-1)
vm_forcing(2:pverp)=dtauy3_fd(i,pver:1:-1)
endif
endif
! Need to flip arrays around for CLUBB core
do k=1,pverp
um_in(k) = real(um(i,pverp-k+1), kind = core_rknd)
Expand Down Expand Up @@ -3170,7 +3170,7 @@ end subroutine clubb_tend_cam
! !
! =============================================================================== !

subroutine clubb_surface (state, cam_in, ustar, obklen)
subroutine clubb_surface (state, cam_in, pbuf, ustar, obklen)

!-------------------------------------------------------------------------------
! Description: Provide the obukhov length and the surface friction velocity
Expand All @@ -3192,16 +3192,17 @@ subroutine clubb_surface (state, cam_in, ustar, obklen)
use constituents, only: cnst_get_ind
use camsrfexch, only: cam_in_t
use hb_diff, only: pblintd_ri

use physics_buffer, only: pbuf_get_index, pbuf_get_field, physics_buffer_desc

implicit none

! --------------- !
! Input Auguments !
! --------------- !

type(physics_state), intent(inout) :: state ! Physics state variables
type(cam_in_t), intent(in) :: cam_in
type(physics_state), intent(inout) :: state ! Physics state variables
type(cam_in_t), intent(in) :: cam_in
type(physics_buffer_desc), pointer, intent(in) :: pbuf(:)

! ---------------- !
! Output Auguments !
Expand Down Expand Up @@ -3231,6 +3232,9 @@ subroutine clubb_surface (state, cam_in, ustar, obklen)
integer :: ixq,ixcldliq !PMA fix for thv
real(r8) :: rrho ! Inverse air density

integer :: oro_drag_ribulk_idx ! pbuf index of bulk richardson number for oro drag
real(r8), pointer :: oro_drag_ribulk(:) ! pbuf pointer for bulk richardson number


#endif
obklen(pcols) = 0.0_r8
Expand Down Expand Up @@ -3295,9 +3299,12 @@ subroutine clubb_surface (state, cam_in, ustar, obklen)
kbfs_pcol(i)=kbfs
enddo

oro_drag_ribulk_idx = pbuf_get_index('oro_drag_ribulk')
call pbuf_get_field(pbuf, oro_drag_ribulk_idx, oro_drag_ribulk)

!calculate the bulk richardson number
call pblintd_ri(ncol, gravit, thv_lv, state%zm, state%u, state%v, &
ustar, obklen, kbfs_pcol, state%ribulk)
ustar, obklen, kbfs_pcol, oro_drag_ribulk)
endif

return
Expand Down
32 changes: 1 addition & 31 deletions components/eam/src/physics/cam/comsrf.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -17,7 +17,7 @@ module comsrf
! USES:
!
use shr_kind_mod, only: r8 => shr_kind_r8, r4 => shr_kind_r4
use ppgrid, only: pcols, begchunk, endchunk,nvar_dirOA,nvar_dirOL
use ppgrid, only: pcols, begchunk, endchunk
use infnan, only: nan, assignment(=)
use cam_abortutils, only: endrun

Expand All @@ -31,8 +31,6 @@ module comsrf
! ! PUBLIC MEMBER FUNCTIONS:
!
public initialize_comsrf ! Set the surface temperature and sea-ice fraction
!!added for separate input of ogwd parareters in gw_drag
public initialize_comsrf_OD
!
! Public data
!
Expand All @@ -56,10 +54,6 @@ module comsrf
real(r8), allocatable:: trefmxav(:,:) ! diagnostic: tref max over the day
real(r8), allocatable:: trefmnav(:,:) ! diagnostic: tref min over the day

public oc, ol, oadir
real(r8), allocatable:: oc(:,:) ! Convexity
real(r8), allocatable:: oadir(:,:,:) ! Asymmetry
real(r8), allocatable:: ol(:,:,:) ! Effective length
!
! Private module data

Expand Down Expand Up @@ -138,28 +132,4 @@ subroutine initialize_comsrf
end if
end subroutine initialize_comsrf

subroutine initialize_comsrf_OD
use cam_control_mod, only: ideal_phys, adiabatic
!-----------------------------------------------------------------------
!
! Purpose:
! Initialize surface data
!
! Method:
!
! Author: Mariana Vertenstein
!
!-----------------------------------------------------------------------
integer k,c ! level, constituent indices

if(.not. (adiabatic .or. ideal_phys)) then
allocate (oc (pcols,begchunk:endchunk))
allocate (oadir (pcols,nvar_dirOA,begchunk:endchunk))
allocate (ol (pcols,nvar_dirOL,begchunk:endchunk))
oc (:,:) = nan
oadir (:,:,:) = nan
ol (:,:,:) = nan
end if
end subroutine initialize_comsrf_OD

end module comsrf
85 changes: 25 additions & 60 deletions components/eam/src/physics/cam/gw_drag.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -24,7 +24,7 @@ module gw_drag
!--------------------------------------------------------------------------

use shr_kind_mod, only: r8 => shr_kind_r8
use ppgrid, only: pcols, pver, pverp, nvar_dirOA, nvar_dirOL, begchunk, endchunk
use ppgrid, only: pcols, pver
use hycoef, only: hyai, hybi, hyam, hybm, etamid
use constituents, only: pcnst
use physics_types, only: physics_state, physics_ptend, physics_ptend_init
Expand All @@ -49,6 +49,7 @@ module gw_drag
! PUBLIC: interfaces
!
public :: gw_drag_readnl ! Read namelist
public :: gw_register ! Register pbuf variables
public :: gw_init ! Initialization
public :: gw_tend ! interface to actual parameterization

Expand Down Expand Up @@ -199,7 +200,16 @@ end subroutine gw_drag_readnl

!==========================================================================

subroutine gw_init()
subroutine gw_register()
use od_common, only: oro_drag_register

call oro_drag_register()

end subroutine gw_register

!==========================================================================

subroutine gw_init(pbuf2d)
!-----------------------------------------------------------------------
! Time independent initialization for multiple gravity wave
! parameterization.
Expand All @@ -208,7 +218,7 @@ subroutine gw_init()
use cam_history, only: addfld, horiz_only, add_default
use interpolate_data, only: lininterp
use phys_control, only: phys_getopts
use physics_buffer, only: pbuf_get_index
use physics_buffer, only: pbuf_get_index, physics_buffer_desc

use ref_pres, only: pref_edge
use physconst, only: gravit, rair
Expand All @@ -218,12 +228,9 @@ subroutine gw_init()
use gw_front, only: gw_front_init
use gw_convect, only: gw_convect_init

use comsrf, only: oc, oadir, ol, initialize_comsrf_OD
use pio, only: file_desc_t
use startup_initialconds,only: topo_OD_file_get_id, setup_initial_OD, close_initial_file_OD
use ncdio_atm, only: infld
use cam_grid_support, only: cam_grid_check, cam_grid_get_decomp, cam_grid_id,cam_grid_get_dim_names

use od_common, only: oro_drag_init
!------------------------------Arguments--------------------------------
type(physics_buffer_desc), pointer :: pbuf2d(:,:)
!---------------------------Local storage-------------------------------

integer :: l, k
Expand Down Expand Up @@ -296,36 +303,8 @@ subroutine gw_init()
character(len=128) :: errstring

!-----------------------------------------------------------------------
!added for input of od parameters
type(file_desc_t), pointer :: ncid_topo_OD
logical :: found=.false.
character(len=8) :: dim1name, dim2name
character*11 :: subname='gw_init' ! subroutine name
integer :: grid_id
pblh_idx = pbuf_get_index('pblh')
grid_id = cam_grid_id('physgrid')

if (use_od_ls.or.use_od_bl) then
if (.not. cam_grid_check(grid_id)) then
call endrun(trim(subname)//': Internal error, no "physgrid" grid')
end if

call cam_grid_get_dim_names(grid_id, dim1name, dim2name)
call initialize_comsrf_OD()
call setup_initial_OD()

ncid_topo_OD=>topo_OD_file_get_id()
call infld('OC', ncid_topo_OD, dim1name, dim2name, 1, pcols, begchunk, &
endchunk, oc , found, gridname='physgrid')
!keep the same interval of OA,OL
call infld('OA', ncid_topo_OD,dim1name, 'nvar_dirOA', dim2name, 1, pcols, 1, nvar_dirOA, begchunk, &
endchunk, oadir(:,:,:), found, gridname='physgrid')
call infld('OL', ncid_topo_OD,dim1name, 'nvar_dirOL', dim2name, 1, pcols, 1, nvar_dirOL, begchunk, &
endchunk, ol , found, gridname='physgrid')
if(.not. found) call endrun('ERROR: OD topo file readerr')
call close_initial_file_OD()

endif
call oro_drag_init(pbuf2d)

! Set model flags.
do_spectral_waves = (pgwv > 0 .and. (use_gw_front .or. use_gw_convect))
Expand Down Expand Up @@ -699,9 +678,6 @@ subroutine gw_tend(state, sgh, pbuf, dt, ptend, cam_in)
!
real(r8), pointer :: pblh(:)
real(r8) :: dx(pcols),dy(pcols)
!
logical :: gwd_ls,gwd_bl,gwd_ss,gwd_fd
!

!---------------------------Local storage-------------------------------

Expand Down Expand Up @@ -998,22 +974,12 @@ subroutine gw_tend(state, sgh, pbuf, dt, ptend, cam_in)
ttgw, qtgw, taucd, egwdffi, gwut(:,:,0:0), dttdf, dttke)
endif
!
if (use_od_ls.or.&
use_od_bl.or.&
use_od_ss) then
!open ogwd,bl,ss,
!close fd
gwd_ls=use_od_ls
gwd_bl=use_od_bl
gwd_ss=use_od_ss
gwd_fd=.false.
!
if ( use_od_ls .or. use_od_bl .or. use_od_ss) then
utgw=0.0_r8
vtgw=0.0_r8
ttgw=0.0_r8
!
call oro_drag_interface(state,cam_in,sgh,pbuf,dt,nm,&
gwd_ls,gwd_bl,gwd_ss,gwd_fd,&
use_od_ls,use_od_bl,use_od_ss,.false.,&
od_ls_ncleff,od_bl_ncd,od_ss_sncleff,&
utgw,vtgw,ttgw,&
dtaux3_ls=dtaux3_ls,dtauy3_ls=dtauy3_ls,&
Expand All @@ -1024,14 +990,13 @@ subroutine gw_tend(state, sgh, pbuf, dt, ptend, cam_in)
dusfc_bl=dusfc_bl,dvsfc_bl=dvsfc_bl,&
dusfc_ss=dusfc_ss,dvsfc_ss=dvsfc_ss,&
dusfc_fd=dummx_fd,dvsfc_fd=dummy_fd)

endif
!
! Add the orographic tendencies to the spectrum tendencies
! Compute the temperature tendency from energy conservation
! (includes spectrum).
! both old and new gwd scheme will add the tendency to circulation
!
!
! Add the orographic tendencies to the spectrum tendencies
! Compute the temperature tendency from energy conservation
! (includes spectrum).
! both old and new gwd scheme will add the tendency to circulation
!
if (use_gw_oro.or.&
use_od_ls .or.&
use_od_bl .or.&
Expand Down
Loading

0 comments on commit 0c2508b

Please sign in to comment.