fold_north_v_face_3d Subroutine

private pure subroutine fold_north_v_face_3d(v, nx_total, ny_face, nz, nx_phys, ny_phys, nghost, negate)

3D y-face (Cv) fold: north-halo fill + on-line antisymmetric projection at the fold row. See the 2D twin for the negate (vector vs. scalar) contract.

Arguments

Type IntentOptional Attributes Name
real(kind=wp), intent(inout) :: v(nx_total,ny_face,nz)

y-face 3D field, shape (nx_total, ny_total+1, nz).
integer, intent(in) :: nx_total
integer, intent(in) :: ny_face
integer, intent(in) :: nz
integer, intent(in) :: nx_phys
integer, intent(in) :: ny_phys
integer, intent(in) :: nghost
logical, intent(in), optional :: negate

.true. (default) = true-vector component; .false. = scalar.

Calls

proc~~fold_north_v_face_3d~~CallsGraph proc~fold_north_v_face_3d fold_north_v_face_3d local local proc~fold_north_v_face_3d->local

Called by

proc~~fold_north_v_face_3d~~CalledByGraph proc~fold_north_v_face_3d fold_north_v_face_3d interface~fold_north_v_face fold_north_v_face interface~fold_north_v_face->proc~fold_north_v_face_3d proc~drain_wrap_face_y drain_wrap_face_y proc~drain_wrap_face_y->interface~fold_north_v_face proc~fold_v_2d fold_v_2d proc~fold_v_2d->interface~fold_north_v_face proc~fold_v_3d fold_v_3d proc~fold_v_3d->interface~fold_north_v_face proc~ocean_fold_wrap_state ocean_fold_wrap_state proc~ocean_fold_wrap_state->interface~fold_north_v_face proc~ocean_fold_wrap_stress ocean_fold_wrap_stress proc~ocean_fold_wrap_stress->interface~fold_north_v_face proc~ocean_fold_wrap_time_means ocean_fold_wrap_time_means proc~ocean_fold_wrap_time_means->interface~fold_north_v_face proc~ocean_fold_wrap_visc_rem ocean_fold_wrap_visc_rem proc~ocean_fold_wrap_visc_rem->interface~fold_north_v_face interface~ocean_fold_north_v_face ocean_fold_north_v_face interface~ocean_fold_north_v_face->proc~fold_v_2d interface~ocean_fold_north_v_face->proc~fold_v_3d proc~continuity_tracer_drain continuity_tracer_drain proc~continuity_tracer_drain->proc~drain_wrap_face_y proc~engine_setup engine_setup proc~engine_setup->proc~ocean_fold_wrap_state proc~configure_ocean_forcing configure_ocean_forcing proc~engine_setup->proc~configure_ocean_forcing proc~ocean_data_forcing_configure ocean_data_forcing_configure proc~engine_setup->proc~ocean_data_forcing_configure proc~ocean_seam_refresh_surface_stress ocean_seam_refresh_surface_stress proc~ocean_seam_refresh_surface_stress->proc~ocean_fold_wrap_stress proc~run_continuity_chain run_continuity_chain proc~run_continuity_chain->proc~ocean_fold_wrap_state proc~continuity_tracer_step_split continuity_tracer_step_split proc~run_continuity_chain->proc~continuity_tracer_step_split proc~run_gm_step run_gm_step proc~run_gm_step->proc~ocean_fold_wrap_state proc~continuity_gm_apply continuity_gm_apply proc~run_gm_step->proc~continuity_gm_apply proc~run_stage_split run_stage_split proc~run_stage_split->proc~ocean_fold_wrap_state proc~run_stage_split->proc~ocean_fold_wrap_time_means proc~run_stage_split->proc~run_continuity_chain proc~visc_rem_precompute visc_rem_precompute proc~run_stage_split->proc~visc_rem_precompute proc~vmix_apply_in_stage vmix_apply_in_stage proc~run_stage_split->proc~vmix_apply_in_stage proc~visc_rem_halo_refresh visc_rem_halo_refresh proc~visc_rem_halo_refresh->proc~ocean_fold_wrap_visc_rem proc~barotropic_substep_nonlinear barotropic_substep_nonlinear proc~barotropic_substep_nonlinear->interface~ocean_fold_north_v_face proc~complete_ocean_create complete_ocean_create proc~complete_ocean_create->proc~engine_setup proc~configure_ocean_forcing->proc~ocean_seam_refresh_surface_stress proc~continuity_gm_apply->interface~ocean_fold_north_v_face proc~continuity_tracer_step_split->interface~ocean_fold_north_v_face proc~driver_run_ocean driver_run_ocean proc~driver_run_ocean->proc~engine_setup proc~ocean_dyn_flush_tracer_window ocean_dyn_flush_tracer_window proc~driver_run_ocean->proc~ocean_dyn_flush_tracer_window proc~driver_validate driver_validate proc~driver_validate->proc~engine_setup proc~ice_ocean_stress_flux ice_ocean_stress_flux proc~ice_ocean_stress_flux->proc~ocean_seam_refresh_surface_stress proc~ocean_data_forcing_apply ocean_data_forcing_apply proc~ocean_data_forcing_apply->proc~ocean_seam_refresh_surface_stress proc~ocean_data_forcing_configure->proc~ocean_seam_refresh_surface_stress 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~ocean_dyn_step_split->proc~run_gm_step proc~ocean_dyn_step_split->proc~run_stage_split proc~visc_rem_precompute->proc~visc_rem_halo_refresh proc~vmix_apply_in_stage->proc~visc_rem_halo_refresh proc~vmix_apply_in_stage->proc~visc_rem_precompute proc~barotropic_substep_nonlinear_interior barotropic_substep_nonlinear_interior proc~barotropic_substep_nonlinear_interior->proc~barotropic_substep_nonlinear proc~bt_wide_substep bt_wide_substep proc~bt_wide_substep->proc~barotropic_substep_nonlinear proc~driver_run driver_run proc~driver_run->proc~driver_run_ocean proc~engine_step engine_step proc~engine_step->proc~ocean_data_forcing_apply proc~engine_step->proc~ocean_dyn_step proc~engine_step->proc~ocean_dyn_step_split proc~engine_step_ice engine_step_ice proc~engine_step_ice->proc~ice_ocean_stress_flux proc~rdb_ocean_create_finalize rdb_ocean_create_finalize proc~rdb_ocean_create_finalize->proc~complete_ocean_create proc~rdb_ocean_create_from_string rdb_ocean_create_from_string proc~rdb_ocean_create_from_string->proc~complete_ocean_create proc~rdb_ocean_set_tracer rdb_ocean_set_tracer proc~rdb_ocean_set_tracer->proc~ocean_dyn_flush_tracer_window proc~run_stage run_stage proc~run_stage->proc~continuity_tracer_step_split proc~run_stage->proc~vmix_apply_in_stage

