parallel_reductions.F90 Source File

!> @file parallel_reductions.F90
!> @brief Thin wrappers around MPI_Allreduce for the three reduction kinds
!!        the 1D Euler solver needs: scalar real max, scalar real sum, and
!!        scalar logical OR.
!!
!! Every call goes through MPI_Allreduce so call sites remain correct at any
!! rank count. At `-np 1` the operations are identities; bit-identity with
!! the pre-MPI serial code is preserved by construction.
!!
!! We deliberately use separate send/recv buffers rather than =MPI_IN_PLACE=:
!! MS-MPI's legacy =mpi= module mishandles =MPI_IN_PLACE= at =-np 1=, returning
!! garbage instead of the input value. Two-buffer Allreduce is the textbook
!! form and works on every MPI implementation we care about.
!!
!! See `mpi_runtime.F90` for the rationale behind the `mpi_f08` / legacy
!! `mpi` cpp split.

module parallel_reductions
  use precision, only: wp
#ifdef CFD_SOLVER_LEGACY_MPI
  use mpi, only: MPI_Allreduce, MPI_DOUBLE_PRECISION, MPI_LOGICAL, &
                 MPI_MAX, MPI_SUM, MPI_LOR
#else
  use mpi_f08, only: MPI_Allreduce, MPI_DOUBLE_PRECISION, MPI_LOGICAL, &
                     MPI_MAX, MPI_SUM, MPI_LOR
#endif
  use mpi_runtime, only: mpi_world, parallel_fatal
  implicit none
  private

  public :: par_max_real
  public :: par_sum_real
  public :: par_lor

contains

  !> Return the maximum of a scalar real(wp) across all ranks.
  function par_max_real(local) result(global)
    real(wp), intent(in) :: local
    real(wp)             :: global
    integer              :: ierr

    call MPI_Allreduce(local, global, 1, MPI_DOUBLE_PRECISION, &
                       MPI_MAX, mpi_world(), ierr)
    if (ierr /= 0) call parallel_fatal('par_max_real: MPI_Allreduce failed')
  end function par_max_real

  !> Return the sum of a scalar real(wp) across all ranks.
  function par_sum_real(local) result(global)
    real(wp), intent(in) :: local
    real(wp)             :: global
    integer              :: ierr

    call MPI_Allreduce(local, global, 1, MPI_DOUBLE_PRECISION, &
                       MPI_SUM, mpi_world(), ierr)
    if (ierr /= 0) call parallel_fatal('par_sum_real: MPI_Allreduce failed')
  end function par_sum_real

  !> Return the logical OR of a scalar logical across all ranks.
  function par_lor(local) result(global)
    logical, intent(in) :: local
    logical             :: global
    integer             :: ierr

    call MPI_Allreduce(local, global, 1, MPI_LOGICAL, &
                       MPI_LOR, mpi_world(), ierr)
    if (ierr /= 0) call parallel_fatal('par_lor: MPI_Allreduce failed')
  end function par_lor

end module parallel_reductions