From 00a610bd11f7b0313fe36cf16cb5c6ba70f83308 Mon Sep 17 00:00:00 2001 From: Abishek Gopal Date: Thu, 23 Jul 2026 14:25:01 -0600 Subject: [PATCH 1/5] 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..dc19885cb6 100644 --- a/src/core_atmosphere/dynamics/mpas_atm_time_integration.F +++ b/src/core_atmosphere/dynamics/mpas_atm_time_integration.F @@ -5551,7 +5551,7 @@ subroutine atm_advance_scalars_mono_work(field_name, block, state, nCells, nEdge !$acc end parallel !$OMP BARRIER - + call mpas_timer_start('atm_advance_scalars_mono_work_5555') !$acc parallel !$acc loop gang worker @@ -5615,7 +5615,7 @@ subroutine atm_advance_scalars_mono_work(field_name, block, state, nCells, nEdge end if !$acc end parallel - + call mpas_timer_stop('atm_advance_scalars_mono_work_5555') ! ! communicate scale factors here. ! communicate only first halo row in these next two exchanges From 0c4e7d05b538fd9aa4a04909cbccf4864e611e77 Mon Sep 17 00:00:00 2001 From: Abishek Gopal Date: Thu, 23 Jul 2026 15:16:52 -0600 Subject: [PATCH 2/5] Opt 1 - Split up into different parallel regions --- src/core_atmosphere/dynamics/mpas_atm_time_integration.F | 9 +++++++-- 1 file changed, 7 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 dc19885cb6..bb722241d1 100644 --- a/src/core_atmosphere/dynamics/mpas_atm_time_integration.F +++ b/src/core_atmosphere/dynamics/mpas_atm_time_integration.F @@ -5573,7 +5573,7 @@ subroutine atm_advance_scalars_mono_work(field_name, block, state, nCells, nEdge end do end do - + !$acc end parallel ! ! next, the limiter @@ -5583,6 +5583,7 @@ subroutine atm_advance_scalars_mono_work(field_name, block, state, nCells, nEdge ! worked through algebra and found equivalent form ! added benefit that it should address ifort single prec overflow issue if (local_advance_density) then + !$acc parallel !$acc loop gang worker do iCell=cellSolveStart,cellSolveEnd @@ -5597,7 +5598,9 @@ subroutine atm_advance_scalars_mono_work(field_name, block, state, nCells, nEdge scale_arr(k,SCALE_OUT,iCell) = min( 1.0_RKIND, max( 0.0_RKIND, scale_factor) ) end do end do + !$acc end parallel else + !$acc parallel !$acc loop gang worker do iCell=cellSolveStart,cellSolveEnd @@ -5612,10 +5615,12 @@ subroutine atm_advance_scalars_mono_work(field_name, block, state, nCells, nEdge scale_arr(k,SCALE_OUT,iCell) = min( 1.0_RKIND, max( 0.0_RKIND, scale_factor) ) end do end do + !$acc end parallel end if - !$acc end parallel + call mpas_timer_stop('atm_advance_scalars_mono_work_5555') + ! ! communicate scale factors here. ! communicate only first halo row in these next two exchanges From 56d45839f112e56b09af7de52a4c0c8ec1f26b72 Mon Sep 17 00:00:00 2001 From: Abishek Gopal Date: Thu, 23 Jul 2026 16:03:13 -0600 Subject: [PATCH 3/5] Opt 2 - Use vector collapse(2) for last two parallel regions --- src/core_atmosphere/dynamics/mpas_atm_time_integration.F | 8 ++------ 1 file changed, 2 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 bb722241d1..f2423fa6e6 100644 --- a/src/core_atmosphere/dynamics/mpas_atm_time_integration.F +++ b/src/core_atmosphere/dynamics/mpas_atm_time_integration.F @@ -5584,10 +5584,8 @@ subroutine atm_advance_scalars_mono_work(field_name, block, state, nCells, nEdge ! added benefit that it should address ifort single prec overflow issue if (local_advance_density) then !$acc parallel - !$acc loop gang worker + !$acc loop gang worker vector collapse(2) do iCell=cellSolveStart,cellSolveEnd - - !$acc loop vector do k = 1, nVertLevels scale_factor = (s_max(k,iCell)*rho_zz_int(k,iCell) - scalar_new(k,iCell)) / & (scale_arr(k,SCALE_IN,iCell) + eps) @@ -5601,10 +5599,8 @@ subroutine atm_advance_scalars_mono_work(field_name, block, state, nCells, nEdge !$acc end parallel else !$acc parallel - !$acc loop gang worker + !$acc loop gang worker vector collapse(2) do iCell=cellSolveStart,cellSolveEnd - - !$acc loop vector do k = 1, nVertLevels scale_factor = (s_max(k,iCell)*rho_zz_new(k,iCell) - scalar_new(k,iCell)) / & (scale_arr(k,SCALE_IN,iCell) + eps) From 5dba28083276fe5edbc8fa9b5b051dec3ca943ab Mon Sep 17 00:00:00 2001 From: Abishek Gopal Date: Thu, 23 Jul 2026 16:58:00 -0600 Subject: [PATCH 4/5] Opt 3 - Swap loop vector and seq in first parallel region --- .../dynamics/mpas_atm_time_integration.F | 26 +++++++++---------- 1 file changed, 13 insertions(+), 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 f2423fa6e6..62b787d5c3 100644 --- a/src/core_atmosphere/dynamics/mpas_atm_time_integration.F +++ b/src/core_atmosphere/dynamics/mpas_atm_time_integration.F @@ -5165,6 +5165,7 @@ subroutine atm_advance_scalars_mono_work(field_name, block, state, nCells, nEdge real (kind=RKIND), dimension(nVertLevels) :: flux_upwind_arr real (kind=RKIND) :: flux3, flux4, flux_upwind real (kind=RKIND) :: q_im2, q_im1, q_i, q_ip1, ua, coef3 + real (kind=RKIND) :: iac, eoc_s, f_t #ifdef DEBUG_TRANSPORT real (kind=RKIND) :: scmin,scmax #endif @@ -5556,19 +5557,18 @@ subroutine atm_advance_scalars_mono_work(field_name, block, state, nCells, nEdge !$acc loop gang worker do iCell=cellSolveStart,cellSolveEnd - - !$acc loop seq - do i=1,nEdgesOnCell(iCell) - iEdge = edgesOnCell(i,iCell) - - !$acc loop vector - do k=1, nVertLevels - scalar_new(k,iCell) = scalar_new(k,iCell) - edgesOnCell_sign(i,iCell) * flux_upwind_tmp(k,iEdge) * invAreaCell(iCell) - - scale_arr(k,SCALE_OUT,iCell) = scale_arr(k,SCALE_OUT,iCell) & - - max(0.0_RKIND,edgesOnCell_sign(i,iCell)*flux_tmp(k,iEdge)) * invAreaCell(iCell) - scale_arr(k,SCALE_IN, iCell) = scale_arr(k,SCALE_IN, iCell) & - - min(0.0_RKIND,edgesOnCell_sign(i,iCell)*flux_tmp(k,iEdge)) * invAreaCell(iCell) + iac = invAreaCell(iCell) + !$acc loop vector + do k=1, nVertLevels + !$acc loop seq + do i=1,nEdgesOnCell(iCell) + iEdge = edgesOnCell(i,iCell) + eoc_s = edgesOnCell_sign(i,iCell) + f_t = flux_tmp(k,iEdge) + + scalar_new(k,iCell) = scalar_new(k,iCell) - eoc_s * flux_upwind_tmp(k,iEdge) * iac + scale_arr(k,SCALE_OUT,iCell) = scale_arr(k,SCALE_OUT,iCell) - max(0.0_RKIND,eoc_s*f_t) * iac + scale_arr(k,SCALE_IN, iCell) = scale_arr(k,SCALE_IN, iCell) - min(0.0_RKIND,eoc_s*f_t) * iac end do end do From 937ff3ad8f222e08b83d52f4ef39c95eb5b39a41 Mon Sep 17 00:00:00 2001 From: Abishek Gopal Date: Thu, 23 Jul 2026 17:39:52 -0600 Subject: [PATCH 5/5] Opt 4 - Remove vector collapse(2) in 2nd & 3rd parallel regions --- src/core_atmosphere/dynamics/mpas_atm_time_integration.F | 6 ++++-- 1 file changed, 4 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 62b787d5c3..d27c1491a1 100644 --- a/src/core_atmosphere/dynamics/mpas_atm_time_integration.F +++ b/src/core_atmosphere/dynamics/mpas_atm_time_integration.F @@ -5584,8 +5584,9 @@ subroutine atm_advance_scalars_mono_work(field_name, block, state, nCells, nEdge ! added benefit that it should address ifort single prec overflow issue if (local_advance_density) then !$acc parallel - !$acc loop gang worker vector collapse(2) + !$acc loop gang worker do iCell=cellSolveStart,cellSolveEnd + !$acc loop vector do k = 1, nVertLevels scale_factor = (s_max(k,iCell)*rho_zz_int(k,iCell) - scalar_new(k,iCell)) / & (scale_arr(k,SCALE_IN,iCell) + eps) @@ -5599,8 +5600,9 @@ subroutine atm_advance_scalars_mono_work(field_name, block, state, nCells, nEdge !$acc end parallel else !$acc parallel - !$acc loop gang worker vector collapse(2) + !$acc loop gang worker do iCell=cellSolveStart,cellSolveEnd + !$acc loop vector do k = 1, nVertLevels scale_factor = (s_max(k,iCell)*rho_zz_new(k,iCell) - scalar_new(k,iCell)) / & (scale_arr(k,SCALE_IN,iCell) + eps)