drain_avail_scale_x Subroutine

private pure subroutine drain_avail_scale_x(nx, ny, nz, scratch, uhtr)

Scale each interior x-face transport by its INFLOW-receiving cell’s factor (drain_avail_limit step 2). Face i between cell (i-1) and cell (i): uhtr(i)>0 ⇒ receiver i, uhtr(i)<0 ⇒ receiver i-1.

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: nx
integer, intent(in) :: ny
integer, intent(in) :: nz
real(kind=wp), intent(in) :: scratch(nx,ny,nz)
real(kind=wp), intent(inout) :: uhtr(nx+1,ny,nz)

Calls

proc~~drain_avail_scale_x~~CallsGraph proc~drain_avail_scale_x drain_avail_scale_x local local proc~drain_avail_scale_x->local

Called by

proc~~drain_avail_scale_x~~CalledByGraph proc~drain_avail_scale_x drain_avail_scale_x proc~continuity_tracer_drain continuity_tracer_drain proc~continuity_tracer_drain->proc~drain_avail_scale_x 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
integer, private :: i
integer, private :: j
integer, private :: k
real(kind=wp), private :: sfac

Source Code

   pure subroutine drain_avail_scale_x(nx, ny, nz, scratch, uhtr)
      !! Scale each interior x-face transport by its INFLOW-receiving cell's
      !! factor (drain_avail_limit step 2).  Face i between cell (i-1) and
      !! cell (i): uhtr(i)>0 ⇒ receiver i, uhtr(i)<0 ⇒ receiver i-1.
      integer, intent(in) :: nx, ny, nz
      real(wp), intent(in) :: scratch(nx, ny, nz)
      real(wp), intent(inout) :: uhtr(nx + 1, ny, nz)
      integer :: i, j, k
      real(wp) :: sfac
      do concurrent(k=1:nz, j=1:ny, i=2:nx) local(sfac)
         if (uhtr(i, j, k) > 0.0_wp) then
            sfac = scratch(i, j, k)
         else if (uhtr(i, j, k) < 0.0_wp) then
            sfac = scratch(i - 1, j, k)
         else
            sfac = 1.0_wp
         end if
         uhtr(i, j, k) = uhtr(i, j, k)*sfac
      end do
   end subroutine drain_avail_scale_x