meke_backscatter_apply_impl Subroutine

private pure subroutine meke_backscatter_apply_impl(nx, ny, nz, dt, cfl_safety, ku, idxCu, idyCu, idxCv, idyCv, ah_face_x, ah_face_y)

harmonic viscosity and floor the net at the CFL-stable minimum. Explicit-shape dummies for NVHPC stdpar (no descriptor walk). The backscatter coefficient is z-independent in v1 (BS_struct=1), so the cell-centred ku(i,j) is broadcast to every layer.

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: nx
integer, intent(in) :: ny
integer, intent(in) :: nz
real(kind=wp), intent(in) :: dt
real(kind=wp), intent(in) :: cfl_safety
real(kind=wp), intent(in) :: ku(nx,ny)
real(kind=wp), intent(in) :: idxCu(nx+1,ny)
real(kind=wp), intent(in) :: idyCu(nx+1,ny)
real(kind=wp), intent(in) :: idxCv(nx,ny+1)
real(kind=wp), intent(in) :: idyCv(nx,ny+1)
real(kind=wp), intent(inout) :: ah_face_x(nx+1,ny,nz)
real(kind=wp), intent(inout) :: ah_face_y(nx,ny+1,nz)

Calls

proc~~meke_backscatter_apply_impl~~CallsGraph proc~meke_backscatter_apply_impl meke_backscatter_apply_impl local local proc~meke_backscatter_apply_impl->local

Called by

proc~~meke_backscatter_apply_impl~~CalledByGraph proc~meke_backscatter_apply_impl meke_backscatter_apply_impl proc~meke_backscatter_apply meke_backscatter_apply proc~meke_backscatter_apply->proc~meke_backscatter_apply_impl proc~run_stage_split run_stage_split proc~run_stage_split->proc~meke_backscatter_apply proc~ocean_dyn_step_split ocean_dyn_step_split proc~ocean_dyn_step_split->proc~run_stage_split proc~engine_step engine_step proc~engine_step->proc~ocean_dyn_step_split 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 :: a_floor
real(kind=wp), private :: a_net
real(kind=wp), private :: denom
integer, private :: i
integer, private :: j
integer, private :: k
real(kind=wp), private :: ku_face

Source Code

   pure subroutine meke_backscatter_apply_impl(nx, ny, nz, dt, cfl_safety, ku, &
                                               idxCu, idyCu, idxCv, idyCv, &
                                               ah_face_x, ah_face_y)
      !! Flat-impl: subtract the face-averaged `ku` from each per-face
      !! harmonic viscosity and floor the net at the CFL-stable minimum.
      !! Explicit-shape dummies for NVHPC stdpar (no descriptor walk).
      !! The backscatter coefficient is z-independent in v1 (`BS_struct=1`),
      !! so the cell-centred `ku(i,j)` is broadcast to every layer.
      integer, intent(in) :: nx, ny, nz
      real(wp), intent(in) :: dt, cfl_safety
      real(wp), intent(in) :: ku(nx, ny)
      real(wp), intent(in) :: idxCu(nx + 1, ny), idyCu(nx + 1, ny)
      real(wp), intent(in) :: idxCv(nx, ny + 1), idyCv(nx, ny + 1)
      real(wp), intent(inout) :: ah_face_x(nx + 1, ny, nz), ah_face_y(nx, ny + 1, nz)
      integer :: i, j, k
      real(wp) :: ku_face, denom, a_floor, a_net

      ! u-faces (i-1/2, j): Ku averaged from the two adjacent T-cells
      ! (i-1, i).  Interior faces only; wall faces (i=1, i=nx+1) keep the
      ! resolved background (no backscatter at the closed boundary, matching
      ! the lateral-mix wall convention).
      do concurrent(k=1:nz, j=1:ny, i=2:nx) &
         local(ku_face, denom, a_floor, a_net)
         ku_face = 0.5_wp*(ku(i - 1, j) + ku(i, j))
         denom = dt*(idxCu(i, j)*idxCu(i, j) + idyCu(i, j)*idyCu(i, j))
         a_net = ah_face_x(i, j, k) - ku_face
         if (denom > 0.0_wp) then
            a_floor = -cfl_safety*0.5_wp/denom
            if (a_net < a_floor) a_net = a_floor
         end if
         ah_face_x(i, j, k) = a_net
      end do

      ! v-faces (i, j-1/2): Ku averaged from the two adjacent T-cells
      ! (j-1, j).  Interior faces only.
      do concurrent(k=1:nz, j=2:ny, i=1:nx) &
         local(ku_face, denom, a_floor, a_net)
         ku_face = 0.5_wp*(ku(i, j - 1) + ku(i, j))
         denom = dt*(idxCv(i, j)*idxCv(i, j) + idyCv(i, j)*idyCv(i, j))
         a_net = ah_face_y(i, j, k) - ku_face
         if (denom > 0.0_wp) then
            a_floor = -cfl_safety*0.5_wp/denom
            if (a_net < a_floor) a_net = a_floor
         end if
         ah_face_y(i, j, k) = a_net
      end do
   end subroutine meke_backscatter_apply_impl