From e8200143563faedcba8dd95f315ebfc12f6ca71b Mon Sep 17 00:00:00 2001 From: Abishek Gopal Date: Tue, 23 Jun 2026 13:48:09 -0600 Subject: [PATCH 1/3] Add timer dyn_tend_work_6652 --- 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..a84c97de0b 100644 --- a/src/core_atmosphere/dynamics/mpas_atm_time_integration.F +++ b/src/core_atmosphere/dynamics/mpas_atm_time_integration.F @@ -6648,7 +6648,7 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm ! ! horizontal advection for w ! - + call mpas_timer_start('atm_dyn_tend_work_6652') !$acc parallel default(present) !$acc loop gang worker private(ru_edge_w, flux_arr) do iCell=cellSolveStart,cellSolveEnd ! Technically updating fewer cells than before... @@ -6696,7 +6696,7 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm end do end do !$acc end parallel - + call mpas_timer_stop('atm_dyn_tend_work_6652') #ifdef CURVATURE !$acc parallel default(present) !$acc loop gang worker From 4338a08e6730a2d2484f289387461ec5c4926bd9 Mon Sep 17 00:00:00 2001 From: Abishek Gopal Date: Tue, 23 Jun 2026 14:24:09 -0600 Subject: [PATCH 2/3] Opt 1 - Swap loops and replace flux_arr with scalar --- .../dynamics/mpas_atm_time_integration.F | 30 +++++++------------ 1 file changed, 10 insertions(+), 20 deletions(-) diff --git a/src/core_atmosphere/dynamics/mpas_atm_time_integration.F b/src/core_atmosphere/dynamics/mpas_atm_time_integration.F index a84c97de0b..b616ae7bdc 100644 --- a/src/core_atmosphere/dynamics/mpas_atm_time_integration.F +++ b/src/core_atmosphere/dynamics/mpas_atm_time_integration.F @@ -6294,7 +6294,7 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm real (kind=RKIND), dimension( nVertLevels ) :: rayleigh_damp_coef - real (kind=RKIND) :: flux3, flux4 + real (kind=RKIND) :: flux3, flux4, flux_arr_local real (kind=RKIND) :: q_im2, q_im1, q_i, q_ip1, ua, coef3 logical, parameter :: perturbation_coriolis = .true. @@ -6650,7 +6650,7 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm ! call mpas_timer_start('atm_dyn_tend_work_6652') !$acc parallel default(present) - !$acc loop gang worker private(ru_edge_w, flux_arr) + !$acc loop gang worker private(ru_edge_w) do iCell=cellSolveStart,cellSolveEnd ! Technically updating fewer cells than before... !$acc loop vector @@ -6669,28 +6669,18 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm ru_edge_w(k) = fzm(k)*ru(k,iEdge) + fzp(k)*ru(k-1,iEdge) end do - !$acc loop vector - do k=1,nVertLevels - flux_arr(k) = 0.0_RKIND - end do - ! flux_arr stores the value of w at the cell edge used in the horizontal transport - !$acc loop seq - do j=1,nAdvCellsForEdge(iEdge) - iAdvCell = advCellsForEdge(j,iEdge) - - !$acc loop vector - do k=2,nVertLevels - scalar_weight = adv_coefs(j,iEdge) + sign(1.0_RKIND,ru_edge_w(k)) * adv_coefs_3rd(j,iEdge) - flux_arr(k) = flux_arr(k) + scalar_weight * w(k,iAdvCell) - end do - end do - -!DIR$ IVDEP !$acc loop vector do k=2,nVertLevels - tend_w(k,iCell) = tend_w(k,iCell) - edgesOnCell_sign(i,iCell) * ru_edge_w(k)*flux_arr(k) + flux_arr_local = 0.0_RKIND + !$acc loop seq + do j=1,nAdvCellsForEdge(iEdge) + iAdvCell = advCellsForEdge(j,iEdge) + scalar_weight = adv_coefs(j,iEdge) + sign(1.0_RKIND,ru_edge_w(k)) * adv_coefs_3rd(j,iEdge) + flux_arr_local = flux_arr_local + scalar_weight * w(k,iAdvCell) + end do + tend_w(k,iCell) = tend_w(k,iCell) - edgesOnCell_sign(i,iCell) * ru_edge_w(k)*flux_arr_local end do end do From 80ce4e948c0aa07b65e0cc042147294485348139 Mon Sep 17 00:00:00 2001 From: Abishek Gopal Date: Wed, 24 Jun 2026 11:22:32 -0600 Subject: [PATCH 3/3] Opt 2 --- .../dynamics/mpas_atm_time_integration.F | 23 ++++++++++++++----- 1 file 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 b616ae7bdc..0f64947129 100644 --- a/src/core_atmosphere/dynamics/mpas_atm_time_integration.F +++ b/src/core_atmosphere/dynamics/mpas_atm_time_integration.F @@ -6674,12 +6674,23 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm !$acc loop vector do k=2,nVertLevels flux_arr_local = 0.0_RKIND - !$acc loop seq - do j=1,nAdvCellsForEdge(iEdge) - iAdvCell = advCellsForEdge(j,iEdge) - scalar_weight = adv_coefs(j,iEdge) + sign(1.0_RKIND,ru_edge_w(k)) * adv_coefs_3rd(j,iEdge) - flux_arr_local = flux_arr_local + scalar_weight * w(k,iAdvCell) - end do + + select case(nAdvCellsForEdge(iEdge)) + case (10) + !$acc loop seq + do j=1,nAdvCellsForEdge(iEdge) + iAdvCell = advCellsForEdge(j,iEdge) + scalar_weight = adv_coefs(j,iEdge) + sign(1.0_RKIND,ru_edge_w(k)) * adv_coefs_3rd(j,iEdge) + flux_arr_local = flux_arr_local + scalar_weight * w(k,iAdvCell) + end do + case default + !$acc loop seq + do j=1,nAdvCellsForEdge(iEdge) + iAdvCell = advCellsForEdge(j,iEdge) + scalar_weight = adv_coefs(j,iEdge) + sign(1.0_RKIND,ru_edge_w(k)) * adv_coefs_3rd(j,iEdge) + flux_arr_local = flux_arr_local + scalar_weight * w(k,iAdvCell) + end do + end select tend_w(k,iCell) = tend_w(k,iCell) - edgesOnCell_sign(i,iCell) * ru_edge_w(k)*flux_arr_local end do