drain_swept_flux_x Subroutine

private pure subroutine drain_swept_flux_x(nx, ny, nz, areaT, uhh, hprev, aL, aR, a6, F)

MOM6 swept-average CW parabola flux for the zonal faces. Face i, donor = cell (i-1) if uhh>0 else cell (i). Per-pass Courant CFL = |uhh| / (areaT·hprev) on the donor, clamped [0,1]. uhh >= 0: F = uhh·( aR − 0.5·CFL·((aR−aL) − a6·(1 − ⅔·CFL)) ) uhh < 0: F = uhh·( aL + 0.5·CFL·((aR−aL) + a6·(1 − ⅔·CFL)) )

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: nx
integer, intent(in) :: ny
integer, intent(in) :: nz
real(kind=wp), intent(in) :: areaT(nx,ny)
real(kind=wp), intent(in) :: uhh(nx+1,ny,nz)
real(kind=wp), intent(in) :: hprev(nx,ny,nz)
real(kind=wp), intent(in) :: aL(nx,ny,nz)
real(kind=wp), intent(in) :: aR(nx,ny,nz)
real(kind=wp), intent(in) :: a6(nx,ny,nz)
real(kind=wp), intent(inout) :: F(nx+1,ny,nz)

Calls

proc~~drain_swept_flux_x~~CallsGraph proc~drain_swept_flux_x drain_swept_flux_x local local proc~drain_swept_flux_x->local

Called by

proc~~drain_swept_flux_x~~CalledByGraph proc~drain_swept_flux_x drain_swept_flux_x proc~continuity_tracer_drain continuity_tracer_drain proc~continuity_tracer_drain->proc~drain_swept_flux_x proc~ocean_dyn_flush_tracer_window ocean_dyn_flush_tracer_window proc~ocean_dyn_flush_tracer_window->proc~continuity_tracer_drain proc~ocean_dyn_step ocean_dyn_step proc~ocean_dyn_step->proc~continuity_tracer_drain proc~ocean_dyn_step_split ocean_dyn_step_split proc~ocean_dyn_step_split->proc~continuity_tracer_drain proc~driver_run_ocean driver_run_ocean proc~driver_run_ocean->proc~ocean_dyn_flush_tracer_window proc~engine_step engine_step proc~driver_run_ocean->proc~engine_step proc~engine_step->proc~ocean_dyn_step proc~engine_step->proc~ocean_dyn_step_split proc~rdb_ocean_set_tracer rdb_ocean_set_tracer proc~rdb_ocean_set_tracer->proc~ocean_dyn_flush_tracer_window proc~driver_run driver_run proc~driver_run->proc~driver_run_ocean proc~rdb_ocean_step rdb_ocean_step proc~rdb_ocean_step->proc~engine_step

Variables

Type Visibility Attributes Name Initial
real(kind=wp), private :: cfl
real(kind=wp), private :: conc
integer, private :: i
integer, private :: j
integer, private :: k
real(kind=wp), private :: u
real(kind=wp), private :: vol

Source Code

   pure subroutine drain_swept_flux_x(nx, ny, nz, areaT, uhh, hprev, aL, aR, a6, F)
      !! MOM6 swept-average CW parabola flux for the zonal faces.
      !! Face i, donor = cell (i-1) if uhh>0 else cell (i).  Per-pass
      !! Courant CFL = |uhh| / (areaT·hprev) on the donor, clamped [0,1].
      !!   uhh >= 0: F = uhh·( aR − 0.5·CFL·((aR−aL) − a6·(1 − ⅔·CFL)) )
      !!   uhh <  0: F = uhh·( aL + 0.5·CFL·((aR−aL) + a6·(1 − ⅔·CFL)) )
      integer, intent(in) :: nx, ny, nz
      real(wp), intent(in) :: areaT(nx, ny)
      real(wp), intent(in) :: uhh(nx + 1, ny, nz)
      real(wp), intent(in) :: hprev(nx, ny, nz)
      real(wp), intent(in) :: aL(nx, ny, nz), aR(nx, ny, nz), a6(nx, ny, nz)
      real(wp), intent(inout) :: F(nx + 1, ny, nz)
      integer :: i, j, k
      real(wp) :: u, cfl, vol, conc
      ! Array-edge faces (1, nx+1) have no donor cell -- the u>0 donor at
      ! face 1 is cell 0 and the u<0 donor at face nx+1 is cell nx+1, both
      ! off the [1,nx] cell arrays.  They feed only ghost cells the caller
      ! re-wraps, so set them to zero.  Explicit do concurrent (not the
      ! F(1,:,:)=0 array-section assignment, which does not reliably
      ! offload under stdpar).
      do concurrent(k=1:nz, j=1:ny)
         F(1, j, k) = 0.0_wp
         F(nx + 1, j, k) = 0.0_wp
      end do
      ! Interior faces 2..nx: the u>0 donor i-1 >= 1 and the u<0 donor i
      ! <= nx are both in range.  (Was i=1:nx+1, which read cell 0 / nx+1
      ! at the edge faces -- a latent OOB that only faults once the array
      ! is page-aligned at large grids.)
      do concurrent(k=1:nz, j=1:ny, i=2:nx) local(u, cfl, vol, conc)
         u = uhh(i, j, k)
         if (u > 0.0_wp) then
            vol = max(areaT(i - 1, j)*hprev(i - 1, j, k), DRAIN_MIN_VOL)
            cfl = min(u/vol, 1.0_wp)
            conc = aR(i - 1, j, k) - 0.5_wp*cfl* &
                   ((aR(i - 1, j, k) - aL(i - 1, j, k)) &
                    - a6(i - 1, j, k)*(1.0_wp - (2.0_wp/3.0_wp)*cfl))
            F(i, j, k) = u*conc
         else if (u < 0.0_wp) then
            vol = max(areaT(i, j)*hprev(i, j, k), DRAIN_MIN_VOL)
            cfl = min(-u/vol, 1.0_wp)
            conc = aL(i, j, k) + 0.5_wp*cfl* &
                   ((aR(i, j, k) - aL(i, j, k)) &
                    + a6(i, j, k)*(1.0_wp - (2.0_wp/3.0_wp)*cfl))
            F(i, j, k) = u*conc
         else
            F(i, j, k) = 0.0_wp
         end if
      end do
   end subroutine drain_swept_flux_x