meke_feed_khth Subroutine

private pure subroutine meke_feed_khth(nx, ny, khth_fac, khtr_fac, kh_diff, khth_u, khth_v, khtr_u, khtr_v)

Add the geometric mean of neighbour kh_diff into VarMix’s per-face KhTh (and KhTr) base BEFORE GM’s CFL clamp: khth_u(i,j) += khth_facsqrt(kh(i-1,j)kh(i,j)) khth_fac=0 ⇒ nothing added ⇒ bit-identical seam.

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: nx
integer, intent(in) :: ny
real(kind=wp), intent(in) :: khth_fac
real(kind=wp), intent(in) :: khtr_fac
real(kind=wp), intent(in) :: kh_diff(nx,ny)
real(kind=wp), intent(inout) :: khth_u(nx+1,ny)
real(kind=wp), intent(inout) :: khth_v(nx,ny+1)
real(kind=wp), intent(inout) :: khtr_u(nx+1,ny)
real(kind=wp), intent(inout) :: khtr_v(nx,ny+1)

Calls

proc~~meke_feed_khth~~CallsGraph proc~meke_feed_khth meke_feed_khth local local proc~meke_feed_khth->local

Called by

proc~~meke_feed_khth~~CalledByGraph proc~meke_feed_khth meke_feed_khth proc~meke_step meke_step proc~meke_step->proc~meke_feed_khth proc~run_meke_step run_meke_step proc~run_meke_step->proc~meke_step proc~ocean_dyn_step_split ocean_dyn_step_split proc~ocean_dyn_step_split->proc~run_meke_step 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 :: gm_u
real(kind=wp), private :: gm_v
integer, private :: i
integer, private :: j

Source Code

   pure subroutine meke_feed_khth(nx, ny, khth_fac, khtr_fac, kh_diff, &
                                  khth_u, khth_v, khtr_u, khtr_v)
      !! Add the geometric mean of neighbour `kh_diff` into VarMix's per-face
      !! KhTh (and KhTr) base BEFORE GM's CFL clamp:
      !!   khth_u(i,j) += khth_fac*sqrt(kh(i-1,j)*kh(i,j))
      !! `khth_fac=0` ⇒ nothing added ⇒ bit-identical seam.
      integer, intent(in) :: nx, ny
      real(wp), intent(in) :: khth_fac, khtr_fac
      real(wp), intent(in) :: kh_diff(nx, ny)
      real(wp), intent(inout) :: khth_u(nx + 1, ny)
      real(wp), intent(inout) :: khth_v(nx, ny + 1)
      real(wp), intent(inout) :: khtr_u(nx + 1, ny)
      real(wp), intent(inout) :: khtr_v(nx, ny + 1)
      integer :: i, j
      real(wp) :: gm_u, gm_v

      ! u-faces: interior i=2..nx pairs (i-1,i).
      do concurrent(j=1:ny, i=2:nx) local(gm_u)
         gm_u = sqrt(max(0.0_wp, kh_diff(i - 1, j))*max(0.0_wp, kh_diff(i, j)))
         khth_u(i, j) = khth_u(i, j) + khth_fac*gm_u
         khtr_u(i, j) = khtr_u(i, j) + khtr_fac*gm_u
      end do
      ! v-faces: interior j=2..ny pairs (j-1,j).
      do concurrent(j=2:ny, i=1:nx) local(gm_v)
         gm_v = sqrt(max(0.0_wp, kh_diff(i, j - 1))*max(0.0_wp, kh_diff(i, j)))
         khth_v(i, j) = khth_v(i, j) + khth_fac*gm_v
         khtr_v(i, j) = khtr_v(i, j) + khtr_fac*gm_v
      end do
   end subroutine meke_feed_khth