From 6e4729697d5e0b3343b8f19fd244aedfeadd4152 Mon Sep 17 00:00:00 2001 From: Abishek Gopal Date: Tue, 13 May 2025 11:23:11 -0600 Subject: [PATCH 01/11] Consolidating OpenACC device-host memory transfers This PR consolidates much of the OpenACC host and device data transfers during the course of the dynamical execution to two subroutines mpas_atm_pre_dynamics _h2d and mpas_atm_post_dynamics_d2h that are called before and after the call to atm_srk3 subroutine. Due to atm_compute_solve_diagnostics also being called once before the start of model run, we also have a pair of subroutines mpas_atm _pre_computesolvediag_h2d and mpas_atm_post_computesolvediag_d2h to handle data movements around the first call to atm_compute_solve_diagnostics. Any fields copied onto the device in these subroutines are removed from explicit data movement statements in the dynamical core. The mesh/time-invariant fields are still copied onto the device in mpas_atm_ dynamics_init and removed from the device in mpas_atm_dynamics_finalize, with the exception of select fields moved in mpas_atm_pre_computesolvediag_h2d and mpas_atm_post_computesolvediag_d2h. This is a special case due to atm_compute_ solve_diagnostics being called for the first time before the call to mpas_atm_ dynamics_init This PR also includes explicit host-device data transfers in the mpas_atm_iau, mpas_atmphys_interface and mpas_atmphys_todynamics modules to ensure that the physics and IAU regions, which run on CPU, use the latest values from the dynamical core running on GPUs, and vice versa. In addition, this PR also includes explicit data transfers around halo exchanges in the atm_srk3 subroutine. These subroutines for data routines, and the acc update statements are an interim solution until we have a book-keeping method in place. This PR also introduces a couple of new timers to keep track of the cost of data transfers. --- .../dynamics/mpas_atm_boundaries.F | 32 - src/core_atmosphere/dynamics/mpas_atm_iau.F | 14 + .../dynamics/mpas_atm_time_integration.F | 1359 ++++++++++++----- src/core_atmosphere/mpas_atm_core.F | 5 +- .../physics/mpas_atmphys_interface.F | 20 + .../physics/mpas_atmphys_todynamics.F | 17 + 6 files changed, 1071 insertions(+), 376 deletions(-) diff --git a/src/core_atmosphere/dynamics/mpas_atm_boundaries.F b/src/core_atmosphere/dynamics/mpas_atm_boundaries.F index 787e7719a1..6c19ed7931 100644 --- a/src/core_atmosphere/dynamics/mpas_atm_boundaries.F +++ b/src/core_atmosphere/dynamics/mpas_atm_boundaries.F @@ -395,18 +395,14 @@ subroutine mpas_atm_get_bdy_tend(clock, block, vertDim, horizDim, field, delta_t nullify(tend) call mpas_pool_get_array(lbc, 'lbc_'//trim(field), tend, 1) - MPAS_ACC_TIMER_START('mpas_atm_get_bdy_tend [ACC_data_xfer]') if (associated(tend)) then - !$acc enter data copyin(tend) else call mpas_pool_get_array(lbc, 'lbc_scalars', tend_scalars, 1) - !$acc enter data copyin(tend_scalars) ! Ensure the integer pointed to by idx_ptr is copied to the gpu device call mpas_pool_get_dimension(lbc, 'index_'//trim(field), idx_ptr) idx = idx_ptr end if - MPAS_ACC_TIMER_STOP('mpas_atm_get_bdy_tend [ACC_data_xfer]') !$acc parallel default(present) if (associated(tend)) then @@ -426,13 +422,6 @@ subroutine mpas_atm_get_bdy_tend(clock, block, vertDim, horizDim, field, delta_t end if !$acc end parallel - MPAS_ACC_TIMER_START('mpas_atm_get_bdy_tend [ACC_data_xfer]') - if (associated(tend)) then - !$acc exit data delete(tend) - else - !$acc exit data delete(tend_scalars) - end if - MPAS_ACC_TIMER_STOP('mpas_atm_get_bdy_tend [ACC_data_xfer]') end subroutine mpas_atm_get_bdy_tend @@ -533,9 +522,6 @@ subroutine mpas_atm_get_bdy_state_2d(clock, block, vertDim, horizDim, field, del ! query the field as a scalar constituent ! if (associated(tend) .and. associated(state)) then - MPAS_ACC_TIMER_START('mpas_atm_get_bdy_state_2d [ACC_data_xfer]') - !$acc enter data copyin(tend, state) - MPAS_ACC_TIMER_STOP('mpas_atm_get_bdy_state_2d [ACC_data_xfer]') !$acc parallel default(present) !$acc loop gang vector collapse(2) @@ -546,9 +532,6 @@ subroutine mpas_atm_get_bdy_state_2d(clock, block, vertDim, horizDim, field, del end do !$acc end parallel - MPAS_ACC_TIMER_START('mpas_atm_get_bdy_state_2d [ACC_data_xfer]') - !$acc exit data delete(tend, state) - MPAS_ACC_TIMER_STOP('mpas_atm_get_bdy_state_2d [ACC_data_xfer]') else call mpas_pool_get_array(lbc, 'lbc_scalars', tend_scalars, 1) call mpas_pool_get_array(lbc, 'lbc_scalars', state_scalars, 2) @@ -556,10 +539,6 @@ subroutine mpas_atm_get_bdy_state_2d(clock, block, vertDim, horizDim, field, del idx=idx_ptr ! Avoid non-array pointer for OpenACC - MPAS_ACC_TIMER_START('mpas_atm_get_bdy_state_2d [ACC_data_xfer]') - !$acc enter data copyin(tend_scalars, state_scalars) - MPAS_ACC_TIMER_STOP('mpas_atm_get_bdy_state_2d [ACC_data_xfer]') - !$acc parallel default(present) !$acc loop gang vector collapse(2) do i=1, horizDim+1 @@ -569,9 +548,6 @@ subroutine mpas_atm_get_bdy_state_2d(clock, block, vertDim, horizDim, field, del end do !$acc end parallel - MPAS_ACC_TIMER_START('mpas_atm_get_bdy_state_2d [ACC_data_xfer]') - !$acc exit data delete(tend_scalars, state_scalars) - MPAS_ACC_TIMER_STOP('mpas_atm_get_bdy_state_2d [ACC_data_xfer]') end if end subroutine mpas_atm_get_bdy_state_2d @@ -652,10 +628,6 @@ subroutine mpas_atm_get_bdy_state_3d(clock, block, innerDim, vertDim, horizDim, call mpas_pool_get_array(lbc, 'lbc_'//trim(field), tend, 1) call mpas_pool_get_array(lbc, 'lbc_'//trim(field), state, 2) - MPAS_ACC_TIMER_START('mpas_atm_get_bdy_state_3d [ACC_data_xfer]') - !$acc enter data copyin(tend, state) - MPAS_ACC_TIMER_STOP('mpas_atm_get_bdy_state_3d [ACC_data_xfer]') - !$acc parallel default(present) !$acc loop gang vector collapse(3) do i=1, horizDim+1 @@ -667,10 +639,6 @@ subroutine mpas_atm_get_bdy_state_3d(clock, block, innerDim, vertDim, horizDim, end do !$acc end parallel - MPAS_ACC_TIMER_START('mpas_atm_get_bdy_state_3d [ACC_data_xfer]') - !$acc exit data delete(tend, state) - MPAS_ACC_TIMER_STOP('mpas_atm_get_bdy_state_3d [ACC_data_xfer]') - end subroutine mpas_atm_get_bdy_state_3d diff --git a/src/core_atmosphere/dynamics/mpas_atm_iau.F b/src/core_atmosphere/dynamics/mpas_atm_iau.F index 654fd3ae82..b380e3c0e8 100644 --- a/src/core_atmosphere/dynamics/mpas_atm_iau.F +++ b/src/core_atmosphere/dynamics/mpas_atm_iau.F @@ -13,9 +13,20 @@ module mpas_atm_iau use mpas_dmpar use mpas_constants use mpas_log, only : mpas_log_write + use mpas_timer !public :: atm_compute_iau_coef, atm_add_tend_anal_incr + + #ifdef MPAS_OPENACC + #define MPAS_ACC_TIMER_START(X) call mpas_timer_start(X) + #define MPAS_ACC_TIMER_STOP(X) call mpas_timer_stop(X) + #else + #define MPAS_ACC_TIMER_START(X) + #define MPAS_ACC_TIMER_STOP(X) + #endif + + contains !================================================================================================== @@ -137,6 +148,7 @@ subroutine atm_add_tend_anal_incr (configs, structs, itimestep, dt, tend_ru, ten call mpas_pool_get_array(state, 'scalars', scalars, 1) call mpas_pool_get_array(state, 'rho_zz', rho_zz, 2) call mpas_pool_get_array(diag , 'rho_edge', rho_edge) + !$acc update self(theta_m, scalars, rho_zz, rho_edge) call mpas_pool_get_dimension(state, 'moist_start', moist_start) call mpas_pool_get_dimension(state, 'moist_end', moist_end) @@ -149,6 +161,8 @@ subroutine atm_add_tend_anal_incr (configs, structs, itimestep, dt, tend_ru, ten ! call mpas_pool_get_array(tend, 'rho_zz', tend_rho) ! call mpas_pool_get_array(tend, 'theta_m', tend_theta) call mpas_pool_get_array(tend, 'scalars_tend', tend_scalars) + !$acc update self(tend_scalars) + MPAS_ACC_TIMER_STOP('atm_srk3: physics ACC_data_xfer') call mpas_pool_get_array(tend_iau, 'theta', theta_amb) call mpas_pool_get_array(tend_iau, 'rho', rho_amb) diff --git a/src/core_atmosphere/dynamics/mpas_atm_time_integration.F b/src/core_atmosphere/dynamics/mpas_atm_time_integration.F index 4fe2faefc4..de3565637b 100644 --- a/src/core_atmosphere/dynamics/mpas_atm_time_integration.F +++ b/src/core_atmosphere/dynamics/mpas_atm_time_integration.F @@ -272,6 +272,8 @@ subroutine mpas_atm_dynamics_init(domain) real (kind=RKIND), dimension(:), pointer :: angleEdge real (kind=RKIND), dimension(:), pointer :: meshScalingDel2 real (kind=RKIND), dimension(:), pointer :: meshScalingDel4 + real (kind=RKIND), dimension(:), pointer :: u_init, v_init, qv_init + real (kind=RKIND), dimension(:,:), pointer :: t_init #endif #ifdef MPAS_CAM_DYCORE @@ -292,6 +294,7 @@ subroutine mpas_atm_dynamics_init(domain) nullify(mesh) call mpas_pool_get_subpool(domain % blocklist % structs, 'mesh', mesh) + MPAS_ACC_TIMER_START('mpas_dynamics_init [ACC_data_xfer]') call mpas_pool_get_array(mesh, 'dvEdge', dvEdge) !$acc enter data copyin(dvEdge) @@ -456,9 +459,904 @@ subroutine mpas_atm_dynamics_init(domain) call mpas_pool_get_array(mesh, 'meshScalingDel4', meshScalingDel4) !$acc enter data copyin(meshScalingDel4) + + call mpas_pool_get_array(mesh, 'u_init', u_init) + !$acc enter data copyin(u_init) + call mpas_pool_get_array(mesh, 'v_init', v_init) + !$acc enter data copyin(v_init) + call mpas_pool_get_array(mesh, 't_init', t_init) + !$acc enter data copyin(t_init) + call mpas_pool_get_array(mesh, 'qv_init', qv_init) + !$acc enter data copyin(qv_init) + + MPAS_ACC_TIMER_STOP('mpas_dynamics_init [ACC_data_xfer]') +#endif + + end subroutine mpas_atm_dynamics_init + + subroutine mpas_atm_pre_computesolvediag_h2d(block) + + implicit none + + type (block_type), intent(inout) :: block + + +#ifdef MPAS_OPENACC + type (mpas_pool_type), pointer :: mesh + type (mpas_pool_type), pointer :: diag + type (mpas_pool_type), pointer :: state + type (mpas_pool_type), pointer :: tend_physics + real (kind=RKIND), dimension(:,:), pointer :: rthdynten + + real (kind=RKIND), dimension(:,:), pointer :: h_edge, v, vorticity, ke, pv_edge, & + pv_vertex, pv_cell, gradPVn, gradPVt, divergence + real (kind=RKIND), dimension(:,:), pointer :: u, h + + real (kind=RKIND), dimension(:,:), pointer :: zz + real (kind=RKIND), dimension(:,:,:), pointer :: zb_cell + real (kind=RKIND), dimension(:,:,:), pointer :: zb3_cell + real (kind=RKIND), dimension(:), pointer :: fzm + real (kind=RKIND), dimension(:), pointer :: fzp + real (kind=RKIND), dimension(:,:,:), pointer :: zb + real (kind=RKIND), dimension(:,:,:), pointer :: zb3 + + + real (kind=RKIND), dimension(:), pointer :: dvEdge + integer, dimension(:,:), pointer :: cellsOnCell + integer, dimension(:,:), pointer :: cellsOnEdge + integer, dimension(:,:), pointer :: advCellsForEdge + integer, dimension(:,:), pointer :: edgesOnCell + integer, dimension(:), pointer :: nAdvCellsForEdge + integer, dimension(:), pointer :: nEdgesOnCell + real (kind=RKIND), dimension(:,:), pointer :: adv_coefs + real (kind=RKIND), dimension(:,:), pointer :: adv_coefs_3rd + real (kind=RKIND), dimension(:,:), pointer :: edgesOnCell_sign + real (kind=RKIND), dimension(:), pointer :: invAreaCell + integer, dimension(:), pointer :: bdyMaskCell + integer, dimension(:), pointer :: bdyMaskEdge + real (kind=RKIND), dimension(:), pointer :: specZoneMaskEdge + real (kind=RKIND), dimension(:), pointer :: invDvEdge + real (kind=RKIND), dimension(:), pointer :: dcEdge + real (kind=RKIND), dimension(:), pointer :: invDcEdge + integer, dimension(:,:), pointer :: edgesOnEdge + integer, dimension(:,:), pointer :: edgesOnVertex + real (kind=RKIND), dimension(:,:), pointer :: edgesOnVertex_sign + integer, dimension(:), pointer :: nEdgesOnEdge + real (kind=RKIND), dimension(:,:), pointer :: weightsOnEdge + integer, dimension(:,:), pointer :: cellsOnVertex + integer, dimension(:,:), pointer :: verticesOnCell + integer, dimension(:,:), pointer :: verticesOnEdge + real (kind=RKIND), dimension(:), pointer :: invAreaTriangle + integer, dimension(:,:), pointer :: kiteForCell + real (kind=RKIND), dimension(:,:), pointer :: kiteAreasOnVertex + real (kind=RKIND), dimension(:), pointer :: fEdge + real (kind=RKIND), dimension(:), pointer :: fVertex + + nullify(mesh) + call mpas_pool_get_subpool(block % structs, 'mesh', mesh) + nullify(state) + call mpas_pool_get_subpool(block % structs, 'state', state) + nullify(diag) + call mpas_pool_get_subpool(block % structs, 'diag', diag) + + MPAS_ACC_TIMER_START('first_compute_solve_diagnostics [ACC_data_xfer]') + call mpas_pool_get_array(state, 'rho_zz', h, 1) + !$acc enter data create(h) + call mpas_pool_get_array(state, 'u', u, 1) + !$acc enter data copyin(u) + + call mpas_pool_get_array(diag, 'v', v) + !$acc enter data copyin(v) + call mpas_pool_get_array(diag, 'rho_edge', h_edge) + !$acc enter data copyin(h_edge) + call mpas_pool_get_array(diag, 'vorticity', vorticity) + !$acc enter data copyin(vorticity) + call mpas_pool_get_array(diag, 'divergence', divergence) + !$acc enter data copyin(divergence) + call mpas_pool_get_array(diag, 'ke', ke) + !$acc enter data copyin(ke) + call mpas_pool_get_array(diag, 'pv_edge', pv_edge) + !$acc enter data copyin(pv_edge) + call mpas_pool_get_array(diag, 'pv_vertex', pv_vertex) + !$acc enter data copyin(pv_vertex) + call mpas_pool_get_array(diag, 'pv_cell', pv_cell) + !$acc enter data copyin(pv_cell) + call mpas_pool_get_array(diag, 'gradPVn', gradPVn) + !$acc enter data copyin(gradPVn) + call mpas_pool_get_array(diag, 'gradPVt', gradPVt) + !$acc enter data copyin(gradPVt) + + ! Required by atm_init_coupled_diagnostics + call mpas_pool_get_array(mesh, 'zz', zz) + !$acc enter data copyin(zz) + + call mpas_pool_get_array(mesh, 'zb_cell', zb_cell) + !$acc enter data copyin(zb_cell) + + call mpas_pool_get_array(mesh, 'zb3_cell', zb3_cell) + !$acc enter data copyin(zb3_cell) + + call mpas_pool_get_array(mesh, 'fzm', fzm) + !$acc enter data copyin(fzm) + + call mpas_pool_get_array(mesh, 'fzp', fzp) + !$acc enter data copyin(fzp) + + call mpas_pool_get_array(mesh, 'zb', zb) + !$acc enter data copyin(zb) + + call mpas_pool_get_array(mesh, 'zb3', zb3) + !$acc enter data copyin(zb3) + + ! Required by atm_compute_solve_diagnostics + call mpas_pool_get_array(mesh, 'dvEdge', dvEdge) + !$acc enter data copyin(dvEdge) + + call mpas_pool_get_array(mesh, 'cellsOnEdge', cellsOnEdge) + !$acc enter data copyin(cellsOnEdge) + + call mpas_pool_get_array(mesh, 'edgesOnCell', edgesOnCell) + !$acc enter data copyin(edgesOnCell) + + call mpas_pool_get_array(mesh, 'nEdgesOnCell', nEdgesOnCell) + !$acc enter data copyin(nEdgesOnCell) + + call mpas_pool_get_array(mesh, 'edgesOnCell_sign', edgesOnCell_sign) + !$acc enter data copyin(edgesOnCell_sign) + + call mpas_pool_get_array(mesh, 'invAreaCell', invAreaCell) + !$acc enter data copyin(invAreaCell) + + call mpas_pool_get_array(mesh, 'invDvEdge', invDvEdge) + !$acc enter data copyin(invDvEdge) + + call mpas_pool_get_array(mesh, 'dcEdge', dcEdge) + !$acc enter data copyin(dcEdge) + + call mpas_pool_get_array(mesh, 'invDcEdge', invDcEdge) + !$acc enter data copyin(invDcEdge) + + call mpas_pool_get_array(mesh, 'edgesOnEdge', edgesOnEdge) + !$acc enter data copyin(edgesOnEdge) + + call mpas_pool_get_array(mesh, 'edgesOnVertex', edgesOnVertex) + !$acc enter data copyin(edgesOnVertex) + + call mpas_pool_get_array(mesh, 'edgesOnVertex_sign', edgesOnVertex_sign) + !$acc enter data copyin(edgesOnVertex_sign) + + call mpas_pool_get_array(mesh, 'nEdgesOnEdge', nEdgesOnEdge) + !$acc enter data copyin(nEdgesOnEdge) + + call mpas_pool_get_array(mesh, 'weightsOnEdge', weightsOnEdge) + !$acc enter data copyin(weightsOnEdge) + + call mpas_pool_get_array(mesh, 'verticesOnCell', verticesOnCell) + !$acc enter data copyin(verticesOnCell) + + call mpas_pool_get_array(mesh, 'verticesOnEdge', verticesOnEdge) + !$acc enter data copyin(verticesOnEdge) + + call mpas_pool_get_array(mesh, 'invAreaTriangle', invAreaTriangle) + !$acc enter data copyin(invAreaTriangle) + + call mpas_pool_get_array(mesh, 'kiteForCell', kiteForCell) + !$acc enter data copyin(kiteForCell) + + call mpas_pool_get_array(mesh, 'kiteAreasOnVertex', kiteAreasOnVertex) + !$acc enter data copyin(kiteAreasOnVertex) + + call mpas_pool_get_array(mesh, 'fVertex', fVertex) + !$acc enter data copyin(fVertex) + + MPAS_ACC_TIMER_STOP('first_compute_solve_diagnostics [ACC_data_xfer]') +#endif + + end subroutine mpas_atm_pre_computesolvediag_h2d + + + subroutine mpas_atm_post_computesolvediag_d2h(block) + + implicit none + + type (block_type), intent(inout) :: block + + +#ifdef MPAS_OPENACC + type (mpas_pool_type), pointer :: mesh + type (mpas_pool_type), pointer :: diag + type (mpas_pool_type), pointer :: state + type (mpas_pool_type), pointer :: tend_physics + real (kind=RKIND), dimension(:,:), pointer :: rthdynten + + real (kind=RKIND), dimension(:,:), pointer :: h_edge, v, vorticity, ke, pv_edge, & + pv_vertex, pv_cell, gradPVn, gradPVt, divergence + real (kind=RKIND), dimension(:,:), pointer :: u, h + + real (kind=RKIND), dimension(:,:), pointer :: zz + real (kind=RKIND), dimension(:,:,:), pointer :: zb_cell + real (kind=RKIND), dimension(:,:,:), pointer :: zb3_cell + real (kind=RKIND), dimension(:), pointer :: fzm + real (kind=RKIND), dimension(:), pointer :: fzp + real (kind=RKIND), dimension(:,:,:), pointer :: zb + real (kind=RKIND), dimension(:,:,:), pointer :: zb3 + + + real (kind=RKIND), dimension(:), pointer :: dvEdge + integer, dimension(:,:), pointer :: cellsOnCell + integer, dimension(:,:), pointer :: cellsOnEdge + integer, dimension(:,:), pointer :: advCellsForEdge + integer, dimension(:,:), pointer :: edgesOnCell + integer, dimension(:), pointer :: nAdvCellsForEdge + integer, dimension(:), pointer :: nEdgesOnCell + real (kind=RKIND), dimension(:,:), pointer :: adv_coefs + real (kind=RKIND), dimension(:,:), pointer :: adv_coefs_3rd + real (kind=RKIND), dimension(:,:), pointer :: edgesOnCell_sign + real (kind=RKIND), dimension(:), pointer :: invAreaCell + integer, dimension(:), pointer :: bdyMaskCell + integer, dimension(:), pointer :: bdyMaskEdge + real (kind=RKIND), dimension(:), pointer :: specZoneMaskEdge + real (kind=RKIND), dimension(:), pointer :: invDvEdge + real (kind=RKIND), dimension(:), pointer :: dcEdge + real (kind=RKIND), dimension(:), pointer :: invDcEdge + integer, dimension(:,:), pointer :: edgesOnEdge + integer, dimension(:,:), pointer :: edgesOnVertex + real (kind=RKIND), dimension(:,:), pointer :: edgesOnVertex_sign + integer, dimension(:), pointer :: nEdgesOnEdge + real (kind=RKIND), dimension(:,:), pointer :: weightsOnEdge + integer, dimension(:,:), pointer :: cellsOnVertex + integer, dimension(:,:), pointer :: verticesOnCell + integer, dimension(:,:), pointer :: verticesOnEdge + real (kind=RKIND), dimension(:), pointer :: invAreaTriangle + integer, dimension(:,:), pointer :: kiteForCell + real (kind=RKIND), dimension(:,:), pointer :: kiteAreasOnVertex + real (kind=RKIND), dimension(:), pointer :: fEdge + real (kind=RKIND), dimension(:), pointer :: fVertex + + nullify(mesh) + call mpas_pool_get_subpool(block % structs, 'mesh', mesh) + nullify(state) + call mpas_pool_get_subpool(block % structs, 'state', state) + nullify(diag) + call mpas_pool_get_subpool(block % structs, 'diag', diag) + + MPAS_ACC_TIMER_START('first_compute_solve_diagnostics [ACC_data_xfer]') + + call mpas_pool_get_array(state, 'rho_zz', h, 1) + !$acc exit data copyout(h) + call mpas_pool_get_array(state, 'u', u, 1) + !$acc exit data copyout(u) + + call mpas_pool_get_array(diag, 'v', v) + !$acc exit data copyout(v) + call mpas_pool_get_array(diag, 'rho_edge', h_edge) + !$acc exit data copyout(h_edge) + call mpas_pool_get_array(diag, 'vorticity', vorticity) + !$acc exit data copyout(vorticity) + call mpas_pool_get_array(diag, 'divergence', divergence) + !$acc exit data copyout(divergence) + call mpas_pool_get_array(diag, 'ke', ke) + !$acc exit data copyout(ke) + call mpas_pool_get_array(diag, 'pv_edge', pv_edge) + !$acc exit data copyout(pv_edge) + call mpas_pool_get_array(diag, 'pv_vertex', pv_vertex) + !$acc exit data copyout(pv_vertex) + call mpas_pool_get_array(diag, 'pv_cell', pv_cell) + !$acc exit data copyout(pv_cell) + call mpas_pool_get_array(diag, 'gradPVn', gradPVn) + !$acc exit data copyout(gradPVn) + call mpas_pool_get_array(diag, 'gradPVt', gradPVt) + !$acc exit data copyout(gradPVt) + + ! Required by atm_init_coupled_diagnostics + call mpas_pool_get_array(mesh, 'zz', zz) + !$acc exit data delete(zz) + + call mpas_pool_get_array(mesh, 'zb_cell', zb_cell) + !$acc exit data delete(zb_cell) + + call mpas_pool_get_array(mesh, 'zb3_cell', zb3_cell) + !$acc exit data delete(zb3_cell) + + call mpas_pool_get_array(mesh, 'fzm', fzm) + !$acc exit data delete(fzm) + + call mpas_pool_get_array(mesh, 'fzp', fzp) + !$acc exit data delete(fzp) + + call mpas_pool_get_array(mesh, 'zb', zb) + !$acc exit data delete(zb) + + call mpas_pool_get_array(mesh, 'zb3', zb3) + !$acc exit data delete(zb3) + + + call mpas_pool_get_array(mesh, 'dvEdge', dvEdge) + !$acc exit data delete(dvEdge) + + call mpas_pool_get_array(mesh, 'cellsOnEdge', cellsOnEdge) + !$acc exit data delete(cellsOnEdge) + + call mpas_pool_get_array(mesh, 'edgesOnCell', edgesOnCell) + !$acc exit data delete(edgesOnCell) + + call mpas_pool_get_array(mesh, 'nEdgesOnCell', nEdgesOnCell) + !$acc exit data delete(nEdgesOnCell) + + call mpas_pool_get_array(mesh, 'edgesOnCell_sign', edgesOnCell_sign) + !$acc exit data delete(edgesOnCell_sign) + + call mpas_pool_get_array(mesh, 'invAreaCell', invAreaCell) + !$acc exit data delete(invAreaCell) + + call mpas_pool_get_array(mesh, 'invDvEdge', invDvEdge) + !$acc exit data delete(invDvEdge) + + call mpas_pool_get_array(mesh, 'dcEdge', dcEdge) + !$acc exit data delete(dcEdge) + + call mpas_pool_get_array(mesh, 'invDcEdge', invDcEdge) + !$acc exit data delete(invDcEdge) + + call mpas_pool_get_array(mesh, 'edgesOnEdge', edgesOnEdge) + !$acc exit data delete(edgesOnEdge) + + call mpas_pool_get_array(mesh, 'edgesOnVertex', edgesOnVertex) + !$acc exit data delete(edgesOnVertex) + + call mpas_pool_get_array(mesh, 'edgesOnVertex_sign', edgesOnVertex_sign) + !$acc exit data delete(edgesOnVertex_sign) + + call mpas_pool_get_array(mesh, 'nEdgesOnEdge', nEdgesOnEdge) + !$acc exit data delete(nEdgesOnEdge) + + call mpas_pool_get_array(mesh, 'weightsOnEdge', weightsOnEdge) + !$acc exit data delete(weightsOnEdge) + + call mpas_pool_get_array(mesh, 'verticesOnCell', verticesOnCell) + !$acc exit data delete(verticesOnCell) + + call mpas_pool_get_array(mesh, 'verticesOnEdge', verticesOnEdge) + !$acc exit data delete(verticesOnEdge) + + call mpas_pool_get_array(mesh, 'invAreaTriangle', invAreaTriangle) + !$acc exit data delete(invAreaTriangle) + + call mpas_pool_get_array(mesh, 'kiteForCell', kiteForCell) + !$acc exit data delete(kiteForCell) + + call mpas_pool_get_array(mesh, 'kiteAreasOnVertex', kiteAreasOnVertex) + !$acc exit data delete(kiteAreasOnVertex) + + call mpas_pool_get_array(mesh, 'fVertex', fVertex) + !$acc exit data delete(fVertex) + + MPAS_ACC_TIMER_STOP('first_compute_solve_diagnostics [ACC_data_xfer]') +#endif + + end subroutine mpas_atm_post_computesolvediag_d2h + + subroutine mpas_atm_pre_dynamics_h2d(domain) + + implicit none + + type (domain_type), intent(inout) :: domain + + +#ifdef MPAS_OPENACC + type (mpas_pool_type), pointer :: state + type (mpas_pool_type), pointer :: diag + type (mpas_pool_type), pointer :: tend + type (mpas_pool_type), pointer :: tend_physics + type (mpas_pool_type), pointer :: lbc + + + real (kind=RKIND), dimension(:,:), pointer :: ru, ru_p + real (kind=RKIND), dimension(:,:), pointer :: ru_save + real (kind=RKIND), dimension(:,:), pointer :: rw, rw_p + real (kind=RKIND), dimension(:,:), pointer :: rw_save + real (kind=RKIND), dimension(:,:), pointer :: rtheta_p + real (kind=RKIND), dimension(:,:), pointer :: exner, exner_base + real (kind=RKIND), dimension(:,:), pointer :: rtheta_base, rho_base + real (kind=RKIND), dimension(:,:), pointer :: rtheta_p_save + real (kind=RKIND), dimension(:,:), pointer :: rho_p, rho_pp, rho, theta, theta_base + real (kind=RKIND), dimension(:,:), pointer :: rho_p_save + real (kind=RKIND), dimension(:,:), pointer :: rho_zz_old_split + real (kind=RKIND), dimension(:,:), pointer :: cqw, rtheta_pp_old, rtheta_pp + real (kind=RKIND), dimension(:,:), pointer :: cqu, pressure_base, pressure_p, pressure, v + real (kind=RKIND), dimension(:,:), pointer :: kdiff, pv_edge, pv_vertex, pv_cell, rho_edge, h_divergence, ke + real (kind=RKIND), dimension(:,:), pointer :: cofwr, cofwz, coftz, cofwt, a_tri, alpha_tri, gamma_tri + real (kind=RKIND), dimension(:), pointer :: cofrz + real (kind=RKIND), dimension(:,:), pointer :: gradPVn, gradPVt + + + real (kind=RKIND), dimension(:,:), pointer :: u_1, u_2 + real (kind=RKIND), dimension(:,:), pointer :: w_1, w_2 + real (kind=RKIND), dimension(:,:), pointer :: theta_m_1, theta_m_2 + real (kind=RKIND), dimension(:,:), pointer :: rho_zz_1, rho_zz_2 + real (kind=RKIND), dimension(:,:,:), pointer :: scalars_1, scalars_2 + real (kind=RKIND), dimension(:,:), pointer :: ruAvg, wwAvg, ruAvg_split, wwAvg_split + + real (kind=RKIND), dimension(:,:), pointer :: tend_ru, tend_rt, tend_rho, tend_rw, rt_diabatic_tend + real (kind=RKIND), dimension(:,:), pointer :: tend_u_euler, tend_w_euler, tend_theta_euler + real(kind=RKIND), dimension(:,:), pointer :: tend_w_pgf, tend_w_buoy + real(kind=RKIND), dimension(:,:,:), pointer :: scalar_tend_save + + real (kind=RKIND), dimension(:,:), pointer :: rthdynten, divergence, vorticity + + real (kind=RKIND), dimension(:,:), pointer :: lbc_u, lbc_w, lbc_ru, lbc_rho_edge, lbc_rho, lbc_rtheta_m, lbc_rho_zz, lbc_theta + real (kind=RKIND), dimension(:,:), pointer :: lbc_tend_u, lbc_tend_w, lbc_tend_ru, lbc_tend_rho_edge, lbc_tend_rho + real (kind=RKIND), dimension(:,:), pointer :: lbc_tend_rtheta_m, lbc_tend_rho_zz, lbc_tend_theta + + real (kind=RKIND), dimension(:,:,:), pointer :: lbc_scalars, lbc_tend_scalars + + nullify(state) + nullify(diag) + nullify(tend) + nullify(tend_physics) + nullify(lbc) + call mpas_pool_get_subpool(domain % blocklist % structs, 'state', state) + call mpas_pool_get_subpool(domain % blocklist % structs, 'diag', diag) + call mpas_pool_get_subpool(domain % blocklist % structs, 'tend', tend) + call mpas_pool_get_subpool(domain % blocklist % structs, 'tend_physics', tend_physics) + call mpas_pool_get_subpool(domain % blocklist % structs, 'lbc', lbc) + + MPAS_ACC_TIMER_START('atm_srk3 [ACC_data_xfer]') + call mpas_pool_get_array(diag, 'ru', ru) + !$acc enter data copyin(ru) ! use values from atm_init_coupled_diagnostics + call mpas_pool_get_array(diag, 'ru_p', ru_p) + !$acc enter data copyin(ru_p) + call mpas_pool_get_array(diag, 'ru_save', ru_save) + !$acc enter data copyin(ru_save) + call mpas_pool_get_array(diag, 'rw', rw) + !$acc enter data copyin(rw) ! use values from atm_init_coupled_diagnostics + call mpas_pool_get_array(diag, 'rw_p', rw_p) + !$acc enter data copyin(rw_p) + call mpas_pool_get_array(diag, 'rw_save', rw_save) + !$acc enter data copyin(rw_save) + call mpas_pool_get_array(diag, 'rtheta_p', rtheta_p) + !$acc enter data copyin(rtheta_p) ! use values from atm_init_coupled_diagnostics + call mpas_pool_get_array(diag, 'rtheta_p_save', rtheta_p_save) + !$acc enter data copyin(rtheta_p_save) + call mpas_pool_get_array(diag, 'exner', exner) + !$acc enter data copyin(exner) ! use values from atm_init_coupled_diagnostics + call mpas_pool_get_array(diag, 'exner_base', exner_base) + !$acc enter data copyin(exner_base) ! use values from atm_init_coupled_diagnostics + call mpas_pool_get_array(diag, 'rtheta_base', rtheta_base) + !$acc enter data copyin(rtheta_base) ! use values from atm_init_coupled_diagnostics + call mpas_pool_get_array(diag, 'rho_base', rho_base) + !$acc enter data copyin(rho_base) + call mpas_pool_get_array(diag, 'rho', rho) + !$acc enter data copyin(rho) + call mpas_pool_get_array(diag, 'theta', theta) + !$acc enter data copyin(theta) + call mpas_pool_get_array(diag, 'theta_base', theta_base) + !$acc enter data copyin(theta_base) + call mpas_pool_get_array(diag, 'rho_p', rho_p) + !$acc enter data copyin(rho_p) ! use values from atm_init_coupled_diagnostics + call mpas_pool_get_array(diag, 'rho_p_save', rho_p_save) + !$acc enter data copyin(rho_p_save) + call mpas_pool_get_array(diag, 'rho_pp', rho_pp) + !$acc enter data copyin(rho_pp) + call mpas_pool_get_array(diag, 'rho_zz_old_split', rho_zz_old_split) + !$acc enter data copyin(rho_zz_old_split) + call mpas_pool_get_array(diag, 'cqw', cqw) + !$acc enter data copyin(cqw) + call mpas_pool_get_array(diag, 'cqu', cqu) + !$acc enter data copyin(cqu) + call mpas_pool_get_array(diag, 'pressure_p', pressure_p) + !$acc enter data copyin(pressure_p) ! use values from atm_init_coupled_diagnostics + call mpas_pool_get_array(diag, 'pressure_base', pressure_base) + !$acc enter data copyin(pressure_base) ! use values from atm_init_coupled_diagnostics + call mpas_pool_get_array(diag, 'pressure', pressure) + !$acc enter data copyin(pressure) + call mpas_pool_get_array(diag, 'v', v) + !$acc enter data copyin(v) ! use values from atm_compute_solve_diagnostics + call mpas_pool_get_array(diag, 'rtheta_pp', rtheta_pp) + !$acc enter data copyin(rtheta_pp) + call mpas_pool_get_array(diag, 'rtheta_pp_old', rtheta_pp_old) + !$acc enter data copyin(rtheta_pp_old) + call mpas_pool_get_array(diag, 'kdiff', kdiff) + !$acc enter data copyin(kdiff) + call mpas_pool_get_array(diag, 'pv_edge', pv_edge) + !$acc enter data copyin(pv_edge) ! use values from atm_compute_solve_diagnostics + call mpas_pool_get_array(diag, 'pv_vertex', pv_vertex) + !$acc enter data copyin(pv_vertex) + call mpas_pool_get_array(diag, 'pv_cell', pv_cell) + !$acc enter data copyin(pv_cell) + call mpas_pool_get_array(diag, 'rho_edge', rho_edge) + !$acc enter data copyin(rho_edge) ! use values from atm_compute_solve_diagnostics + call mpas_pool_get_array(diag, 'h_divergence', h_divergence) + !$acc enter data copyin(h_divergence) + call mpas_pool_get_array(diag, 'ke', ke) + !$acc enter data copyin(ke) ! use values from atm_compute_solve_diagnostics + call mpas_pool_get_array(diag, 'gradPVn', gradPVn) + !$acc enter data copyin(gradPVn) + call mpas_pool_get_array(diag, 'gradPVt', gradPVt) + !$acc enter data copyin(gradPVt) + + call mpas_pool_get_array(diag, 'alpha_tri', alpha_tri) + !$acc enter data copyin(alpha_tri) + call mpas_pool_get_array(diag, 'gamma_tri', gamma_tri) + !$acc enter data copyin(gamma_tri) + call mpas_pool_get_array(diag, 'a_tri', a_tri) + !$acc enter data copyin(a_tri) + call mpas_pool_get_array(diag, 'cofwr', cofwr) + !$acc enter data copyin(cofwr) + call mpas_pool_get_array(diag, 'cofwz', cofwz) + !$acc enter data copyin(cofwz) + call mpas_pool_get_array(diag, 'coftz', coftz) + !$acc enter data copyin(coftz) + call mpas_pool_get_array(diag, 'cofwt', cofwt) + !$acc enter data copyin(cofwt) + call mpas_pool_get_array(diag, 'cofrz', cofrz) + !$acc enter data copyin(cofrz) + call mpas_pool_get_array(diag, 'vorticity', vorticity) + !$acc enter data copyin(vorticity) + call mpas_pool_get_array(diag, 'divergence', divergence) + !$acc enter data copyin(divergence) + call mpas_pool_get_array(diag, 'ruAvg', ruAvg) + !$acc enter data copyin(ruAvg) + call mpas_pool_get_array(diag, 'ruAvg_split', ruAvg_split) + !$acc enter data copyin(ruAvg_split) + call mpas_pool_get_array(diag, 'wwAvg', wwAvg) + !$acc enter data copyin(wwAvg) + call mpas_pool_get_array(diag, 'wwAvg_split', wwAvg_split) + !$acc enter data copyin(wwAvg_split) + + call mpas_pool_get_array(state, 'u', u_1, 1) + !$acc enter data copyin(u_1) + call mpas_pool_get_array(state, 'u', u_2, 2) + !$acc enter data copyin(u_2) + call mpas_pool_get_array(state, 'w', w_1, 1) + !$acc enter data copyin(w_1) + call mpas_pool_get_array(state, 'w', w_2, 2) + !$acc enter data copyin(w_2) + call mpas_pool_get_array(state, 'theta_m', theta_m_1, 1) + !$acc enter data copyin(theta_m_1) ! use values from atm_init_coupled_diagnostics + call mpas_pool_get_array(state, 'theta_m', theta_m_2, 2) + !$acc enter data copyin(theta_m_2) + call mpas_pool_get_array(state, 'rho_zz', rho_zz_1, 1) + !$acc enter data copyin(rho_zz_1) + call mpas_pool_get_array(state, 'rho_zz', rho_zz_2, 2) + !$acc enter data copyin(rho_zz_2) + call mpas_pool_get_array(state, 'scalars', scalars_1, 1) + !$acc enter data copyin(scalars_1) + call mpas_pool_get_array(state, 'scalars', scalars_2, 2) + !$acc enter data copyin(scalars_2) + + + call mpas_pool_get_array(tend, 'u', tend_ru) + !$acc enter data copyin(tend_ru) + call mpas_pool_get_array(tend, 'rho_zz', tend_rho) + !$acc enter data copyin(tend_rho) + call mpas_pool_get_array(tend, 'theta_m', tend_rt) + !$acc enter data copyin(tend_rt) + call mpas_pool_get_array(tend, 'w', tend_rw) + !$acc enter data copyin(tend_rw) + call mpas_pool_get_array(tend, 'rt_diabatic_tend', rt_diabatic_tend) + !$acc enter data copyin(rt_diabatic_tend) + call mpas_pool_get_array(tend, 'u_euler', tend_u_euler) + !$acc enter data copyin(tend_u_euler) + call mpas_pool_get_array(tend, 'theta_euler', tend_theta_euler) + !$acc enter data copyin(tend_theta_euler) + call mpas_pool_get_array(tend, 'w_euler', tend_w_euler) + !$acc enter data copyin(tend_w_euler) + call mpas_pool_get_array(tend, 'w_pgf', tend_w_pgf) + !$acc enter data copyin(tend_w_pgf) + call mpas_pool_get_array(tend, 'w_buoy', tend_w_buoy) + !$acc enter data copyin(tend_w_buoy) + call mpas_pool_get_array(tend, 'scalars_tend', scalar_tend_save) + !$acc enter data copyin(scalar_tend_save) + + + call mpas_pool_get_array(lbc, 'lbc_u', lbc_u, 2) + !$acc enter data copyin(lbc_u) + call mpas_pool_get_array(lbc, 'lbc_w', lbc_w, 2) + !$acc enter data copyin(lbc_w) + call mpas_pool_get_array(lbc, 'lbc_ru', lbc_ru, 2) + !$acc enter data copyin(lbc_ru) + call mpas_pool_get_array(lbc, 'lbc_rho_edge', lbc_rho_edge, 2) + !$acc enter data copyin(lbc_rho_edge) + call mpas_pool_get_array(lbc, 'lbc_theta', lbc_theta, 2) + !$acc enter data copyin(lbc_theta) + call mpas_pool_get_array(lbc, 'lbc_rtheta_m', lbc_rtheta_m, 2) + !$acc enter data copyin(lbc_rtheta_m) + call mpas_pool_get_array(lbc, 'lbc_rho_zz', lbc_rho_zz, 2) + !$acc enter data copyin(lbc_rho_zz) + call mpas_pool_get_array(lbc, 'lbc_rho', lbc_rho, 2) + !$acc enter data copyin(lbc_rho) + call mpas_pool_get_array(lbc, 'lbc_scalars', lbc_scalars, 2) + !$acc enter data copyin(lbc_scalars) + + + call mpas_pool_get_array(lbc, 'lbc_u', lbc_tend_u, 1) + !$acc enter data copyin(lbc_tend_u) + call mpas_pool_get_array(lbc, 'lbc_ru', lbc_tend_ru, 1) + !$acc enter data copyin(lbc_tend_ru) + call mpas_pool_get_array(lbc, 'lbc_rho_edge', lbc_tend_rho_edge, 1) + !$acc enter data copyin(lbc_tend_rho_edge) + call mpas_pool_get_array(lbc, 'lbc_w', lbc_tend_w, 1) + !$acc enter data copyin(lbc_tend_w) + call mpas_pool_get_array(lbc, 'lbc_theta', lbc_tend_theta, 1) + !$acc enter data copyin(lbc_tend_theta) + call mpas_pool_get_array(lbc, 'lbc_rtheta_m', lbc_tend_rtheta_m, 1) + !$acc enter data copyin(lbc_tend_rtheta_m) + call mpas_pool_get_array(lbc, 'lbc_rho_zz', lbc_tend_rho_zz, 1) + !$acc enter data copyin(lbc_tend_rho_zz) + call mpas_pool_get_array(lbc, 'lbc_rho', lbc_tend_rho, 1) + !$acc enter data copyin(lbc_tend_rho) + call mpas_pool_get_array(lbc, 'lbc_scalars', lbc_tend_scalars, 1) + !$acc enter data copyin(lbc_tend_scalars) + + call mpas_pool_get_array(tend_physics, 'rthdynten', rthdynten) + !$acc enter data copyin(rthdynten) + + MPAS_ACC_TIMER_STOP('atm_srk3 [ACC_data_xfer]') #endif - end subroutine mpas_atm_dynamics_init + end subroutine mpas_atm_pre_dynamics_h2d + + + subroutine mpas_atm_post_dynamics_d2h(domain) + + implicit none + + type (domain_type), intent(inout) :: domain + + +#ifdef MPAS_OPENACC + type (mpas_pool_type), pointer :: state + type (mpas_pool_type), pointer :: diag + type (mpas_pool_type), pointer :: tend + type (mpas_pool_type), pointer :: tend_physics + type (mpas_pool_type), pointer :: lbc + + + real (kind=RKIND), dimension(:,:), pointer :: ru, ru_p + real (kind=RKIND), dimension(:,:), pointer :: ru_save + real (kind=RKIND), dimension(:,:), pointer :: rw, rw_p + real (kind=RKIND), dimension(:,:), pointer :: rw_save + real (kind=RKIND), dimension(:,:), pointer :: rtheta_p + real (kind=RKIND), dimension(:,:), pointer :: exner, exner_base + real (kind=RKIND), dimension(:,:), pointer :: rtheta_base, rho_base + real (kind=RKIND), dimension(:,:), pointer :: rtheta_p_save + real (kind=RKIND), dimension(:,:), pointer :: rho_p, rho_pp, rho, theta, theta_base + real (kind=RKIND), dimension(:,:), pointer :: rho_p_save + real (kind=RKIND), dimension(:,:), pointer :: rho_zz_old_split + real (kind=RKIND), dimension(:,:), pointer :: cqw, rtheta_pp_old, rtheta_pp + real (kind=RKIND), dimension(:,:), pointer :: cqu, pressure_base, pressure_p, pressure, v + real (kind=RKIND), dimension(:,:), pointer :: kdiff, pv_edge, pv_vertex, pv_cell, rho_edge, h_divergence, ke + real (kind=RKIND), dimension(:,:), pointer :: cofwr, cofwz, coftz, cofwt, a_tri, alpha_tri, gamma_tri + real (kind=RKIND), dimension(:), pointer :: cofrz + real (kind=RKIND), dimension(:,:), pointer :: gradPVn, gradPVt + + + real (kind=RKIND), dimension(:,:), pointer :: u_1, u_2 + real (kind=RKIND), dimension(:,:), pointer :: w_1, w_2 + real (kind=RKIND), dimension(:,:), pointer :: theta_m_1, theta_m_2 + real (kind=RKIND), dimension(:,:), pointer :: rho_zz_1, rho_zz_2 + real (kind=RKIND), dimension(:,:,:), pointer :: scalars_1, scalars_2 + real (kind=RKIND), dimension(:,:), pointer :: ruAvg, wwAvg, ruAvg_split, wwAvg_split + + real (kind=RKIND), dimension(:,:), pointer :: tend_ru, tend_rt, tend_rho, tend_rw, rt_diabatic_tend + real (kind=RKIND), dimension(:,:), pointer :: tend_u_euler, tend_w_euler, tend_theta_euler + real(kind=RKIND), dimension(:,:), pointer :: tend_w_pgf, tend_w_buoy + real(kind=RKIND), dimension(:,:,:), pointer :: scalar_tend_save + + real (kind=RKIND), dimension(:,:), pointer :: rthdynten, divergence, vorticity + + real (kind=RKIND), dimension(:,:), pointer :: lbc_u, lbc_w, lbc_ru, lbc_rho_edge, lbc_rho, lbc_rtheta_m, lbc_rho_zz, lbc_theta + real (kind=RKIND), dimension(:,:), pointer :: lbc_tend_u, lbc_tend_w, lbc_tend_ru, lbc_tend_rho_edge, lbc_tend_rho + real (kind=RKIND), dimension(:,:), pointer :: lbc_tend_rtheta_m, lbc_tend_rho_zz, lbc_tend_theta + + real (kind=RKIND), dimension(:,:,:), pointer :: lbc_scalars, lbc_tend_scalars + + nullify(state) + nullify(diag) + nullify(tend) + nullify(tend_physics) + nullify(lbc) + call mpas_pool_get_subpool(domain % blocklist % structs, 'state', state) + call mpas_pool_get_subpool(domain % blocklist % structs, 'diag', diag) + call mpas_pool_get_subpool(domain % blocklist % structs, 'tend', tend) + call mpas_pool_get_subpool(domain % blocklist % structs, 'tend_physics', tend_physics) + call mpas_pool_get_subpool(domain % blocklist % structs, 'lbc', lbc) + + MPAS_ACC_TIMER_START('atm_srk3 [ACC_data_xfer]') + call mpas_pool_get_array(diag, 'ru', ru) + !$acc exit data copyout(ru) ! use values from atm_init_coupled_diagnostics + call mpas_pool_get_array(diag, 'ru_p', ru_p) + !$acc exit data copyout(ru_p) + call mpas_pool_get_array(diag, 'ru_save', ru_save) + !$acc exit data delete(ru_save) + call mpas_pool_get_array(diag, 'rw', rw) + !$acc exit data copyout(rw) ! use values from atm_init_coupled_diagnostics + call mpas_pool_get_array(diag, 'rw_p', rw_p) + !$acc exit data copyout(rw_p) + call mpas_pool_get_array(diag, 'rw_save', rw_save) + !$acc exit data delete(rw_save) + call mpas_pool_get_array(diag, 'rtheta_p', rtheta_p) + !$acc exit data copyout(rtheta_p) ! use values from atm_init_coupled_diagnostics + call mpas_pool_get_array(diag, 'rtheta_p_save', rtheta_p_save) + !$acc exit data delete(rtheta_p_save) + call mpas_pool_get_array(diag, 'exner', exner) + !$acc exit data copyout(exner) ! use values from atm_init_coupled_diagnostics + call mpas_pool_get_array(diag, 'exner_base', exner_base) + !$acc exit data copyout(exner_base) ! use values from atm_init_coupled_diagnostics + call mpas_pool_get_array(diag, 'rtheta_base', rtheta_base) + !$acc exit data copyout(rtheta_base) ! use values from atm_init_coupled_diagnostics + call mpas_pool_get_array(diag, 'rho_base', rho_base) + !$acc exit data copyout(rho_base) + call mpas_pool_get_array(diag, 'rho', rho) + !$acc exit data copyout(rho) + call mpas_pool_get_array(diag, 'theta', theta) + !$acc exit data copyout(theta) + call mpas_pool_get_array(diag, 'theta_base', theta_base) + !$acc exit data copyout(theta_base) + call mpas_pool_get_array(diag, 'rho_p', rho_p) + !$acc exit data copyout(rho_p) ! use values from atm_init_coupled_diagnostics + call mpas_pool_get_array(diag, 'rho_p_save', rho_p_save) + !$acc exit data delete(rho_p_save) + call mpas_pool_get_array(diag, 'rho_pp', rho_pp) + !$acc exit data copyout(rho_pp) + call mpas_pool_get_array(diag, 'rho_zz_old_split', rho_zz_old_split) + !$acc exit data delete(rho_zz_old_split) + call mpas_pool_get_array(diag, 'cqw', cqw) + !$acc exit data delete(cqw) + call mpas_pool_get_array(diag, 'cqu', cqu) + !$acc exit data copyout(cqu) + call mpas_pool_get_array(diag, 'pressure_p', pressure_p) + !$acc exit data copyout(pressure_p) ! use values from atm_init_coupled_diagnostics + call mpas_pool_get_array(diag, 'pressure_base', pressure_base) + !$acc exit data copyout(pressure_base) ! use values from atm_init_coupled_diagnostics + call mpas_pool_get_array(diag, 'pressure', pressure) + !$acc exit data copyout(pressure) + call mpas_pool_get_array(diag, 'v', v) + !$acc exit data copyout(v) ! use values from atm_compute_solve_diagnostics + call mpas_pool_get_array(diag, 'rtheta_pp', rtheta_pp) + !$acc exit data copyout(rtheta_pp) + call mpas_pool_get_array(diag, 'rtheta_pp_old', rtheta_pp_old) + !$acc exit data copyout(rtheta_pp_old) + call mpas_pool_get_array(diag, 'kdiff', kdiff) + !$acc exit data copyout(kdiff) + call mpas_pool_get_array(diag, 'pv_edge', pv_edge) + !$acc exit data copyout(pv_edge) ! use values from atm_compute_solve_diagnostics + call mpas_pool_get_array(diag, 'pv_vertex', pv_vertex) + !$acc exit data copyout(pv_vertex) + call mpas_pool_get_array(diag, 'pv_cell', pv_cell) + !$acc exit data delete(pv_cell) + call mpas_pool_get_array(diag, 'rho_edge', rho_edge) + !$acc exit data copyout(rho_edge) ! use values from atm_compute_solve_diagnostics + call mpas_pool_get_array(diag, 'h_divergence', h_divergence) + !$acc exit data copyout(h_divergence) + call mpas_pool_get_array(diag, 'ke', ke) + !$acc exit data copyout(ke) ! use values from atm_compute_solve_diagnostics + call mpas_pool_get_array(diag, 'gradPVn', gradPVn) + !$acc exit data delete(gradPVn) + call mpas_pool_get_array(diag, 'gradPVt', gradPVt) + !$acc exit data delete(gradPVt) + + call mpas_pool_get_array(diag, 'alpha_tri', alpha_tri) + !$acc exit data delete(alpha_tri) + call mpas_pool_get_array(diag, 'gamma_tri', gamma_tri) + !$acc exit data delete(gamma_tri) + call mpas_pool_get_array(diag, 'a_tri', a_tri) + !$acc exit data delete(a_tri) + call mpas_pool_get_array(diag, 'cofwr', cofwr) + !$acc exit data delete(cofwr) + call mpas_pool_get_array(diag, 'cofwz', cofwz) + !$acc exit data delete(cofwz) + call mpas_pool_get_array(diag, 'coftz', coftz) + !$acc exit data delete(coftz) + call mpas_pool_get_array(diag, 'cofwt', cofwt) + !$acc exit data delete(cofwt) + call mpas_pool_get_array(diag, 'cofrz', cofrz) + !$acc exit data delete(cofrz) + call mpas_pool_get_array(diag, 'vorticity', vorticity) + !$acc exit data copyout(vorticity) + call mpas_pool_get_array(diag, 'divergence', divergence) + !$acc exit data copyout(divergence) + call mpas_pool_get_array(diag, 'ruAvg', ruAvg) + !$acc exit data copyout(ruAvg) + call mpas_pool_get_array(diag, 'ruAvg_split', ruAvg_split) + !$acc exit data copyout(ruAvg_split) + call mpas_pool_get_array(diag, 'wwAvg', wwAvg) + !$acc exit data copyout(wwAvg) + call mpas_pool_get_array(diag, 'wwAvg_split', wwAvg_split) + !$acc exit data copyout(wwAvg_split) + + call mpas_pool_get_array(state, 'u', u_1, 1) + !$acc exit data copyout(u_1) + call mpas_pool_get_array(state, 'u', u_2, 2) + !$acc exit data delete(u_2) + call mpas_pool_get_array(state, 'w', w_1, 1) + !$acc exit data copyout(w_1) + call mpas_pool_get_array(state, 'w', w_2, 2) + !$acc exit data delete(w_2) + call mpas_pool_get_array(state, 'theta_m', theta_m_1, 1) + !$acc exit data copyout(theta_m_1) ! use values from atm_init_coupled_diagnostics + call mpas_pool_get_array(state, 'theta_m', theta_m_2, 2) + !$acc exit data copyout(theta_m_2) ! Delete gives incorrect results + call mpas_pool_get_array(state, 'rho_zz', rho_zz_1, 1) + !$acc exit data copyout(rho_zz_1) + call mpas_pool_get_array(state, 'rho_zz', rho_zz_2, 2) + !$acc exit data delete(rho_zz_2) + call mpas_pool_get_array(state, 'scalars', scalars_1, 1) + !$acc exit data copyout(scalars_1) + call mpas_pool_get_array(state, 'scalars', scalars_2, 2) + !$acc exit data copyout(scalars_2) ! Delete gives incorrect results + + + call mpas_pool_get_array(tend, 'u', tend_ru) + !$acc exit data copyout(tend_ru) + call mpas_pool_get_array(tend, 'rho_zz', tend_rho) + !$acc exit data copyout(tend_rho) + call mpas_pool_get_array(tend, 'theta_m', tend_rt) + !$acc exit data copyout(tend_rt) + call mpas_pool_get_array(tend, 'w', tend_rw) + !$acc exit data copyout(tend_rw) + call mpas_pool_get_array(tend, 'rt_diabatic_tend', rt_diabatic_tend) + !$acc exit data copyout(rt_diabatic_tend) + call mpas_pool_get_array(tend, 'u_euler', tend_u_euler) + !$acc exit data copyout(tend_u_euler) + call mpas_pool_get_array(tend, 'theta_euler', tend_theta_euler) + !$acc exit data copyout(tend_theta_euler) + call mpas_pool_get_array(tend, 'w_euler', tend_w_euler) + !$acc exit data copyout(tend_w_euler) + call mpas_pool_get_array(tend, 'w_pgf', tend_w_pgf) + !$acc exit data copyout(tend_w_pgf) + call mpas_pool_get_array(tend, 'w_buoy', tend_w_buoy) + !$acc exit data copyout(tend_w_buoy) + call mpas_pool_get_array(tend, 'scalars_tend', scalar_tend_save) + !$acc exit data copyout(scalar_tend_save) + + + call mpas_pool_get_array(lbc, 'lbc_u', lbc_u, 2) + !$acc exit data delete(lbc_u) + call mpas_pool_get_array(lbc, 'lbc_w', lbc_w, 2) + !$acc exit data delete(lbc_w) + call mpas_pool_get_array(lbc, 'lbc_ru', lbc_ru, 2) + !$acc exit data delete(lbc_ru) + call mpas_pool_get_array(lbc, 'lbc_rho_edge', lbc_rho_edge, 2) + !$acc exit data delete(lbc_rho_edge) + call mpas_pool_get_array(lbc, 'lbc_theta', lbc_theta, 2) + !$acc exit data delete(lbc_theta) + call mpas_pool_get_array(lbc, 'lbc_rtheta_m', lbc_rtheta_m, 2) + !$acc exit data delete(lbc_rtheta_m) + call mpas_pool_get_array(lbc, 'lbc_rho_zz', lbc_rho_zz, 2) + !$acc exit data delete(lbc_rho_zz) + call mpas_pool_get_array(lbc, 'lbc_rho', lbc_rho, 2) + !$acc exit data delete(lbc_rho) + call mpas_pool_get_array(lbc, 'lbc_scalars', lbc_scalars, 2) + !$acc exit data delete(lbc_scalars) + + + call mpas_pool_get_array(lbc, 'lbc_u', lbc_tend_u, 1) + !$acc exit data delete(lbc_tend_u) + call mpas_pool_get_array(lbc, 'lbc_ru', lbc_tend_ru, 1) + !$acc exit data delete(lbc_tend_ru) + call mpas_pool_get_array(lbc, 'lbc_rho_edge', lbc_tend_rho_edge, 1) + !$acc exit data delete(lbc_tend_rho_edge) + call mpas_pool_get_array(lbc, 'lbc_w', lbc_tend_w, 1) + !$acc exit data delete(lbc_tend_w) + call mpas_pool_get_array(lbc, 'lbc_theta', lbc_tend_theta, 1) + !$acc exit data delete(lbc_tend_theta) + call mpas_pool_get_array(lbc, 'lbc_rtheta_m', lbc_tend_rtheta_m, 1) + !$acc exit data delete(lbc_tend_rtheta_m) + call mpas_pool_get_array(lbc, 'lbc_rho_zz', lbc_tend_rho_zz, 1) + !$acc exit data delete(lbc_tend_rho_zz) + call mpas_pool_get_array(lbc, 'lbc_rho', lbc_tend_rho, 1) + !$acc exit data delete(lbc_tend_rho) + call mpas_pool_get_array(lbc, 'lbc_scalars', lbc_tend_scalars, 1) + !$acc exit data delete(lbc_tend_scalars) + + call mpas_pool_get_array(tend_physics, 'rthdynten', rthdynten) + !$acc exit data copyout(rthdynten) + MPAS_ACC_TIMER_STOP('atm_srk3 [ACC_data_xfer]') +#endif + + end subroutine mpas_atm_post_dynamics_d2h !---------------------------------------------------------------------------- @@ -774,12 +1672,14 @@ subroutine atm_timestep(domain, dt, nowTime, itimestep, exchange_halo_group) config_apply_lbcs = config_apply_lbcs_ptr + call mpas_atm_pre_dynamics_h2d(domain) if (trim(config_time_integration) == 'SRK3') then call atm_srk3(domain, dt, itimestep, exchange_halo_group) else call mpas_log_write('Unknown time integration option '//trim(config_time_integration), messageType=MPAS_LOG_ERR) call mpas_log_write('Currently, only ''SRK3'' is supported.', messageType=MPAS_LOG_CRIT) end if + call mpas_atm_post_dynamics_d2h(domain) call mpas_set_timeInterval(dtInterval, dt=dt) currTime = nowTime + dtInterval @@ -873,6 +1773,8 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) real (kind=RKIND), dimension(:,:,:), pointer :: scalars, scalars_1, scalars_2 real (kind=RKIND), dimension(:,:), pointer :: rqvdynten, rthdynten, theta_m + real (kind=RKIND), dimension(:,:), pointer :: pressure_p, rtheta_p, exner, tend_u + real (kind=RKIND), dimension(:,:), pointer :: rho_pp, rtheta_pp, ru_p, rw_p, pv_edge, rho_edge real (kind=RKIND) :: theta_local, fac_m #ifndef MPAS_CAM_DYCORE @@ -1040,7 +1942,15 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) ! ! Communicate halos for theta_m, scalars, pressure_p, and rtheta_p ! + MPAS_ACC_TIMER_START('atm_srk3: halo_exchanges + ACC_data_xfer') + call mpas_pool_get_array(state, 'theta_m', theta_m, 1) + call mpas_pool_get_array(state, 'scalars', scalars_1, 1) + call mpas_pool_get_array(diag, 'pressure_p', pressure_p) + call mpas_pool_get_array(diag, 'rtheta_p', rtheta_p) + !$acc update self(theta_m,scalars_1,pressure_p,rtheta_p) call exchange_halo_group(domain, 'dynamics:theta_m,scalars,pressure_p,rtheta_p') + !$acc update device(theta_m,scalars_1,pressure_p,rtheta_p) + MPAS_ACC_TIMER_STOP('atm_srk3: halo_exchanges + ACC_data_xfer') call mpas_timer_start('atm_rk_integration_setup') @@ -1102,6 +2012,8 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) tend_ru_physics, tend_rtheta_physics, tend_rho_physics) end if + !$acc enter data copyin(tend_rtheta_physics,tend_rho_physics,tend_ru_physics) + DYNAMICS_SUBSTEPS : do dynamics_substep = 1, dynamics_split @@ -1121,8 +2033,12 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) !$OMP END PARALLEL DO call mpas_timer_stop('atm_compute_vert_imp_coefs') + MPAS_ACC_TIMER_START('atm_srk3: halo_exchanges + ACC_data_xfer') + call mpas_pool_get_array(diag, 'exner', exner) + !$acc update self(exner) call exchange_halo_group(domain, 'dynamics:exner') - + !$acc update device(exner) + MPAS_ACC_TIMER_STOP('atm_srk3: halo_exchanges + ACC_data_xfer') !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! BEGIN Runge-Kutta loop @@ -1200,7 +2116,12 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) !*********************************** ! tend_u + MPAS_ACC_TIMER_START('atm_srk3: halo_exchanges + ACC_data_xfer') + call mpas_pool_get_array(tend, 'u', tend_u) + !$acc update self(tend_u) call exchange_halo_group(domain, 'dynamics:tend_u') + !$acc update device(tend_u) + MPAS_ACC_TIMER_STOP('atm_srk3: halo_exchanges + ACC_data_xfer') call mpas_timer_start('small_step_prep') @@ -1276,7 +2197,12 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) do small_step = 1, number_sub_steps(rk_step) + MPAS_ACC_TIMER_START('atm_srk3: halo_exchanges + ACC_data_xfer') + call mpas_pool_get_array(diag, 'rho_pp', rho_pp) + !$acc update self(rho_pp) call exchange_halo_group(domain, 'dynamics:rho_pp') + !$acc update device(rho_pp) + MPAS_ACC_TIMER_STOP('atm_srk3: halo_exchanges + ACC_data_xfer') call mpas_timer_start('atm_advance_acoustic_step') @@ -1298,8 +2224,12 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) ! rtheta_pp ! This is the only communications needed during the acoustic steps because we solve for u on all edges of owned cells - + MPAS_ACC_TIMER_START('atm_srk3: halo_exchanges + ACC_data_xfer') + call mpas_pool_get_array(diag, 'rtheta_pp', rtheta_pp) + !$acc update self(rtheta_pp) call exchange_halo_group(domain, 'dynamics:rtheta_pp') + !$acc update device(rtheta_pp) + MPAS_ACC_TIMER_STOP('atm_srk3: halo_exchanges + ACC_data_xfer') ! complete update of horizontal momentum by including 3d divergence damping at the end of the acoustic step @@ -1319,7 +2249,15 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) ! ! Communicate halos for rw_p[1,2], ru_p[1,2], rho_pp[1,2], rtheta_pp[2] ! + MPAS_ACC_TIMER_START('atm_srk3: halo_exchanges + ACC_data_xfer') + call mpas_pool_get_array(diag, 'ru_p', ru_p) + call mpas_pool_get_array(diag, 'rw_p', rw_p) + call mpas_pool_get_array(diag, 'rho_pp', rho_pp) + call mpas_pool_get_array(diag, 'rtheta_pp', rtheta_pp) + !$acc update self(rw_p,ru_p,rho_pp,rtheta_pp) call exchange_halo_group(domain, 'dynamics:rw_p,ru_p,rho_pp,rtheta_pp') + !$acc update device(rw_p,ru_p,rho_pp,rtheta_pp) + MPAS_ACC_TIMER_STOP('atm_srk3: halo_exchanges + ACC_data_xfer') call mpas_timer_start('atm_recover_large_step_variables') @@ -1354,7 +2292,6 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) call mpas_atm_get_bdy_state(clock, block, nVertLevels, nEdges, 'u', time_dyn_step, ru_driving_values) ! do this inline at present - it is simple enough - !$acc enter data copyin(u) !$acc parallel default(present) !$acc loop gang worker do iEdge = 1, nEdgesSolve @@ -1366,12 +2303,10 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) end if end do !$acc end parallel - !$acc exit data copyout(u) call mpas_atm_get_bdy_state(clock, block, nVertLevels, nEdges, 'ru', time_dyn_step, ru_driving_values) call mpas_pool_get_array(diag, 'ru', u) ! do this inline at present - it is simple enough - !$acc enter data copyin(u) !$acc parallel default(present) !$acc loop gang worker do iEdge = 1, nEdges @@ -1383,7 +2318,6 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) end if end do !$acc end parallel - !$acc exit data copyout(u) deallocate(ru_driving_values) @@ -1391,12 +2325,17 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) !------------------------------------------------------------------- + MPAS_ACC_TIMER_START('atm_srk3: halo_exchanges + ACC_data_xfer') + call mpas_pool_get_array(state, 'u', u, 2) + !$acc update self(u) ! u if (config_apply_lbcs) then call exchange_halo_group(domain, 'dynamics:u_123') else call exchange_halo_group(domain, 'dynamics:u_3') end if + !$acc update device(u) + MPAS_ACC_TIMER_STOP('atm_srk3: halo_exchanges + ACC_data_xfer') ! scalar advection: RK3 scheme of Skamarock and Gassmann (2011). ! PD or monotonicity constraints applied only on the final Runge-Kutta substep. @@ -1408,7 +2347,12 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) if (config_apply_lbcs) then ! adjust boundary tendencies for regional_MPAS scalar transport + MPAS_ACC_TIMER_START('atm_srk3: halo_exchanges + ACC_data_xfer') + call mpas_pool_get_array(state, 'scalars', scalars_2, 2) + !$acc update self(scalars_2) call exchange_halo_group(domain, 'dynamics:scalars') + !$acc update device(scalars_2) + MPAS_ACC_TIMER_STOP('atm_srk3: halo_exchanges + ACC_data_xfer') allocate(scalars_driving(num_scalars,nVertLevels,nCells+1)) @@ -1460,17 +2404,27 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) call mpas_timer_stop('atm_compute_solve_diagnostics') + MPAS_ACC_TIMER_START('atm_srk3: halo_exchanges + ACC_data_xfer') + call mpas_pool_get_array(state, 'w', w, 2) + call mpas_pool_get_array(diag, 'pv_edge', pv_edge) + call mpas_pool_get_array(diag, 'rho_edge', rho_edge) + !$acc update self(w,pv_edge,rho_edge) if (config_scalar_advection .and. (.not. config_split_dynamics_transport) ) then ! ! Communicate halos for w[1,2], pv_edge[1,2], rho_edge[1,2], scalars[1,2] ! + call mpas_pool_get_array(state, 'scalars', scalars_2, 2) + !$acc update self(scalars_2) call exchange_halo_group(domain, 'dynamics:w,pv_edge,rho_edge,scalars') + !$acc update device(scalars_2) else ! ! Communicate halos for w[1,2], pv_edge[1,2], rho_edge[1,2] ! call exchange_halo_group(domain, 'dynamics:w,pv_edge,rho_edge') end if + !$acc update device(w,pv_edge,rho_edge) + MPAS_ACC_TIMER_STOP('atm_srk3: halo_exchanges + ACC_data_xfer') ! set the zero-gradient condition on w for regional_MPAS @@ -1483,8 +2437,13 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) end do !$OMP END PARALLEL DO + MPAS_ACC_TIMER_START('atm_srk3: halo_exchanges + ACC_data_xfer') ! w halo values needs resetting after regional boundary update + call mpas_pool_get_array(state, 'w', w, 2) + !$acc update self(w) call exchange_halo_group(domain, 'dynamics:w') + !$acc update device(w) + MPAS_ACC_TIMER_STOP('atm_srk3: halo_exchanges + ACC_data_xfer') end if ! end of regional_MPAS addition @@ -1495,7 +2454,14 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) ! ! Communicate halos for theta_m[1,2], pressure_p[1,2], and rtheta_p[1,2] ! + MPAS_ACC_TIMER_START('atm_srk3: halo_exchanges + ACC_data_xfer') + call mpas_pool_get_array(state, 'theta_m', theta_m, 2) + call mpas_pool_get_array(diag, 'pressure_p', pressure_p) + call mpas_pool_get_array(diag, 'rtheta_p', rtheta_p) + !$acc update self(theta_m,pressure_p,rtheta_p) call exchange_halo_group(domain, 'dynamics:theta_m,pressure_p,rtheta_p') + !$acc update device(theta_m,pressure_p,rtheta_p) + MPAS_ACC_TIMER_STOP('atm_srk3: halo_exchanges + ACC_data_xfer') ! ! Note: A halo exchange for 'exner' here as well as after the call @@ -1532,6 +2498,7 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) deallocate(qtot) ! we are finished with these now + !$acc exit data delete(tend_rtheta_physics,tend_rho_physics,tend_ru_physics) #ifndef MPAS_CAM_DYCORE call mpas_deallocate_scratch_field(tend_rtheta_physicsField) call mpas_deallocate_scratch_field(tend_rho_physicsField) @@ -1559,8 +2526,13 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) if (config_apply_lbcs) then ! adjust boundary tendencies for regional_MPAS scalar transport + MPAS_ACC_TIMER_START('atm_srk3: halo_exchanges + ACC_data_xfer') ! need to fill halo for horizontal filter + call mpas_pool_get_array(state, 'scalars', scalars_2, 2) + !$acc update self(scalars_2) call exchange_halo_group(domain, 'dynamics:scalars') + !$acc update device(scalars_2) + MPAS_ACC_TIMER_STOP('atm_srk3: halo_exchanges + ACC_data_xfer') allocate(scalars_driving(num_scalars,nVertLevels,nCells+1)) @@ -1586,7 +2558,12 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) !------------------------------------------------------------------------------------------------------------------------ if (rk_step < 3) then + MPAS_ACC_TIMER_START('atm_srk3: halo_exchanges + ACC_data_xfer') + call mpas_pool_get_array(state, 'scalars', scalars_2, 2) + !$acc update self(scalars_2) call exchange_halo_group(domain, 'dynamics:scalars') + !$acc update device(scalars_2) + MPAS_ACC_TIMER_STOP('atm_srk3: halo_exchanges + ACC_data_xfer') end if end do RK3_SPLIT_TRANSPORT @@ -1618,16 +2595,25 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) ! #ifdef DO_PHYSICS + MPAS_ACC_TIMER_START('atm_srk3: physics ACC_data_xfer') call mpas_pool_get_array(state, 'scalars', scalars_1, 1) + !$acc update self(scalars_1) call mpas_pool_get_array(state, 'scalars', scalars_2, 2) + !$acc update self(scalars_2) + MPAS_ACC_TIMER_STOP('atm_srk3: physics ACC_data_xfer') if(config_convection_scheme == 'cu_grell_freitas' .or. & config_convection_scheme == 'cu_ntiedtke') then + MPAS_ACC_TIMER_START('atm_srk3: physics ACC_data_xfer') call mpas_pool_get_array(tend_physics, 'rqvdynten', rqvdynten) call mpas_pool_get_array(state, 'theta_m', theta_m, 2) + !$acc update self(theta_m) call mpas_pool_get_array(tend_physics, 'rthdynten', rthdynten) + !$acc update self(rthdynten) + MPAS_ACC_TIMER_STOP('atm_srk3: physics ACC_data_xfer') + !NOTE: The calculation of the tendency due to horizontal and vertical advection for the water vapor mixing ratio !requires that the subroutine atm_advance_scalars_mono was called on the third Runge Kutta step, so that a halo @@ -1652,6 +2638,9 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) where ( scalars_2(:,:,:) < 0.0) & scalars_2(:,:,:) = 0.0 + MPAS_ACC_TIMER_START('atm_srk3: physics ACC_data_xfer') + !$acc update device(scalars_2, rthdynten) + MPAS_ACC_TIMER_STOP('atm_srk3: physics ACC_data_xfer') !call microphysics schemes: if (trim(config_microp_scheme) /= 'off') then call mpas_timer_start('microphysics') @@ -1699,7 +2688,12 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) if (config_apply_lbcs) then ! adjust boundary values for regional_MPAS scalar transport + MPAS_ACC_TIMER_START('atm_srk3: halo_exchanges + ACC_data_xfer') + call mpas_pool_get_array(state, 'scalars', scalars_2, 2) + !$acc update self(scalars_2) call exchange_halo_group(domain, 'dynamics:scalars') + !$acc update device(scalars_2) + MPAS_ACC_TIMER_STOP('atm_srk3: halo_exchanges + ACC_data_xfer') allocate(scalars_driving(num_scalars,nVertLevels,nCells+1)) @@ -1976,12 +2970,6 @@ subroutine atm_rk_integration_setup( state, diag, nVertLevels, num_scalars, & call mpas_pool_get_array(state, 'scalars', scalars_1, 1) call mpas_pool_get_array(state, 'scalars', scalars_2, 2) - MPAS_ACC_TIMER_START('atm_rk_integration_setup [ACC_data_xfer]') - !$acc enter data create(ru_save, u_2, rw_save, rtheta_p_save, rho_p_save, & - !$acc w_2, theta_m_2, rho_zz_2, rho_zz_old_split, scalars_2) & - !$acc copyin(ru, rw, rtheta_p, rho_p, u_1, w_1, theta_m_1, & - !$acc rho_zz_1, scalars_1) - MPAS_ACC_TIMER_STOP('atm_rk_integration_setup [ACC_data_xfer]') !$acc kernels theta_m_2(:,cellEnd+1) = 0.0_RKIND @@ -2029,12 +3017,6 @@ subroutine atm_rk_integration_setup( state, diag, nVertLevels, num_scalars, & end do !$acc end parallel - MPAS_ACC_TIMER_START('atm_rk_integration_setup [ACC_data_xfer]') - !$acc exit data copyout(ru_save, rw_save, rtheta_p_save, rho_p_save, u_2, & - !$acc w_2, theta_m_2, rho_zz_2, rho_zz_old_split, scalars_2) & - !$acc delete(ru, rw, rtheta_p, rho_p, u_1, w_1, theta_m_1, & - !$acc rho_zz_1, scalars_1) - MPAS_ACC_TIMER_STOP('atm_rk_integration_setup [ACC_data_xfer]') end subroutine atm_rk_integration_setup @@ -2085,11 +3067,6 @@ subroutine atm_compute_moist_coefficients( dims, state, diag, mesh, & moist_start = moist_start_ptr moist_end = moist_end_ptr - MPAS_ACC_TIMER_START('atm_compute_moist_coefficients [ACC_data_xfer]') - !$acc enter data create(cqw, cqu) & - !$acc copyin(scalars) - MPAS_ACC_TIMER_STOP('atm_compute_moist_coefficients [ACC_data_xfer]') - !$acc parallel default(present) !$acc loop gang worker ! do iCell = cellSolveStart,cellSolveEnd @@ -2138,10 +3115,6 @@ subroutine atm_compute_moist_coefficients( dims, state, diag, mesh, & end do !$acc end parallel - MPAS_ACC_TIMER_START('atm_compute_moist_coefficients [ACC_data_xfer]') - !$acc exit data copyout(cqw, cqu) & - !$acc delete(scalars) - MPAS_ACC_TIMER_STOP('atm_compute_moist_coefficients [ACC_data_xfer]') end subroutine atm_compute_moist_coefficients @@ -2274,9 +3247,7 @@ subroutine atm_compute_vert_imp_coefs_work(nCells, moist_start, moist_end, dts, real (kind=RKIND), dimension( nVertLevels ) :: b_tri, c_tri MPAS_ACC_TIMER_START('atm_compute_vert_imp_coefs_work [ACC_data_xfer]') - !$acc enter data copyin(cqw, p, t, rb, rtb, rt, pb) - !$acc enter data create(cofrz, cofwr, cofwz, coftz, cofwt, a_tri, b_tri, & - !$acc c_tri, alpha_tri, gamma_tri) + !$acc enter data create(b_tri, c_tri) MPAS_ACC_TIMER_STOP('atm_compute_vert_imp_coefs_work [ACC_data_xfer]') ! set coefficients @@ -2358,9 +3329,7 @@ subroutine atm_compute_vert_imp_coefs_work(nCells, moist_start, moist_end, dts, !$acc end parallel MPAS_ACC_TIMER_START('atm_compute_vert_imp_coefs_work [ACC_data_xfer]') - !$acc exit data copyout(cofrz, cofwr, cofwz, coftz, cofwt, a_tri, b_tri, & - !$acc c_tri, alpha_tri, gamma_tri) - !$acc exit data delete(cqw, p, t, rb, rtb, rt, pb) + !$acc exit data copyout(b_tri, c_tri) MPAS_ACC_TIMER_STOP('atm_compute_vert_imp_coefs_work [ACC_data_xfer]') end subroutine atm_compute_vert_imp_coefs_work @@ -2465,9 +3434,6 @@ subroutine atm_set_smlstep_pert_variables_work(nCells, nEdges, & integer :: iCell, iEdge, i, k real (kind=RKIND) :: flux - MPAS_ACC_TIMER_START('atm_set_smlstep_pert_variables [ACC_data_xfer]') - !$acc enter data copyin(u_tend, w_tend) - MPAS_ACC_TIMER_STOP('atm_set_smlstep_pert_variables [ACC_data_xfer]') ! we solve for omega instead of w (see Klemp et al MWR 2007), ! so here we change the w_p tendency to an omega_p tendency @@ -2500,10 +3466,6 @@ subroutine atm_set_smlstep_pert_variables_work(nCells, nEdges, & end do !$acc end parallel - MPAS_ACC_TIMER_START('atm_set_smlstep_pert_variables [ACC_data_xfer]') - !$acc exit data delete(u_tend) - !$acc exit data copyout(w_tend) - MPAS_ACC_TIMER_STOP('atm_set_smlstep_pert_variables [ACC_data_xfer]') end subroutine atm_set_smlstep_pert_variables_work @@ -2736,17 +3698,6 @@ subroutine atm_advance_acoustic_step_work(nCells, nEdges, nCellsSolve, cellStart resm = (1.0 - epssm) / (1.0 + epssm) rdts = 1./dts - MPAS_ACC_TIMER_START('atm_advance_acoustic_step [ACC_data_xfer]') - !$acc enter data copyin(exner,cqu,cofwt,coftz,cofrz,cofwr,cofwz, & - !$acc a_tri,alpha_tri,gamma_tri,rho_zz,theta_m,w, & - !$acc tend_ru,tend_rho,tend_rt,tend_rw,rw,rw_save) - !$acc enter data create(rtheta_pp_old) - if(small_step == 1) then - !$acc enter data create(ru_p,ruAvg,rho_pp,rtheta_pp,wwAvg,rw_p) - else - !$acc enter data copyin(ru_p,ruAvg,rho_pp,rtheta_pp,wwAvg,rw_p) - end if - MPAS_ACC_TIMER_STOP('atm_advance_acoustic_step [ACC_data_xfer]') if(small_step /= 1) then ! not needed on first small step @@ -2973,13 +3924,6 @@ subroutine atm_advance_acoustic_step_work(nCells, nEdges, nCellsSolve, cellStart end do ! end of loop over cells !$acc end parallel - MPAS_ACC_TIMER_START('atm_advance_acoustic_step [ACC_data_xfer]') - !$acc exit data delete(exner,cqu,cofwt,coftz,cofrz,cofwr,cofwz, & - !$acc a_tri,alpha_tri,gamma_tri,rho_zz,theta_m,w, & - !$acc tend_ru,tend_rho,tend_rt,tend_rw,rw,rw_save) - !$acc exit data copyout(rtheta_pp_old,ru_p,ruAvg,rho_pp, & - !$acc rtheta_pp,wwAvg,rw_p) - MPAS_ACC_TIMER_STOP('atm_advance_acoustic_step [ACC_data_xfer]') end subroutine atm_advance_acoustic_step_work @@ -3031,9 +3975,6 @@ subroutine atm_divergence_damping_3d( state, diag, mesh, configs, dts, edgeStart nCellsSolve = nCellsSolve_ptr nVertLevels = nVertLevels_ptr - MPAS_ACC_TIMER_START('atm_divergence_damping_3d [ACC_data_xfer]') - !$acc enter data copyin(ru_p, rtheta_pp, rtheta_pp_old, theta_m) - MPAS_ACC_TIMER_STOP('atm_divergence_damping_3d [ACC_data_xfer]') !$acc parallel default(present) !$acc loop gang worker @@ -3066,10 +4007,6 @@ subroutine atm_divergence_damping_3d( state, diag, mesh, configs, dts, edgeStart end do ! end loop over edges !$acc end parallel - MPAS_ACC_TIMER_START('atm_divergence_damping_3d [ACC_data_xfer]') - !$acc exit data copyout(ru_p) & - !$acc delete(rtheta_pp, rtheta_pp_old, theta_m) - MPAS_ACC_TIMER_STOP('atm_divergence_damping_3d [ACC_data_xfer]') end subroutine atm_divergence_damping_3d @@ -3260,17 +4197,6 @@ subroutine atm_recover_large_step_variables_work(nCells, nEdges, nCellsSolve, nE integer :: i, iCell, iEdge, k, cell1, cell2 real (kind=RKIND) :: invNs, rcv, p0, flux - MPAS_ACC_TIMER_START('atm_recover_large_step_variables [ACC_data_xfer]') - !$acc enter data copyin(rho_p_save,rho_pp,rho_base,rw_save,rw_p, & - !$acc rtheta_p_save,rtheta_pp,rtheta_base, & - !$acc ru_save,ru_p,wwAvg,ruAvg) & - !$acc create(rho_zz,rho_p,rw,w,rtheta_p,theta_m, & - !$acc ru,u) - if (rk_step == 3) then - !$acc enter data copyin(rt_diabatic_tend,exner_base) & - !$acc create(exner,pressure_p) - end if - MPAS_ACC_TIMER_STOP('atm_recover_large_step_variables [ACC_data_xfer]') rcv = rgas/(cp-rgas) p0 = 1.0e+05 ! this should come from somewhere else... @@ -3416,17 +4342,6 @@ subroutine atm_recover_large_step_variables_work(nCells, nEdges, nCellsSolve, nE end do !$acc end parallel - MPAS_ACC_TIMER_START('atm_recover_large_step_variables [ACC_data_xfer]') - !$acc exit data delete(rho_p_save,rho_pp,rho_base,rw_save,rw_p, & - !$acc rtheta_p_save,rtheta_pp,rtheta_base, & - !$acc ru_save,ru_p) & - !$acc copyout(rho_zz,rho_p,rw,w,rtheta_p,theta_m, & - !$acc ru,u,wwAvg,ruAvg) - if (rk_step == 3) then - !$acc exit data delete(rt_diabatic_tend,exner_base) & - !$acc copyout(exner,pressure_p) - end if - MPAS_ACC_TIMER_STOP('atm_recover_large_step_variables [ACC_data_xfer]') end subroutine atm_recover_large_step_variables_work @@ -3661,10 +4576,6 @@ subroutine atm_advance_scalars_work(nCells, num_scalars, dt, & weight_time_old = 1. - weight_time_new - MPAS_ACC_TIMER_START('atm_advance_scalars [ACC_data_xfer]') - !$acc enter data copyin(uhAvg, scalar_new) - MPAS_ACC_TIMER_STOP('atm_advance_scalars [ACC_data_xfer]') - !$acc parallel async !$acc loop gang worker private(scalar_weight2, ica) do iEdge=edgeStart,edgeEnd @@ -3759,12 +4670,6 @@ subroutine atm_advance_scalars_work(nCells, num_scalars, dt, & ! MPAS_ACC_TIMER_START('atm_advance_scalars [ACC_data_xfer]') -#ifndef DO_PHYSICS - !$acc enter data create(scalar_tend_save) -#else - !$acc enter data copyin(scalar_tend_save) -#endif - !$acc enter data copyin(scalar_old, fnm, fnp, rdnw, wwAvg, rho_zz_old, rho_zz_new) !$acc enter data create(scalar_tend_column) MPAS_ACC_TIMER_STOP('atm_advance_scalars [ACC_data_xfer]') @@ -3847,9 +4752,7 @@ subroutine atm_advance_scalars_work(nCells, num_scalars, dt, & !$acc end parallel MPAS_ACC_TIMER_START('atm_advance_scalars [ACC_data_xfer]') - !$acc exit data copyout(scalar_new) - !$acc exit data delete(scalar_tend_column, uhAvg, wwAvg, scalar_old, fnm, fnp, & - !$acc rdnw, rho_zz_old, rho_zz_new, scalar_tend_save) + !$acc exit data delete(scalar_tend_column) MPAS_ACC_TIMER_STOP('atm_advance_scalars [ACC_data_xfer]') end subroutine atm_advance_scalars_work @@ -4108,19 +5011,9 @@ subroutine atm_advance_scalars_mono_work(field_name, block, state, nCells, nEdge MPAS_ACC_TIMER_START('atm_advance_scalars_mono [ACC_data_xfer]') - !$acc data present(nEdgesOnCell, edgesOnCell, edgesOnCell_sign, & - !$acc invAreaCell, cellsOnCell, cellsOnEdge, nAdvCellsForEdge, & - !$acc advCellsForEdge, adv_coefs, adv_coefs_3rd, dvEdge, bdyMaskCell) - -#ifdef DO_PHYSICS - !$acc enter data copyin(scalar_tend) -#else - !$acc enter data create(scalar_tend) -#endif if (local_advance_density) then !$acc enter data copyin(rho_zz_int) end if - !$acc enter data copyin(scalars_old, rho_zz_old, rdnw, uhAvg, wwAvg) MPAS_ACC_TIMER_STOP('atm_advance_scalars_mono [ACC_data_xfer]') !$acc parallel @@ -4145,8 +5038,6 @@ subroutine atm_advance_scalars_mono_work(field_name, block, state, nCells, nEdge !$acc end parallel MPAS_ACC_TIMER_START('atm_advance_scalars_mono [ACC_data_xfer]') - !$acc exit data copyout(scalar_tend) - !$acc update self(scalars_old) MPAS_ACC_TIMER_STOP('atm_advance_scalars_mono [ACC_data_xfer]') @@ -4210,10 +5101,6 @@ subroutine atm_advance_scalars_mono_work(field_name, block, state, nCells, nEdge end if MPAS_ACC_TIMER_START('atm_advance_scalars_mono [ACC_data_xfer]') - if (.not. local_advance_density) then - !$acc enter data copyin(rho_zz_new) - end if - !$acc enter data copyin(scalars_new, fnm, fnp) !$acc enter data create(scale_arr) MPAS_ACC_TIMER_STOP('atm_advance_scalars_mono [ACC_data_xfer]') @@ -4721,14 +5608,8 @@ subroutine atm_advance_scalars_mono_work(field_name, block, state, nCells, nEdge MPAS_ACC_TIMER_START('atm_advance_scalars_mono [ACC_data_xfer]') if (local_advance_density) then !$acc exit data copyout(rho_zz_int) - else - !$acc exit data delete(rho_zz_new) end if - !$acc exit data copyout(scalars_new) - !$acc exit data delete(scalars_old, scale_arr, rho_zz_old, wwAvg, & - !$acc uhAvg, fnm, fnp, rdnw) - - !$acc end data + !$acc exit data delete(scale_arr) MPAS_ACC_TIMER_STOP('atm_advance_scalars_mono [ACC_data_xfer]') end subroutine atm_advance_scalars_mono_work @@ -5162,43 +6043,10 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm MPAS_ACC_TIMER_START('atm_compute_dyn_tend_work [ACC_data_xfer]') - if (rk_step == 1) then - !$acc enter data create(tend_w_euler) - !$acc enter data create(tend_u_euler) - !$acc enter data create(tend_theta_euler) - !$acc enter data create(tend_rho) - - !$acc enter data create(kdiff) - !$acc enter data copyin(tend_rho_physics) - !$acc enter data copyin(rb, rr_save) - !$acc enter data copyin(divergence, vorticity) - !$acc enter data copyin(v) - !$acc enter data copyin(u_init, v_init) - else - !$acc enter data copyin(tend_w_euler) - !$acc enter data copyin(tend_u_euler) - !$acc enter data copyin(tend_theta_euler) - !$acc enter data copyin(tend_rho) - end if - !$acc enter data create(tend_u) - !$acc enter data copyin(cqu, pp, u, w, pv_edge, rho_edge, ke) - !$acc enter data create(h_divergence) - !$acc enter data copyin(ru, rw) !$acc enter data create(rayleigh_damp_coef) - !$acc enter data copyin(tend_ru_physics) - !$acc enter data create(tend_w) - !$acc enter data copyin(rho_zz) - !$acc enter data create(tend_theta) - !$acc enter data copyin(theta_m) - !$acc enter data copyin(ru_save, theta_m_save) - !$acc enter data copyin(cqw) - !$acc enter data copyin(tend_rtheta_physics) - !$acc enter data copyin(rw_save, rt_diabatic_tend) - !$acc enter data create(rthdynten) - !$acc enter data copyin(t_init) -#ifdef CURVATURE + #ifdef CURVATURE !$acc enter data copyin(ur_cell, vr_cell) -#endif + #endif MPAS_ACC_TIMER_STOP('atm_compute_dyn_tend_work [ACC_data_xfer]') prandtl_inv = 1.0_RKIND / prandtl @@ -6198,43 +7046,10 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm !$acc end parallel MPAS_ACC_TIMER_START('atm_compute_dyn_tend_work [ACC_data_xfer]') - if (rk_step == 1) then - !$acc exit data copyout(tend_w_euler) - !$acc exit data copyout(tend_u_euler) - !$acc exit data copyout(tend_theta_euler) - !$acc exit data copyout(tend_rho) - - !$acc exit data delete(kdiff) - !$acc exit data delete(tend_rho_physics) - !$acc exit data delete(rb, rr_save) - !$acc exit data delete(divergence, vorticity) - !$acc exit data delete(v) - !$acc exit data delete(u_init, v_init) - else - !$acc exit data delete(tend_w_euler) - !$acc exit data delete(tend_u_euler) - !$acc exit data delete(tend_theta_euler) - !$acc exit data delete(tend_rho) - end if - !$acc exit data copyout(tend_u) - !$acc exit data delete(cqu, pp, u, w, pv_edge, rho_edge, ke) - !$acc exit data copyout(h_divergence) - !$acc exit data delete(ru, rw) !$acc exit data delete(rayleigh_damp_coef) - !$acc exit data delete(tend_ru_physics) - !$acc exit data copyout(tend_w) - !$acc exit data delete(rho_zz) - !$acc exit data copyout(tend_theta) - !$acc exit data delete(theta_m) - !$acc exit data delete(ru_save, theta_m_save) - !$acc exit data delete(cqw) - !$acc exit data delete(tend_rtheta_physics) - !$acc exit data delete(rw_save, rt_diabatic_tend) - !$acc exit data copyout(rthdynten) - !$acc exit data delete(t_init) -#ifdef CURVATURE + #ifdef CURVATURE !$acc exit data delete(ur_cell, vr_cell) -#endif + #endif MPAS_ACC_TIMER_STOP('atm_compute_dyn_tend_work [ACC_data_xfer]') end subroutine atm_compute_dyn_tend_work @@ -6403,26 +7218,10 @@ subroutine atm_compute_solve_diagnostics_work(nCells, nEdges, nVertices, & logical :: reconstruct_v - MPAS_ACC_TIMER_START('atm_compute_solve_diagnostics [ACC_data_xfer]') - !$acc enter data copyin(cellsOnEdge,dcEdge,dvEdge, & - !$acc edgesOnVertex,edgesOnVertex_sign,invAreaTriangle, & - !$acc nEdgesOnCell,edgesOnCell, & - !$acc edgesOnCell_sign,invAreaCell, & - !$acc invAreaTriangle,edgesOnVertex, & - !$acc verticesOnCell,kiteForCell,kiteAreasOnVertex, & - !$acc nEdgesOnEdge,edgesOnEdge,weightsOnEdge, & - !$acc fVertex, & - !$acc verticesOnEdge, & - !$acc invDvEdge,invDcEdge) - !$acc enter data copyin(u,h) - MPAS_ACC_TIMER_STOP('atm_compute_solve_diagnostics [ACC_data_xfer]') ! ! Compute height on cell edges at velocity locations ! - MPAS_ACC_TIMER_START('atm_compute_solve_diagnostics [ACC_data_xfer]') - !$acc enter data create(h_edge,vorticity,divergence) - MPAS_ACC_TIMER_STOP('atm_compute_solve_diagnostics [ACC_data_xfer]') !$acc parallel default(present) !$acc loop gang do iEdge=edgeStart,edgeEnd @@ -6507,9 +7306,6 @@ subroutine atm_compute_solve_diagnostics_work(nCells, nEdges, nVertices, & ! ! Replace 2.0 with 2 in exponentiation to avoid outside chance that ! compiler will actually allow "float raised to float" operation - MPAS_ACC_TIMER_START('atm_compute_solve_diagnostics [ACC_data_xfer]') - !$acc enter data create(ke) - MPAS_ACC_TIMER_STOP('atm_compute_solve_diagnostics [ACC_data_xfer]') !$acc parallel default(present) !$acc loop gang do iCell=cellStart,cellEnd @@ -6604,14 +7400,6 @@ subroutine atm_compute_solve_diagnostics_work(nCells, nEdges, nVertices, & if(rk_step /= 3) reconstruct_v = .false. end if - MPAS_ACC_TIMER_START('atm_compute_solve_diagnostics [ACC_data_xfer]') - if (reconstruct_v) then - !$acc enter data create(v) - else - !$acc enter data copyin(v) - end if - MPAS_ACC_TIMER_STOP('atm_compute_solve_diagnostics [ACC_data_xfer]') - if (reconstruct_v) then !$acc parallel default(present) !$acc loop gang @@ -6639,9 +7427,6 @@ subroutine atm_compute_solve_diagnostics_work(nCells, nEdges, nVertices, & ! ! Avoid dividing h_vertex by areaTriangle and move areaTriangle into ! numerator for the pv_vertex calculation - MPAS_ACC_TIMER_START('atm_compute_solve_diagnostics [ACC_data_xfer]') - !$acc enter data create(pv_vertex) - MPAS_ACC_TIMER_STOP('atm_compute_solve_diagnostics [ACC_data_xfer]') !$acc parallel default(present) !$acc loop collapse(2) do iVertex = vertexStart,vertexEnd @@ -6665,9 +7450,6 @@ subroutine atm_compute_solve_diagnostics_work(nCells, nEdges, nVertices, & ! Compute pv at the edges ! ( this computes pv_edge at all edges bounding real cells ) ! - MPAS_ACC_TIMER_START('atm_compute_solve_diagnostics [ACC_data_xfer]') - !$acc enter data create(pv_edge) - MPAS_ACC_TIMER_STOP('atm_compute_solve_diagnostics [ACC_data_xfer]') !$acc parallel default(present) !$acc loop collapse(2) do iEdge = edgeStart,edgeEnd @@ -6685,9 +7467,6 @@ subroutine atm_compute_solve_diagnostics_work(nCells, nEdges, nVertices, & ! ( this computes pv_cell for all real cells ) ! only needed for APVM upwinding ! - MPAS_ACC_TIMER_START('atm_compute_solve_diagnostics [ACC_data_xfer]') - !$acc enter data create(pv_cell) - MPAS_ACC_TIMER_STOP('atm_compute_solve_diagnostics [ACC_data_xfer]') !$acc parallel default(present) !$acc loop gang do iCell=cellStart,cellEnd @@ -6726,9 +7505,6 @@ subroutine atm_compute_solve_diagnostics_work(nCells, nEdges, nVertices, & ! Merged loops for calculating gradPVt, gradPVn and pv_edge ! Also precomputed inverses of dvEdge and dcEdge to avoid repeated divisions ! - MPAS_ACC_TIMER_START('atm_compute_solve_diagnostics [ACC_data_xfer]') - !$acc enter data create(gradPVt,gradPVn) - MPAS_ACC_TIMER_STOP('atm_compute_solve_diagnostics [ACC_data_xfer]') r = config_apvm_upwinding * dt !$acc parallel default(present) !$acc loop gang @@ -6745,31 +7521,10 @@ subroutine atm_compute_solve_diagnostics_work(nCells, nEdges, nVertices, & end do !$acc end parallel - MPAS_ACC_TIMER_START('atm_compute_solve_diagnostics [ACC_data_xfer]') - !$acc exit data delete(pv_cell,gradPVt,gradPVn) - MPAS_ACC_TIMER_STOP('atm_compute_solve_diagnostics [ACC_data_xfer]') end if ! apvm upwinding - MPAS_ACC_TIMER_START('atm_compute_solve_diagnostics [ACC_data_xfer]') - !$acc exit data delete(cellsOnEdge,dcEdge,dvEdge, & - !$acc edgesOnVertex,edgesOnVertex_sign,invAreaTriangle, & - !$acc nEdgesOnCell,edgesOnCell, & - !$acc edgesOnCell_sign,invAreaCell, & - !$acc invAreaTriangle,edgesOnVertex, & - !$acc verticesOnCell,kiteForCell,kiteAreasOnVertex, & - !$acc nEdgesOnEdge,edgesOnEdge,weightsOnEdge, & - !$acc verticesOnEdge, & - !$acc fVertex,invDvEdge,invDcEdge) - !$acc exit data delete(u,h) - !$acc exit data copyout(h_edge,vorticity,divergence, & - !$acc ke, & - !$acc v, & - !$acc pv_vertex, & - !$acc pv_edge) - MPAS_ACC_TIMER_STOP('atm_compute_solve_diagnostics [ACC_data_xfer]') - end subroutine atm_compute_solve_diagnostics_work @@ -6858,17 +7613,13 @@ subroutine atm_init_coupled_diagnostics(state, time_lev, diag, mesh, configs, & call mpas_pool_get_array(mesh, 'zb3_cell', zb3_cell) MPAS_ACC_TIMER_START('atm_init_coupled_diagnostics [ACC_data_xfer]') - ! copyin invariant fields - !$acc enter data copyin(cellsOnEdge,nEdgesOnCell,edgesOnCell, & - !$acc edgesOnCell_sign,zz,fzm,fzp,zb,zb3, & - !$acc zb_cell,zb3_cell) ! copyin the data that is only on the right-hand side - !$acc enter data copyin(scalars(index_qv,:,:),u,w,rho,theta, & + !$acc enter data copyin(scalars(index_qv,:,:),w,rho,theta, & !$acc rho_base,theta_base) ! copyin the data that will be modified in this routine - !$acc enter data create(theta_m,rho_zz,ru,rw,rho_p,rtheta_base, & + !$acc enter data create(theta_m,ru,rw,rho_p,rtheta_base, & !$acc rtheta_p,exner,exner_base,pressure_p, & !$acc pressure_base) MPAS_ACC_TIMER_STOP('atm_init_coupled_diagnostics [ACC_data_xfer]') @@ -6992,17 +7743,12 @@ subroutine atm_init_coupled_diagnostics(state, time_lev, diag, mesh, configs, & !$acc end parallel MPAS_ACC_TIMER_START('atm_init_coupled_diagnostics [ACC_data_xfer]') - ! delete invariant fields - !$acc exit data delete(cellsOnEdge,nEdgesOnCell,edgesOnCell, & - !$acc edgesOnCell_sign,zz,fzm,fzp,zb,zb3, & - !$acc zb_cell,zb3_cell) - ! delete the data that is only on the right-hand side - !$acc exit data delete(scalars(index_qv,:,:),u,w,rho,theta, & + !$acc exit data delete(scalars(index_qv,:,:),w,rho,theta, & !$acc rho_base,theta_base) ! copyout the data that will be modified in this routine - !$acc exit data copyout(theta_m,rho_zz,ru,rw,rho_p,rtheta_base, & + !$acc exit data copyout(theta_m,ru,rw,rho_p,rtheta_base, & !$acc rtheta_p,exner,exner_base,pressure_p, & !$acc pressure_base) MPAS_ACC_TIMER_STOP('atm_init_coupled_diagnostics [ACC_data_xfer]') @@ -7069,13 +7815,6 @@ subroutine atm_rk_dynamics_substep_finish( state, diag, nVertLevels, dynamics_su call mpas_pool_get_array(state, 'rho_zz', rho_zz_1, 1) call mpas_pool_get_array(state, 'rho_zz', rho_zz_2, 2) - MPAS_ACC_TIMER_START('atm_rk_dynamics_substep_finish [ACC_data_xfer]') - !$acc enter data create(ru_save, u_1, rtheta_p_save, theta_m_1, rho_p_save, rw_save, & - !$acc w_1, rho_zz_1) & - !$acc copyin(ru, u_2, rtheta_p, rho_p, theta_m_2, rho_zz_2, rw, & - !$acc w_2, ruAvg, wwAvg, ruAvg_split, wwAvg_split, rho_zz_old_split) - MPAS_ACC_TIMER_STOP('atm_rk_dynamics_substep_finish [ACC_data_xfer]') - ! Interim fix for the atm_compute_dyn_tend_work subroutine accessing uninitialized values ! in garbage cells of theta_m !$acc kernels @@ -7180,13 +7919,6 @@ subroutine atm_rk_dynamics_substep_finish( state, diag, nVertLevels, dynamics_su !$acc end parallel end if - MPAS_ACC_TIMER_START('atm_rk_dynamics_substep_finish [ACC_data_xfer]') - !$acc exit data copyout(ru_save, u_1, rtheta_p_save, rho_p_save, rw_save, & - !$acc w_1, theta_m_1, rho_zz_1, ruAvg, wwAvg, ruAvg_split, & - !$acc wwAvg_split) & - !$acc delete(ru, u_2, rtheta_p, rho_p, theta_m_2, rho_zz_2, rw, & - !$acc w_2, rho_zz_old_split) - MPAS_ACC_TIMER_STOP('atm_rk_dynamics_substep_finish [ACC_data_xfer]') end subroutine atm_rk_dynamics_substep_finish @@ -7241,9 +7973,6 @@ subroutine atm_zero_gradient_w_bdy_work( w, bdyMaskCell, nearestRelaxationCell, integer :: iCell, k - MPAS_ACC_TIMER_START('atm_zero_gradient_w_bdy_work [ACC_data_xfer]') - !$acc enter data copyin(w) - MPAS_ACC_TIMER_STOP('atm_zero_gradient_w_bdy_work [ACC_data_xfer]') !$acc parallel default(present) !$acc loop gang worker @@ -7259,9 +7988,6 @@ subroutine atm_zero_gradient_w_bdy_work( w, bdyMaskCell, nearestRelaxationCell, end do !$acc end parallel - MPAS_ACC_TIMER_START('atm_zero_gradient_w_bdy_work [ACC_data_xfer]') - !$acc exit data copyout(w) - MPAS_ACC_TIMER_STOP('atm_zero_gradient_w_bdy_work [ACC_data_xfer]') end subroutine atm_zero_gradient_w_bdy_work @@ -7302,11 +8028,6 @@ subroutine atm_bdy_adjust_dynamics_speczone_tend( tend, mesh, config, nVertLevel call mpas_pool_get_array(mesh, 'bdyMaskEdge', bdyMaskEdge) call mpas_pool_get_array(tend, 'rt_diabatic_tend', rt_diabatic_tend) - MPAS_ACC_TIMER_START('atm_bdy_adjust_dynamics_speczone_tend [ACC_data_xfer]') - !$acc enter data copyin(tend_ru,tend_rho,tend_rt,tend_rw, & - !$acc rt_diabatic_tend) - MPAS_ACC_TIMER_STOP('atm_bdy_adjust_dynamics_speczone_tend [ACC_data_xfer]') - !$acc parallel default(present) !$acc loop gang worker do iCell = cellSolveStart, cellSolveEnd @@ -7333,11 +8054,6 @@ subroutine atm_bdy_adjust_dynamics_speczone_tend( tend, mesh, config, nVertLevel end if end do !$acc end parallel - - MPAS_ACC_TIMER_START('atm_bdy_adjust_dynamics_speczone_tend [ACC_data_xfer]') - !$acc exit data copyout(tend_ru,tend_rho,tend_rt, & - !$acc tend_rw,rt_diabatic_tend) - MPAS_ACC_TIMER_STOP('atm_bdy_adjust_dynamics_speczone_tend [ACC_data_xfer]') end subroutine atm_bdy_adjust_dynamics_speczone_tend @@ -7424,7 +8140,6 @@ subroutine atm_bdy_adjust_dynamics_relaxzone_tend( config, tend, state, diag, me vertexDegree = vertexDegree_ptr MPAS_ACC_TIMER_START('atm_bdy_adjust_dynamics_relaxzone_tend [ACC_data_xfer]') - !$acc enter data copyin(tend_rho, tend_rt, rho_zz, theta_m, tend_ru, ru) !$acc enter data create(divergence1, divergence2, vorticity1, vorticity2) MPAS_ACC_TIMER_STOP('atm_bdy_adjust_dynamics_relaxzone_tend [ACC_data_xfer]') @@ -7572,9 +8287,7 @@ subroutine atm_bdy_adjust_dynamics_relaxzone_tend( config, tend, state, diag, me !$acc end parallel MPAS_ACC_TIMER_START('atm_bdy_adjust_dynamics_relaxzone_tend [ACC_data_xfer]') - !$acc exit data copyout(tend_rho, tend_rt, tend_ru) - !$acc exit data delete(rho_zz, theta_m, ru, & - !$acc divergence1, divergence2, vorticity1, vorticity2) + !$acc exit data delete(divergence1, divergence2, vorticity1, vorticity2) MPAS_ACC_TIMER_STOP('atm_bdy_adjust_dynamics_relaxzone_tend [ACC_data_xfer]') end subroutine atm_bdy_adjust_dynamics_relaxzone_tend @@ -7609,10 +8322,6 @@ subroutine atm_bdy_reset_speczone_values( state, diag, mesh, nVertLevels, & call mpas_pool_get_array(state, 'theta_m', theta_m, 2) call mpas_pool_get_array(diag, 'rtheta_p', rtheta_p) call mpas_pool_get_array(diag, 'rtheta_base', rtheta_base) - - MPAS_ACC_TIMER_START('atm_bdy_reset_speczone_values [ACC_data_xfer]') - !$acc enter data copyin(rtheta_base, theta_m, rtheta_p) - MPAS_ACC_TIMER_STOP('atm_bdy_reset_speczone_values [ACC_data_xfer]') !$acc parallel default(present) !$acc loop gang worker @@ -7627,11 +8336,6 @@ subroutine atm_bdy_reset_speczone_values( state, diag, mesh, nVertLevels, & end do !$acc end parallel - MPAS_ACC_TIMER_START('atm_bdy_reset_speczone_values [ACC_data_xfer]') - !$acc exit data copyout(theta_m, rtheta_p) & - !$acc delete(rtheta_base) - MPAS_ACC_TIMER_STOP('atm_bdy_reset_speczone_values [ACC_data_xfer]') - end subroutine atm_bdy_reset_speczone_values !------------------------------------------------------------------------- @@ -7721,8 +8425,7 @@ subroutine atm_bdy_adjust_scalars_work( scalars_new, scalars_driving, dt, dt_rk, !--- MPAS_ACC_TIMER_START('atm_bdy_adjust_scalars [ACC_data_xfer]') - !$acc enter data create(scalars_tmp) & - !$acc copyin(scalars_new) + !$acc enter data create(scalars_tmp) MPAS_ACC_TIMER_STOP('atm_bdy_adjust_scalars [ACC_data_xfer]') !$acc parallel default(present) @@ -7806,8 +8509,7 @@ subroutine atm_bdy_adjust_scalars_work( scalars_new, scalars_driving, dt, dt_rk, !$acc end parallel MPAS_ACC_TIMER_START('atm_bdy_adjust_scalars [ACC_data_xfer]') - !$acc exit data delete(scalars_tmp) & - !$acc copyout(scalars_new) + !$acc exit data delete(scalars_tmp) MPAS_ACC_TIMER_STOP('atm_bdy_adjust_scalars [ACC_data_xfer]') end subroutine atm_bdy_adjust_scalars_work @@ -7878,10 +8580,6 @@ subroutine atm_bdy_set_scalars_work( scalars_driving, scalars_new, & !--- - MPAS_ACC_TIMER_START('atm_bdy_set_scalars_work [ACC_data_xfer]') - !$acc enter data copyin(scalars_new) - MPAS_ACC_TIMER_STOP('atm_bdy_set_scalars_work [ACC_data_xfer]') - !$acc parallel default(present) !$acc loop gang worker do iCell = cellSolveStart, cellSolveEnd ! threaded over cells @@ -7902,10 +8600,6 @@ subroutine atm_bdy_set_scalars_work( scalars_driving, scalars_new, & end do ! updates now in temp storage !$acc end parallel - - MPAS_ACC_TIMER_START('atm_bdy_set_scalars_work [ACC_data_xfer]') - !$acc exit data copyout(scalars_new) - MPAS_ACC_TIMER_STOP('atm_bdy_set_scalars_work [ACC_data_xfer]') end subroutine atm_bdy_set_scalars_work @@ -7975,16 +8669,6 @@ subroutine summarize_timestep(domain) nVertLevels = nVertLevels_ptr num_scalars = num_scalars_ptr - MPAS_ACC_TIMER_START('summarize_timestep [ACC_data_xfer]') - if (config_print_detailed_minmax_vel) then - !$acc enter data copyin(w,u,v) - else if (config_print_global_minmax_vel) then - !$acc enter data copyin(w,u) - end if - if (config_print_global_minmax_sca) then - !$acc enter data copyin(scalars) - end if - MPAS_ACC_TIMER_STOP('summarize_timestep [ACC_data_xfer]') if (config_print_detailed_minmax_vel) then call mpas_log_write('') @@ -8343,17 +9027,6 @@ subroutine summarize_timestep(domain) end if - MPAS_ACC_TIMER_START('summarize_timestep [ACC_data_xfer]') - if (config_print_detailed_minmax_vel) then - !$acc exit data delete(w,u,v) - else if (config_print_global_minmax_vel) then - !$acc exit data delete(w,u) - end if - if (config_print_global_minmax_sca) then - !$acc exit data delete(scalars) - end if - MPAS_ACC_TIMER_STOP('summarize_timestep [ACC_data_xfer]') - end subroutine summarize_timestep end module atm_time_integration diff --git a/src/core_atmosphere/mpas_atm_core.F b/src/core_atmosphere/mpas_atm_core.F index f7d04a1f0c..d1b9931c6c 100644 --- a/src/core_atmosphere/mpas_atm_core.F +++ b/src/core_atmosphere/mpas_atm_core.F @@ -43,7 +43,8 @@ function atm_core_init(domain, startTimeStamp) result(ierr) use mpas_atm_dimensions, only : mpas_atm_set_dims use mpas_atm_diagnostics_manager, only : mpas_atm_diag_setup use mpas_atm_threading, only : mpas_atm_threading_init - use atm_time_integration, only : mpas_atm_dynamics_init + use atm_time_integration, only : mpas_atm_dynamics_init, & + mpas_atm_pre_dynamics_h2d, mpas_atm_post_dynamics_d2h use mpas_timer, only : mpas_timer_start, mpas_timer_stop use mpas_attlist, only : mpas_modify_att use mpas_string_utils, only : mpas_string_replace @@ -509,6 +510,7 @@ subroutine atm_mpas_init_block(dminfo, stream_manager, block, mesh, dt) call mpas_pool_get_dimension(block % dimensions, 'edgeSolveThreadStart', edgeSolveThreadStart) call mpas_pool_get_dimension(block % dimensions, 'edgeSolveThreadEnd', edgeSolveThreadEnd) + call mpas_atm_pre_computesolvediag_h2d(block) !$OMP PARALLEL DO do thread=1,nThreads if (.not. config_do_restart .or. (config_do_restart .and. config_do_DAcycling)) then @@ -527,6 +529,7 @@ subroutine atm_mpas_init_block(dminfo, stream_manager, block, mesh, dt) edgeThreadStart(thread), edgeThreadEnd(thread)) end do !$OMP END PARALLEL DO + call mpas_atm_post_computesolvediag_d2h(block) deallocate(ke_vertex) deallocate(ke_edge) diff --git a/src/core_atmosphere/physics/mpas_atmphys_interface.F b/src/core_atmosphere/physics/mpas_atmphys_interface.F index 71e46dfcd2..afd8ed2810 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_interface.F +++ b/src/core_atmosphere/physics/mpas_atmphys_interface.F @@ -12,6 +12,16 @@ module mpas_atmphys_interface use mpas_atmphys_constants use mpas_atmphys_vars + use mpas_timer + +#ifdef MPAS_OPENACC +#define MPAS_ACC_TIMER_START(X) call mpas_timer_start(X) +#define MPAS_ACC_TIMER_STOP(X) call mpas_timer_stop(X) +#else +#define MPAS_ACC_TIMER_START(X) +#define MPAS_ACC_TIMER_STOP(X) +#endif + implicit none private @@ -588,6 +598,7 @@ subroutine microphysics_from_MPAS(configs,mesh,state,time_lev,diag,diag_physics, call mpas_pool_get_array(mesh,'zgrid',zgrid) call mpas_pool_get_array(mesh,'zz' ,zz ) + MPAS_ACC_TIMER_START('atm_srk3: physics ACC_data_xfer') call mpas_pool_get_array(diag,'exner' ,exner ) call mpas_pool_get_array(diag,'pressure_base',pressure_b) call mpas_pool_get_array(diag,'pressure_p' ,pressure_p) @@ -595,11 +606,14 @@ subroutine microphysics_from_MPAS(configs,mesh,state,time_lev,diag,diag_physics, call mpas_pool_get_array(state,'rho_zz' ,rho_zz ,time_lev) call mpas_pool_get_array(state,'theta_m',theta_m,time_lev) call mpas_pool_get_array(state,'w' ,w ,time_lev) + !$acc update host(exner, pressure_b, pressure_p, rho_zz, theta_m, w) call mpas_pool_get_dimension(state,'index_qv',index_qv) call mpas_pool_get_dimension(state,'index_qc',index_qc) call mpas_pool_get_dimension(state,'index_qr',index_qr) call mpas_pool_get_array(state,'scalars',scalars,time_lev) + !$acc update host(scalars) + MPAS_ACC_TIMER_STOP('atm_srk3: physics ACC_data_xfer') qv => scalars(index_qv,:,:) qc => scalars(index_qc,:,:) qr => scalars(index_qr,:,:) @@ -1040,6 +1054,12 @@ subroutine microphysics_to_MPAS(configs,mesh,state,time_lev,diag,diag_physics,te case default end select mp_tend_select + MPAS_ACC_TIMER_START('atm_srk3: physics ACC_data_xfer') + !$acc update device(exner, exner_b, pressure_b, pressure_p, rtheta_b) + !$acc update device(rtheta_p, rho_zz, theta_m, scalars) + !$acc update device(rt_diabatic_tend) + MPAS_ACC_TIMER_STOP('atm_srk3: physics ACC_data_xfer') + end subroutine microphysics_to_MPAS !================================================================================================================= diff --git a/src/core_atmosphere/physics/mpas_atmphys_todynamics.F b/src/core_atmosphere/physics/mpas_atmphys_todynamics.F index 284b072851..290cc56330 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_todynamics.F +++ b/src/core_atmosphere/physics/mpas_atmphys_todynamics.F @@ -13,11 +13,20 @@ module mpas_atmphys_todynamics use mpas_atm_dimensions use mpas_atmphys_constants, only: R_d,R_v,degrad + use mpas_timer implicit none private public:: physics_get_tend +#ifdef MPAS_OPENACC +#define MPAS_ACC_TIMER_START(X) call mpas_timer_start(X) +#define MPAS_ACC_TIMER_STOP(X) call mpas_timer_stop(X) +#else +#define MPAS_ACC_TIMER_START(X) +#define MPAS_ACC_TIMER_STOP(X) +#endif + !Interface between the physics parameterizations and the non-hydrostatic dynamical core. !Laura D. Fowler (send comments to laura@ucar.edu). @@ -127,12 +136,14 @@ subroutine physics_get_tend(block,mesh,state,diag,tend,tend_physics,configs,rk_s call mpas_pool_get_config(configs,'config_radt_lw_scheme' ,radt_lw_scheme ) call mpas_pool_get_config(configs,'config_radt_sw_scheme' ,radt_sw_scheme ) + MPAS_ACC_TIMER_START('atm_srk3: physics ACC_data_xfer') call mpas_pool_get_array(state,'theta_m' ,theta_m,1) call mpas_pool_get_array(state,'scalars' ,scalars,1) call mpas_pool_get_array(state,'rho_zz' ,mass,2 ) call mpas_pool_get_array(diag ,'rho_edge',mass_edge) call mpas_pool_get_array(diag ,'tend_u_phys',tend_u_phys) + !$acc update self(theta_m, scalars, mass, mass_edge) call mpas_pool_get_dimension(state,'index_qv',index_qv) call mpas_pool_get_dimension(state,'index_qc',index_qc) call mpas_pool_get_dimension(state,'index_qr',index_qr) @@ -170,6 +181,8 @@ subroutine physics_get_tend(block,mesh,state,diag,tend,tend_physics,configs,rk_s call mpas_pool_get_array(tend_physics,'rthratensw',rthratensw) call mpas_pool_get_array(tend,'scalars_tend',tend_scalars) +!$acc update self(tend_scalars) ! Probably not needed +MPAS_ACC_TIMER_STOP('atm_srk3: physics ACC_data_xfer') !initialize the tendency for the potential temperature and all scalars due to PBL, convection, @@ -219,6 +232,10 @@ subroutine physics_get_tend(block,mesh,state,diag,tend,tend_physics,configs,rk_s tend_th,tend_rtheta_physics,tend_scalars,tend_ru_physics,tend_u_phys, & exchange_halo_group) +MPAS_ACC_TIMER_START('atm_srk3: physics ACC_data_xfer') +!$acc update device(tend_scalars) +MPAS_ACC_TIMER_STOP('atm_srk3: physics ACC_data_xfer') + !clean up any pointers that were allocated with zero size before the call to physics_get_tend_work: if(size(rucuten) == 0 ) deallocate(rucuten ) if(size(rvcuten) == 0 ) deallocate(rvcuten ) From ac59b66b8d2b13e9603f6bd1870486651ffcf0c1 Mon Sep 17 00:00:00 2001 From: Abishek Gopal Date: Thu, 22 May 2025 13:56:08 -0600 Subject: [PATCH 02/11] Fixing bug associated with rho_zz_2 not being copied out at the end of dynamics --- src/core_atmosphere/dynamics/mpas_atm_time_integration.F | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core_atmosphere/dynamics/mpas_atm_time_integration.F b/src/core_atmosphere/dynamics/mpas_atm_time_integration.F index de3565637b..18dbe434ea 100644 --- a/src/core_atmosphere/dynamics/mpas_atm_time_integration.F +++ b/src/core_atmosphere/dynamics/mpas_atm_time_integration.F @@ -1281,7 +1281,7 @@ subroutine mpas_atm_post_dynamics_d2h(domain) call mpas_pool_get_array(state, 'rho_zz', rho_zz_1, 1) !$acc exit data copyout(rho_zz_1) call mpas_pool_get_array(state, 'rho_zz', rho_zz_2, 2) - !$acc exit data delete(rho_zz_2) + !$acc exit data copyout(rho_zz_2) call mpas_pool_get_array(state, 'scalars', scalars_1, 1) !$acc exit data copyout(scalars_1) call mpas_pool_get_array(state, 'scalars', scalars_2, 2) From 2ccf89d5137f5b3a869f34f4cc49ccc024332267 Mon Sep 17 00:00:00 2001 From: Abishek Gopal Date: Fri, 13 Jun 2025 18:19:15 -0600 Subject: [PATCH 03/11] Moving some OpenACC data movements to subroutines --- src/core_atmosphere/dynamics/mpas_atm_iau.F | 57 ++++++++--- .../dynamics/mpas_atm_time_integration.F | 7 +- .../physics/mpas_atmphys_interface.F | 96 ++++++++++++++++--- .../physics/mpas_atmphys_todynamics.F | 81 ++++++++++++---- 4 files changed, 194 insertions(+), 47 deletions(-) diff --git a/src/core_atmosphere/dynamics/mpas_atm_iau.F b/src/core_atmosphere/dynamics/mpas_atm_iau.F index b380e3c0e8..d5999e18c7 100644 --- a/src/core_atmosphere/dynamics/mpas_atm_iau.F +++ b/src/core_atmosphere/dynamics/mpas_atm_iau.F @@ -5,6 +5,15 @@ ! Additional copyright and license information can be found in the LICENSE file ! distributed with this code, or at http://mpas-dev.github.com/license.html ! + + #ifdef MPAS_OPENACC + #define MPAS_ACC_TIMER_START(X) call mpas_timer_start(X) + #define MPAS_ACC_TIMER_STOP(X) call mpas_timer_stop(X) + #else + #define MPAS_ACC_TIMER_START(X) + #define MPAS_ACC_TIMER_STOP(X) + #endif + module mpas_atm_iau use mpas_derived_types @@ -15,17 +24,7 @@ module mpas_atm_iau use mpas_log, only : mpas_log_write use mpas_timer - !public :: atm_compute_iau_coef, atm_add_tend_anal_incr - - - #ifdef MPAS_OPENACC - #define MPAS_ACC_TIMER_START(X) call mpas_timer_start(X) - #define MPAS_ACC_TIMER_STOP(X) call mpas_timer_stop(X) - #else - #define MPAS_ACC_TIMER_START(X) - #define MPAS_ACC_TIMER_STOP(X) - #endif - + !public :: atm_compute_iau_coef, atm_add_tend_anal_incr contains @@ -87,6 +86,39 @@ real (kind=RKIND) function atm_iau_coef(configs, itimestep, dt) result(wgt_iau) end if end function atm_iau_coef + +!================================================================================================== + subroutine update_d2h_pre_add_tend_anal_incr(configs,structs) +!================================================================================================== + + implicit none + + type (mpas_pool_type), intent(in) :: configs + type (mpas_pool_type), intent(inout) :: structs + + type (mpas_pool_type), pointer :: tend + type (mpas_pool_type), pointer :: state + type (mpas_pool_type), pointer :: diag + + real (kind=RKIND), dimension(:,:), pointer :: rho_edge, rho_zz, theta_m + real(kind=RKIND),dimension(:,:,:), pointer :: scalars, tend_scalars + + call mpas_pool_get_subpool(structs, 'tend', tend) + call mpas_pool_get_subpool(structs, 'state', state) + call mpas_pool_get_subpool(structs, 'diag', diag) + + MPAS_ACC_TIMER_START('atm_srk3: physics ACC_data_xfer') + call mpas_pool_get_array(state, 'theta_m', theta_m, 1) + call mpas_pool_get_array(state, 'scalars', scalars, 1) + call mpas_pool_get_array(state, 'rho_zz', rho_zz, 2) + call mpas_pool_get_array(diag , 'rho_edge', rho_edge) + !$acc update self(theta_m, scalars, rho_zz, rho_edge) + + call mpas_pool_get_array(tend, 'scalars_tend', tend_scalars) + !$acc update self(tend_scalars) + MPAS_ACC_TIMER_STOP('atm_srk3: physics ACC_data_xfer') + + end subroutine update_d2h_pre_add_tend_anal_incr !================================================================================================== subroutine atm_add_tend_anal_incr (configs, structs, itimestep, dt, tend_ru, tend_rtheta, tend_rho) @@ -148,7 +180,6 @@ subroutine atm_add_tend_anal_incr (configs, structs, itimestep, dt, tend_ru, ten call mpas_pool_get_array(state, 'scalars', scalars, 1) call mpas_pool_get_array(state, 'rho_zz', rho_zz, 2) call mpas_pool_get_array(diag , 'rho_edge', rho_edge) - !$acc update self(theta_m, scalars, rho_zz, rho_edge) call mpas_pool_get_dimension(state, 'moist_start', moist_start) call mpas_pool_get_dimension(state, 'moist_end', moist_end) @@ -161,8 +192,6 @@ subroutine atm_add_tend_anal_incr (configs, structs, itimestep, dt, tend_ru, ten ! call mpas_pool_get_array(tend, 'rho_zz', tend_rho) ! call mpas_pool_get_array(tend, 'theta_m', tend_theta) call mpas_pool_get_array(tend, 'scalars_tend', tend_scalars) - !$acc update self(tend_scalars) - MPAS_ACC_TIMER_STOP('atm_srk3: physics ACC_data_xfer') call mpas_pool_get_array(tend_iau, 'theta', theta_amb) call mpas_pool_get_array(tend_iau, 'rho', rho_amb) diff --git a/src/core_atmosphere/dynamics/mpas_atm_time_integration.F b/src/core_atmosphere/dynamics/mpas_atm_time_integration.F index 18dbe434ea..4bcc59cb66 100644 --- a/src/core_atmosphere/dynamics/mpas_atm_time_integration.F +++ b/src/core_atmosphere/dynamics/mpas_atm_time_integration.F @@ -29,6 +29,7 @@ module atm_time_integration #ifdef DO_PHYSICS use mpas_atmphys_driver_microphysics + use mpas_atmphys_interface, only: update_d2h_pre_microphysics, update_h2d_post_microphysics use mpas_atmphys_todynamics use mpas_atmphys_utilities #endif @@ -1985,6 +1986,7 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) call mpas_timer_stop('atm_compute_moist_coefficients') #ifdef DO_PHYSICS + call update_d2h_pre_physics_get_tend(block % configs, state, diag, tend) call mpas_timer_start('physics_get_tend') rk_step = 1 dynamics_substep = 1 @@ -1993,6 +1995,7 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) tend_ru_physics, tend_rtheta_physics, tend_rho_physics, & exchange_halo_group ) call mpas_timer_stop('physics_get_tend') + call update_h2d_post_physics_get_tend(block % configs, state, diag, tend) #else #ifndef MPAS_CAM_DYCORE ! @@ -2008,6 +2011,7 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) ! IAU - Incremental Analysis Update ! if (trim(config_IAU_option) /= 'off') then + call update_d2h_pre_add_tend_anal_incr(block % configs, block % structs) call atm_add_tend_anal_incr(block % configs, block % structs, itimestep, dt, & tend_ru_physics, tend_rtheta_physics, tend_rho_physics) end if @@ -2614,7 +2618,6 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) !$acc update self(rthdynten) MPAS_ACC_TIMER_STOP('atm_srk3: physics ACC_data_xfer') - !NOTE: The calculation of the tendency due to horizontal and vertical advection for the water vapor mixing ratio !requires that the subroutine atm_advance_scalars_mono was called on the third Runge Kutta step, so that a halo !update for the scalars at time_levs(1) is applied. A halo update for the scalars at time_levs(2) is done above. @@ -2643,6 +2646,7 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) MPAS_ACC_TIMER_STOP('atm_srk3: physics ACC_data_xfer') !call microphysics schemes: if (trim(config_microp_scheme) /= 'off') then + call update_d2h_pre_microphysics( block % configs, state, diag, 2) call mpas_timer_start('microphysics') !$OMP PARALLEL DO do thread=1,nThreads @@ -2651,6 +2655,7 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) end do !$OMP END PARALLEL DO call mpas_timer_stop('microphysics') + call update_h2d_post_microphysics( block % configs, state, diag, tend, 2) end if ! diff --git a/src/core_atmosphere/physics/mpas_atmphys_interface.F b/src/core_atmosphere/physics/mpas_atmphys_interface.F index afd8ed2810..4e65cffd7a 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_interface.F +++ b/src/core_atmosphere/physics/mpas_atmphys_interface.F @@ -6,13 +6,6 @@ ! distributed with this code, or at http://mpas-dev.github.com/license.html ! !================================================================================================================= - module mpas_atmphys_interface - use mpas_kind_types - use mpas_pool_routines - - use mpas_atmphys_constants - use mpas_atmphys_vars - use mpas_timer #ifdef MPAS_OPENACC #define MPAS_ACC_TIMER_START(X) call mpas_timer_start(X) @@ -22,6 +15,13 @@ module mpas_atmphys_interface #define MPAS_ACC_TIMER_STOP(X) #endif + module mpas_atmphys_interface + use mpas_kind_types + use mpas_pool_routines + + use mpas_atmphys_constants + use mpas_atmphys_vars + use mpas_timer implicit none private @@ -555,6 +555,40 @@ subroutine MPAS_to_physics(configs,mesh,state,time_lev,diag,diag_physics,its,ite end subroutine MPAS_to_physics +!================================================================================================================= + subroutine update_d2h_pre_microphysics(configs,state,diag,time_lev) +!================================================================================================================= + +!input variables: + type(mpas_pool_type),intent(in):: configs + type(mpas_pool_type),intent(in):: state + type(mpas_pool_type),intent(in):: diag + + integer:: time_lev + +!local pointers: + real(kind=RKIND),dimension(:,:),pointer :: exner,pressure_b,w + real(kind=RKIND),dimension(:,:),pointer :: rho_zz,theta_m,pressure_p + real(kind=RKIND),dimension(:,:,:),pointer:: scalars + + + MPAS_ACC_TIMER_START('update_d2h_pre_microphysics [ACC_data_xfer]') + call mpas_pool_get_array(diag,'exner' ,exner ) + call mpas_pool_get_array(diag,'pressure_base',pressure_b) + call mpas_pool_get_array(diag,'pressure_p' ,pressure_p) + + call mpas_pool_get_array(state,'rho_zz' ,rho_zz ,time_lev) + call mpas_pool_get_array(state,'theta_m',theta_m,time_lev) + call mpas_pool_get_array(state,'w' ,w ,time_lev) + !$acc update host(exner, pressure_b, pressure_p, rho_zz, theta_m, w) + + call mpas_pool_get_array(state,'scalars',scalars,time_lev) + !$acc update host(scalars) + + MPAS_ACC_TIMER_STOP('update_d2h_pre_microphysics [ACC_data_xfer]') + +end subroutine update_d2h_pre_microphysics + !================================================================================================================= subroutine microphysics_from_MPAS(configs,mesh,state,time_lev,diag,diag_physics,tend_physics,its,ite) !================================================================================================================= @@ -598,7 +632,6 @@ subroutine microphysics_from_MPAS(configs,mesh,state,time_lev,diag,diag_physics, call mpas_pool_get_array(mesh,'zgrid',zgrid) call mpas_pool_get_array(mesh,'zz' ,zz ) - MPAS_ACC_TIMER_START('atm_srk3: physics ACC_data_xfer') call mpas_pool_get_array(diag,'exner' ,exner ) call mpas_pool_get_array(diag,'pressure_base',pressure_b) call mpas_pool_get_array(diag,'pressure_p' ,pressure_p) @@ -606,14 +639,11 @@ subroutine microphysics_from_MPAS(configs,mesh,state,time_lev,diag,diag_physics, call mpas_pool_get_array(state,'rho_zz' ,rho_zz ,time_lev) call mpas_pool_get_array(state,'theta_m',theta_m,time_lev) call mpas_pool_get_array(state,'w' ,w ,time_lev) - !$acc update host(exner, pressure_b, pressure_p, rho_zz, theta_m, w) call mpas_pool_get_dimension(state,'index_qv',index_qv) call mpas_pool_get_dimension(state,'index_qc',index_qc) call mpas_pool_get_dimension(state,'index_qr',index_qr) - call mpas_pool_get_array(state,'scalars',scalars,time_lev) - !$acc update host(scalars) - MPAS_ACC_TIMER_STOP('atm_srk3: physics ACC_data_xfer') + call mpas_pool_get_array(state,'scalars',scalars,time_lev) qv => scalars(index_qv,:,:) qc => scalars(index_qc,:,:) qr => scalars(index_qr,:,:) @@ -1054,13 +1084,49 @@ subroutine microphysics_to_MPAS(configs,mesh,state,time_lev,diag,diag_physics,te case default end select mp_tend_select - MPAS_ACC_TIMER_START('atm_srk3: physics ACC_data_xfer') + end subroutine microphysics_to_MPAS + + !================================================================================================================= + subroutine update_h2d_post_microphysics(configs,state,diag,tend,time_lev) +!================================================================================================================= + +!input variables: + type(mpas_pool_type),intent(in):: configs + type(mpas_pool_type),intent(in):: state + type(mpas_pool_type),intent(in):: diag + type(mpas_pool_type),intent(inout):: tend + + + integer:: time_lev + +!local pointers: + real(kind=RKIND),dimension(:,:),pointer :: exner,exner_b,pressure_b,rtheta_p,rtheta_b + real(kind=RKIND),dimension(:,:),pointer :: rho_zz,theta_m,pressure_p + real(kind=RKIND),dimension(:,:,:),pointer:: scalars + real(kind=RKIND),dimension(:,:),pointer :: rt_diabatic_tend + + call mpas_pool_get_array(diag,'exner' ,exner ) + call mpas_pool_get_array(diag,'exner_base' ,exner_b ) + call mpas_pool_get_array(diag,'pressure_base',pressure_b) + call mpas_pool_get_array(diag,'pressure_p' ,pressure_p) + call mpas_pool_get_array(diag,'rtheta_base' ,rtheta_b ) + call mpas_pool_get_array(diag,'rtheta_p' ,rtheta_p ) + + call mpas_pool_get_array(state,'rho_zz' ,rho_zz ,time_lev) + call mpas_pool_get_array(state,'theta_m',theta_m,time_lev) + + call mpas_pool_get_array(state,'scalars',scalars,time_lev) + + call mpas_pool_get_array(tend,'rt_diabatic_tend',rt_diabatic_tend) + + + MPAS_ACC_TIMER_START('update_h2d_post_microphysics [ACC_data_xfer]') !$acc update device(exner, exner_b, pressure_b, pressure_p, rtheta_b) !$acc update device(rtheta_p, rho_zz, theta_m, scalars) !$acc update device(rt_diabatic_tend) - MPAS_ACC_TIMER_STOP('atm_srk3: physics ACC_data_xfer') + MPAS_ACC_TIMER_STOP('update_h2d_post_microphysics [ACC_data_xfer]') - end subroutine microphysics_to_MPAS +end subroutine update_h2d_post_microphysics !================================================================================================================= end module mpas_atmphys_interface diff --git a/src/core_atmosphere/physics/mpas_atmphys_todynamics.F b/src/core_atmosphere/physics/mpas_atmphys_todynamics.F index 290cc56330..2cb94a7ba5 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_todynamics.F +++ b/src/core_atmosphere/physics/mpas_atmphys_todynamics.F @@ -6,6 +6,15 @@ ! distributed with this code, or at http://mpas-dev.github.com/license.html ! !================================================================================================================= + +#ifdef MPAS_OPENACC +#define MPAS_ACC_TIMER_START(X) call mpas_timer_start(X) +#define MPAS_ACC_TIMER_STOP(X) call mpas_timer_stop(X) +#else +#define MPAS_ACC_TIMER_START(X) +#define MPAS_ACC_TIMER_STOP(X) +#endif + module mpas_atmphys_todynamics use mpas_kind_types use mpas_pool_routines @@ -17,15 +26,7 @@ module mpas_atmphys_todynamics implicit none private - public:: physics_get_tend - -#ifdef MPAS_OPENACC -#define MPAS_ACC_TIMER_START(X) call mpas_timer_start(X) -#define MPAS_ACC_TIMER_STOP(X) call mpas_timer_stop(X) -#else -#define MPAS_ACC_TIMER_START(X) -#define MPAS_ACC_TIMER_STOP(X) -#endif + public:: physics_get_tend, update_d2h_pre_physics_get_tend, update_h2d_post_physics_get_tend !Interface between the physics parameterizations and the non-hydrostatic dynamical core. @@ -69,6 +70,40 @@ end subroutine halo_exchange_routine contains + +!================================================================================================================= + subroutine update_d2h_pre_physics_get_tend(configs,state,diag,tend) +!================================================================================================================= + +!input variables: + type(mpas_pool_type),intent(in):: configs + type(mpas_pool_type),intent(in):: state + type(mpas_pool_type),intent(in):: diag + type(mpas_pool_type),intent(in):: tend + +!local variables: + real(kind=RKIND),dimension(:,:),pointer:: mass ! time level 2 rho_zz + real(kind=RKIND),dimension(:,:),pointer:: mass_edge ! diag rho_edge + real(kind=RKIND),dimension(:,:),pointer:: theta_m ! time level 1 + real(kind=RKIND),dimension(:,:,:),pointer:: scalars + + real(kind=RKIND),dimension(:,:),pointer:: tend_u_phys + real(kind=RKIND),dimension(:,:,:),pointer:: tend_scalars + + MPAS_ACC_TIMER_START('atm_srk3: physics ACC_data_xfer') + call mpas_pool_get_array(state,'theta_m' ,theta_m,1) + call mpas_pool_get_array(state,'scalars' ,scalars,1) + call mpas_pool_get_array(state,'rho_zz' ,mass,2 ) + call mpas_pool_get_array(diag ,'rho_edge',mass_edge) + call mpas_pool_get_array(diag ,'tend_u_phys',tend_u_phys) + + !$acc update self(theta_m, scalars, mass, mass_edge) + + call mpas_pool_get_array(tend,'scalars_tend',tend_scalars) + !$acc update self(tend_scalars) ! Probably not needed + MPAS_ACC_TIMER_STOP('atm_srk3: physics ACC_data_xfer') + + end subroutine update_d2h_pre_physics_get_tend !================================================================================================================= subroutine physics_get_tend(block,mesh,state,diag,tend,tend_physics,configs,rk_step,dynamics_substep, & @@ -136,14 +171,12 @@ subroutine physics_get_tend(block,mesh,state,diag,tend,tend_physics,configs,rk_s call mpas_pool_get_config(configs,'config_radt_lw_scheme' ,radt_lw_scheme ) call mpas_pool_get_config(configs,'config_radt_sw_scheme' ,radt_sw_scheme ) - MPAS_ACC_TIMER_START('atm_srk3: physics ACC_data_xfer') call mpas_pool_get_array(state,'theta_m' ,theta_m,1) call mpas_pool_get_array(state,'scalars' ,scalars,1) call mpas_pool_get_array(state,'rho_zz' ,mass,2 ) call mpas_pool_get_array(diag ,'rho_edge',mass_edge) call mpas_pool_get_array(diag ,'tend_u_phys',tend_u_phys) - !$acc update self(theta_m, scalars, mass, mass_edge) call mpas_pool_get_dimension(state,'index_qv',index_qv) call mpas_pool_get_dimension(state,'index_qc',index_qc) call mpas_pool_get_dimension(state,'index_qr',index_qr) @@ -181,8 +214,6 @@ subroutine physics_get_tend(block,mesh,state,diag,tend,tend_physics,configs,rk_s call mpas_pool_get_array(tend_physics,'rthratensw',rthratensw) call mpas_pool_get_array(tend,'scalars_tend',tend_scalars) -!$acc update self(tend_scalars) ! Probably not needed -MPAS_ACC_TIMER_STOP('atm_srk3: physics ACC_data_xfer') !initialize the tendency for the potential temperature and all scalars due to PBL, convection, @@ -232,10 +263,6 @@ subroutine physics_get_tend(block,mesh,state,diag,tend,tend_physics,configs,rk_s tend_th,tend_rtheta_physics,tend_scalars,tend_ru_physics,tend_u_phys, & exchange_halo_group) -MPAS_ACC_TIMER_START('atm_srk3: physics ACC_data_xfer') -!$acc update device(tend_scalars) -MPAS_ACC_TIMER_STOP('atm_srk3: physics ACC_data_xfer') - !clean up any pointers that were allocated with zero size before the call to physics_get_tend_work: if(size(rucuten) == 0 ) deallocate(rucuten ) if(size(rvcuten) == 0 ) deallocate(rvcuten ) @@ -262,6 +289,26 @@ subroutine physics_get_tend(block,mesh,state,diag,tend,tend_physics,configs,rk_s end subroutine physics_get_tend + !================================================================================================================= + subroutine update_h2d_post_physics_get_tend(configs,state,diag,tend) +!================================================================================================================= + +!input variables: + type(mpas_pool_type),intent(in):: configs + type(mpas_pool_type),intent(in):: state + type(mpas_pool_type),intent(in):: diag + type(mpas_pool_type),intent(in):: tend + +!local variables: + real(kind=RKIND),dimension(:,:,:),pointer:: tend_scalars + + MPAS_ACC_TIMER_START('atm_srk3: physics ACC_data_xfer') + call mpas_pool_get_array(tend,'scalars_tend',tend_scalars) + !$acc update device(tend_scalars) + MPAS_ACC_TIMER_STOP('atm_srk3: physics ACC_data_xfer') + + end subroutine update_h2d_post_physics_get_tend + !================================================================================================================= subroutine physics_get_tend_work( & block,mesh,nCells,nEdges,nCellsSolve,nEdgesSolve,rk_step,dynamics_substep, & From f55d6509a8f30f4c7325a366460dbf7510e893e4 Mon Sep 17 00:00:00 2001 From: Abishek Gopal Date: Thu, 3 Jul 2025 17:10:06 -0600 Subject: [PATCH 04/11] Removing acc data xfer timers for device variables using create/delete --- .../dynamics/mpas_atm_time_integration.F | 14 +------------- 1 file changed, 1 insertion(+), 13 deletions(-) diff --git a/src/core_atmosphere/dynamics/mpas_atm_time_integration.F b/src/core_atmosphere/dynamics/mpas_atm_time_integration.F index 4bcc59cb66..1a221b22ef 100644 --- a/src/core_atmosphere/dynamics/mpas_atm_time_integration.F +++ b/src/core_atmosphere/dynamics/mpas_atm_time_integration.F @@ -3251,9 +3251,7 @@ subroutine atm_compute_vert_imp_coefs_work(nCells, moist_start, moist_end, dts, real (kind=RKIND) :: dtseps, c2, qtotal, rcv real (kind=RKIND), dimension( nVertLevels ) :: b_tri, c_tri - MPAS_ACC_TIMER_START('atm_compute_vert_imp_coefs_work [ACC_data_xfer]') !$acc enter data create(b_tri, c_tri) - MPAS_ACC_TIMER_STOP('atm_compute_vert_imp_coefs_work [ACC_data_xfer]') ! set coefficients dtseps = .5*dts*(1.+epssm) @@ -3333,9 +3331,7 @@ subroutine atm_compute_vert_imp_coefs_work(nCells, moist_start, moist_end, dts, end do ! loop over cells !$acc end parallel - MPAS_ACC_TIMER_START('atm_compute_vert_imp_coefs_work [ACC_data_xfer]') - !$acc exit data copyout(b_tri, c_tri) - MPAS_ACC_TIMER_STOP('atm_compute_vert_imp_coefs_work [ACC_data_xfer]') + !$acc exit data delete(b_tri, c_tri) end subroutine atm_compute_vert_imp_coefs_work @@ -8144,9 +8140,7 @@ subroutine atm_bdy_adjust_dynamics_relaxzone_tend( config, tend, state, diag, me divdamp_coef = divdamp_coef_ptr vertexDegree = vertexDegree_ptr - MPAS_ACC_TIMER_START('atm_bdy_adjust_dynamics_relaxzone_tend [ACC_data_xfer]') !$acc enter data create(divergence1, divergence2, vorticity1, vorticity2) - MPAS_ACC_TIMER_STOP('atm_bdy_adjust_dynamics_relaxzone_tend [ACC_data_xfer]') ! First, Rayleigh damping terms for ru, rtheta_m and rho_zz !$acc parallel default(present) @@ -8291,9 +8285,7 @@ subroutine atm_bdy_adjust_dynamics_relaxzone_tend( config, tend, state, diag, me end do ! end of loop over edges !$acc end parallel - MPAS_ACC_TIMER_START('atm_bdy_adjust_dynamics_relaxzone_tend [ACC_data_xfer]') !$acc exit data delete(divergence1, divergence2, vorticity1, vorticity2) - MPAS_ACC_TIMER_STOP('atm_bdy_adjust_dynamics_relaxzone_tend [ACC_data_xfer]') end subroutine atm_bdy_adjust_dynamics_relaxzone_tend @@ -8429,9 +8421,7 @@ subroutine atm_bdy_adjust_scalars_work( scalars_new, scalars_driving, dt, dt_rk, integer :: iCell, iEdge, iScalar, i, k, cell1, cell2 !--- - MPAS_ACC_TIMER_START('atm_bdy_adjust_scalars [ACC_data_xfer]') !$acc enter data create(scalars_tmp) - MPAS_ACC_TIMER_STOP('atm_bdy_adjust_scalars [ACC_data_xfer]') !$acc parallel default(present) !$acc loop gang worker @@ -8513,9 +8503,7 @@ subroutine atm_bdy_adjust_scalars_work( scalars_new, scalars_driving, dt, dt_rk, end do !$acc end parallel - MPAS_ACC_TIMER_START('atm_bdy_adjust_scalars [ACC_data_xfer]') !$acc exit data delete(scalars_tmp) - MPAS_ACC_TIMER_STOP('atm_bdy_adjust_scalars [ACC_data_xfer]') end subroutine atm_bdy_adjust_scalars_work From cf373f52fdb286304500ae54ce06e3e01583e394 Mon Sep 17 00:00:00 2001 From: Abishek Gopal Date: Mon, 7 Jul 2025 19:10:23 -0600 Subject: [PATCH 05/11] Using acc declare create for rho_zz_int and corresponding cleanup --- .../dynamics/mpas_atm_time_integration.F | 10 +--------- 1 file changed, 1 insertion(+), 9 deletions(-) diff --git a/src/core_atmosphere/dynamics/mpas_atm_time_integration.F b/src/core_atmosphere/dynamics/mpas_atm_time_integration.F index 1a221b22ef..b26c4344db 100644 --- a/src/core_atmosphere/dynamics/mpas_atm_time_integration.F +++ b/src/core_atmosphere/dynamics/mpas_atm_time_integration.F @@ -86,6 +86,7 @@ end subroutine halo_exchange_routine !$acc declare create(s_max_arr, s_min_arr) !$acc declare create(flux_array, flux_upwind_tmp_arr) !$acc declare create(flux_tmp_arr, wdtn_arr) + !$acc declare create(rho_zz_int) real (kind=RKIND), dimension(:,:), allocatable :: ru_driving_tend ! regional_MPAS addition real (kind=RKIND), dimension(:,:), allocatable :: rt_driving_tend ! regional_MPAS addition @@ -5011,12 +5012,6 @@ subroutine atm_advance_scalars_mono_work(field_name, block, state, nCells, nEdge ! The transport will maintain this positive definite solution and optionally, shape preservation (monotonicity). - MPAS_ACC_TIMER_START('atm_advance_scalars_mono [ACC_data_xfer]') - if (local_advance_density) then - !$acc enter data copyin(rho_zz_int) - end if - MPAS_ACC_TIMER_STOP('atm_advance_scalars_mono [ACC_data_xfer]') - !$acc parallel !$acc loop gang worker @@ -5607,9 +5602,6 @@ subroutine atm_advance_scalars_mono_work(field_name, block, state, nCells, nEdge end do ! loop over scalars MPAS_ACC_TIMER_START('atm_advance_scalars_mono [ACC_data_xfer]') - if (local_advance_density) then - !$acc exit data copyout(rho_zz_int) - end if !$acc exit data delete(scale_arr) MPAS_ACC_TIMER_STOP('atm_advance_scalars_mono [ACC_data_xfer]') From 34d4c8c389a4987e9eaf89e105d29e749e37f0a4 Mon Sep 17 00:00:00 2001 From: Abishek Gopal Date: Mon, 7 Jul 2025 19:12:52 -0600 Subject: [PATCH 06/11] Removing atm_advance_scalars_mono ACC_data_xfer timers around create/delete --- src/core_atmosphere/dynamics/mpas_atm_time_integration.F | 4 ---- 1 file changed, 4 deletions(-) diff --git a/src/core_atmosphere/dynamics/mpas_atm_time_integration.F b/src/core_atmosphere/dynamics/mpas_atm_time_integration.F index b26c4344db..6684f46a09 100644 --- a/src/core_atmosphere/dynamics/mpas_atm_time_integration.F +++ b/src/core_atmosphere/dynamics/mpas_atm_time_integration.F @@ -5096,9 +5096,7 @@ subroutine atm_advance_scalars_mono_work(field_name, block, state, nCells, nEdge end if - MPAS_ACC_TIMER_START('atm_advance_scalars_mono [ACC_data_xfer]') !$acc enter data create(scale_arr) - MPAS_ACC_TIMER_STOP('atm_advance_scalars_mono [ACC_data_xfer]') do iScalar = 1, num_scalars @@ -5601,9 +5599,7 @@ subroutine atm_advance_scalars_mono_work(field_name, block, state, nCells, nEdge end do ! loop over scalars - MPAS_ACC_TIMER_START('atm_advance_scalars_mono [ACC_data_xfer]') !$acc exit data delete(scale_arr) - MPAS_ACC_TIMER_STOP('atm_advance_scalars_mono [ACC_data_xfer]') end subroutine atm_advance_scalars_mono_work From 9d3c3fcd6398b1f523a5d502dd859c01e87467fc Mon Sep 17 00:00:00 2001 From: Abishek Gopal Date: Tue, 8 Jul 2025 16:31:09 -0600 Subject: [PATCH 07/11] Simplifying OpenACC data transfers around the call to mpas_reconstruct_2d This commit introduces two OpenACC data transfer routines, mpas_reconstruct_2d_h2d and mpas_reconstruct_2d_d2h in order to remove the data transfers from the mpas_reconstruct_2d routine itself. This also allows us to remove extraneous data movements within the atm_srk3 routine. mpas_reconstruct_2d_h2d and mpas_reconstruct_2d_d2h are called before and after the call to mpas_reconstruct in atm_mpas_init_block. And the reconstructed vector fields are also copied to and from the device before and after every dynamics call in mpas_atm_pre_dynamics_h2d and mpas_atm_post_dynamics_d2h. --- .../dynamics/mpas_atm_time_integration.F | 40 ++++++ src/core_atmosphere/mpas_atm_core.F | 4 + src/operators/mpas_vector_reconstruction.F | 115 ++++++++++++++++-- 3 files changed, 148 insertions(+), 11 deletions(-) diff --git a/src/core_atmosphere/dynamics/mpas_atm_time_integration.F b/src/core_atmosphere/dynamics/mpas_atm_time_integration.F index 6684f46a09..b24d4cebfd 100644 --- a/src/core_atmosphere/dynamics/mpas_atm_time_integration.F +++ b/src/core_atmosphere/dynamics/mpas_atm_time_integration.F @@ -846,6 +846,7 @@ subroutine mpas_atm_pre_dynamics_h2d(domain) #ifdef MPAS_OPENACC + type (mpas_pool_type), pointer :: mesh type (mpas_pool_type), pointer :: state type (mpas_pool_type), pointer :: diag type (mpas_pool_type), pointer :: tend @@ -879,6 +880,10 @@ subroutine mpas_atm_pre_dynamics_h2d(domain) real (kind=RKIND), dimension(:,:,:), pointer :: scalars_1, scalars_2 real (kind=RKIND), dimension(:,:), pointer :: ruAvg, wwAvg, ruAvg_split, wwAvg_split + integer, pointer :: nCells_ptr + integer :: nCells + real (kind=RKIND), dimension(:,:), pointer :: uReconstructZonal, uReconstructMeridional, uReconstructX, uReconstructY, uReconstructZ + real (kind=RKIND), dimension(:,:), pointer :: tend_ru, tend_rt, tend_rho, tend_rw, rt_diabatic_tend real (kind=RKIND), dimension(:,:), pointer :: tend_u_euler, tend_w_euler, tend_theta_euler real(kind=RKIND), dimension(:,:), pointer :: tend_w_pgf, tend_w_buoy @@ -892,11 +897,13 @@ subroutine mpas_atm_pre_dynamics_h2d(domain) real (kind=RKIND), dimension(:,:,:), pointer :: lbc_scalars, lbc_tend_scalars + nullify(mesh) nullify(state) nullify(diag) nullify(tend) nullify(tend_physics) nullify(lbc) + call mpas_pool_get_subpool(domain % blocklist % structs, 'mesh', mesh) call mpas_pool_get_subpool(domain % blocklist % structs, 'state', state) call mpas_pool_get_subpool(domain % blocklist % structs, 'diag', diag) call mpas_pool_get_subpool(domain % blocklist % structs, 'tend', tend) @@ -1006,6 +1013,19 @@ subroutine mpas_atm_pre_dynamics_h2d(domain) call mpas_pool_get_array(diag, 'wwAvg_split', wwAvg_split) !$acc enter data copyin(wwAvg_split) + call mpas_pool_get_dimension(mesh, 'nCellsSolve', nCells_ptr) + nCells = nCells_ptr + call mpas_pool_get_array(diag, 'uReconstructX', uReconstructX) + !$acc enter data create(uReconstructX(:,1:nCells)) + call mpas_pool_get_array(diag, 'uReconstructY', uReconstructY) + !$acc enter data create(uReconstructY(:,1:nCells)) + call mpas_pool_get_array(diag, 'uReconstructZ', uReconstructZ) + !$acc enter data create(uReconstructZ(:,1:nCells)) + call mpas_pool_get_array(diag, 'uReconstructZonal', uReconstructZonal) + !$acc enter data create(uReconstructZonal(:,1:nCells)) + call mpas_pool_get_array(diag, 'uReconstructMeridional', uReconstructMeridional) + !$acc enter data create(uReconstructMeridional(:,1:nCells)) + call mpas_pool_get_array(state, 'u', u_1, 1) !$acc enter data copyin(u_1) call mpas_pool_get_array(state, 'u', u_2, 2) @@ -1108,6 +1128,7 @@ subroutine mpas_atm_post_dynamics_d2h(domain) #ifdef MPAS_OPENACC + type (mpas_pool_type), pointer :: mesh type (mpas_pool_type), pointer :: state type (mpas_pool_type), pointer :: diag type (mpas_pool_type), pointer :: tend @@ -1141,6 +1162,10 @@ subroutine mpas_atm_post_dynamics_d2h(domain) real (kind=RKIND), dimension(:,:,:), pointer :: scalars_1, scalars_2 real (kind=RKIND), dimension(:,:), pointer :: ruAvg, wwAvg, ruAvg_split, wwAvg_split + integer, pointer :: nCells_ptr + integer :: nCells + real (kind=RKIND), dimension(:,:), pointer :: uReconstructZonal, uReconstructMeridional, uReconstructX, uReconstructY, uReconstructZ + real (kind=RKIND), dimension(:,:), pointer :: tend_ru, tend_rt, tend_rho, tend_rw, rt_diabatic_tend real (kind=RKIND), dimension(:,:), pointer :: tend_u_euler, tend_w_euler, tend_theta_euler real(kind=RKIND), dimension(:,:), pointer :: tend_w_pgf, tend_w_buoy @@ -1154,11 +1179,13 @@ subroutine mpas_atm_post_dynamics_d2h(domain) real (kind=RKIND), dimension(:,:,:), pointer :: lbc_scalars, lbc_tend_scalars + nullify(mesh) nullify(state) nullify(diag) nullify(tend) nullify(tend_physics) nullify(lbc) + call mpas_pool_get_subpool(domain % blocklist % structs, 'mesh', mesh) call mpas_pool_get_subpool(domain % blocklist % structs, 'state', state) call mpas_pool_get_subpool(domain % blocklist % structs, 'diag', diag) call mpas_pool_get_subpool(domain % blocklist % structs, 'tend', tend) @@ -1268,6 +1295,19 @@ subroutine mpas_atm_post_dynamics_d2h(domain) call mpas_pool_get_array(diag, 'wwAvg_split', wwAvg_split) !$acc exit data copyout(wwAvg_split) + call mpas_pool_get_dimension(mesh, 'nCellsSolve', nCells_ptr) + nCells = nCells_ptr + call mpas_pool_get_array(diag, 'uReconstructX', uReconstructX) + !$acc exit data copyout(uReconstructX(:,1:nCells)) + call mpas_pool_get_array(diag, 'uReconstructY', uReconstructY) + !$acc exit data copyout(uReconstructY(:,1:nCells)) + call mpas_pool_get_array(diag, 'uReconstructZ', uReconstructZ) + !$acc exit data copyout(uReconstructZ(:,1:nCells)) + call mpas_pool_get_array(diag, 'uReconstructZonal', uReconstructZonal) + !$acc exit data copyout(uReconstructZonal(:,1:nCells)) + call mpas_pool_get_array(diag, 'uReconstructMeridional', uReconstructMeridional) + !$acc exit data copyout(uReconstructMeridional(:,1:nCells)) + call mpas_pool_get_array(state, 'u', u_1, 1) !$acc exit data copyout(u_1) call mpas_pool_get_array(state, 'u', u_2, 2) diff --git a/src/core_atmosphere/mpas_atm_core.F b/src/core_atmosphere/mpas_atm_core.F index d1b9931c6c..087cfc2f2c 100644 --- a/src/core_atmosphere/mpas_atm_core.F +++ b/src/core_atmosphere/mpas_atm_core.F @@ -543,6 +543,8 @@ subroutine atm_mpas_init_block(dminfo, stream_manager, block, mesh, dt) call mpas_pool_get_array(diag, 'uReconstructZ', uReconstructZ) call mpas_pool_get_array(diag, 'uReconstructZonal', uReconstructZonal) call mpas_pool_get_array(diag, 'uReconstructMeridional', uReconstructMeridional) + call mpas_reconstruct_2d_h2d(mesh, u, uReconstructX, uReconstructY, uReconstructZ, & + uReconstructZonal, uReconstructMeridional) call mpas_reconstruct(mesh, u, & uReconstructX, & uReconstructY, & @@ -550,6 +552,8 @@ subroutine atm_mpas_init_block(dminfo, stream_manager, block, mesh, dt) uReconstructZonal, & uReconstructMeridional & ) + call mpas_reconstruct_2d_d2h(mesh, u, uReconstructX, uReconstructY, uReconstructZ, & + uReconstructZonal, uReconstructMeridional) #ifdef DO_PHYSICS !proceed with initialization of physics parameterization if moist_physics is set to true: diff --git a/src/operators/mpas_vector_reconstruction.F b/src/operators/mpas_vector_reconstruction.F index 605da9cd6d..2aa4ca2aee 100644 --- a/src/operators/mpas_vector_reconstruction.F +++ b/src/operators/mpas_vector_reconstruction.F @@ -258,16 +258,6 @@ subroutine mpas_reconstruct_2d(meshPool, u, uReconstructX, uReconstructY, uRecon call mpas_pool_get_config(meshPool, 'on_a_sphere', on_a_sphere) - MPAS_ACC_TIMER_START('mpas_reconstruct_2d [ACC_data_xfer]') - ! Only use sections needed, nCells may be all cells or only non-halo cells - !$acc enter data copyin(coeffs_reconstruct(:,:,1:nCells),nEdgesOnCell(1:nCells), & - !$acc edgesOnCell(:,1:nCells),latCell(1:nCells),lonCell(1:nCells)) - !$acc enter data copyin(u(:,:)) - !$acc enter data create(uReconstructX(:,1:nCells),uReconstructY(:,1:nCells), & - !$acc uReconstructZ(:,1:nCells),uReconstructZonal(:,1:nCells), & - !$acc uReconstructMeridional(:,1:nCells)) - MPAS_ACC_TIMER_STOP('mpas_reconstruct_2d [ACC_data_xfer]') - ! loop over cell centers !$omp do schedule(runtime) !$acc parallel default(present) @@ -337,6 +327,109 @@ subroutine mpas_reconstruct_2d(meshPool, u, uReconstructX, uReconstructY, uRecon !$omp end do end if + end subroutine mpas_reconstruct_2d!}}} + + + subroutine mpas_reconstruct_2d_h2d(meshPool, u, uReconstructX, uReconstructY, uReconstructZ, uReconstructZonal, uReconstructMeridional, includeHalos)!{{{ + + implicit none + + type (mpas_pool_type), intent(in) :: meshPool !< Input: Mesh information + real (kind=RKIND), dimension(:,:), intent(in) :: u !< Input: Velocity field on edges + real (kind=RKIND), dimension(:,:), intent(out) :: uReconstructX !< Output: X Component of velocity reconstructed to cell centers + real (kind=RKIND), dimension(:,:), intent(out) :: uReconstructY !< Output: Y Component of velocity reconstructed to cell centers + real (kind=RKIND), dimension(:,:), intent(out) :: uReconstructZ !< Output: Z Component of velocity reconstructed to cell centers + real (kind=RKIND), dimension(:,:), intent(out) :: uReconstructZonal !< Output: Zonal Component of velocity reconstructed to cell centers + real (kind=RKIND), dimension(:,:), intent(out) :: uReconstructMeridional !< Output: Meridional Component of velocity reconstructed to cell centers + logical, optional, intent(in) :: includeHalos !< Input: Optional logical that allows reconstruction over halo regions + + logical :: includeHalosLocal + integer, dimension(:,:), pointer :: edgesOnCell + integer, dimension(:), pointer :: nEdgesOnCell + integer :: nCells + integer, pointer :: nCells_ptr + real(kind=RKIND), dimension(:), pointer :: latCell, lonCell + real (kind=RKIND), dimension(:,:,:), pointer :: coeffs_reconstruct + + if ( present(includeHalos) ) then + includeHalosLocal = includeHalos + else + includeHalosLocal = .false. + end if + + ! stored arrays used during compute procedure + call mpas_pool_get_array(meshPool, 'coeffs_reconstruct', coeffs_reconstruct) + + ! temporary variables + call mpas_pool_get_array(meshPool, 'nEdgesOnCell', nEdgesOnCell) + call mpas_pool_get_array(meshPool, 'edgesOnCell', edgesOnCell) + call mpas_pool_get_array(meshPool, 'latCell', latCell) + call mpas_pool_get_array(meshPool, 'lonCell', lonCell) + + if ( includeHalosLocal ) then + call mpas_pool_get_dimension(meshPool, 'nCells', nCells_ptr) + else + call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCells_ptr) + end if + nCells = nCells_ptr + + MPAS_ACC_TIMER_START('mpas_reconstruct_2d [ACC_data_xfer]') + ! Only use sections needed, nCells may be all cells or only non-halo cells + !$acc enter data copyin(coeffs_reconstruct(:,:,1:nCells),nEdgesOnCell(1:nCells), & + !$acc edgesOnCell(:,1:nCells),latCell(1:nCells),lonCell(1:nCells)) + !$acc enter data copyin(u(:,:)) + !$acc enter data create(uReconstructX(:,1:nCells),uReconstructY(:,1:nCells), & + !$acc uReconstructZ(:,1:nCells),uReconstructZonal(:,1:nCells), & + !$acc uReconstructMeridional(:,1:nCells)) + MPAS_ACC_TIMER_STOP('mpas_reconstruct_2d [ACC_data_xfer]') + + end subroutine mpas_reconstruct_2d_h2d + + + + subroutine mpas_reconstruct_2d_d2h(meshPool, u, uReconstructX, uReconstructY, uReconstructZ, uReconstructZonal, uReconstructMeridional, includeHalos)!{{{ + + implicit none + + type (mpas_pool_type), intent(in) :: meshPool !< Input: Mesh information + real (kind=RKIND), dimension(:,:), intent(in) :: u !< Input: Velocity field on edges + real (kind=RKIND), dimension(:,:), intent(out) :: uReconstructX !< Output: X Component of velocity reconstructed to cell centers + real (kind=RKIND), dimension(:,:), intent(out) :: uReconstructY !< Output: Y Component of velocity reconstructed to cell centers + real (kind=RKIND), dimension(:,:), intent(out) :: uReconstructZ !< Output: Z Component of velocity reconstructed to cell centers + real (kind=RKIND), dimension(:,:), intent(out) :: uReconstructZonal !< Output: Zonal Component of velocity reconstructed to cell centers + real (kind=RKIND), dimension(:,:), intent(out) :: uReconstructMeridional !< Output: Meridional Component of velocity reconstructed to cell centers + logical, optional, intent(in) :: includeHalos !< Input: Optional logical that allows reconstruction over halo regions + + logical :: includeHalosLocal + integer, dimension(:,:), pointer :: edgesOnCell + integer, dimension(:), pointer :: nEdgesOnCell + integer :: nCells + integer, pointer :: nCells_ptr + real(kind=RKIND), dimension(:), pointer :: latCell, lonCell + real (kind=RKIND), dimension(:,:,:), pointer :: coeffs_reconstruct + + if ( present(includeHalos) ) then + includeHalosLocal = includeHalos + else + includeHalosLocal = .false. + end if + + ! stored arrays used during compute procedure + call mpas_pool_get_array(meshPool, 'coeffs_reconstruct', coeffs_reconstruct) + + ! temporary variables + call mpas_pool_get_array(meshPool, 'nEdgesOnCell', nEdgesOnCell) + call mpas_pool_get_array(meshPool, 'edgesOnCell', edgesOnCell) + call mpas_pool_get_array(meshPool, 'latCell', latCell) + call mpas_pool_get_array(meshPool, 'lonCell', lonCell) + + if ( includeHalosLocal ) then + call mpas_pool_get_dimension(meshPool, 'nCells', nCells_ptr) + else + call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCells_ptr) + end if + nCells = nCells_ptr + MPAS_ACC_TIMER_START('mpas_reconstruct_2d [ACC_data_xfer]') !$acc exit data delete(coeffs_reconstruct(:,:,1:nCells),nEdgesOnCell(1:nCells), & !$acc edgesOnCell(:,1:nCells),latCell(1:nCells),lonCell(1:nCells)) @@ -346,7 +439,7 @@ subroutine mpas_reconstruct_2d(meshPool, u, uReconstructX, uReconstructY, uRecon !$acc uReconstructMeridional(:,1:nCells)) MPAS_ACC_TIMER_STOP('mpas_reconstruct_2d [ACC_data_xfer]') - end subroutine mpas_reconstruct_2d!}}} + end subroutine mpas_reconstruct_2d_d2h !*********************************************************************** From 4b7137d9c29719afb006961060f259230449e993 Mon Sep 17 00:00:00 2001 From: Abishek Gopal Date: Thu, 14 Aug 2025 10:31:53 -0600 Subject: [PATCH 08/11] Need to copyout u_2 and w_2 at the end of dynamics --- src/core_atmosphere/dynamics/mpas_atm_time_integration.F | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core_atmosphere/dynamics/mpas_atm_time_integration.F b/src/core_atmosphere/dynamics/mpas_atm_time_integration.F index b24d4cebfd..5cb15624f2 100644 --- a/src/core_atmosphere/dynamics/mpas_atm_time_integration.F +++ b/src/core_atmosphere/dynamics/mpas_atm_time_integration.F @@ -1311,11 +1311,11 @@ subroutine mpas_atm_post_dynamics_d2h(domain) call mpas_pool_get_array(state, 'u', u_1, 1) !$acc exit data copyout(u_1) call mpas_pool_get_array(state, 'u', u_2, 2) - !$acc exit data delete(u_2) + !$acc exit data copyout(u_2) call mpas_pool_get_array(state, 'w', w_1, 1) !$acc exit data copyout(w_1) call mpas_pool_get_array(state, 'w', w_2, 2) - !$acc exit data delete(w_2) + !$acc exit data copyout(w_2) call mpas_pool_get_array(state, 'theta_m', theta_m_1, 1) !$acc exit data copyout(theta_m_1) ! use values from atm_init_coupled_diagnostics call mpas_pool_get_array(state, 'theta_m', theta_m_2, 2) From 70c1e4217c223ef97353765be23e0bfdd1264910 Mon Sep 17 00:00:00 2001 From: Abishek Gopal Date: Fri, 22 Aug 2025 13:36:24 -0600 Subject: [PATCH 09/11] Fixes to produce correct results with CURVATURE This commit introduces changes to ensure that building with -DCURVATURE still produces the correct results, compared to the nvhpc cpu reference. This involves removing the data movement of the reconstructed zonal and meridional velocities in the atm_compute_dyn_tend_work subroutine and instead using copyin for the same fields in mpas_atm_pre_dynamics_h2d. This commit also removes the ACC data Xfer timers for the atm_compute_dyn_tend_work subroutine, as we only have create/delete statements --- .../dynamics/mpas_atm_time_integration.F | 14 ++------------ 1 file changed, 2 insertions(+), 12 deletions(-) diff --git a/src/core_atmosphere/dynamics/mpas_atm_time_integration.F b/src/core_atmosphere/dynamics/mpas_atm_time_integration.F index 5cb15624f2..5576d18fea 100644 --- a/src/core_atmosphere/dynamics/mpas_atm_time_integration.F +++ b/src/core_atmosphere/dynamics/mpas_atm_time_integration.F @@ -1022,9 +1022,9 @@ subroutine mpas_atm_pre_dynamics_h2d(domain) call mpas_pool_get_array(diag, 'uReconstructZ', uReconstructZ) !$acc enter data create(uReconstructZ(:,1:nCells)) call mpas_pool_get_array(diag, 'uReconstructZonal', uReconstructZonal) - !$acc enter data create(uReconstructZonal(:,1:nCells)) + !$acc enter data copyin(uReconstructZonal(:,1:nCells)) call mpas_pool_get_array(diag, 'uReconstructMeridional', uReconstructMeridional) - !$acc enter data create(uReconstructMeridional(:,1:nCells)) + !$acc enter data copyin(uReconstructMeridional(:,1:nCells)) call mpas_pool_get_array(state, 'u', u_1, 1) !$acc enter data copyin(u_1) @@ -6071,12 +6071,7 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm coef3*abs(ua)*((q_ip1 - q_im2)-3.*(q_i-q_im1))/12.0 - MPAS_ACC_TIMER_START('atm_compute_dyn_tend_work [ACC_data_xfer]') !$acc enter data create(rayleigh_damp_coef) - #ifdef CURVATURE - !$acc enter data copyin(ur_cell, vr_cell) - #endif - MPAS_ACC_TIMER_STOP('atm_compute_dyn_tend_work [ACC_data_xfer]') prandtl_inv = 1.0_RKIND / prandtl invDt = 1.0_RKIND / dt @@ -7074,12 +7069,7 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm end do !$acc end parallel - MPAS_ACC_TIMER_START('atm_compute_dyn_tend_work [ACC_data_xfer]') !$acc exit data delete(rayleigh_damp_coef) - #ifdef CURVATURE - !$acc exit data delete(ur_cell, vr_cell) - #endif - MPAS_ACC_TIMER_STOP('atm_compute_dyn_tend_work [ACC_data_xfer]') end subroutine atm_compute_dyn_tend_work From c69475181760760b9e77ab038665d5da6a3b4122 Mon Sep 17 00:00:00 2001 From: Abishek Gopal Date: Fri, 3 Oct 2025 15:05:50 -0600 Subject: [PATCH 10/11] Adding option to enable GPU execution of mpas_reconstruct_2d --- .../dynamics/mpas_atm_time_integration.F | 3 ++- src/core_atmosphere/mpas_atm_core.F | 3 ++- src/operators/mpas_vector_reconstruction.F | 17 +++++++++++++---- 3 files changed, 17 insertions(+), 6 deletions(-) diff --git a/src/core_atmosphere/dynamics/mpas_atm_time_integration.F b/src/core_atmosphere/dynamics/mpas_atm_time_integration.F index 5576d18fea..7ab9b65866 100644 --- a/src/core_atmosphere/dynamics/mpas_atm_time_integration.F +++ b/src/core_atmosphere/dynamics/mpas_atm_time_integration.F @@ -2630,7 +2630,8 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) uReconstructY, & uReconstructZ, & uReconstructZonal, & - uReconstructMeridional & + uReconstructMeridional, & + lACC = .true. & ) diff --git a/src/core_atmosphere/mpas_atm_core.F b/src/core_atmosphere/mpas_atm_core.F index 087cfc2f2c..248cdf2393 100644 --- a/src/core_atmosphere/mpas_atm_core.F +++ b/src/core_atmosphere/mpas_atm_core.F @@ -550,7 +550,8 @@ subroutine atm_mpas_init_block(dminfo, stream_manager, block, mesh, dt) uReconstructY, & uReconstructZ, & uReconstructZonal, & - uReconstructMeridional & + uReconstructMeridional, & + lACC = .true. & ) call mpas_reconstruct_2d_d2h(mesh, u, uReconstructX, uReconstructY, uReconstructZ, & uReconstructZonal, uReconstructMeridional) diff --git a/src/operators/mpas_vector_reconstruction.F b/src/operators/mpas_vector_reconstruction.F index 2aa4ca2aee..88d87474ab 100644 --- a/src/operators/mpas_vector_reconstruction.F +++ b/src/operators/mpas_vector_reconstruction.F @@ -202,7 +202,8 @@ end subroutine mpas_init_reconstruct!}}} !> Input: grid meta data and vector component data residing at cell edges !> Output: reconstructed vector field (measured in X,Y,Z) located at cell centers !----------------------------------------------------------------------- - subroutine mpas_reconstruct_2d(meshPool, u, uReconstructX, uReconstructY, uReconstructZ, uReconstructZonal, uReconstructMeridional, includeHalos)!{{{ + subroutine mpas_reconstruct_2d(meshPool, u, uReconstructX, uReconstructY, uReconstructZ, & + uReconstructZonal, uReconstructMeridional, includeHalos, lACC)!{{{ implicit none @@ -214,9 +215,11 @@ subroutine mpas_reconstruct_2d(meshPool, u, uReconstructX, uReconstructY, uRecon real (kind=RKIND), dimension(:,:), intent(out) :: uReconstructZonal !< Output: Zonal Component of velocity reconstructed to cell centers real (kind=RKIND), dimension(:,:), intent(out) :: uReconstructMeridional !< Output: Meridional Component of velocity reconstructed to cell centers logical, optional, intent(in) :: includeHalos !< Input: Optional logical that allows reconstruction over halo regions + logical, optional, intent(in) :: lACC !< Input: Optional logical that controls execution on the GPU with OpenACC ! temporary arrays needed in the compute procedure logical :: includeHalosLocal + logical :: lACCLocal integer, pointer :: nCells_ptr, nVertLevels_ptr integer :: nCells, nVertLevels integer, dimension(:,:), pointer :: edgesOnCell @@ -236,6 +239,12 @@ subroutine mpas_reconstruct_2d(meshPool, u, uReconstructX, uReconstructY, uRecon includeHalosLocal = .false. end if + if ( present(lACC) ) then + lACCLocal = lACC + else + lACCLocal = .false. + end if + ! stored arrays used during compute procedure call mpas_pool_get_array(meshPool, 'coeffs_reconstruct', coeffs_reconstruct) @@ -260,7 +269,7 @@ subroutine mpas_reconstruct_2d(meshPool, u, uReconstructX, uReconstructY, uRecon ! loop over cell centers !$omp do schedule(runtime) - !$acc parallel default(present) + !$acc parallel default(present) if(lACCLocal) !$acc loop gang do iCell = 1, nCells ! initialize the reconstructed vectors @@ -295,7 +304,7 @@ subroutine mpas_reconstruct_2d(meshPool, u, uReconstructX, uReconstructY, uRecon if (on_a_sphere) then !$omp do schedule(runtime) - !$acc parallel default(present) + !$acc parallel default(present) if(lACCLocal) !$acc loop gang do iCell = 1, nCells clat = cos(latCell(iCell)) @@ -315,7 +324,7 @@ subroutine mpas_reconstruct_2d(meshPool, u, uReconstructX, uReconstructY, uRecon !$omp end do else !$omp do schedule(runtime) - !$acc parallel default(present) + !$acc parallel default(present) if(lACCLocal) !$acc loop gang vector collapse(2) do iCell = 1, nCells do k = 1, nVertLevels From 905f1a0e187ba2be654f5c6be2a6c391f7f695cd Mon Sep 17 00:00:00 2001 From: Abishek Gopal Date: Mon, 13 Oct 2025 14:00:23 -0600 Subject: [PATCH 11/11] fixes needed with intel compiler --- src/core_atmosphere/dynamics/mpas_atm_iau.F | 14 +++++++------- .../physics/mpas_atmphys_interface.F | 2 ++ 2 files changed, 9 insertions(+), 7 deletions(-) diff --git a/src/core_atmosphere/dynamics/mpas_atm_iau.F b/src/core_atmosphere/dynamics/mpas_atm_iau.F index d5999e18c7..7459de89b4 100644 --- a/src/core_atmosphere/dynamics/mpas_atm_iau.F +++ b/src/core_atmosphere/dynamics/mpas_atm_iau.F @@ -6,13 +6,13 @@ ! distributed with this code, or at http://mpas-dev.github.com/license.html ! - #ifdef MPAS_OPENACC - #define MPAS_ACC_TIMER_START(X) call mpas_timer_start(X) - #define MPAS_ACC_TIMER_STOP(X) call mpas_timer_stop(X) - #else - #define MPAS_ACC_TIMER_START(X) - #define MPAS_ACC_TIMER_STOP(X) - #endif +#ifdef MPAS_OPENACC +#define MPAS_ACC_TIMER_START(X) call mpas_timer_start(X) +#define MPAS_ACC_TIMER_STOP(X) call mpas_timer_stop(X) +#else +#define MPAS_ACC_TIMER_START(X) +#define MPAS_ACC_TIMER_STOP(X) +#endif module mpas_atm_iau diff --git a/src/core_atmosphere/physics/mpas_atmphys_interface.F b/src/core_atmosphere/physics/mpas_atmphys_interface.F index 4e65cffd7a..76a7e4fb6d 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_interface.F +++ b/src/core_atmosphere/physics/mpas_atmphys_interface.F @@ -27,6 +27,8 @@ module mpas_atmphys_interface private public:: allocate_forall_physics, & deallocate_forall_physics, & + update_d2h_pre_microphysics, & + update_h2d_post_microphysics, & MPAS_to_physics, & microphysics_from_MPAS, & microphysics_to_MPAS