Skip to content

Commit 5ddeda6

Browse files
committed
Merge branch 'atmosphere/port_compute_moist_coefficients' into develop (PR #1238)
This merge enables the GPU execution of the atm_compute_moist_coefficients subroutine using OpenACC directives for the data movements and loops. A new timer, 'atm_compute_moist_coefficients [ACC_data_xfer]', has been added for data transfers in the atm_compute_moist_coefficients subroutine. * atmosphere/port_compute_moist_coefficients: Initial OpenACC port of atm_compute_moist_coefficients subroutine
2 parents d035210 + 4add487 commit 5ddeda6

File tree

1 file changed

+43
-10
lines changed

1 file changed

+43
-10
lines changed

src/core_atmosphere/dynamics/mpas_atm_time_integration.F

Lines changed: 43 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -1795,59 +1795,92 @@ subroutine atm_compute_moist_coefficients( dims, state, diag, mesh, &
17951795
integer, intent(in) :: cellSolveStart, cellSolveEnd, vertexSolveStart, vertexSolveEnd, edgeSolveStart, edgeSolveEnd
17961796

17971797
integer :: iEdge, iCell, k, cell1, cell2, iq
1798-
integer, pointer :: nCells, nEdges, nVertLevels, nCellsSolve
1798+
integer, pointer :: nCells_ptr, nEdges_ptr, nVertLevels_ptr, nCellsSolve_ptr
1799+
integer :: nCells, nEdges, nVertLevels, nCellsSolve
17991800
real (kind=RKIND) :: qtotal
18001801
integer, dimension(:,:), pointer :: cellsOnEdge
1801-
integer, pointer :: moist_start, moist_end
1802+
integer, pointer :: moist_start_ptr, moist_end_ptr
1803+
integer :: moist_start, moist_end
18021804
real (kind=RKIND), dimension(:,:,:), pointer :: scalars
18031805
real (kind=RKIND), dimension(:,:), pointer :: cqw
18041806
real (kind=RKIND), dimension(:,:), pointer :: cqu
18051807

1806-
call mpas_pool_get_dimension(dims, 'nCells', nCells)
1807-
call mpas_pool_get_dimension(dims, 'nEdges', nEdges)
1808-
call mpas_pool_get_dimension(dims, 'nVertLevels', nVertLevels)
1809-
call mpas_pool_get_dimension(dims, 'nCellsSolve', nCellsSolve)
1810-
call mpas_pool_get_dimension(state, 'moist_start', moist_start)
1811-
call mpas_pool_get_dimension(state, 'moist_end', moist_end)
1808+
call mpas_pool_get_dimension(dims, 'nCells', nCells_ptr)
1809+
call mpas_pool_get_dimension(dims, 'nEdges', nEdges_ptr)
1810+
call mpas_pool_get_dimension(dims, 'nVertLevels', nVertLevels_ptr)
1811+
call mpas_pool_get_dimension(dims, 'nCellsSolve', nCellsSolve_ptr)
1812+
call mpas_pool_get_dimension(state, 'moist_start', moist_start_ptr)
1813+
call mpas_pool_get_dimension(state, 'moist_end', moist_end_ptr)
18121814

18131815
call mpas_pool_get_array(mesh, 'cellsOnEdge', cellsOnEdge)
18141816
call mpas_pool_get_array(state, 'scalars', scalars, 2)
18151817
call mpas_pool_get_array(diag, 'cqw', cqw)
18161818
call mpas_pool_get_array(diag, 'cqu', cqu)
18171819

1820+
nCells = nCells_ptr
1821+
nEdges = nEdges_ptr
1822+
nVertLevels = nVertLevels_ptr
1823+
nCellsSolve = nCellsSolve_ptr
1824+
moist_start = moist_start_ptr
1825+
moist_end = moist_end_ptr
1826+
1827+
MPAS_ACC_TIMER_START('atm_compute_moist_coefficients [ACC_data_xfer]')
1828+
!$acc enter data create(qtot, cqw, cqu) &
1829+
!$acc copyin(scalars)
1830+
MPAS_ACC_TIMER_STOP('atm_compute_moist_coefficients [ACC_data_xfer]')
1831+
1832+
!$acc parallel default(present)
1833+
!$acc loop gang worker
18181834
! do iCell = cellSolveStart,cellSolveEnd
18191835
do iCell = cellStart,cellEnd
1820-
qtot(1:nVertLevels,iCell) = 0.0
1836+
!$acc loop vector
18211837
do k = 1,nVertLevels
1838+
qtot(k,iCell) = 0.0
1839+
!$acc loop seq
18221840
do iq = moist_start, moist_end
18231841
qtot(k,iCell) = qtot(k,iCell) + scalars(iq, k, iCell)
18241842
end do
18251843
end do
18261844
end do
1845+
!$acc end parallel
18271846

18281847
! do iCell = cellSolveStart,cellSolveEnd
1848+
!$acc parallel default(present)
1849+
!$acc loop gang worker
18291850
do iCell = cellStart,cellEnd
1851+
!$acc loop vector
18301852
do k = 2, nVertLevels
18311853
qtotal = 0.5*(qtot(k,iCell)+qtot(k-1,iCell))
18321854
cqw(k,iCell) = 1.0 / (1.0 + qtotal)
18331855
end do
18341856
end do
1857+
!$acc end parallel
18351858

18361859
! would need to compute qtot for all cells and an openmp barrier to use qtot below.
18371860

1861+
!$acc parallel default(present)
1862+
!$acc loop gang worker
18381863
do iEdge = edgeStart,edgeEnd
18391864
cell1 = cellsOnEdge(1,iEdge)
18401865
cell2 = cellsOnEdge(2,iEdge)
18411866
if (cell1 <= nCellsSolve .or. cell2 <= nCellsSolve) then
1842-
do k = 1, nVertLevels
1867+
!$acc loop vector
1868+
do k = 1, nVertLevels
18431869
qtotal = 0.0
1870+
!$acc loop seq
18441871
do iq = moist_start, moist_end
18451872
qtotal = qtotal + 0.5 * ( scalars(iq, k, cell1) + scalars(iq, k, cell2) )
18461873
end do
18471874
cqu(k,iEdge) = 1.0 / (1.0 + qtotal)
18481875
end do
18491876
end if
18501877
end do
1878+
!$acc end parallel
1879+
1880+
MPAS_ACC_TIMER_START('atm_compute_moist_coefficients [ACC_data_xfer]')
1881+
!$acc exit data copyout(cqw, cqu, qtot) &
1882+
!$acc delete(scalars)
1883+
MPAS_ACC_TIMER_STOP('atm_compute_moist_coefficients [ACC_data_xfer]')
18511884

18521885
end subroutine atm_compute_moist_coefficients
18531886

0 commit comments

Comments
 (0)