halo_allreduce_efp_list Subroutine

   subroutine halo_allreduce_efp_list(local_list, global_list, nval)
      !! Order-invariant EXACT cross-rank combine of `nval` EFP values in
      !! ONE collective (PR-32).  Replaces N separate scalar
      !! `halo_allreduce_sum` calls with one packed `allreduce`.
      !!
      !! Transport mechanism (see `rdb_efp`'s module docstring for the
      !! full derivation): `pic_mpi_lib` has NO `integer(int64)` allreduce
      !! overload (`MPI_INTEGER8` reaches only send/recv, never
      !! allreduce), so the six int64 bins per value are packed as
      !! EXACTLY-representable `real64` doubles and combined with a plain
      !! `MPI_SUM`.  This is exact, not approximate, PROVIDED every
      !! partial sum MPI could form stays `<= 2**53` (the double mantissa
      !! bound) — enforced below by two fail-loud guards, never a silent
      !! fallback:
      !!
      !!   1. `num_ranks <= EFP_MAX_RANKS` (2**17 = 131072) — the bound
      !!      that makes bins 2..6 (each `< 2**P` after a local carry)
      !!      summable across ranks without exceeding 2**53.
      !!   2. `efp_bin1_within_transport_bound` on every LOCAL value —
      !!      bin 1 is NOT bounded by `efp_carry` (see `rdb_efp`), so it
      !!      needs its own runtime check: `|e(1)| <= 2**53 / num_ranks`.
      !!
      !! COLLECTIVE: every compute rank must call this with the SAME
      !! `nval`.  Both guards are evaluated on rank-uniform data (the
      !! rank count, and each rank's own local value) so a violation
      !! aborts identically on every rank — no rank-dependent branch that
      !! could hang the collective (CLAUDE.md's collective-panic idiom,
      !! `rdb_console_stats.F90:255-280`).
      !!
      !! Non-in-place — `local_list` and `global_list` must be distinct
      !! actual arguments, matching `halo_allreduce_sum`'s aliasing
      !! contract.
      !!
      !! Non-finite propagation: `efp_to_transport`/`efp_from_transport`
      !! carry each value's `poison` counter through the SAME `MPI_SUM` as
      !! the bins (`EFP_TRANSPORT_WIDTH`, not `EFP_DIGITS`, per value), so
      !! a NaN/+-Inf/overflow summand on ANY rank makes `global_list(i)`
      !! read as NaN via `efp_to_real` on EVERY rank -- never a
      !! rank-dependent result. A NaN-poisoned local value decomposes to
      !! zeroed bins (`v(1) = 0`), so it sails through guard 2 below and is
      !! resolved by the poison counter alone; an overflow-poisoned local
      !! value instead saturates `v(1)` and typically TRIPS guard 2
      !! itself at >1 rank -- a louder, equally fail-loud outcome, just
      !! from a different guard.
      type(efp_t), intent(in) :: local_list(:)
      type(efp_t), intent(out) :: global_list(:)
      integer, intent(in) :: nval

      type(comm_t) :: comm
      integer :: num_ranks, i
      real(real64) :: sendbuf(EFP_TRANSPORT_WIDTH*nval), recvbuf(EFP_TRANSPORT_WIDTH*nval)
      logical :: transport_ok

      comm = comm_env_compute_comm()
      num_ranks = comm%size()

      ! Single rank: the reduction is the identity, so return this rank's
      ! own contribution without entering a collective.  Not just an
      ! optimisation -- pic-mpi's serial backend (PIC_ENABLE_MPI=OFF)
      ! deliberately `error stop`s in `allreduce`, pushing the size()==1
      ! case onto the caller.  This IS that case.
      ! The transport-bound guards below police the cross-rank
      ! transport only, so there is nothing for them to check here;
      ! the copy is bit-identical to the serial path by construction.
      if (num_ranks == 1) then
         global_list(1:nval) = local_list(1:nval)
         return
      end if

      if (num_ranks > EFP_MAX_RANKS) then
         call logger%error("============================================")
         call logger%error("[panic] halo_allreduce_efp_list: num_ranks exceeds EFP_MAX_RANKS")
         call logger%error("============================================")
         error stop "halo_allreduce_efp_list: rank count exceeds the exact-transport bound"
      end if

      do i = 1, nval
         if (.not. efp_bin1_within_transport_bound(local_list(i), num_ranks)) then
            call logger%error("============================================")
            call logger%error("[panic] halo_allreduce_efp_list: EFP bin-1 transport bound violated")
            call logger%error("============================================")
            error stop "halo_allreduce_efp_list: bin-1 magnitude exceeds 2**53/num_ranks"
         end if
      end do

      call efp_to_transport(local_list(1:nval), sendbuf)
      call allreduce(comm, sendbuf, recvbuf, EFP_TRANSPORT_WIDTH*nval, op=MPI_SUM)

      call efp_from_transport(recvbuf, global_list(1:nval), transport_ok)
      if (.not. transport_ok) then
         call logger%error("============================================")
         call logger%error("[panic] halo_allreduce_efp_list: post-combine bin is not an exact integer")
         call logger%error("============================================")
         error stop "halo_allreduce_efp_list: exact-double transport invariant violated"
      end if

   end subroutine halo_allreduce_efp_list