drain_limit_y Subroutine

private pure subroutine drain_limit_y(nx, ny, nz, areaT, h_min, uhr_y, hprev, uhh_y)

Meridional analogue of drain_limit_x. Face j between cell (i,j-1) and cell (i,j); positive donor = cell (i,j-1).

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: nx
integer, intent(in) :: ny
integer, intent(in) :: nz
real(kind=wp), intent(in) :: areaT(nx,ny)
real(kind=wp), intent(in) :: h_min
real(kind=wp), intent(in) :: uhr_y(nx,ny+1,nz)
real(kind=wp), intent(in) :: hprev(nx,ny,nz)
real(kind=wp), intent(inout) :: uhh_y(nx,ny+1,nz)

Calls

proc~~drain_limit_y~~CallsGraph proc~drain_limit_y drain_limit_y local local proc~drain_limit_y->local

Called by

proc~~drain_limit_y~~CalledByGraph proc~drain_limit_y drain_limit_y proc~continuity_tracer_drain continuity_tracer_drain proc~continuity_tracer_drain->proc~drain_limit_y proc~ocean_dyn_flush_tracer_window ocean_dyn_flush_tracer_window proc~ocean_dyn_flush_tracer_window->proc~continuity_tracer_drain proc~ocean_dyn_step ocean_dyn_step proc~ocean_dyn_step->proc~continuity_tracer_drain proc~ocean_dyn_step_split ocean_dyn_step_split proc~ocean_dyn_step_split->proc~continuity_tracer_drain proc~driver_run_ocean driver_run_ocean proc~driver_run_ocean->proc~ocean_dyn_flush_tracer_window proc~engine_step engine_step proc~driver_run_ocean->proc~engine_step proc~engine_step->proc~ocean_dyn_step proc~engine_step->proc~ocean_dyn_step_split proc~rdb_ocean_set_tracer rdb_ocean_set_tracer proc~rdb_ocean_set_tracer->proc~ocean_dyn_flush_tracer_window proc~driver_run driver_run proc~driver_run->proc~driver_run_ocean proc~rdb_ocean_step rdb_ocean_step proc~rdb_ocean_step->proc~engine_step

Variables

Type Visibility Attributes Name Initial
real(kind=wp), private :: hlos
real(kind=wp), private :: hup
integer, private :: i
integer, private :: j
integer, private :: k
real(kind=wp), private :: uhr

Source Code

   pure subroutine drain_limit_y(nx, ny, nz, areaT, h_min, uhr_y, hprev, uhh_y)
      !! Meridional analogue of drain_limit_x.  Face j between cell (i,j-1)
      !! and cell (i,j); positive donor = cell (i,j-1).
      integer, intent(in) :: nx, ny, nz
      real(wp), intent(in) :: areaT(nx, ny)
      real(wp), intent(in) :: h_min
      real(wp), intent(in) :: uhr_y(nx, ny + 1, nz)
      real(wp), intent(in) :: hprev(nx, ny, nz)
      real(wp), intent(inout) :: uhh_y(nx, ny + 1, nz)
      integer :: i, j, k
      real(wp) :: uhr, hup, hlos
      do concurrent(k=1:nz, j=2:ny, i=1:nx) local(uhr, hup, hlos)
         uhr = uhr_y(i, j, k)
         if (uhr > 0.0_wp) then
            hup = areaT(i, j - 1)*hprev(i, j - 1, k) - areaT(i, j - 1)*h_min
            hlos = max(0.0_wp, -uhr_y(i, j - 1, k))
            if (((hup - hlos) - uhr < 0.0_wp) .and. (0.5_wp*hup - uhr < 0.0_wp)) then
               uhh_y(i, j, k) = max(0.0_wp, max(0.5_wp*hup, hup - hlos))
            else
               uhh_y(i, j, k) = uhr
            end if
         else if (uhr < 0.0_wp) then
            hup = areaT(i, j)*hprev(i, j, k) - areaT(i, j)*h_min
            hlos = max(0.0_wp, uhr_y(i, j + 1, k))
            if (((hup - hlos) + uhr < 0.0_wp) .and. (0.5_wp*hup + uhr < 0.0_wp)) then
               uhh_y(i, j, k) = -max(0.0_wp, max(0.5_wp*hup, hup - hlos))
            else
               uhh_y(i, j, k) = uhr
            end if
         else
            uhh_y(i, j, k) = 0.0_wp
         end if
      end do
      do concurrent(k=1:nz, i=1:nx)
         uhh_y(i, 1, k) = 0.0_wp
         uhh_y(i, ny + 1, k) = 0.0_wp
      end do
   end subroutine drain_limit_y