continuity_compute_fluxes Subroutine

private pure subroutine continuity_compute_fluxes(grid, metrics, this, ms)

Test-only (no production caller): the unsplit reference path, kept as the oracle the split production path is checked against. Multilayer counterpart to continuity_compute_fluxes_barotropic: identical PPM reconstruction + upwind face pick + flux divergence, lifted per-layer. Each k-slice is independent (the PPM stencil reads only the same k), so the do-concurrent kernels parallelize over (k, j, i) simultaneously for GPU occupancy.

Workspaces (this%h_face_*_x/y) must have been initialised with nz_ml matching ms%nz_ml — handled by passing the optional nz_ml to continuity_init.

Arguments

Type IntentOptional Attributes Name
type(hgrid_t), intent(in) :: grid
type(ocean_metrics_t), intent(in) :: metrics
type(continuity_t), intent(inout) :: this
type(multilayer_state_t), intent(inout) :: ms

Calls

proc~~continuity_compute_fluxes~~CallsGraph proc~continuity_compute_fluxes continuity_compute_fluxes local local proc~continuity_compute_fluxes->local proc~ppm_cell_limiter ppm_cell_limiter proc~continuity_compute_fluxes->proc~ppm_cell_limiter proc~ppm_limit_pos ppm_limit_pos proc~continuity_compute_fluxes->proc~ppm_limit_pos proc~ppm_limited_slope ppm_limited_slope proc~continuity_compute_fluxes->proc~ppm_limited_slope proc~ppm_mirror_h ppm_mirror_h proc~continuity_compute_fluxes->proc~ppm_mirror_h

Variables

Type Visibility Attributes Name Initial
real(kind=wp), private :: dh_0
real(kind=wp), private :: dh_m1
real(kind=wp), private :: dh_p1
logical, private :: do_pos
real(kind=wp), private :: h0
real(kind=wp), private :: h_face
real(kind=wp), private :: h_left
real(kind=wp), private :: h_min_pos
real(kind=wp), private :: h_right
real(kind=wp), private :: hm1
real(kind=wp), private :: hm2
real(kind=wp), private :: hp1
real(kind=wp), private :: hp2
integer, private :: i
integer, private :: j
integer, private :: k
integer, private :: nx
integer, private :: ny
integer, private :: nz
real(kind=wp), private :: u
real(kind=wp), private :: v

