Skip to content

Commit

Permalink
Move allocation of native RRTMGP DDTs from HEAP memory into scheme dr…
Browse files Browse the repository at this point in the history 
…iver. Working with multiple threads
  • Loading branch information
dustinswales committed May 11, 2023
1 parent 3a306a4 commit 9dd9e86
Show file tree
Hide file tree
Showing 2 changed files with 66 additions and 64 deletions.
71 changes: 37 additions & 34 deletions physics/rrtmgp_lw_main.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -27,13 +27,6 @@ module rrtmgp_lw_main
use rrtmgp_sampling, only: sampled_mask, draw_samples
implicit none

type(ty_gas_concs) :: gas_concs
type(ty_optical_props_1scl) :: lw_optical_props_clrsky, lw_optical_props_aerosol_local
type(ty_optical_props_2str) :: lw_optical_props_clouds, lw_optical_props_cloudsByBand, &
lw_optical_props_cnvcloudsByBand, lw_optical_props_pblcloudsByBand, &
lw_optical_props_precipByBand
type(ty_source_func_lw) :: sources

public rrtmgp_lw_main_init, rrtmgp_lw_main_run
contains
! #########################################################################################
Expand Down Expand Up @@ -94,33 +87,6 @@ subroutine rrtmgp_lw_main_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp_lw_fi
doGP_cldoptics_PADE, doGP_cldoptics_LUT, nrghice, mpicomm, mpirank, mpiroot, &
errmsg, errflg)

! DDTs

! ty_gas_concs
call check_error_msg('rrtmgp_lw_main_gas_concs_init',gas_concs%init(active_gases_array))

! ty_optical_props
call check_error_msg('rrtmgp_lw_main_gas_optics_init',&
lw_optical_props_clrsky%alloc_1scl(rrtmgp_phys_blksz, nLay, lw_gas_props))
call check_error_msg('rrtmgp_lw_main_sources_init',&
sources%alloc(rrtmgp_phys_blksz, nLay, lw_gas_props))
call check_error_msg('rrtmgp_lw_main_cloud_optics_init',&
lw_optical_props_cloudsByBand%alloc_2str(rrtmgp_phys_blksz, nLay, lw_gas_props%get_band_lims_wavenumber()))
call check_error_msg('rrtmgp_lw_main_precip_optics_init',&
lw_optical_props_precipByBand%alloc_2str(rrtmgp_phys_blksz, nLay, lw_gas_props%get_band_lims_wavenumber()))
call check_error_msg('rrtmgp_lw_mian_cloud_sampling_init', &
lw_optical_props_clouds%alloc_2str(rrtmgp_phys_blksz, nLay, lw_gas_props))
call check_error_msg('rrtmgp_lw_main_aerosol_optics_init',&
lw_optical_props_aerosol_local%alloc_1scl(rrtmgp_phys_blksz, nLay, lw_gas_props%get_band_lims_wavenumber()))
if (doGP_sgs_cnv) then
call check_error_msg('rrtmgp_lw_main_cnv_cloud_optics_init',&
lw_optical_props_cnvcloudsByBand%alloc_2str(rrtmgp_phys_blksz, nLay, lw_gas_props%get_band_lims_wavenumber()))
endif
if (doGP_sgs_pbl) then
call check_error_msg('rrtmgp_lw_main_pbl_cloud_optics_init',&
lw_optical_props_pblcloudsByBand%alloc_2str(rrtmgp_phys_blksz, nLay, lw_gas_props%get_band_lims_wavenumber()))
endif

end subroutine rrtmgp_lw_main_init
!> @}
! ######################################################################################
Expand Down Expand Up @@ -242,12 +208,49 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat,
real(kind_phys), dimension(rrtmgp_phys_blksz,lw_gas_props%get_ngpt()) :: lw_Ds
real(kind_phys), dimension(lw_gas_props%get_nband(),rrtmgp_phys_blksz) :: sfc_emiss_byband

