ocean_slopes_vert_fill_ts Subroutine

public subroutine ocean_slopes_vert_fill_ts(nx, ny, nz, h_layer, t_htr, s_htr, kd_smooth, dt, t_fill, s_fill)

Fill massless layers in T/S with sensible values via one pass of constant-kappa·dt vertical diffusion — a SINGLE forward-elim + back-sub Thomas sweep per column (no iteration). Operates on the tracer-from-hTr conversion (T = hTr/h) and writes the scratch t_fill/s_fill; the prognostic tracers are untouched.

kap_dt_x2 = 2·kappa·dt; the inter-layer entrainment is ent(K) = kap_dt_x2 / ((h(k)+h(k+1)) + h_neglect). Surface + bed boundary rows close the tridiagonal exactly. Column locals are fixed-size (NZ_STACK_MAX) so the local() clause is legal on -stdpar=gpu (dummy-sized automatics crash).

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: nx
integer, intent(in) :: ny
integer, intent(in) :: nz
real(kind=wp), intent(in) :: h_layer(nx,ny,nz)
real(kind=wp), intent(in) :: t_htr(nx,ny,nz)
real(kind=wp), intent(in) :: s_htr(nx,ny,nz)
real(kind=wp), intent(in) :: kd_smooth
real(kind=wp), intent(in) :: dt
real(kind=wp), intent(out) :: t_fill(nx,ny,nz)
real(kind=wp), intent(out) :: s_fill(nx,ny,nz)

Calls

proc~~ocean_slopes_vert_fill_ts~~CallsGraph proc~ocean_slopes_vert_fill_ts ocean_slopes_vert_fill_ts local local proc~ocean_slopes_vert_fill_ts->local

Called by

proc~~ocean_slopes_vert_fill_ts~~CalledByGraph proc~ocean_slopes_vert_fill_ts ocean_slopes_vert_fill_ts proc~ocean_slopes_compute_impl ocean_slopes_compute_impl proc~ocean_slopes_compute_impl->proc~ocean_slopes_vert_fill_ts 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 :: b1
real(kind=wp), private :: c1(NZ_STACK_MAX)
real(kind=wp), private :: d1
real(kind=wp), private :: ent(NZ_STACK_MAX+1)
real(kind=wp), private :: h0c
real(kind=wp), private :: h_eff
real(kind=wp), private :: h_neglect
real(kind=wp), private :: h_tr
integer, private :: i
integer, private :: j
integer, private :: k
real(kind=wp), private :: kap_dt_x2
real(kind=wp), private :: s_in(NZ_STACK_MAX)
real(kind=wp), private :: t_in(NZ_STACK_MAX)

