From 420c339e2faee868526e35583d234db75b34ad14 Mon Sep 17 00:00:00 2001 From: Abishek Gopal Date: Fri, 21 Aug 2026 11:40:35 -0600 Subject: [PATCH 1/6] Add timers --- 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 227fbde862..7fb44bef01 100644 --- a/src/core_atmosphere/dynamics/mpas_atm_time_integration.F +++ b/src/core_atmosphere/dynamics/mpas_atm_time_integration.F @@ -3972,7 +3972,7 @@ subroutine atm_advance_acoustic_step_work(nCells, nEdges, nCellsSolve, cellStart end if !$OMP BARRIER - + call mpas_timer_start('atm_advance_acoustic_step_3976') !$acc parallel default(present) !$acc loop gang worker private(ts,rs) do iCell=cellSolveStart,cellSolveEnd ! loop over all owned cells to solve @@ -4104,7 +4104,7 @@ subroutine atm_advance_acoustic_step_work(nCells, nEdges, nCellsSolve, cellStart end do ! end of loop over cells !$acc end parallel - + call mpas_timer_stop('atm_advance_acoustic_step_3976') end subroutine atm_advance_acoustic_step_work From d29206d6e0b9d45a88915546ddd622038756cd32 Mon Sep 17 00:00:00 2001 From: Abishek Gopal Date: Tue, 25 Aug 2026 16:58:50 -0600 Subject: [PATCH 2/6] Opt 1 - split loops --- .../dynamics/mpas_atm_time_integration.F | 18 ++++++++++++++++-- 1 file changed, 16 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 7fb44bef01..f7b30d2480 100644 --- a/src/core_atmosphere/dynamics/mpas_atm_time_integration.F +++ b/src/core_atmosphere/dynamics/mpas_atm_time_integration.F @@ -4046,8 +4046,22 @@ subroutine atm_advance_acoustic_step_work(nCells, nEdges, nCellsSolve, cellStart + cofwt(k-1,iCell)*(etp(k-1)*ts(k-1)+etm(k-1)*rtheta_pp(k-1,iCell))) end do + !$acc loop vector + do k=1,nVertLevels + rho_pp(k,iCell) = rs(k) + rtheta_pp(k,iCell) = ts(k) + end do + + end if + enddo + !$acc end parallel + ! tridiagonal solve sweeping up and then down the column + !$acc parallel default(present) + !$acc loop gang worker + do iCell=cellSolveStart,cellSolveEnd ! loop over all owned cells to solve + if(specZoneMaskCell(iCell) == 0.0) then ! not specified zone, compute... !MGD VECTOR DEPENDENCE !$acc loop seq do k=2,nVertLevels @@ -4084,9 +4098,9 @@ subroutine atm_advance_acoustic_step_work(nCells, nEdges, nCellsSolve, cellStart !DIR$ IVDEP !$acc loop vector do k=1,nVertLevels - rho_pp(k,iCell) = rs(k) - dts*cofrz(k) *( ewp(k+1)*rw_p(k+1,iCell) & + rho_pp(k,iCell) = rho_pp(k,iCell) - dts*cofrz(k) *( ewp(k+1)*rw_p(k+1,iCell) & -ewp(k )*rw_p(k ,iCell)) - rtheta_pp(k,iCell) = ts(k) - dts*rdzw(k)*( ewp(k+1)*coftz(k+1,iCell)*rw_p(k+1,iCell) & + rtheta_pp(k,iCell) = rtheta_pp(k,iCell) - dts*rdzw(k)*( ewp(k+1)*coftz(k+1,iCell)*rw_p(k+1,iCell) & -ewp(k )*coftz(k ,iCell)*rw_p(k ,iCell)) end do From 2206c221dbdcc3353ee1ef87cc9afc26603b30a4 Mon Sep 17 00:00:00 2001 From: Abishek Gopal Date: Thu, 27 Aug 2026 17:05:33 -0600 Subject: [PATCH 3/6] Opt 1 + macros --- .../dynamics/mpas_atm_time_integration.F | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/src/core_atmosphere/dynamics/mpas_atm_time_integration.F b/src/core_atmosphere/dynamics/mpas_atm_time_integration.F index f7b30d2480..722fa15359 100644 --- a/src/core_atmosphere/dynamics/mpas_atm_time_integration.F +++ b/src/core_atmosphere/dynamics/mpas_atm_time_integration.F @@ -9,9 +9,13 @@ #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) +#define RHO_PP(i,j) rho_pp(i, j) +#define RTHETA_PP(i,j) rtheta_pp(i, j) #else #define MPAS_ACC_TIMER_START(X) #define MPAS_ACC_TIMER_STOP(X) +#define RHO_PP(i,j) rho_pp(i) +#define RTHETA_PP(i,j) rtheta_pp(i) #endif module atm_time_integration @@ -4046,6 +4050,7 @@ subroutine atm_advance_acoustic_step_work(nCells, nEdges, nCellsSolve, cellStart + cofwt(k-1,iCell)*(etp(k-1)*ts(k-1)+etm(k-1)*rtheta_pp(k-1,iCell))) end do +#ifdef MPAS_OPENACC !$acc loop vector do k=1,nVertLevels rho_pp(k,iCell) = rs(k) @@ -4056,12 +4061,14 @@ subroutine atm_advance_acoustic_step_work(nCells, nEdges, nCellsSolve, cellStart enddo !$acc end parallel - ! tridiagonal solve sweeping up and then down the column + !$acc parallel default(present) !$acc loop gang worker do iCell=cellSolveStart,cellSolveEnd ! loop over all owned cells to solve if(specZoneMaskCell(iCell) == 0.0) then ! not specified zone, compute... +#endif + ! tridiagonal solve sweeping up and then down the column !MGD VECTOR DEPENDENCE !$acc loop seq do k=2,nVertLevels @@ -4098,9 +4105,9 @@ subroutine atm_advance_acoustic_step_work(nCells, nEdges, nCellsSolve, cellStart !DIR$ IVDEP !$acc loop vector do k=1,nVertLevels - rho_pp(k,iCell) = rho_pp(k,iCell) - dts*cofrz(k) *( ewp(k+1)*rw_p(k+1,iCell) & + rho_pp(k,iCell) = RHO_PP(k,iCell) - dts*cofrz(k) *( ewp(k+1)*rw_p(k+1,iCell) & -ewp(k )*rw_p(k ,iCell)) - rtheta_pp(k,iCell) = rtheta_pp(k,iCell) - dts*rdzw(k)*( ewp(k+1)*coftz(k+1,iCell)*rw_p(k+1,iCell) & + rtheta_pp(k,iCell) = RTHETA_PP(k,iCell) - dts*rdzw(k)*( ewp(k+1)*coftz(k+1,iCell)*rw_p(k+1,iCell) & -ewp(k )*coftz(k ,iCell)*rw_p(k ,iCell)) end do From 166ef882bb3c13af1dbeda6971f5c51e7b241dc2 Mon Sep 17 00:00:00 2001 From: Abishek Gopal Date: Thu, 27 Aug 2026 17:13:11 -0600 Subject: [PATCH 4/6] quick fix --- 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 722fa15359..f6d4d36a49 100644 --- a/src/core_atmosphere/dynamics/mpas_atm_time_integration.F +++ b/src/core_atmosphere/dynamics/mpas_atm_time_integration.F @@ -14,8 +14,8 @@ #else #define MPAS_ACC_TIMER_START(X) #define MPAS_ACC_TIMER_STOP(X) -#define RHO_PP(i,j) rho_pp(i) -#define RTHETA_PP(i,j) rtheta_pp(i) +#define RHO_PP(i,j) rs(i) +#define RTHETA_PP(i,j) ts(i) #endif module atm_time_integration From 26098ef9aaa74832f2886e91b31186eca68f2dc9 Mon Sep 17 00:00:00 2001 From: Abishek Gopal Date: Fri, 28 Aug 2026 13:28:22 -0600 Subject: [PATCH 5/6] Opt 2 + macro --- .../dynamics/mpas_atm_time_integration.F | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/src/core_atmosphere/dynamics/mpas_atm_time_integration.F b/src/core_atmosphere/dynamics/mpas_atm_time_integration.F index f6d4d36a49..bd88c86a72 100644 --- a/src/core_atmosphere/dynamics/mpas_atm_time_integration.F +++ b/src/core_atmosphere/dynamics/mpas_atm_time_integration.F @@ -11,11 +11,15 @@ #define MPAS_ACC_TIMER_STOP(X) call mpas_timer_stop(X) #define RHO_PP(i,j) rho_pp(i, j) #define RTHETA_PP(i,j) rtheta_pp(i, j) +#define GPU_LOOP() do i=1,nEdgesOnCell(iCell) +#define CPU_LOOP() #else #define MPAS_ACC_TIMER_START(X) #define MPAS_ACC_TIMER_STOP(X) #define RHO_PP(i,j) rs(i) #define RTHETA_PP(i,j) ts(i) +#define CPU_LOOP() do i=1,nEdgesOnCell(iCell) +#define GPU_LOOP() #endif module atm_time_integration @@ -4001,14 +4005,17 @@ subroutine atm_advance_acoustic_step_work(nCells, nEdges, nCellsSolve, cellStart rs(k) = 0.0 end do - !$acc loop seq - do i=1,nEdgesOnCell(iCell) - iEdge = edgesOnCell(i,iCell) - cell1 = cellsOnEdge(1,iEdge) - cell2 = cellsOnEdge(2,iEdge) + + CPU_LOOP() !DIR$ IVDEP !$acc loop vector do k=1,nVertLevels + !$acc loop seq + GPU_LOOP() + + iEdge = edgesOnCell(i,iCell) + cell1 = cellsOnEdge(1,iEdge) + cell2 = cellsOnEdge(2,iEdge) flux = edgesOnCell_sign(i,iCell)*dts*dvEdge(iEdge)*ru_p(k,iEdge) * invAreaCell(iCell) rs(k) = rs(k)-flux ts(k) = ts(k)-flux*0.5*(theta_m(k,cell2)+theta_m(k,cell1)) From 2c8a236999be40e5cfeb922c46208165c6f67dfa Mon Sep 17 00:00:00 2001 From: Abishek Gopal Date: Tue, 8 Sep 2026 10:44:48 -0600 Subject: [PATCH 6/6] Opt 3 --- src/core_atmosphere/dynamics/mpas_atm_time_integration.F | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/src/core_atmosphere/dynamics/mpas_atm_time_integration.F b/src/core_atmosphere/dynamics/mpas_atm_time_integration.F index bd88c86a72..f170bbbd38 100644 --- a/src/core_atmosphere/dynamics/mpas_atm_time_integration.F +++ b/src/core_atmosphere/dynamics/mpas_atm_time_integration.F @@ -4098,12 +4098,8 @@ subroutine atm_advance_acoustic_step_work(nCells, nEdges, nCellsSolve, cellStart *(fzm(k)*rho_zz(k,iCell)+fzp(k)*rho_zz(k-1,iCell)) & *w(k,iCell) )/(1.0+dts*dss(k,iCell)) & - (rw_save(k ,iCell) - rw(k ,iCell)) - end do - + ! accumulate (rho*omega)' for use later in scalar transport -!DIR$ IVDEP - !$acc loop vector - do k=2,nVertLevels wwAvg(k,iCell) = wwAvg(k,iCell) + ewp(k)*rw_p(k,iCell) end do