fold_north_corner_2d Subroutine

private pure subroutine fold_north_corner_2d(fld, nx_face, ny_face, nx_phys, ny_phys, nghost, negate)

2D Bu-corner fold: north-halo fill + on-line projection.

Arguments

Type IntentOptional Attributes Name
real(kind=wp), intent(inout) :: fld(nx_face,ny_face)

Corner field, shape (nx_total+1, ny_total+1).
integer, intent(in) :: nx_face
integer, intent(in) :: ny_face
integer, intent(in) :: nx_phys
integer, intent(in) :: ny_phys
integer, intent(in) :: nghost
logical, intent(in) :: negate

.true. → negate (true-vector component); .false. → copy (scalar / pseudoscalar vorticity).

Calls

proc~~fold_north_corner_2d~~CallsGraph proc~fold_north_corner_2d fold_north_corner_2d local local proc~fold_north_corner_2d->local

Called by

proc~~fold_north_corner_2d~~CalledByGraph proc~fold_north_corner_2d fold_north_corner_2d interface~fold_north_corner fold_north_corner interface~fold_north_corner->proc~fold_north_corner_2d proc~fill_f_corner_seam_ghosts fill_f_corner_seam_ghosts proc~fill_f_corner_seam_ghosts->interface~fold_north_corner proc~fold_corner_2d fold_corner_2d proc~fold_corner_2d->interface~fold_north_corner proc~metrics_fold_north_faces metrics_fold_north_faces proc~metrics_fold_north_faces->interface~fold_north_corner interface~ocean_fold_north_corner ocean_fold_north_corner interface~ocean_fold_north_corner->proc~fold_corner_2d proc~configure_ocean_forcing configure_ocean_forcing proc~configure_ocean_forcing->proc~fill_f_corner_seam_ghosts proc~metrics_fold_periodic_ghosts metrics_fold_periodic_ghosts proc~metrics_fold_periodic_ghosts->proc~metrics_fold_north_faces proc~engine_setup engine_setup proc~engine_setup->interface~ocean_fold_north_corner proc~engine_setup->proc~configure_ocean_forcing proc~engine_setup->proc~metrics_fold_periodic_ghosts proc~metrics_fill_from_supergrid metrics_fill_from_supergrid proc~metrics_fill_from_supergrid->proc~metrics_fold_periodic_ghosts proc~metrics_fill_tripolar_whole metrics_fill_tripolar_whole proc~metrics_fill_tripolar_whole->proc~metrics_fold_periodic_ghosts proc~complete_ocean_create complete_ocean_create proc~complete_ocean_create->proc~engine_setup proc~configure_ocean_metrics configure_ocean_metrics proc~configure_ocean_metrics->proc~metrics_fill_from_supergrid proc~driver_run_ocean driver_run_ocean proc~driver_run_ocean->proc~engine_setup proc~driver_validate driver_validate proc~driver_validate->proc~engine_setup proc~metrics_fill_tripolar metrics_fill_tripolar proc~metrics_fill_tripolar->proc~metrics_fill_tripolar_whole

Variables

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

Source Code

   pure subroutine fold_north_corner_2d(fld, nx_face, ny_face, &
                                        nx_phys, ny_phys, nghost, negate)
      !! 2D Bu-corner fold: north-halo fill + on-line projection.
      integer, intent(in) :: nx_face, ny_face, nx_phys, ny_phys, nghost
      real(wp), intent(inout) :: fld(nx_face, ny_face)
         !! Corner field, shape (nx_total+1, ny_total+1).
      logical, intent(in) :: negate
         !! .true. → negate (true-vector component); .false. → copy (scalar
         !! / pseudoscalar vorticity).

      integer :: i, j, fsum, jsum, j_fold, i_lo, p, pm
      real(wp) :: sgn

      fsum = 2*nghost + nx_phys + 2
      jsum = 2*nghost + 2*ny_phys + 2   ! corner is SW: y = j-1
      j_fold = nghost + ny_phys + 1
      i_lo = nghost + 1
      sgn = merge(-1.0_wp, 1.0_wp, negate)

      ! Halo rows strictly beyond the fold row.
      do concurrent(j=j_fold + 1:ny_face, i=1:nx_face)
         fld(i, j) = sgn*fld(fsum - i, jsum - j)
      end do

      ! On-line projection at j = j_fold over EVERY storage column
      ! (periodic ghosts included).  Physical corner index p ∈ 1..ni
      ! (c = ni+1 is the periodic image of c = 1); mirror p' = ni+2-p
      ! modulo ni.  The two self-conjugate corners p = 1 and p = ni/2+1 are
      ! the bipoles: a vector component is zeroed there, a scalar is left
      ! as is.  West-half columns take sgn*mirror; the east half is the
      ! read-only source.
      do concurrent(i=1:nx_face) local(p, pm)
         p = modulo(i - i_lo, nx_phys) + 1
         pm = modulo(nx_phys + 1 - p, nx_phys) + 1
         if (p < pm) then
            fld(i, j_fold) = sgn*fld(nghost + pm, j_fold)
         else if (p == pm .and. negate) then
            fld(i, j_fold) = 0.0_wp
         end if
      end do
   end subroutine fold_north_corner_2d