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

Temperature and source function refinements #253

Merged
merged 3 commits into from
Dec 18, 2023
+31 −34
Merged

Temperature and source function refinements #253

Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
2759d38
Remove compiler workaround for present status not being inherited
RobertPincus Dec 15, 2023
94bd57e
Interpolate level temperatures on device
RobertPincus Dec 15, 2023
52cf8b2
OpenACC syntax
RobertPincus Dec 15, 2023
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
65 changes: 31 additions & 34 deletions rrtmgp-frontend/mo_gas_optics_rrtmgp.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -304,30 +304,21 @@ function gas_optics_int(this, &

!
! Interpolate source function
!
if(present(tlev)) then
!
! present status of optional argument should be passed to source()
! but isn't with PGI 19.10
!
error_msg = source(this, &
ncol, nlay, nband, ngpt, &
play, plev, tlay, tsfc, &
jtemp, jpress, jeta, tropo, fmajor, &
sources, &
tlev)
!$acc exit data delete(tlev)
! present status of optional argument is passed to source()
!
error_msg = source(this, &
ncol, nlay, nband, ngpt, &
play, plev, tlay, tsfc, &
jtemp, jpress, jeta, tropo, fmajor, &
sources, &
tlev)
if(present(tlev)) then
!$acc exit data delete(tlev)
!$omp target exit data map(release:tlev)
else
error_msg = source(this, &
ncol, nlay, nband, ngpt, &
play, plev, tlay, tsfc, &
jtemp, jpress, jeta, tropo, fmajor, &
sources)
end if
!$acc exit data delete(tsfc)
end if
!$acc exit data delete(tsfc)
!$omp target exit data map(release:tsfc)
!$acc exit data delete(jtemp, jpress, tropo, fmajor, jeta)
!$acc exit data delete(jtemp, jpress, tropo, fmajor, jeta)
!$omp target exit data map(release:jtemp, jpress, tropo, fmajor, jeta)
end function gas_optics_int
!------------------------------------------------------------------------------------------
Expand Down Expand Up @@ -858,7 +849,15 @@ function source(this, &
error_msg = ""
!
! 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 copyout( sources%sfc_source, sources%sfc_source_Jac) &
!$acc create(tlev_arr)
!$omp target data map(from:sources%lay_source, sources%lev_source) &
!$omp map(from:sources%sfc_source, sources%sfc_source_Jac) &
!$omp map(alloc:tlev_arr)

if (present(tlev)) then
! Users might have provided these
tlev_wk => tlev
Expand All @@ -868,32 +867,30 @@ function source(this, &
! Interpolate temperature to levels if not provided
! Interpolation and extrapolation at boundaries is weighted by pressure
!
!$acc parallel loop gang vector
!$omp target teams distribute parallel do simd
do icol = 1, ncol
tlev_arr(icol,1) = tlay(icol,1) &
tlev_arr(icol,1) = tlay(icol,1) &
+ (plev(icol,1)-play(icol,1))*(tlay(icol,2)-tlay(icol,1)) &
& / (play(icol,2)-play(icol,1))
/ (play(icol,2)-play(icol,1))
tlev_arr(icol,nlay+1) = tlay(icol,nlay) &
+ (plev(icol,nlay+1)-play(icol,nlay))*(tlay(icol,nlay)-tlay(icol,nlay-1)) &
/ (play(icol,nlay)-play(icol,nlay-1))
end do
do ilay = 2, nlay
!$acc parallel loop gang vector collapse(2)
!$omp target teams distribute parallel do simd collapse(2)
do ilay = 2, nlay
do icol = 1, ncol
tlev_arr(icol,ilay) = (play(icol,ilay-1)*tlay(icol,ilay-1)*(plev(icol,ilay )-play(icol,ilay)) &
+ play(icol,ilay )*tlay(icol,ilay )*(play(icol,ilay-1)-plev(icol,ilay))) / &
(plev(icol,ilay)*(play(icol,ilay-1) - play(icol,ilay)))
end do
end do
do icol = 1, ncol
tlev_arr(icol,nlay+1) = tlay(icol,nlay) &
+ (plev(icol,nlay+1)-play(icol,nlay))*(tlay(icol,nlay)-tlay(icol,nlay-1)) &
/ (play(icol,nlay)-play(icol,nlay-1))
end do
end if

!-------------------------------------------------------------------
! Compute internal (Planck) source functions at layers and levels,
! which depend on mapping from spectral space that creates k-distribution.
!$acc data copyin(sources) copyout( sources%lay_source, sources%lev_source) &
!$acc copyout( sources%sfc_source, sources%sfc_source_Jac)
!$omp target data map(from:sources%lay_source, sources%lev_source) &
!$omp map(from:sources%sfc_source, sources%sfc_source_Jac)

!$acc kernels copyout(top_at_1)
!$omp target map(from:top_at_1)
Expand Down