ice_limit_stresses Subroutine

private pure subroutine ice_limit_stresses(areaT, mask_t, pres_mice, mice, str_d, str_t, str_s, ec, nx, ny)

SIS2 limit_stresses (:1619-1684), lim=1 (no optional arg). Called ONCE per ice_evp_dynamics call, BEFORE the substep loop — requirement (2). Corner clamp uses the MASKED-area-weighted mean pressure of the <=4 wet neighbours — requirement (3).

Arguments

Type IntentOptional Attributes Name
real(kind=wp), intent(in) :: areaT(nx,ny)
real(kind=wp), intent(in) :: mask_t(nx,ny)
real(kind=wp), intent(in) :: pres_mice(nx,ny)
real(kind=wp), intent(in) :: mice(nx,ny)
real(kind=wp), intent(inout) :: str_d(nx,ny)
real(kind=wp), intent(inout) :: str_t(nx,ny)
real(kind=wp), intent(inout) :: str_s(nx+1,ny+1)
real(kind=wp), intent(in) :: ec
integer, intent(in) :: nx
integer, intent(in) :: ny

Calls

proc~~ice_limit_stresses~~CallsGraph proc~ice_limit_stresses ice_limit_stresses local local proc~ice_limit_stresses->local

Called by

proc~~ice_limit_stresses~~CalledByGraph proc~ice_limit_stresses ice_limit_stresses proc~ice_evp_dynamics_impl ice_evp_dynamics_impl proc~ice_evp_dynamics_impl->proc~ice_limit_stresses proc~ice_evp_dynamics ice_evp_dynamics proc~ice_evp_dynamics->proc~ice_evp_dynamics_impl proc~ice_evp_step ice_evp_step proc~ice_evp_step->proc~ice_evp_dynamics proc~engine_step_ice engine_step_ice proc~engine_step_ice->proc~ice_evp_step 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

Variables

Type Visibility Attributes Name Initial
integer, private :: i
real(kind=wp), private :: i_2ec
integer, private :: ic
integer, private :: j
integer, private :: jc
real(kind=wp), private :: lim_2
real(kind=wp), private :: pres_avg
real(kind=wp), private :: pressure
real(kind=wp), private :: sum_area

Source Code

   pure subroutine ice_limit_stresses(areaT, mask_t, pres_mice, mice, str_d, str_t, str_s, &
                                      ec, nx, ny)
      !! SIS2 `limit_stresses` (:1619-1684), `lim=1` (no optional arg).
      !! Called ONCE per `ice_evp_dynamics` call, BEFORE the substep loop
      !! — requirement (2). Corner clamp uses the MASKED-area-weighted
      !! mean pressure of the <=4 wet neighbours — requirement (3).
      integer, intent(in) :: nx, ny
      real(wp), intent(in) :: areaT(nx, ny)
      real(wp), intent(in) :: mask_t(nx, ny)
      real(wp), intent(in) :: pres_mice(nx, ny)
      real(wp), intent(in) :: mice(nx, ny)
      real(wp), intent(inout) :: str_d(nx, ny)
      real(wp), intent(inout) :: str_t(nx, ny)
      real(wp), intent(inout) :: str_s(nx + 1, ny + 1)
      real(wp), intent(in) :: ec
      integer :: i, j, ic, jc
      real(wp) :: pressure, i_2ec, lim_2
      real(wp) :: sum_area, pres_avg

      i_2ec = 0.0_wp
      if (ec > 0.0_wp) i_2ec = 0.5_wp/ec
      lim_2 = 0.5_wp

      do concurrent(j=1:ny, i=1:nx) local(pressure)
         pressure = pres_mice(i, j)*mice(i, j)
         if (str_d(i, j) < -pressure) str_d(i, j) = -pressure
         if (ec*str_t(i, j) > lim_2*pressure) str_t(i, j) = i_2ec*pressure
         if (ec*str_t(i, j) < -lim_2*pressure) str_t(i, j) = -i_2ec*pressure
      end do

      ! Interior corners only.  An array-edge corner has no 4th neighbour;
      ! str_s is left untouched there (always a ghost/land corner under
      ! the periodic-or-wall ghost policy, never read by the momentum solve
      ! at a physical interior face).  The loop range, not an in-loop
      ! guard, excludes it -- see `evp_build_masks_impl` (nvfortran CPU
      ! vectoriser, four-way guard).
      do concurrent(jc=2:ny, ic=2:nx) local(sum_area, pres_avg)
         sum_area = (mask_t(ic - 1, jc - 1)*areaT(ic - 1, jc - 1) + &
                     mask_t(ic, jc)*areaT(ic, jc)) + &
                    (mask_t(ic - 1, jc)*areaT(ic - 1, jc) + &
                     mask_t(ic, jc - 1)*areaT(ic, jc - 1))
         pres_avg = 0.0_wp
         if (sum_area > 0.0_wp) then
            pres_avg = ((mask_t(ic - 1, jc - 1)*areaT(ic - 1, jc - 1)* &
                         (pres_mice(ic - 1, jc - 1)*mice(ic - 1, jc - 1)) + &
                         mask_t(ic, jc)*areaT(ic, jc)* &
                         (pres_mice(ic, jc)*mice(ic, jc))) + &
                        (mask_t(ic - 1, jc)*areaT(ic - 1, jc)* &
                         (pres_mice(ic - 1, jc)*mice(ic - 1, jc)) + &
                         mask_t(ic, jc - 1)*areaT(ic, jc - 1)* &
                         (pres_mice(ic, jc - 1)*mice(ic, jc - 1))))/sum_area
         end if
         if (ec*str_s(ic, jc) > lim_2*pres_avg) str_s(ic, jc) = i_2ec*pres_avg
         if (ec*str_s(ic, jc) < -lim_2*pres_avg) str_s(ic, jc) = -i_2ec*pres_avg
      end do
   end subroutine ice_limit_stresses