Source Code

   subroutine ocean_slopes_vert_fill_ts(nx, ny, nz, h_layer, t_htr, s_htr, &
                                        kd_smooth, dt, t_fill, s_fill)
      !! Fill massless layers in T/S with sensible values via one pass of
      !! constant-`kappa·dt` vertical diffusion — a SINGLE forward-elim +
      !! back-sub Thomas sweep per column (no iteration).  Operates on the
      !! tracer-from-hTr conversion (`T = hTr/h`) and writes the scratch
      !! `t_fill`/`s_fill`; the prognostic tracers are untouched.
      !!
      !! `kap_dt_x2 = 2·kappa·dt`; the inter-layer entrainment is
      !! `ent(K) = kap_dt_x2 / ((h(k)+h(k+1)) + h_neglect)`.  Surface +
      !! bed boundary rows close the tridiagonal exactly.  Column locals
      !! are fixed-size (`NZ_STACK_MAX`) so the `local()` clause is legal
      !! on `-stdpar=gpu` (dummy-sized automatics crash).
      integer, intent(in) :: nx, ny, nz
      real(wp), intent(in) :: h_layer(nx, ny, nz)
      real(wp), intent(in) :: t_htr(nx, ny, nz)
      real(wp), intent(in) :: s_htr(nx, ny, nz)
      real(wp), intent(in) :: kd_smooth, dt
      real(wp), intent(out) :: t_fill(nx, ny, nz)
      real(wp), intent(out) :: s_fill(nx, ny, nz)

      integer :: i, j, k
      real(wp) :: kap_dt_x2, h_neglect, h0c
      real(wp) :: ent(NZ_STACK_MAX + 1)
      real(wp) :: c1(NZ_STACK_MAX)
      real(wp) :: b1, d1, h_tr, h_eff
      real(wp) :: t_in(NZ_STACK_MAX), s_in(NZ_STACK_MAX)

      kap_dt_x2 = 2.0_wp*kd_smooth*dt
      h_neglect = H_DIV_EPS
      h0c = h_neglect

      if (kap_dt_x2 <= 0.0_wp .or. nz < 2) then
         ! No smoothing — pass the raw tracer-from-hTr through.
         do concurrent(k=1:nz, j=1:ny, i=1:nx)
            h_eff = max(h_layer(i, j, k), H_VANISHED)
            t_fill(i, j, k) = t_htr(i, j, k)/h_eff
            s_fill(i, j, k) = s_htr(i, j, k)/h_eff
         end do
         return
      end if

      ! Per-column Thomas sweep.  k=1 bed ... k=nz surface (bottom-up);
      ! the tridiagonal couples layer k to k±1 identically regardless of
      ! orientation, so the bottom-up index runs the published sweep with
      ! "k=1" as the first boundary row.
      do concurrent(j=1:ny, i=1:nx) &
         local(k, ent, c1, b1, d1, h_tr, h_eff, t_in, s_in)
         ! T,S from hTr/h (floor h consistently — vanished layers feed a
         ! near-zero raw T that the diffusion then overwrites).
         do k = 1, nz
            h_eff = max(h_layer(i, j, k), H_VANISHED)
            t_in(k) = t_htr(i, j, k)/h_eff
            s_in(k) = s_htr(i, j, k)/h_eff
         end do

         ! Forward elimination — first (bed) boundary row at k=1.
         ent(2) = kap_dt_x2/((h_layer(i, j, 1) + h_layer(i, j, 2)) + h0c)
         h_tr = h_layer(i, j, 1) + h_neglect
         b1 = 1.0_wp/(h_tr + ent(2))
         d1 = b1*h_tr
         t_fill(i, j, 1) = (b1*h_tr)*t_in(1)
         s_fill(i, j, 1) = (b1*h_tr)*s_in(1)
         do k = 2, nz - 1
            ent(k + 1) = kap_dt_x2/((h_layer(i, j, k) + h_layer(i, j, k + 1)) + h0c)
            h_tr = h_layer(i, j, k) + h_neglect
            c1(k) = ent(k)*b1
            b1 = 1.0_wp/((h_tr + d1*ent(k)) + ent(k + 1))
            d1 = b1*(h_tr + d1*ent(k))
            t_fill(i, j, k) = b1*(h_tr*t_in(k) + ent(k)*t_fill(i, j, k - 1))
            s_fill(i, j, k) = b1*(h_tr*s_in(k) + ent(k)*s_fill(i, j, k - 1))
         end do
         ! Last (surface) boundary row at k=nz.
         c1(nz) = ent(nz)*b1
         h_tr = h_layer(i, j, nz) + h_neglect
         b1 = 1.0_wp/(h_tr + d1*ent(nz))
         t_fill(i, j, nz) = b1*(h_tr*t_in(nz) + ent(nz)*t_fill(i, j, nz - 1))
         s_fill(i, j, nz) = b1*(h_tr*s_in(nz) + ent(nz)*s_fill(i, j, nz - 1))
         ! Back substitution.
         do k = nz - 1, 1, -1
            t_fill(i, j, k) = t_fill(i, j, k) + c1(k + 1)*t_fill(i, j, k + 1)
            s_fill(i, j, k) = s_fill(i, j, k) + c1(k + 1)*s_fill(i, j, k + 1)
         end do
      end do
   end subroutine ocean_slopes_vert_fill_ts