! Local RRTMGP DDTs.
type(ty_gas_concs) :: gas_concs
type(ty_optical_props_1scl) :: lw_optical_props_clrsky, lw_optical_props_aerosol_local
type(ty_optical_props_2str) :: lw_optical_props_clouds, lw_optical_props_cloudsByBand, &
lw_optical_props_cnvcloudsByBand, lw_optical_props_pblcloudsByBand, &
lw_optical_props_precipByBand
type(ty_source_func_lw) :: sources

! Initialize CCPP error handling variables
errmsg = ''
errflg = 0

if (.not. doLWrad) return

!
! Initialize RRTMGP DDTs (local)
!

! ty_gas_concs
call check_error_msg('rrtmgp_lw_main_gas_concs_run',gas_concs%init(active_gases_array))

! ty_optical_props
call check_error_msg('rrtmgp_lw_main_gas_optics_run',&
lw_optical_props_clrsky%alloc_1scl(rrtmgp_phys_blksz, nLay, lw_gas_props))
call check_error_msg('rrtmgp_lw_main_sources_run',&
sources%alloc(rrtmgp_phys_blksz, nLay, lw_gas_props))
call check_error_msg('rrtmgp_lw_main_cloud_optics_run',&
lw_optical_props_cloudsByBand%alloc_2str(rrtmgp_phys_blksz, nLay, lw_gas_props%get_band_lims_wavenumber()))
call check_error_msg('rrtmgp_lw_main_precip_optics_run',&
lw_optical_props_precipByBand%alloc_2str(rrtmgp_phys_blksz, nLay, lw_gas_props%get_band_lims_wavenumber()))
call check_error_msg('rrtmgp_lw_mian_cloud_sampling_run', &
lw_optical_props_clouds%alloc_2str(rrtmgp_phys_blksz, nLay, lw_gas_props))
call check_error_msg('rrtmgp_lw_main_aerosol_optics_run',&
lw_optical_props_aerosol_local%alloc_1scl(rrtmgp_phys_blksz, nLay, lw_gas_props%get_band_lims_wavenumber()))
if (doGP_sgs_cnv) then
call check_error_msg('rrtmgp_lw_main_cnv_cloud_optics_run',&
lw_optical_props_cnvcloudsByBand%alloc_2str(rrtmgp_phys_blksz, nLay, lw_gas_props%get_band_lims_wavenumber()))
endif
if (doGP_sgs_pbl) then
call check_error_msg('rrtmgp_lw_main_pbl_cloud_optics_run',&
lw_optical_props_pblcloudsByBand%alloc_2str(rrtmgp_phys_blksz, nLay, lw_gas_props%get_band_lims_wavenumber()))
endif

! ######################################################################################
!
! Loop over all columns...
Expand Down
59 changes: 29 additions & 30 deletions physics/rrtmgp_sw_main.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -20,12 +20,6 @@ module rrtmgp_sw_main
use rrtmgp_sampling, only: sampled_mask, draw_samples
implicit none

type(ty_gas_concs) :: gas_concs
type(ty_optical_props_2str) :: sw_optical_props_accum, sw_optical_props_aerosol_local, &
sw_optical_props_cloudsByBand, sw_optical_props_cnvcloudsByBand, &
sw_optical_props_pblcloudsByBand, sw_optical_props_precipByBand, &
sw_optical_props_clouds

public rrtmgp_sw_main_init, rrtmgp_sw_main_run

contains
Expand Down Expand Up @@ -80,30 +74,6 @@ subroutine rrtmgp_sw_main_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp_sw_fi
doGP_cldoptics_PADE, doGP_cldoptics_LUT, nrghice, mpicomm, mpirank, mpiroot, &
errmsg, errflg)

! DDTs

! ty_gas_concs
call check_error_msg('rrtmgp_sw_main_gas_concs_init',gas_concs%init(active_gases_array))

