ocean_slopes_pass_x Subroutine

private pure subroutine ocean_slopes_pass_x(nx, ny, nz, eos, rho0, min_dz, h_layer, t_fill, s_fill, e_int, idxCu, wet_u, slope_x, n2_u)

u-face slope + N² pass. Interface K (interior 2..nz) straddles layer k=K (above, surface side) and k=K-1 (below, bed side). Bed (K=1) + surface (K=nz+1) are forced to zero. The u-face at (i,j) sits between cells (i-1,j) and (i,j); pairs columns iw=i-1 (west) and i (east), so loop i=2:nx.

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: nx
integer, intent(in) :: ny
integer, intent(in) :: nz
type(eos_t), intent(in) :: eos
real(kind=wp), intent(in) :: rho0
real(kind=wp), intent(in) :: min_dz
real(kind=wp), intent(in) :: h_layer(nx,ny,nz)
real(kind=wp), intent(in) :: t_fill(nx,ny,nz)
real(kind=wp), intent(in) :: s_fill(nx,ny,nz)
real(kind=wp), intent(in) :: e_int(nx,ny,nz+1)
real(kind=wp), intent(in) :: idxCu(nx+1,ny)
real(kind=wp), intent(in) :: wet_u(nx+1,ny)
real(kind=wp), intent(out) :: slope_x(nx+1,ny,nz+1)
real(kind=wp), intent(out) :: n2_u(nx+1,ny,nz+1)

Calls

proc~~ocean_slopes_pass_x~~CallsGraph proc~ocean_slopes_pass_x ocean_slopes_pass_x local local proc~ocean_slopes_pass_x->local proc~eos_density_specvol_derivs eos_density_specvol_derivs proc~ocean_slopes_pass_x->proc~eos_density_specvol_derivs proc~pressure_above_x pressure_above_x proc~ocean_slopes_pass_x->proc~pressure_above_x proc~roquet_spv_point roquet_spv_point proc~eos_density_specvol_derivs->proc~roquet_spv_point

Called by

proc~~ocean_slopes_pass_x~~CalledByGraph proc~ocean_slopes_pass_x ocean_slopes_pass_x proc~ocean_slopes_compute_impl ocean_slopes_compute_impl proc~ocean_slopes_compute_impl->proc~ocean_slopes_pass_x proc~ocean_slopes_compute ocean_slopes_compute proc~ocean_slopes_compute->proc~ocean_slopes_compute_impl proc~ocean_dyn_step_split ocean_dyn_step_split proc~ocean_dyn_step_split->proc~ocean_slopes_compute proc~run_stage run_stage proc~run_stage->proc~ocean_slopes_compute proc~engine_step engine_step proc~engine_step->proc~ocean_dyn_step_split proc~ocean_dyn_step ocean_dyn_step proc~engine_step->proc~ocean_dyn_step proc~ocean_dyn_step->proc~run_stage proc~driver_run_ocean driver_run_ocean proc~driver_run_ocean->proc~engine_step proc~rdb_ocean_step rdb_ocean_step proc~rdb_ocean_step->proc~engine_step

Variables

Type Visibility Attributes Name Initial
real(kind=wp), private :: drdiA
real(kind=wp), private :: drdiB
real(kind=wp), private :: drdkL
real(kind=wp), private :: drdkR
real(kind=wp), private :: drds
real(kind=wp), private :: drdt
real(kind=wp), private :: drdx
real(kind=wp), private :: drdz
real(kind=wp), private :: dsv_ds
real(kind=wp), private :: dsv_dt
real(kind=wp), private :: dzaL
real(kind=wp), private :: dzaR
real(kind=wp), private :: g_rho0
real(kind=wp), private :: haA
real(kind=wp), private :: haB
real(kind=wp), private :: haL
real(kind=wp), private :: haR
real(kind=wp), private :: hg2A
real(kind=wp), private :: hg2B
real(kind=wp), private :: hg2L
real(kind=wp), private :: hg2R
integer, private :: i
integer, private :: iw
integer, private :: j
integer, private :: k
integer, private :: ka
integer, private :: kb
real(kind=wp), private :: mag2
real(kind=wp), private :: mask
real(kind=wp), private :: presL
real(kind=wp), private :: presR
real(kind=wp), private :: pres_u
real(kind=wp), private :: rho_u
real(kind=wp), private :: s_u
real(kind=wp), private :: slope
real(kind=wp), private :: t_u
real(kind=wp), private :: wtA
real(kind=wp), private :: wtB
real(kind=wp), private :: wtL
real(kind=wp), private :: wtR

