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.

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 and simplified LW transport #280

Closed
wants to merge 11 commits into from
Closed
3 changes: 2 additions & 1 deletion .github/workflows/containerized-ci.yml
Original file line number Diff line number Diff line change
Expand Up @@ -57,7 +57,7 @@ jobs:
RUN_CMD:
# https://github.com/earth-system-radiation/rte-rrtmgp/issues/194
OMP_TARGET_OFFLOAD: DISABLED
FAILURE_THRESHOLD: 5.8e-2 # 7.e-4
FAILURE_THRESHOLD: 7.e-4

steps:
#
Expand All @@ -72,6 +72,7 @@ jobs:
with:
repository: earth-system-radiation/rrtmgp-data
path: rrtmgp-data
ref: feature-new-lw-quadrature
#
# Build libraries, examples and tests (expect success)
#
Expand Down
3 changes: 2 additions & 1 deletion .github/workflows/continuous-integration.yml
Original file line number Diff line number Diff line change
Expand Up @@ -31,7 +31,7 @@ jobs:
RRTMGP_ROOT: ${{ github.workspace }}
RRTMGP_DATA: ${{ github.workspace }}/rrtmgp-data
RUN_CMD:
FAILURE_THRESHOLD: 5.8e-2 # 7.e-4
FAILURE_THRESHOLD: 7.e-4
steps:
#
# Relax failure thresholds for single precision
Expand All @@ -52,6 +52,7 @@ jobs:
with:
repository: earth-system-radiation/rrtmgp-data
path: rrtmgp-data
ref: feature-new-lw-quadrature
#
# Synchronize the package index
#
Expand Down
1 change: 1 addition & 0 deletions .github/workflows/self-hosted-ci.yml
Original file line number Diff line number Diff line change
Expand Up @@ -62,6 +62,7 @@ jobs:
with:
repository: earth-system-radiation/rrtmgp-data
path: rrtmgp-data
ref: feature-new-lw-quadrature
#
# Finalize build environment
#
Expand Down
5 changes: 3 additions & 2 deletions .gitlab/levante.yml
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,7 @@ include:
file: '.slurm-ci.yml'

variables:
RRTMGP_DATA_TAG: feature-update-lw-quadrature
SCHEDULER_PARAMETERS: >-
--account=mh0287
--time=05:00
Expand Down Expand Up @@ -47,7 +48,7 @@ variables:
.dp:
variables:
FPMODEL: DP
FAILURE_THRESHOLD: "5.8e-2"
FAILURE_THRESHOLD: "7.e-4"

.sp:
variables:
Expand Down Expand Up @@ -81,7 +82,7 @@ variables:
#
# Check out data
#
- git clone --depth 1 https://github.com/earth-system-radiation/rrtmgp-data.git "${RRTMGP_DATA}"
- git clone --branch ${RRTMGP_DATA_TAG}--depth 1 https://github.com/earth-system-radiation/rrtmgp-data.git "${RRTMGP_DATA}"
#
# Run examples and tests
#
Expand Down
5 changes: 3 additions & 2 deletions .gitlab/lumi.yml
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,7 @@ default:
- lumi

variables:
RRTMGP_DATA_TAG: feature-update-lw-quadrature
SCHEDULER_PARAMETERS: >-
--account=project_465000454
--nodes=1
Expand Down Expand Up @@ -39,7 +40,7 @@ variables:
.dp:
variables:
FPMODEL: DP
FAILURE_THRESHOLD: "5.8e-2"
FAILURE_THRESHOLD: "7.e-4"