! ty_optical_props
call check_error_msg('rrtmgp_sw_main_accumulated_optics_init',&
sw_optical_props_accum%alloc_2str(rrtmgp_phys_blksz, nLay, sw_gas_props))
call check_error_msg('rrtmgp_sw_main_cloud_optics_init',&
sw_optical_props_cloudsByBand%alloc_2str(rrtmgp_phys_blksz, nLay, sw_gas_props%get_band_lims_wavenumber()))
call check_error_msg('rrtmgp_sw_main_precip_optics_init',&
sw_optical_props_precipByBand%alloc_2str(rrtmgp_phys_blksz, nLay, sw_gas_props%get_band_lims_wavenumber()))
call check_error_msg('rrtmgp_sw_mian_cloud_sampling_init', &
sw_optical_props_clouds%alloc_2str(rrtmgp_phys_blksz, nLay, sw_gas_props))
call check_error_msg('rrtmgp_sw_main_aerosol_optics_init',&
sw_optical_props_aerosol_local%alloc_2str(rrtmgp_phys_blksz, nLay, sw_gas_props%get_band_lims_wavenumber()))
if (doGP_sgs_cnv) then
call check_error_msg('rrtmgp_sw_main_cnv_cloud_optics_init',&
sw_optical_props_cnvcloudsByBand%alloc_2str(rrtmgp_phys_blksz, nLay, sw_gas_props%get_band_lims_wavenumber()))
endif
if (doGP_sgs_pbl) then
call check_error_msg('rrtmgp_sw_main_pbl_cloud_optics_init',&
sw_optical_props_pblcloudsByBand%alloc_2str(rrtmgp_phys_blksz, nLay, sw_gas_props%get_band_lims_wavenumber()))
endif
end subroutine rrtmgp_sw_main_init

! #########################################################################################
Expand Down Expand Up @@ -241,12 +211,41 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_
uvb_bnd = (/29000,38000/)
real(kind_phys), dimension(rrtmgp_phys_blksz,sw_gas_props%get_ngpt()) :: toa_src_sw

type(ty_gas_concs) :: gas_concs
type(ty_optical_props_2str) :: sw_optical_props_accum, sw_optical_props_aerosol_local, &
sw_optical_props_cloudsByBand, sw_optical_props_cnvcloudsByBand, &
sw_optical_props_pblcloudsByBand, sw_optical_props_precipByBand, &
sw_optical_props_clouds

! Initialize CCPP error handling variables
errmsg = ''
errflg = 0

if (.not. doSWrad) return

! ty_gas_concs
call check_error_msg('rrtmgp_sw_main_gas_concs_init',gas_concs%init(active_gases_array))

! ty_optical_props
call check_error_msg('rrtmgp_sw_main_accumulated_optics_init',&
sw_optical_props_accum%alloc_2str(rrtmgp_phys_blksz, nLay, sw_gas_props))
call check_error_msg('rrtmgp_sw_main_cloud_optics_init',&
sw_optical_props_cloudsByBand%alloc_2str(rrtmgp_phys_blksz, nLay, sw_gas_props%get_band_lims_wavenumber()))
call check_error_msg('rrtmgp_sw_main_precip_optics_init',&
sw_optical_props_precipByBand%alloc_2str(rrtmgp_phys_blksz, nLay, sw_gas_props%get_band_lims_wavenumber()))
call check_error_msg('rrtmgp_sw_mian_cloud_sampling_init', &
sw_optical_props_clouds%alloc_2str(rrtmgp_phys_blksz, nLay, sw_gas_props))
call check_error_msg('rrtmgp_sw_main_aerosol_optics_init',&
sw_optical_props_aerosol_local%alloc_2str(rrtmgp_phys_blksz, nLay, sw_gas_props%get_band_lims_wavenumber()))
if (doGP_sgs_cnv) then
call check_error_msg('rrtmgp_sw_main_cnv_cloud_optics_init',&
sw_optical_props_cnvcloudsByBand%alloc_2str(rrtmgp_phys_blksz, nLay, sw_gas_props%get_band_lims_wavenumber()))
endif
if (doGP_sgs_pbl) then
call check_error_msg('rrtmgp_sw_main_pbl_cloud_optics_init',&
sw_optical_props_pblcloudsByBand%alloc_2str(rrtmgp_phys_blksz, nLay, sw_gas_props%get_band_lims_wavenumber()))
endif

if (nDay .gt. 0) then

bandlimits = sw_gas_props%get_band_lims_wavenumber()
Expand Down

0 comments on commit 9dd9e86

Please sign in to comment.