ice_ocean_stress_flux_impl Subroutine

public pure subroutine ice_ocean_stress_flux_impl(tau_x, tau_y, tau_a_x, tau_a_y, fxoc, fyoc, ci, nx, ny)

Face-blend kernel. a_u/a_v interpolate ci onto the u/v faces (Adcroft-style simple average — no mask needed since ci is already 0 on land). Explicit-shape + decl-order.

PUBLIC TEST SEAM (PR 62): exported so a test can drive the real coupler blend on plain arrays (matching a raw ci_evp_dynamics call bit-for-bit) without building a full ocean_sea_ice_t and reverse-engineering a fractional ci through the category ITD gather — mirrors ice_evp_dynamics’s own public-seam rationale.

Arguments

Type IntentOptional Attributes Name
real(kind=wp), intent(inout) :: tau_x(nx+1,ny)
real(kind=wp), intent(inout) :: tau_y(nx,ny+1)
real(kind=wp), intent(in) :: tau_a_x(nx+1,ny)
real(kind=wp), intent(in) :: tau_a_y(nx,ny+1)
real(kind=wp), intent(in) :: fxoc(nx+1,ny)
real(kind=wp), intent(in) :: fyoc(nx,ny+1)
real(kind=wp), intent(in) :: ci(nx,ny)
integer, intent(in) :: nx
integer, intent(in) :: ny

Calls

proc~~ice_ocean_stress_flux_impl~~CallsGraph proc~ice_ocean_stress_flux_impl ice_ocean_stress_flux_impl local local proc~ice_ocean_stress_flux_impl->local

Called by

proc~~ice_ocean_stress_flux_impl~~CalledByGraph proc~ice_ocean_stress_flux_impl ice_ocean_stress_flux_impl proc~ice_ocean_stress_flux ice_ocean_stress_flux proc~ice_ocean_stress_flux->proc~ice_ocean_stress_flux_impl proc~engine_step_ice engine_step_ice proc~engine_step_ice->proc~ice_ocean_stress_flux proc~driver_run_ocean driver_run_ocean proc~driver_run_ocean->proc~engine_step_ice proc~rdb_ocean_step rdb_ocean_step proc~rdb_ocean_step->proc~engine_step_ice proc~driver_run driver_run proc~driver_run->proc~driver_run_ocean

Variables

Type Visibility Attributes Name Initial
real(kind=wp), private :: a_u
real(kind=wp), private :: a_v
integer, private :: i
integer, private :: j

Source Code

   pure subroutine ice_ocean_stress_flux_impl(tau_x, tau_y, tau_a_x, tau_a_y, fxoc, fyoc, ci, &
                                              nx, ny)
      !! Face-blend kernel. `a_u`/`a_v` interpolate `ci` onto the u/v
      !! faces (Adcroft-style simple average — no mask needed since `ci`
      !! is already 0 on land). Explicit-shape + decl-order.
      !!
      !! PUBLIC TEST SEAM (PR 62): exported so a test can drive the
      !! real coupler blend on plain arrays (matching a raw `ci_evp_dynamics`
      !! call bit-for-bit) without building a full `ocean_sea_ice_t` and
      !! reverse-engineering a fractional `ci` through the category ITD
      !! gather — mirrors `ice_evp_dynamics`'s own public-seam rationale.
      integer, intent(in) :: nx, ny
      real(wp), intent(inout) :: tau_x(nx + 1, ny)
      real(wp), intent(inout) :: tau_y(nx, ny + 1)
      real(wp), intent(in) :: tau_a_x(nx + 1, ny)
      real(wp), intent(in) :: tau_a_y(nx, ny + 1)
      real(wp), intent(in) :: fxoc(nx + 1, ny)
      real(wp), intent(in) :: fyoc(nx, ny + 1)
      real(wp), intent(in) :: ci(nx, ny)
      integer :: i, j
      real(wp) :: a_u, a_v

      do concurrent(j=1:ny, i=1:nx + 1) local(a_u)
         if (i == 1) then
            a_u = 0.5_wp*ci(1, j)
         else if (i == nx + 1) then
            a_u = 0.5_wp*ci(nx, j)
         else
            a_u = 0.5_wp*(ci(i - 1, j) + ci(i, j))
         end if
         tau_x(i, j) = (1.0_wp - a_u)*tau_a_x(i, j) + a_u*fxoc(i, j)
      end do
      do concurrent(j=1:ny + 1, i=1:nx) local(a_v)
         if (j == 1) then
            a_v = 0.5_wp*ci(i, 1)
         else if (j == ny + 1) then
            a_v = 0.5_wp*ci(i, ny)
         else
            a_v = 0.5_wp*(ci(i, j - 1) + ci(i, j))
         end if
         tau_y(i, j) = (1.0_wp - a_v)*tau_a_y(i, j) + a_v*fyoc(i, j)
      end do
   end subroutine ice_ocean_stress_flux_impl