evp_q_and_mi_ratio_impl Subroutine

public pure subroutine evp_q_and_mi_ratio_impl(areaT, f_corner, mask_t, mask_u, mask_v, mask_q, mis, m_neglect, m_neglect2, m_neglect4, q, mi_ratio_a_q, nx, ny)

q(ic,jc) = f_corner*tot_area / (Σ areaT*mis over the 4 cells + tot_area*m_neglect) (:977-982); mi_ratio_A_q via ice_evp_mi_ratio_point (requirement 5). 4 T-cells around corner (ic,jc): (ic-1,jc-1) (ic,jc-1) (ic-1,jc) (ic,jc) (SW/SE/NW/NE, §1). Array-edge corners (no T-cell on one side) get q=0/mi_ratio=0 (land-corner convention — consistent with mask_t=0 beyond the array edge).

Arguments

Type IntentOptional Attributes Name
real(kind=wp), intent(in) :: areaT(nx,ny)
real(kind=wp), intent(in) :: f_corner(nx+1,ny+1)
real(kind=wp), intent(in) :: mask_t(nx,ny)
real(kind=wp), intent(in) :: mask_u(nx+1,ny)
real(kind=wp), intent(in) :: mask_v(nx,ny+1)
real(kind=wp), intent(in) :: mask_q(nx+1,ny+1)
real(kind=wp), intent(in) :: mis(nx,ny)
real(kind=wp), intent(in) :: m_neglect
real(kind=wp), intent(in) :: m_neglect2
real(kind=wp), intent(in) :: m_neglect4
real(kind=wp), intent(out) :: q(nx+1,ny+1)
real(kind=wp), intent(out) :: mi_ratio_a_q(nx+1,ny+1)
integer, intent(in) :: nx
integer, intent(in) :: ny

Calls

proc~~evp_q_and_mi_ratio_impl~~CallsGraph proc~evp_q_and_mi_ratio_impl evp_q_and_mi_ratio_impl local local proc~evp_q_and_mi_ratio_impl->local proc~ice_evp_mi_ratio_point ice_evp_mi_ratio_point proc~evp_q_and_mi_ratio_impl->proc~ice_evp_mi_ratio_point

Called by

proc~~evp_q_and_mi_ratio_impl~~CalledByGraph proc~evp_q_and_mi_ratio_impl evp_q_and_mi_ratio_impl proc~ice_evp_dynamics_impl ice_evp_dynamics_impl proc~ice_evp_dynamics_impl->proc~evp_q_and_mi_ratio_impl 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
real(kind=wp), private :: a_ne
real(kind=wp), private :: a_nw
real(kind=wp), private :: a_se
real(kind=wp), private :: a_sw
integer, private :: ic
integer, private :: jc
real(kind=wp), private :: m_ne
real(kind=wp), private :: m_nw
real(kind=wp), private :: m_se
real(kind=wp), private :: m_sw
real(kind=wp), private :: mass_sum
real(kind=wp), private :: mt_ne
real(kind=wp), private :: mt_nw
real(kind=wp), private :: mt_se
real(kind=wp), private :: mt_sw
real(kind=wp), private :: tot_area

Source Code

   pure subroutine evp_q_and_mi_ratio_impl(areaT, f_corner, mask_t, mask_u, mask_v, mask_q, &
                                           mis, m_neglect, m_neglect2, m_neglect4, &
                                           q, mi_ratio_a_q, nx, ny)
      !! `q(ic,jc) = f_corner*tot_area / (Σ areaT*mis over the 4 cells +
      !! tot_area*m_neglect)` (:977-982); `mi_ratio_A_q` via
      !! `ice_evp_mi_ratio_point` (requirement 5).  4 T-cells around
      !! corner `(ic,jc)`: `(ic-1,jc-1) (ic,jc-1) (ic-1,jc) (ic,jc)`
      !! (SW/SE/NW/NE, §1). Array-edge corners (no T-cell on one side)
      !! get `q=0`/`mi_ratio=0` (land-corner convention — consistent with
      !! `mask_t=0` beyond the array edge).
      integer, intent(in) :: nx, ny
      real(wp), intent(in) :: areaT(nx, ny)
      real(wp), intent(in) :: f_corner(nx + 1, ny + 1)
      real(wp), intent(in) :: mask_t(nx, ny)
      real(wp), intent(in) :: mask_u(nx + 1, ny)
      real(wp), intent(in) :: mask_v(nx, ny + 1)
      real(wp), intent(in) :: mask_q(nx + 1, ny + 1)
      real(wp), intent(in) :: mis(nx, ny)
      real(wp), intent(in) :: m_neglect, m_neglect2, m_neglect4
      real(wp), intent(out) :: q(nx + 1, ny + 1)
      real(wp), intent(out) :: mi_ratio_a_q(nx + 1, ny + 1)
      integer :: ic, jc
      real(wp) :: tot_area, mass_sum
      real(wp) :: a_sw, a_se, a_nw, a_ne
      real(wp) :: m_sw, m_se, m_nw, m_ne
      real(wp) :: mt_sw, mt_se, mt_nw, mt_ne

      ! Interior corners, then the array edge in its own loops -- see
      ! `evp_build_masks_impl` (nvfortran CPU vectoriser, four-way guard).
      do concurrent(ic=1:nx + 1)
         q(ic, 1) = 0.0_wp
         mi_ratio_a_q(ic, 1) = 0.0_wp
         q(ic, ny + 1) = 0.0_wp
         mi_ratio_a_q(ic, ny + 1) = 0.0_wp
      end do
      do concurrent(jc=2:ny)
         q(1, jc) = 0.0_wp
         mi_ratio_a_q(1, jc) = 0.0_wp
         q(nx + 1, jc) = 0.0_wp
         mi_ratio_a_q(nx + 1, jc) = 0.0_wp
      end do
      do concurrent(jc=2:ny, ic=2:nx) &
         local(tot_area, mass_sum, a_sw, a_se, a_nw, a_ne, m_sw, m_se, m_nw, m_ne, &
               mt_sw, mt_se, mt_nw, mt_ne)
         a_sw = areaT(ic - 1, jc - 1)
         a_se = areaT(ic, jc - 1)
         a_nw = areaT(ic - 1, jc)
         a_ne = areaT(ic, jc)
         m_sw = mis(ic - 1, jc - 1)
         m_se = mis(ic, jc - 1)
         m_nw = mis(ic - 1, jc)
         m_ne = mis(ic, jc)
         mt_sw = mask_t(ic - 1, jc - 1)
         mt_se = mask_t(ic, jc - 1)
         mt_nw = mask_t(ic - 1, jc)
         mt_ne = mask_t(ic, jc)

         tot_area = (a_sw + a_ne) + (a_nw + a_se)
         mass_sum = (a_sw*m_sw + a_ne*m_ne) + (a_nw*m_nw + a_se*m_se)
         q(ic, jc) = f_corner(ic, jc)*tot_area/(mass_sum + tot_area*m_neglect)

         mi_ratio_a_q(ic, jc) = ice_evp_mi_ratio_point( &
                                m_sw, m_se, m_nw, m_ne, &
                                mask_u(ic, jc - 1), mask_u(ic, jc), &
                                mask_v(ic - 1, jc), mask_v(ic, jc), &
                                mask_q(ic, jc), a_sw, a_se, a_nw, a_ne, &
                                mt_sw, mt_se, mt_nw, mt_ne, m_neglect2, m_neglect4)
      end do
   end subroutine evp_q_and_mi_ratio_impl