Source Code

   pure subroutine continuity_compute_fluxes(grid, metrics, this, ms)
      !! **Test-only** (no production caller): the unsplit reference path,
      !! kept as the oracle the split production path is checked against.
      !! Multilayer counterpart to
      !! `continuity_compute_fluxes_barotropic`: identical PPM
      !! reconstruction + upwind face pick + flux divergence, lifted
      !! per-layer.  Each k-slice is independent (the PPM stencil
      !! reads only the same k), so the do-concurrent kernels
      !! parallelize over (k, j, i) simultaneously for GPU
      !! occupancy.
      !!
      !! Workspaces (`this%h_face_*_x/y`) must have been initialised
      !! with `nz_ml` matching `ms%nz_ml` — handled by passing the
      !! optional `nz_ml` to `continuity_init`.
      type(hgrid_t), intent(in) :: grid
      type(ocean_metrics_t), intent(in) :: metrics
      type(continuity_t), intent(inout) :: this
      type(multilayer_state_t), intent(inout) :: ms

      integer :: i, j, k, nx, ny, nz
      real(wp) :: dh_m1, dh_0, dh_p1, h_left, h_right, u, v, h_face
      real(wp) :: hm2, hm1, h0, hp1, hp2
      logical :: do_pos
      real(wp) :: h_min_pos

      nx = grid%nx_total
      ny = grid%ny_total
      nz = ms%nz_ml
      do_pos = this%use_ppm_limit_pos
      h_min_pos = this%h_min

      ! ============================================================
      ! X-DIRECTION reconstruction (5-point stencil per cell)
      ! ============================================================
      do concurrent(k=1:nz, j=1:ny, i=3:nx - 2) &
         local(dh_m1, dh_0, dh_p1, h_left, h_right, hm2, hm1, h0, hp1, hp2)
         ! Mirror-h at land neighbours (C2); bit-identical for all-wet.
         h0 = ms%h_layer(i, j, k)
         hm1 = ppm_mirror_h(ms%h_layer(i - 1, j, k), h0, metrics%wet_T(i - 1, j))
         hp1 = ppm_mirror_h(ms%h_layer(i + 1, j, k), h0, metrics%wet_T(i + 1, j))
         hm2 = ppm_mirror_h(ms%h_layer(i - 2, j, k), hm1, metrics%wet_T(i - 2, j))
         hp2 = ppm_mirror_h(ms%h_layer(i + 2, j, k), hp1, metrics%wet_T(i + 2, j))
         call ppm_limited_slope(hm2, hm1, h0, dh_m1)
         call ppm_limited_slope(hm1, h0, hp1, dh_0)
         call ppm_limited_slope(h0, hp1, hp2, dh_p1)
         dh_0 = dh_0*metrics%wet_T(i - 1, j)*metrics%wet_T(i, j)*metrics%wet_T(i + 1, j)
         h_left = 0.5_wp*(hm1 + h0) - (dh_0 - dh_m1)/6.0_wp
         h_right = 0.5_wp*(h0 + hp1) - (dh_p1 - dh_0)/6.0_wp
         call ppm_cell_limiter(h0, h_left, h_right)
         if (do_pos) call ppm_limit_pos(h0, h_left, h_right, h_min_pos)
         this%h_face_right_x%data(i, j, k) = h_left
         this%h_face_left_x%data(i + 1, j, k) = h_right
      end do
      ! Boundary cells: 1st-order fallback
      do concurrent(k=1:nz, j=1:ny)
         this%h_face_left_x%data(1, j, k) = ms%h_layer(1, j, k)
         this%h_face_right_x%data(1, j, k) = ms%h_layer(1, j, k)
         this%h_face_left_x%data(2, j, k) = ms%h_layer(1, j, k)
         this%h_face_right_x%data(2, j, k) = ms%h_layer(2, j, k)
         ! Face 3: cell 2's right edge falls back to 1st order (its
         ! 5-point stencil needs cell 0); cell 3's left edge is set
         ! by the interior loop above.
         this%h_face_left_x%data(3, j, k) = ms%h_layer(2, j, k)
         this%h_face_right_x%data(3, j, k) = ms%h_layer(2, j, k)
         ! Face nx-1: mirror of face 3.  Cell nx-1's left edge falls
         ! back to 1st order; cell nx-2's right edge came from the
         ! interior loop.
         this%h_face_right_x%data(nx - 1, j, k) = ms%h_layer(nx - 1, j, k)
         this%h_face_left_x%data(nx, j, k) = ms%h_layer(nx - 1, j, k)
         this%h_face_right_x%data(nx, j, k) = ms%h_layer(nx, j, k)
         this%h_face_left_x%data(nx + 1, j, k) = ms%h_layer(nx, j, k)
         this%h_face_right_x%data(nx + 1, j, k) = ms%h_layer(nx, j, k)
      end do

      ! X-direction face transport (upwind pick) — width-weighted dy_cu
      do concurrent(k=1:nz, j=1:ny, i=2:nx) local(u, h_face)
         u = ms%u_face_x_layer(i, j, k)
         if (u >= 0.0_wp) then
            h_face = this%h_face_left_x%data(i, j, k)
         else
            h_face = this%h_face_right_x%data(i, j, k)
         end if
         ms%mass_flux_x_layer(i, j, k) = u*h_face*metrics%dy_cu(i, j)
      end do
      do concurrent(k=1:nz, j=1:ny)
         ms%mass_flux_x_layer(1, j, k) = 0.0_wp
         ms%mass_flux_x_layer(nx + 1, j, k) = 0.0_wp
      end do
      ! Physical wall zeroing — see `continuity_zonal_flux` for the
      ! full rationale.  Must mirror the split form's wall closure or
      ! `test_split_zonal_only_matches_unsplit` breaks.
      do concurrent(k=1:nz, j=1:ny)
         ms%mass_flux_x_layer(grid%nghost + 1, j, k) = 0.0_wp
         ms%mass_flux_x_layer(grid%nghost + grid%nx_phys + 1, j, k) = 0.0_wp
      end do

      ! ---- Porous barriers (Adcroft 2013) ----
      ! Narrow the layer transport by the OPEN-AREA fraction of the face.
      ! Host-side gate: with the knob off there is no kernel launch and
      ! the loops above are textually unchanged, so the whole path is
      ! byte-identical.  Applied AFTER the wall zeroing (0 stays 0) and
      ! BEFORE the barotropic renormalisation, which must see the narrowed
      ! transports it is constraining.
      !
      ! WRITTEN INLINE, not as a call to `porous_narrow_3d`.  Handing
      ! `ms%mass_flux_*_layer` to an external subroutine as an
      ! `intent(inout)` actual makes nvfortran treat the array as ESCAPING,
      ! which pessimises every `do concurrent` in this routine — even
      ! though the branch never runs with the knob off.  Measured on a
      ! 600x600x50 default-path (porous OFF) double-gyre, V100: the call
      ! form costs `ocean_continuity` 10.58 s vs 9.11 s inline (+4.8% on
      ! total solver time vs origin/main; the inline form is +0.5%, i.e.
      ! noise).  `rdb_coriolis_adv` keeps the shared `porous_narrow_3d`
      ! helper — measured there at no cost.
      if (metrics%use_porous) then
         do concurrent(k=1:nz, j=1:ny, i=1:nx + 1)
            ms%mass_flux_x_layer(i, j, k) = ms%mass_flux_x_layer(i, j, k)* &
                                            metrics%por_face_area_u(i, j, k)
         end do
      end if

      ! ---- z-level closed faces: see the composition rule on
      ! `ocean_metrics_t%open_v`.  A SEPARATE pass, not composed into
      ! `por_face_area_u`: the two gates are independent and the porous
      ! fraction is refreshed per outer step while this mask is static.
      ! Inline for the same escaping-array reason as the porous pass.
      if (metrics%use_closed_faces) then
         do concurrent(k=1:nz, j=1:ny, i=1:nx + 1)
            ms%mass_flux_x_layer(i, j, k) = ms%mass_flux_x_layer(i, j, k)* &
                                            metrics%open_u(i, j, k)
         end do
      end if

      ! ============================================================
      ! Y-DIRECTION reconstruction
      ! ============================================================
      do concurrent(k=1:nz, j=3:ny - 2, i=1:nx) &
         local(dh_m1, dh_0, dh_p1, h_left, h_right, hm2, hm1, h0, hp1, hp2)
         h0 = ms%h_layer(i, j, k)
         hm1 = ppm_mirror_h(ms%h_layer(i, j - 1, k), h0, metrics%wet_T(i, j - 1))
         hp1 = ppm_mirror_h(ms%h_layer(i, j + 1, k), h0, metrics%wet_T(i, j + 1))
         hm2 = ppm_mirror_h(ms%h_layer(i, j - 2, k), hm1, metrics%wet_T(i, j - 2))
         hp2 = ppm_mirror_h(ms%h_layer(i, j + 2, k), hp1, metrics%wet_T(i, j + 2))
         call ppm_limited_slope(hm2, hm1, h0, dh_m1)
         call ppm_limited_slope(hm1, h0, hp1, dh_0)
         call ppm_limited_slope(h0, hp1, hp2, dh_p1)
         dh_0 = dh_0*metrics%wet_T(i, j - 1)*metrics%wet_T(i, j)*metrics%wet_T(i, j + 1)
         h_left = 0.5_wp*(hm1 + h0) - (dh_0 - dh_m1)/6.0_wp
         h_right = 0.5_wp*(h0 + hp1) - (dh_p1 - dh_0)/6.0_wp
         call ppm_cell_limiter(h0, h_left, h_right)
         if (do_pos) call ppm_limit_pos(h0, h_left, h_right, h_min_pos)
         this%h_face_right_y%data(i, j, k) = h_left
         this%h_face_left_y%data(i, j + 1, k) = h_right
      end do
      do concurrent(k=1:nz, i=1:nx)
         this%h_face_left_y%data(i, 1, k) = ms%h_layer(i, 1, k)
         this%h_face_right_y%data(i, 1, k) = ms%h_layer(i, 1, k)
         this%h_face_left_y%data(i, 2, k) = ms%h_layer(i, 1, k)
         this%h_face_right_y%data(i, 2, k) = ms%h_layer(i, 2, k)
         this%h_face_left_y%data(i, 3, k) = ms%h_layer(i, 2, k)
         this%h_face_right_y%data(i, 3, k) = ms%h_layer(i, 2, k)
         this%h_face_right_y%data(i, ny - 1, k) = ms%h_layer(i, ny - 1, k)
         this%h_face_left_y%data(i, ny, k) = ms%h_layer(i, ny - 1, k)
         this%h_face_right_y%data(i, ny, k) = ms%h_layer(i, ny, k)
         this%h_face_left_y%data(i, ny + 1, k) = ms%h_layer(i, ny, k)
         this%h_face_right_y%data(i, ny + 1, k) = ms%h_layer(i, ny, k)
      end do

      do concurrent(k=1:nz, j=2:ny, i=1:nx) local(v, h_face)
         v = ms%v_face_y_layer(i, j, k)
         if (v >= 0.0_wp) then
            h_face = this%h_face_left_y%data(i, j, k)
         else
            h_face = this%h_face_right_y%data(i, j, k)
         end if
         ms%mass_flux_y_layer(i, j, k) = v*h_face*metrics%dx_cv(i, j)
      end do
      do concurrent(k=1:nz, i=1:nx)
         ms%mass_flux_y_layer(i, 1, k) = 0.0_wp
         ms%mass_flux_y_layer(i, ny + 1, k) = 0.0_wp
      end do
      ! Physical wall zeroing — mirrors split form's
      ! `continuity_meridional_flux`.
      do concurrent(k=1:nz, i=1:nx)
         ms%mass_flux_y_layer(i, grid%nghost + 1, k) = 0.0_wp
         ms%mass_flux_y_layer(i, grid%nghost + grid%ny_phys + 1, k) = 0.0_wp
      end do

      ! ---- Porous barriers: see the zonal twin (incl. why it is inline) ----
      if (metrics%use_porous) then
         do concurrent(k=1:nz, j=1:ny + 1, i=1:nx)
            ms%mass_flux_y_layer(i, j, k) = ms%mass_flux_y_layer(i, j, k)* &
                                            metrics%por_face_area_v(i, j, k)
         end do
      end if

      ! ---- z-level closed faces: see the zonal twin ----
      if (metrics%use_closed_faces) then
         do concurrent(k=1:nz, j=1:ny + 1, i=1:nx)
            ms%mass_flux_y_layer(i, j, k) = ms%mass_flux_y_layer(i, j, k)* &
                                            metrics%open_v(i, j, k)
         end do
      end if

      ! ============================================================
      ! Per-layer flux divergence (transport divergence · iareaT)
      ! ============================================================
      do concurrent(k=1:nz, j=1:ny, i=1:nx)
         ms%flux_h_layer(i, j, k) = &
            ((ms%mass_flux_x_layer(i + 1, j, k) - &
              ms%mass_flux_x_layer(i, j, k)) + &
             (ms%mass_flux_y_layer(i, j + 1, k) - &
              ms%mass_flux_y_layer(i, j, k)))*metrics%iareaT(i, j)
      end do
   end subroutine continuity_compute_fluxes