Variables

Type Visibility Attributes Name Initial
integer, private :: i
integer, private :: i_lo
integer, private :: isum
integer, private :: j
integer, private :: j_fold
integer, private :: jsum
integer, private :: k
logical, private :: negate_l
integer, private :: p
integer, private :: pm
real(kind=wp), private :: sgn

Source Code

   pure subroutine fold_north_v_face_3d(v, nx_total, ny_face, nz, &
                                        nx_phys, ny_phys, nghost, negate)
      !! 3D y-face (Cv) fold: north-halo fill + on-line antisymmetric
      !! projection at the fold row.  See the 2D twin for the `negate`
      !! (vector vs. scalar) contract.
      integer, intent(in) :: nx_total, ny_face, nz, nx_phys, ny_phys, nghost
      real(wp), intent(inout) :: v(nx_total, ny_face, nz)
         !! y-face 3D field, shape (nx_total, ny_total+1, nz).
      logical, intent(in), optional :: negate
         !! `.true.` (default) = true-vector component; `.false.` = scalar.

      integer :: i, j, k, isum, jsum, j_fold, i_lo, p, pm
      real(wp) :: sgn
      logical :: negate_l

      negate_l = .true.
      if (present(negate)) negate_l = negate
      sgn = merge(-1.0_wp, 1.0_wp, negate_l)
      isum = 2*nghost + nx_phys + 1
      jsum = 2*nghost + 2*ny_phys + 2    ! v is SOUTH-face: y = j-1
      j_fold = nghost + ny_phys + 1      ! the self-conjugate fold row
      i_lo = nghost + 1                  ! first physical column

      ! (1) Halo rows strictly beyond the fold row.
      do concurrent(k=1:nz, j=j_fold + 1:ny_face, i=1:nx_total)
         v(i, j, k) = sgn*v(isum - i, jsum - j, k)
      end do

      ! (2) On-line projection at j = j_fold (see the 2D twin): every
      !     storage column whose physical index p is in the west half
      !     takes sgn*(its east mirror p' = ni+1-p); the self-conjugate
      !     column (odd ni only) is zeroed for a vector, left as is for a
      !     scalar; the east half is the read-only source, so the kernel
      !     is race-free.
      do concurrent(k=1:nz, i=1:nx_total) local(p, pm)
         p = modulo(i - i_lo, nx_phys) + 1
         pm = nx_phys + 1 - p
         if (p < pm) then
            v(i, j_fold, k) = sgn*v(nghost + pm, j_fold, k)
         else if (p == pm .and. negate_l) then
            v(i, j_fold, k) = 0.0_wp
         end if
      end do
   end subroutine fold_north_v_face_3d