remap_y_face_grounded Subroutine

private pure subroutine remap_y_face_grounded(nx, ny, nz, h_old, h_new, mask, v_face_y)

Conservative north-face velocity remap, mirror of the x routine.

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: nx
integer, intent(in) :: ny
integer, intent(in) :: nz
real(kind=wp), intent(in) :: h_old(nx,ny,nz)
real(kind=wp), intent(in) :: h_new(nx,ny,nz)
real(kind=wp), intent(in) :: mask(nx,ny,1)
real(kind=wp), intent(inout) :: v_face_y(nx,ny+1,nz)

Calls

proc~~remap_y_face_grounded~~CallsGraph proc~remap_y_face_grounded remap_y_face_grounded local local proc~remap_y_face_grounded->local proc~remap_column remap_column proc~remap_y_face_grounded->proc~remap_column proc~remap_column_pcm remap_column_pcm proc~remap_column->proc~remap_column_pcm proc~remap_column_plm remap_column_plm proc~remap_column->proc~remap_column_plm proc~remap_column_ppm remap_column_ppm proc~remap_column->proc~remap_column_ppm proc~remap_column_ppm_h4 remap_column_ppm_h4 proc~remap_column->proc~remap_column_ppm_h4 proc~remap_column_pqm remap_column_pqm proc~remap_column->proc~remap_column_pqm proc~boundary_half_jump boundary_half_jump proc~remap_column_plm->proc~boundary_half_jump proc~plm_slope_nonuniform plm_slope_nonuniform proc~remap_column_plm->proc~plm_slope_nonuniform proc~remap_column_ppm->proc~remap_column_plm proc~remap_column_ppm->proc~boundary_half_jump proc~ppm_edge_nonuniform ppm_edge_nonuniform proc~remap_column_ppm->proc~ppm_edge_nonuniform proc~ppm_edge_two_cell ppm_edge_two_cell proc~remap_column_ppm->proc~ppm_edge_two_cell proc~ppm_jump_nonuniform ppm_jump_nonuniform proc~remap_column_ppm->proc~ppm_jump_nonuniform proc~remap_column_ppm_h4->proc~remap_column_plm proc~remap_column_ppm_h4->proc~boundary_half_jump proc~remap_column_pqm->proc~remap_column_ppm proc~remap_column_pqm->proc~boundary_half_jump proc~pqm_end_value_h4 pqm_end_value_h4 proc~remap_column_pqm->proc~pqm_end_value_h4 proc~pqm_solve_diag_dominant pqm_solve_diag_dominant proc~remap_column_pqm->proc~pqm_solve_diag_dominant

Called by

proc~~remap_y_face_grounded~~CalledByGraph proc~remap_y_face_grounded remap_y_face_grounded proc~ocean_apply_conservative_min_thickness ocean_apply_conservative_min_thickness proc~ocean_apply_conservative_min_thickness->proc~remap_y_face_grounded proc~run_continuity_chain run_continuity_chain proc~run_continuity_chain->proc~ocean_apply_conservative_min_thickness proc~run_stage_split run_stage_split proc~run_stage_split->proc~run_continuity_chain proc~ocean_dyn_step_split ocean_dyn_step_split proc~ocean_dyn_step_split->proc~run_stage_split proc~engine_step engine_step proc~engine_step->proc~ocean_dyn_step_split

Variables

Type Visibility Attributes Name Initial
integer, private :: J
logical, private :: active
logical, private :: gn
logical, private :: gs
real(kind=wp), private :: h_new_face(NZ_STACK_MAX)
real(kind=wp), private :: h_old_face(NZ_STACK_MAX)
real(kind=wp), private :: hnn
real(kind=wp), private :: hns
integer, private :: i
integer, private :: k
real(kind=wp), private :: v_new(NZ_STACK_MAX)
real(kind=wp), private :: v_old(NZ_STACK_MAX)

Source Code

   pure subroutine remap_y_face_grounded(nx, ny, nz, h_old, h_new, mask, v_face_y)
      !! Conservative north-face velocity remap, mirror of the x routine.
      integer, intent(in) :: nx, ny, nz
      real(wp), intent(in) :: h_old(nx, ny, nz)
      real(wp), intent(in) :: h_new(nx, ny, nz)
      real(wp), intent(in) :: mask(nx, ny, 1)
      real(wp), intent(inout) :: v_face_y(nx, ny + 1, nz)
      integer :: i, J, k
      real(wp) :: h_old_face(NZ_STACK_MAX), h_new_face(NZ_STACK_MAX)
      real(wp) :: v_old(NZ_STACK_MAX), v_new(NZ_STACK_MAX)
      real(wp) :: hns, hnn
      logical :: active, gs, gn

      do concurrent(J=1:ny + 1, i=1:nx) &
         local(k, h_old_face, h_new_face, v_old, v_new, active, gs, gn, hns, hnn)
         gs = .false.
         gn = .false.
         if (J >= 2) gs = mask(i, J - 1, 1) > 0.5_wp
         if (J <= ny) gn = mask(i, J, 1) > 0.5_wp
         active = gs .or. gn
         if (active) then
            do k = 1, nz
               if (J == 1) then
                  h_old_face(k) = h_old(i, 1, k)
                  h_new_face(k) = merge(h_new(i, 1, k), h_old(i, 1, k), gn)
               else if (J == ny + 1) then
                  h_old_face(k) = h_old(i, ny, k)
                  h_new_face(k) = merge(h_new(i, ny, k), h_old(i, ny, k), gs)
               else
                  h_old_face(k) = 0.5_wp*(h_old(i, J - 1, k) + h_old(i, J, k))
                  hns = merge(h_new(i, J - 1, k), h_old(i, J - 1, k), gs)
                  hnn = merge(h_new(i, J, k), h_old(i, J, k), gn)
                  h_new_face(k) = 0.5_wp*(hns + hnn)
               end if
               v_old(k) = v_face_y(i, J, k)
            end do
            call remap_column(REMAP_PPM, nz, h_old_face(1:nz), h_new_face(1:nz), &
                              v_old(1:nz), v_new(1:nz))
            do k = 1, nz
               v_face_y(i, J, k) = v_new(k)
            end do
         end if
      end do
   end subroutine remap_y_face_grounded