Source Code

   pure subroutine ocean_slopes_pass_x(nx, ny, nz, eos, rho0, min_dz, &
                                       h_layer, t_fill, s_fill, e_int, &
                                       idxCu, wet_u, slope_x, n2_u)
      !! u-face slope + N² pass.  Interface `K` (interior 2..nz) straddles
      !! layer `k=K` (above, surface side) and `k=K-1` (below, bed side).
      !! Bed (K=1) + surface (K=nz+1) are forced to zero.  The u-face at
      !! (i,j) sits between cells (i-1,j) and (i,j); pairs columns
      !! `iw=i-1` (west) and `i` (east), so loop `i=2:nx`.
      integer, intent(in) :: nx, ny, nz
      type(eos_t), intent(in) :: eos
      real(wp), intent(in) :: rho0, min_dz
      real(wp), intent(in) :: h_layer(nx, ny, nz)
      real(wp), intent(in) :: t_fill(nx, ny, nz)
      real(wp), intent(in) :: s_fill(nx, ny, nz)
      real(wp), intent(in) :: e_int(nx, ny, nz + 1)
      real(wp), intent(in) :: idxCu(nx + 1, ny)
      real(wp), intent(in) :: wet_u(nx + 1, ny)
      real(wp), intent(out) :: slope_x(nx + 1, ny, nz + 1)
      real(wp), intent(out) :: n2_u(nx + 1, ny, nz + 1)

      integer :: i, j, k, iw, ka, kb
      real(wp) :: pres_u, t_u, s_u, rho_u, dsv_dt, dsv_ds, drdt, drds
      real(wp) :: drdiA, drdiB, drdkL, drdkR
      real(wp) :: hg2A, hg2B, hg2L, hg2R, haA, haB, haL, haR
      real(wp) :: dzaL, dzaR, wtA, wtB, wtL, wtR
      real(wp) :: drdx, drdz, mag2, slope, presL, presR
      real(wp) :: g_rho0, mask

      g_rho0 = GRAVITY/rho0

      ! Bed + surface interfaces: zero everywhere.
      do concurrent(j=1:ny, i=1:nx + 1)
         slope_x(i, j, 1) = 0.0_wp
         slope_x(i, j, nz + 1) = 0.0_wp
         n2_u(i, j, 1) = 0.0_wp
         n2_u(i, j, nz + 1) = 0.0_wp
      end do
      ! Wall faces (i=1, i=nx+1): zero at all interfaces (no interior pair).
      do concurrent(k=1:nz + 1, j=1:ny)
         slope_x(1, j, k) = 0.0_wp
         slope_x(nx + 1, j, k) = 0.0_wp
         n2_u(1, j, k) = 0.0_wp
         n2_u(nx + 1, j, k) = 0.0_wp
      end do

      ! Interior interfaces K = 2..nz, interior u-faces i = 2..nx.
      do concurrent(k=2:nz, j=1:ny, i=2:nx) &
         local(iw, ka, kb, pres_u, t_u, s_u, rho_u, dsv_dt, dsv_ds, &
               drdt, drds, drdiA, drdiB, drdkL, drdkR, &
               hg2A, hg2B, hg2L, hg2R, haA, haB, haL, haR, &
               dzaL, dzaR, wtA, wtB, wtL, wtR, drdx, drdz, &
               mag2, slope, presL, presR, mask)
         iw = i - 1
         ka = k          ! layer ABOVE the interface (surface side)
         kb = k - 1      ! layer BELOW the interface (bed side)

         ! Interface pressure: accumulate from the surface (k=nz) down to
         ! the layer above this interface.  Surface-relative hydrostatic
         ! pressure at the interface = g·ρ₀·Σ_{above} h.
         presL = pressure_above_x(nx, ny, nz, h_layer, iw, j, ka, rho0)
         presR = pressure_above_x(nx, ny, nz, h_layer, i, j, ka, rho0)
         pres_u = 0.5_wp*(presL + presR)

         ! 4-point interface T/S (two columns × two adjacent layers).
         t_u = 0.25_wp*((t_fill(iw, j, ka) + t_fill(i, j, ka)) + &
                        (t_fill(iw, j, kb) + t_fill(i, j, kb)))
         s_u = 0.25_wp*((s_fill(iw, j, ka) + s_fill(i, j, ka)) + &
                        (s_fill(iw, j, kb) + s_fill(i, j, kb)))

         ! Locally-referenced density derivatives: drho_dX = -ρ²·dSV/dX.
         call eos_density_specvol_derivs(eos, t_u, s_u, pres_u, rho_u, dsv_dt, dsv_ds)
         drdt = -(rho_u*rho_u)*dsv_dt
         drds = -(rho_u*rho_u)*dsv_ds

         ! Along-layer horizontal ρ-gradients, above (A=ka) / below (B=kb).
         drdiA = drdt*(t_fill(i, j, ka) - t_fill(iw, j, ka)) + &
                 drds*(s_fill(i, j, ka) - s_fill(iw, j, ka))
         drdiB = drdt*(t_fill(i, j, kb) - t_fill(iw, j, kb)) + &
                 drds*(s_fill(i, j, kb) - s_fill(iw, j, kb))

         ! Vertical ρ-difference (below - above): drho_dX·(X[kb]-X[ka]).
         ! For stable stratification (lighter water above) this gives
         ! drdk>0 ⇒ drdz>0 ⇒ N²>0 (punch-list sign fix #2).
         drdkL = drdt*(t_fill(iw, j, kb) - t_fill(iw, j, ka)) + &
                 drds*(s_fill(iw, j, kb) - s_fill(iw, j, ka))
         drdkR = drdt*(t_fill(i, j, kb) - t_fill(i, j, ka)) + &
                 drds*(s_fill(i, j, kb) - s_fill(i, j, ka))

         ! Harmonic-mean thickness weights.
         hg2A = h_layer(iw, j, ka)*h_layer(i, j, ka) + H_DIV_EPS*H_DIV_EPS
         hg2B = h_layer(iw, j, kb)*h_layer(i, j, kb) + H_DIV_EPS*H_DIV_EPS
         hg2L = h_layer(iw, j, ka)*h_layer(iw, j, kb) + H_DIV_EPS*H_DIV_EPS
         hg2R = h_layer(i, j, ka)*h_layer(i, j, kb) + H_DIV_EPS*H_DIV_EPS
         haA = 0.5_wp*(h_layer(iw, j, ka) + h_layer(i, j, ka)) + H_DIV_EPS
         haB = 0.5_wp*(h_layer(iw, j, kb) + h_layer(i, j, kb)) + H_DIV_EPS
         haL = 0.5_wp*(h_layer(iw, j, ka) + h_layer(iw, j, kb)) + H_DIV_EPS
         haR = 0.5_wp*(h_layer(i, j, ka) + h_layer(i, j, kb)) + H_DIV_EPS
         ! Vertical centre spacing across the interface (floored).
         dzaL = max(haL, min_dz)
         dzaR = max(haR, min_dz)
         wtA = hg2A*haB
         wtB = hg2B*haA
         wtL = hg2L*(haR*dzaR)
         wtR = hg2R*(haL*dzaL)

         drdz = ((wtL*drdkL) + (wtR*drdkR))/((dzaL*wtL) + (dzaR*wtR))

         ! Interface-tilt rotation term + metric scaling.  `e_int` is
         ! geopotential (bed datum −D), so `e_W − e_E` is the real tilt of
         ! the interface, never the bathymetry step.
         drdx = ((wtA*drdiA + wtB*drdiB)/(wtA + wtB) - &
                 drdz*(e_int(iw, j, k) - e_int(i, j, k)))*idxCu(i, j)

         mag2 = drdx*drdx + drdz*drdz
         if (mag2 > 0.0_wp) then
            slope = drdx/sqrt(mag2)
         else
            slope = 0.0_wp
         end if

         mask = wet_u(i, j)
         slope_x(i, j, k) = slope*mask
         n2_u(i, j, k) = g_rho0*drdz*mask
      end do
   end subroutine ocean_slopes_pass_x