halo_exchange.f90 Source File

!> @file halo_exchange.f90
!> @brief Non-blocking halo exchange for solver_state_t%ub.
!!
!! `exchange_halos` posts MPI_Irecv from each neighbour into this rank's
!! halo cells, then MPI_Isend the matching interior slices, then
!! MPI_Waitall on all four requests. Boundary ranks (with neighbour
!! MPI_PROC_NULL) have those Isend/Irecv calls degenerate into silent
!! no-ops by MPI standard, so the same code path runs at -np 1.
!!
!! Only one buffer set (state%ub) is halo-exchanged today. If more halo'd
!! arrays are ever added, generalize this module rather than duplicating the
!! request-management logic.

module halo_exchange
  use solver_state, only: solver_state_t, neq
  use domain_decomposition, only: decomp_t
  use mpi_runtime, only: mpi_world, parallel_fatal
  use option_registry, only: method_fvm
#ifdef CFD_SOLVER_LEGACY_MPI
  use mpi, only: MPI_Isend, MPI_Irecv, MPI_Waitall, MPI_DOUBLE_PRECISION, &
                 MPI_STATUSES_IGNORE
#else
  use mpi_f08, only: MPI_Isend, MPI_Irecv, MPI_Waitall, MPI_DOUBLE_PRECISION, &
                     MPI_STATUSES_IGNORE, MPI_Request
#endif
  implicit none
  private

  public :: exchange_halos

  integer, parameter :: TAG_HALO_L = 1001
  integer, parameter :: TAG_HALO_R = 1002

contains

  !> Fill state%ub's halo cells from neighbours.
  subroutine exchange_halos(state, d)
    type(solver_state_t), intent(inout) :: state
    type(decomp_t), intent(in) :: d
#ifdef CFD_SOLVER_LEGACY_MPI
    integer :: requests(4)
#else
    type(MPI_Request) :: requests(4)
#endif
    integer :: ierr, cnt, n_local, h, lsend, rsend

    h = d % halo_width
    n_local = d % n_local
    cnt = neq * h

    ! Interior-side slices sent to neighbours: the first h cells go left, the
    ! last h cells go right.
    lsend = 1
    rsend = n_local - h + 1

    ! Periodic-wrap correction (multi-rank only).  This is specific to the
    ! NODAL (FDM) grid, which has a duplicated endpoint: global node n_global
    ! coincides with global node 1 (x_R == x_L under periodicity). The single-
    ! rank wrap in apply_bcs collapses this duplicate (period = n_pt - 1). The
    ! cross-rank wrap must match: the periodic-edge ranks therefore skip their
    ! duplicated boundary node when sending across the wrap, shifting the sent
    ! slice by one cell. Without this, rank 0's upwind (x_L) halo is filled from
    ! the duplicate node instead of its true periodic neighbour, an off-by-one
    ! that corrupts the boundary solution.
    !
    ! The cell-centered (FVM) grid has NO duplicated endpoint (cells, not nodes,
    ! tile the domain), so this shift MUST NOT be applied there: the FVM periodic
    ! neighbour of global cell 1 is global cell n_global and the slice is sent
    ! unshifted. Applying the nodal skip to FVM produces off-by-one wrap halos,
    ! making the inter-rank periodic-face flux inconsistent between the two
    ! ranks, which breaks discrete conservation at np > 1. Gate on method so the
    ! FDM path stays byte-identical (block_t % method defaults to 'fdm', so any
    ! non-FVM caller keeps the nodal correction).
    if (trim(state % blocks(1) % method) /= method_fvm .and. &
        d % is_periodic .and. d % n_ranks > 1) then
      if (d % my_rank == 0) lsend = 2                       ! skip node 1 (== global last)
      if (d % my_rank == d % n_ranks - 1) rsend = n_local - h  ! skip node n_local (== global 1)
    end if

    ! Post receives first so sends don't deadlock on small MPIs.
    call MPI_Irecv(state % ub(1, 1 - h), cnt, MPI_DOUBLE_PRECISION, &
                   d % left_neighbour, TAG_HALO_R, mpi_world(), requests(1), ierr)
    if (ierr /= 0) call parallel_fatal('halo_exchange: Irecv left failed')

    call MPI_Irecv(state % ub(1, n_local + 1), cnt, MPI_DOUBLE_PRECISION, &
                   d % right_neighbour, TAG_HALO_L, mpi_world(), requests(2), ierr)
    if (ierr /= 0) call parallel_fatal('halo_exchange: Irecv right failed')

    call MPI_Isend(state % ub(1, lsend), cnt, MPI_DOUBLE_PRECISION, &
                   d % left_neighbour, TAG_HALO_L, mpi_world(), requests(3), ierr)
    if (ierr /= 0) call parallel_fatal('halo_exchange: Isend left failed')

    call MPI_Isend(state % ub(1, rsend), cnt, MPI_DOUBLE_PRECISION, &
                   d % right_neighbour, TAG_HALO_R, mpi_world(), requests(4), ierr)
    if (ierr /= 0) call parallel_fatal('halo_exchange: Isend right failed')

    call MPI_Waitall(4, requests, MPI_STATUSES_IGNORE, ierr)
    if (ierr /= 0) call parallel_fatal('halo_exchange: Waitall failed')
  end subroutine exchange_halos

end module halo_exchange