diff --git a/src/core_atmosphere/dynamics/mpas_atm_time_integration.F b/src/core_atmosphere/dynamics/mpas_atm_time_integration.F
index 227fbde862..d27c1491a1 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
@@ -5551,29 +5552,28 @@ 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
          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
          end do
-
+         !$acc end parallel
 
          !
          !  next, the limiter
@@ -5583,9 +5583,9 @@ 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
-
                !$acc loop vector
                do k = 1, nVertLevels
                   scale_factor = (s_max(k,iCell)*rho_zz_int(k,iCell) - scalar_new(k,iCell)) / &
@@ -5597,10 +5597,11 @@ 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
-
                !$acc loop vector
                do k = 1, nVertLevels
                   scale_factor = (s_max(k,iCell)*rho_zz_new(k,iCell) - scalar_new(k,iCell)) / &
@@ -5612,9 +5613,11 @@ 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.