remap_x_face_grounded Subroutine

private pure subroutine remap_x_face_grounded(nx, ny, nz, h_old, h_new, mask, u_face_x)

Conservative east-face velocity remap gated on the grounded mask. A face is active iff either adjacent cell is grounded (2 mask loads — no neighbour-column re-scan); inactive faces are left byte-unchanged. Face thickness is the arithmetic mean of the two adjacent cells (outer walls take the single interior cell); the target side reads h_new only where the mask is set — elsewhere h_new ≡ h_old by construction, so h_old is read directly. remap_column preserves the per-face momentum Sigma h_face . u.

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) :: u_face_x(nx+1,ny,nz)

Calls

proc~~remap_x_face_grounded~~CallsGraph proc~remap_x_face_grounded remap_x_face_grounded local local proc~remap_x_face_grounded->local proc~remap_column remap_column proc~remap_x_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_x_face_grounded~~CalledByGraph proc~remap_x_face_grounded remap_x_face_grounded proc~ocean_apply_conservative_min_thickness ocean_apply_conservative_min_thickness proc~ocean_apply_conservative_min_thickness->proc~remap_x_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 :: I
logical, private :: active
logical, private :: ge
logical, private :: gw
real(kind=wp), private :: h_new_face(NZ_STACK_MAX)
real(kind=wp), private :: h_old_face(NZ_STACK_MAX)
real(kind=wp), private :: hne
real(kind=wp), private :: hnw
integer, private :: j
integer, private :: k
real(kind=wp), private :: u_new(NZ_STACK_MAX)
real(kind=wp), private :: u_old(NZ_STACK_MAX)

Source Code

   pure subroutine remap_x_face_grounded(nx, ny, nz, h_old, h_new, mask, u_face_x)
      !! Conservative east-face velocity remap gated on the grounded mask.  A
      !! face is active iff either adjacent cell is grounded (2 mask loads —
      !! no neighbour-column re-scan); inactive faces are left byte-unchanged.
      !! Face thickness is the arithmetic mean of the two adjacent cells
      !! (outer walls take the single interior cell); the target side reads
      !! h_new only where the mask is set — elsewhere h_new ≡ h_old by
      !! construction, so h_old is read directly.  `remap_column` preserves
      !! the per-face momentum Sigma h_face . u.
      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) :: u_face_x(nx + 1, ny, nz)
      integer :: I, j, k
      real(wp) :: h_old_face(NZ_STACK_MAX), h_new_face(NZ_STACK_MAX)
      real(wp) :: u_old(NZ_STACK_MAX), u_new(NZ_STACK_MAX)
      real(wp) :: hnw, hne
      logical :: active, gw, ge

      do concurrent(j=1:ny, I=1:nx + 1) &
         local(k, h_old_face, h_new_face, u_old, u_new, active, gw, ge, hnw, hne)
         gw = .false.
         ge = .false.
         if (I >= 2) gw = mask(I - 1, j, 1) > 0.5_wp
         if (I <= nx) ge = mask(I, j, 1) > 0.5_wp
         active = gw .or. ge
         if (active) then
            do k = 1, nz
               if (I == 1) then
                  h_old_face(k) = h_old(1, j, k)
                  h_new_face(k) = merge(h_new(1, j, k), h_old(1, j, k), ge)
               else if (I == nx + 1) then
                  h_old_face(k) = h_old(nx, j, k)
                  h_new_face(k) = merge(h_new(nx, j, k), h_old(nx, j, k), gw)
               else
                  h_old_face(k) = 0.5_wp*(h_old(I - 1, j, k) + h_old(I, j, k))
                  hnw = merge(h_new(I - 1, j, k), h_old(I - 1, j, k), gw)
                  hne = merge(h_new(I, j, k), h_old(I, j, k), ge)
                  h_new_face(k) = 0.5_wp*(hnw + hne)
               end if
               u_old(k) = u_face_x(I, j, k)
            end do
            call remap_column(REMAP_PPM, nz, h_old_face(1:nz), h_new_face(1:nz), &
                              u_old(1:nz), u_new(1:nz))
            do k = 1, nz
               u_face_x(I, j, k) = u_new(k)
            end do
         end if
      end do
   end subroutine remap_x_face_grounded