.sp:
variables:
Expand Down Expand Up @@ -96,7 +97,7 @@ setup-python:
#
# Check out data
#
- git clone --depth 1 https://github.com/earth-system-radiation/rrtmgp-data.git "${RRTMGP_DATA}"
- git clone --branch ${RRTMGP_DATA_TAG}--depth 1 https://github.com/earth-system-radiation/rrtmgp-data.git "${RRTMGP_DATA}"
#
# Run examples and tests
#
Expand Down
4 changes: 2 additions & 2 deletions examples/all-sky/rrtmgp_allsky.F90
Original file line number Diff line number Diff line change
Expand Up @@ -310,9 +310,9 @@ program rte_rrtmgp_allsky
!
! Should we allocate these once, rather than once per loop? They're big.
!
!$acc data create( lw_sources, lw_sources%lay_source, lw_sources%lev_source) &
!$acc data create( lw_sources, lw_sources%lev_source) &
!$acc create( lw_sources%sfc_source, lw_sources%sfc_source_Jac)
!$omp target data map(alloc: lw_sources%lay_source, lw_sources%lev_source) &
!$omp target data map(alloc: lw_sources%lev_source) &
!$omp map(alloc: lw_sources%sfc_source, lw_sources%sfc_source_Jac)
call stop_on_err(k_dist%gas_optics(p_lay, p_lev, &
t_lay, t_sfc, &
Expand Down
8 changes: 4 additions & 4 deletions examples/rfmip-clear-sky/rrtmgp_rfmip_lw.F90
Original file line number Diff line number Diff line change
Expand Up @@ -219,8 +219,8 @@ program rrtmgp_rfmip_lw
!$omp target enter data map(alloc:sfc_emis_spec)
!$acc enter data create(optical_props, optical_props%tau)
!$omp target enter data map(alloc:optical_props%tau)
!$acc enter data create(source, source%lay_source, source%lev_source, source%sfc_source)
!$omp target enter data map(alloc:source%lay_source, source%lev_source, source%sfc_source)
!$acc enter data create(source, source%lev_source, source%sfc_source)
!$omp target enter data map(alloc: source%lev_source, source%sfc_source)
! --------------------------------------------------
!
! Loop over blocks
Expand Down Expand Up @@ -265,8 +265,8 @@ program rrtmgp_rfmip_lw
!$omp target exit data map(release:sfc_emis_spec)
!$acc exit data delete(optical_props%tau, optical_props)
!$omp target exit data map(release:optical_props%tau)
!$acc exit data delete(source%lay_source, source%lev_source, source%sfc_source)
!$omp target exit data map(release:source%lay_source, source%lev_source, source%sfc_source)
!$acc exit data delete(source%lev_source, source%sfc_source)
!$omp target exit data map(release:source%lev_source, source%sfc_source)
!$acc exit data delete(source)
! --------------------------------------------------m
call unblock_and_write(trim(flxup_file), 'rlu', flux_up)
Expand Down
6 changes: 3 additions & 3 deletions rrtmgp-frontend/mo_gas_optics_rrtmgp.F90
Original file line number Diff line number Diff line change
Expand Up @@ -869,10 +869,10 @@ function source(this, &
! Source function needs temperature at interfaces/levels and at layer centers
! Allocate small local array for tlev unconditionally
!
!$acc data copyin(sources) copyout( sources%lay_source, sources%lev_source) &
!$acc data copyin(sources) copyout( sources%lev_source) &
!$acc copyout( sources%sfc_source, sources%sfc_source_Jac) &
!$acc create(tlev_arr)
!$omp target data map(from:sources%lay_source, sources%lev_source) &
!$omp target data map(from:sources%lev_source) &
!$omp map(from:sources%sfc_source, sources%sfc_source_Jac) &
!$omp map(alloc:tlev_arr)

Expand Down Expand Up @@ -922,7 +922,7 @@ function source(this, &
fmajor, jeta, tropo, jtemp, jpress, &
this%get_gpoint_bands(), this%get_band_lims_gpoint(), this%planck_frac, this%temp_ref_min,&
this%totplnk_delta, this%totplnk, this%gpoint_flavor, &
sources%sfc_source, sources%lay_source, sources%lev_source, &
sources%sfc_source, sources%lev_source, &
sources%sfc_source_Jac)
!$acc end data
!$omp end target data
Expand Down
11 changes: 3 additions & 8 deletions rrtmgp-kernels/accel/mo_gas_optics_rrtmgp_kernels.F90
Original file line number Diff line number Diff line change
Expand Up @@ -573,7 +573,7 @@ subroutine compute_Planck_source( &
fmajor, jeta, tropo, jtemp, jpress, &
gpoint_bands, band_lims_gpt, &
pfracin, temp_ref_min, totplnk_delta, totplnk, gpoint_flavor, &
sfc_src, lay_src, lev_src, sfc_source_Jac) bind(C, name="rrtmgp_compute_Planck_source")
sfc_src, lev_src, sfc_source_Jac) bind(C, name="rrtmgp_compute_Planck_source")
integer, intent(in) :: ncol, nlay, nbnd, ngpt
integer, intent(in) :: nflav, neta, npres, ntemp, nPlanckTemp
real(wp), dimension(ncol,nlay ), intent(in) :: tlay
Expand All @@ -594,7 +594,6 @@ subroutine compute_Planck_source( &
integer, dimension(2,ngpt), intent(in) :: gpoint_flavor

real(wp), dimension(ncol, ngpt), intent(out) :: sfc_src
real(wp), dimension(ncol,nlay, ngpt), intent(out) :: lay_src
real(wp), dimension(ncol,nlay+1,ngpt), intent(out) :: lev_src
real(wp), dimension(ncol, ngpt), intent(out) :: sfc_source_Jac
! -----------------
Expand All @@ -609,9 +608,9 @@ subroutine compute_Planck_source( &
! -----------------

!$acc data copyin( tlay,tlev,tsfc,fmajor,jeta,tropo,jtemp,jpress,gpoint_bands,pfracin,totplnk,gpoint_flavor) &
!$acc copyout( sfc_src,lay_src,lev_src,sfc_source_Jac)
!$acc copyout( sfc_src,lev_src,sfc_source_Jac)
!$omp target data map( to:tlay,tlev,tsfc,fmajor,jeta,tropo,jtemp,jpress,gpoint_bands,pfracin,totplnk,gpoint_flavor) &
!$omp map(from: sfc_src,lay_src,lev_src,sfc_source_Jac)
!$omp map(from: sfc_src,lev_src,sfc_source_Jac)

! Calculation of fraction of band's Planck irradiance associated with each g-point
!$acc parallel loop tile(128,2)
Expand All @@ -630,10 +629,6 @@ subroutine compute_Planck_source( &
interpolate3D(one, fmajor(:,:,:,icol,ilay,iflav), pfracin, &
igpt, jeta(:,icol,ilay,iflav), jtemp(icol,ilay),jpress(icol,ilay)+itropo)

! Compute layer source irradiance for g-point, equals band irradiance x fraction for g-point
planck_function_1 = interpolate1D(tlay(icol,ilay), temp_ref_min, totplnk_delta, totplnk(:,ibnd))
lay_src (icol,ilay,igpt) = pfrac * planck_function_1

! Compute level source irradiance for g-point
planck_function_1 = interpolate1D(tlev(icol,ilay), temp_ref_min, totplnk_delta, totplnk(:,ibnd))
if (ilay == 1) then
Expand Down
3 changes: 1 addition & 2 deletions rrtmgp-kernels/api/mo_gas_optics_rrtmgp_kernels.F90
Original file line number Diff line number Diff line change
Expand Up @@ -207,7 +207,7 @@ subroutine compute_Planck_source( &
fmajor, jeta, tropo, jtemp, jpress, &
gpoint_bands, band_lims_gpt, &
pfracin, temp_ref_min, totplnk_delta, totplnk, gpoint_flavor, &
sfc_src, lay_src, lev_src, sfc_source_Jac) bind(C, name="rrtmgp_compute_Planck_source")
sfc_src, lev_src, sfc_source_Jac) bind(C, name="rrtmgp_compute_Planck_source")
use mo_rte_kind, only : wp, wl
integer, intent(in) :: ncol, nlay, nbnd, ngpt
!! input dimensions
Expand Down Expand Up @@ -235,7 +235,6 @@ subroutine compute_Planck_source( &
integer, dimension(2,ngpt), intent(in) :: gpoint_flavor !! major gas flavor (pair) by upper/lower, g-point

real(wp), dimension(ncol, ngpt), intent(out) :: sfc_src !! Planck emssion from the surface
real(wp), dimension(ncol,nlay, ngpt), intent(out) :: lay_src !! Planck emssion from layer centers
real(wp), dimension(ncol,nlay+1,ngpt), intent(out) :: lev_src !! Planck emission at layer boundaries
real(wp), dimension(ncol, ngpt), intent(out) :: sfc_source_Jac
!! Jacobian (derivative) of the surface Planck source with respect to surface temperature
Expand Down
1 change: 0 additions & 1 deletion rrtmgp-kernels/api/rrtmgp_kernels.h
Original file line number Diff line number Diff line change
Expand Up @@ -116,7 +116,6 @@ extern "C"
const Float* totplnk, // (nPlanckTemp,nbnd)
const int* gpoint_flavor, // (2,ngpt)
Float* sfc_src, // [out] (ncol, ngpt)
Float* lay_src, // [out] (ncol,nlay, ngpt)
Float* lev_src, // [out] (ncol,nlay+1,ngpt)
Float* sfc_src_jac // [out] (ncol, ngpt)
);
Expand Down
25 changes: 1 addition & 24 deletions rrtmgp-kernels/mo_gas_optics_rrtmgp_kernels.F90
Original file line number Diff line number Diff line change
Expand Up @@ -571,7 +571,7 @@ subroutine compute_Planck_source( &
fmajor, jeta, tropo, jtemp, jpress, &
gpoint_bands, band_lims_gpt, &
pfracin, temp_ref_min, totplnk_delta, totplnk, gpoint_flavor, &
sfc_src, lay_src, lev_src, sfc_source_Jac) bind(C, name="rrtmgp_compute_Planck_source")
sfc_src, lev_src, sfc_source_Jac) bind(C, name="rrtmgp_compute_Planck_source")
integer, intent(in) :: ncol, nlay, nbnd, ngpt
!! input dimensions
integer, intent(in) :: nflav, neta, npres, ntemp, nPlanckTemp
Expand All @@ -598,7 +598,6 @@ subroutine compute_Planck_source( &
integer, dimension(2,ngpt), intent(in) :: gpoint_flavor !! major gas flavor (pair) by upper/lower, g-point

real(wp), dimension(ncol, ngpt), intent(out) :: sfc_src !! Planck emission from the surface
real(wp), dimension(ncol,nlay, ngpt), intent(out) :: lay_src !! Planck emission from layer centers
real(wp), dimension(ncol,nlay+1,ngpt), intent(out) :: lev_src !! Planck emission from layer boundaries
real(wp), dimension(ncol, ngpt), intent(out) :: sfc_source_Jac
!! Jacobian (derivative) of the surface Planck source with respect to surface temperature
Expand Down Expand Up @@ -652,28 +651,6 @@ subroutine compute_Planck_source( &
end do
end do !icol

do ilay = 1, nlay
do icol = 1, ncol
! Compute layer source irradiance for g-point, equals band irradiance x fraction for g-point
planck_function(icol,ilay,1:nbnd) = interpolate1D(tlay(icol,ilay), temp_ref_min, totplnk_delta, totplnk)
end do
end do

!
! Map to g-points
!
do ibnd = 1, nbnd
gptS = band_lims_gpt(1, ibnd)
gptE = band_lims_gpt(2, ibnd)
do igpt = gptS, gptE
do ilay = 1, nlay
do icol = 1, ncol
lay_src(icol,ilay,igpt) = pfrac(icol,ilay,igpt) * planck_function(icol,ilay,ibnd)
end do
end do
end do
end do

! compute level source irradiances for each g-point
do icol = 1, ncol
planck_function (icol, 1,1:nbnd) = interpolate1D(tlev(icol, 1),temp_ref_min, totplnk_delta, totplnk)
Expand Down
33 changes: 17 additions & 16 deletions rte-frontend/mo_rte_lw.F90
Original file line number Diff line number Diff line change
Expand Up @@ -125,22 +125,25 @@ function rte_lw(optical_props, top_at_1, &
real(wp), dimension(:,:), pointer :: inc_flux_diffuse
! --------------------------------------------------
!
! Weights and angle secants for first order (k=1) Gaussian quadrature.
! Values from Table 2, Clough et al, 1992, doi:10.1029/92JD01419
! after Abramowitz & Stegun 1972, page 921
! Weights and angle secants for "Gauss-Jacobi-5" quadrature.
! Values from Table 1, R. J. Hogan 2023, doi:10.1002/qj.4598
!
integer, parameter :: max_gauss_pts = 4
real(wp), parameter, &
dimension(max_gauss_pts, max_gauss_pts) :: &
gauss_Ds = RESHAPE([1.66_wp, 0._wp, 0._wp, 0._wp, & ! Diffusivity angle, not Gaussian angle
1.18350343_wp, 2.81649655_wp, 0._wp, 0._wp, &
1.09719858_wp, 1.69338507_wp, 4.70941630_wp, 0._wp, &
1.06056257_wp, 1.38282560_wp, 2.40148179_wp, 7.15513024_wp], &
!
! Values provided are for mu = cos(theta); we require the inverse
!
gauss_Ds = 1._wp / &
RESHAPE([0.6096748751_wp, huge(1._wp) , huge(1._wp) , huge(1._wp), &
0.2509907356_wp, 0.7908473988_wp, huge(1._wp) , huge(1._wp), &
0.1024922169_wp, 0.4417960320_wp, 0.8633751621_wp, huge(1._wp), &
0.0454586727_wp, 0.2322334416_wp, 0.5740198775_wp, 0.9030775973_wp], &
[max_gauss_pts, max_gauss_pts]), &
gauss_wts = RESHAPE([0.5_wp, 0._wp, 0._wp, 0._wp, &
0.3180413817_wp, 0.1819586183_wp, 0._wp, 0._wp, &
0.2009319137_wp, 0.2292411064_wp, 0.0698269799_wp, 0._wp, &
0.1355069134_wp, 0.2034645680_wp, 0.1298475476_wp, 0.0311809710_wp], &
gauss_wts = RESHAPE([1._wp, 0._wp, 0._wp, 0._wp, &
0.2300253764_wp, 0.7699746236_wp, 0._wp, 0._wp, &
0.0437820218_wp, 0.3875796738_wp, 0.5686383044_wp, 0._wp, &
0.0092068785_wp, 0.1285704278_wp, 0.4323381850_wp, 0.4298845087_wp], &
[max_gauss_pts, max_gauss_pts])
! ------------------------------------------------------------------------------------
ncol = optical_props%get_ncol()
Expand Down Expand Up @@ -353,7 +356,6 @@ function rte_lw(optical_props, top_at_1, &
logical(top_at_1, wl), n_quad_angs, &
secants, gauss_wts(1:n_quad_angs,n_quad_angs), &
optical_props%tau, &
sources%lay_source, &
sources%lev_source, &
sfc_emis_gpt, sources%sfc_source, &
inc_flux_diffuse, &
Expand All @@ -372,9 +374,9 @@ function rte_lw(optical_props, top_at_1, &
!
call lw_solver_2stream(ncol, nlay, ngpt, logical(top_at_1, wl), &
optical_props%tau, optical_props%ssa, optical_props%g, &
sources%lay_source, sources%lev_source, &
sfc_emis_gpt, sources%sfc_source, &
inc_flux_diffuse, &
sources%lev_source, &
sfc_emis_gpt, sources%sfc_source, &
inc_flux_diffuse, &
gpt_flux_up, gpt_flux_dn)
else
allocate(secants(ncol, ngpt, n_quad_angs))
Expand All @@ -396,7 +398,6 @@ function rte_lw(optical_props, top_at_1, &
logical(top_at_1, wl), n_quad_angs, &
secants, gauss_wts(1:n_quad_angs,n_quad_angs), &
optical_props%tau, &
sources%lay_source, &
sources%lev_source, &
sfc_emis_gpt, sources%sfc_source, &
inc_flux_diffuse, &
Expand Down
11 changes: 3 additions & 8 deletions rte-frontend/mo_source_functions.F90
Original file line number Diff line number Diff line change
Expand Up @@ -28,8 +28,6 @@ module mo_source_functions
!> spectral mapping in each direction separately, and at the surface
!>
type, extends(ty_optical_props), public :: ty_source_func_lw
real(wp), allocatable, dimension(:,:,:) :: lay_source
!! Planck source at layer average temperature (ncol, nlay, ngpt)
real(wp), allocatable, dimension(:,:,:) :: lev_source
!! Planck source at layer edge (ncol, nlay+1, ngpt)
real(wp), allocatable, dimension(:,: ) :: sfc_source
Expand Down Expand Up @@ -99,11 +97,10 @@ function alloc_lw(this, ncol, nlay) result(err_message)

if(allocated(this%sfc_source)) deallocate(this%sfc_source)
if(allocated(this%sfc_source_Jac)) deallocate(this%sfc_source_Jac)
if(allocated(this%lay_source)) deallocate(this%lay_source)
if(allocated(this%lev_source)) deallocate(this%lev_source)

ngpt = this%get_ngpt()
allocate(this%sfc_source (ncol, ngpt), this%lay_source (ncol,nlay,ngpt), &
allocate(this%sfc_source (ncol, ngpt), &
this%lev_source (ncol,nlay+1,ngpt), this%sfc_source_Jac(ncol, ngpt))
end function alloc_lw
! --------------------------------------------------------------
Expand Down Expand Up @@ -176,7 +173,6 @@ end function copy_and_alloc_sw
subroutine finalize_lw(this)
class(ty_source_func_lw), intent(inout) :: this

if(allocated(this%lay_source )) deallocate(this%lay_source)
if(allocated(this%lev_source )) deallocate(this%lev_source)
if(allocated(this%sfc_source )) deallocate(this%sfc_source)
if(allocated(this%sfc_source_Jac)) deallocate(this%sfc_source_Jac)
Expand All @@ -199,7 +195,7 @@ pure function get_ncol_lw(this)
integer :: get_ncol_lw

if(this%is_allocated()) then
get_ncol_lw = size(this%lay_source,1)
get_ncol_lw = size(this%lev_source,1)
else
get_ncol_lw = 0
end if
Expand All @@ -210,7 +206,7 @@ pure function get_nlay_lw(this)
integer :: get_nlay_lw

if(this%is_allocated()) then
get_nlay_lw = size(this%lay_source,2)
get_nlay_lw = size(this%lev_source,2)-1
else
get_nlay_lw = 0
end if
Expand Down Expand Up @@ -254,7 +250,6 @@ function get_subset_range_lw(full, start, n, subset) result(err_message)
if(err_message /= "") return
subset%sfc_source (1:n, :) = full%sfc_source (start:start+n-1, :)
subset%sfc_source_Jac(1:n, :) = full%sfc_source_Jac(start:start+n-1, :)
subset%lay_source (1:n,:,:) = full%lay_source (start:start+n-1,:,:)
subset%lev_source (1:n,:,:) = full%lev_source (start:start+n-1,:,:)
end function get_subset_range_lw
! ------------------------------------------------------------------------------------------
Expand Down
Loading
Loading