fold_plan_build Subroutine

   pure subroutine fold_plan_build(plan, ni, px, ng, rx, status)
      !! Build tile `rx`'s send/receive lists for every peer and both
      !! column families.  Pure: every north-row rank computes every tile's
      !! receive lists itself (`decomp_init` arithmetic), so no handshake.
      type(fold_plan_t), intent(out) :: plan
      integer, intent(in) :: ni
         !! Global physical width of the fold row.
      integer, intent(in) :: px
         !! Tiles along the fold row.
      integer, intent(in) :: ng
         !! Ghost width.
      integer, intent(in) :: rx
         !! This tile's x-coordinate (0-based).
      integer, intent(out) :: status
         !! `FOLD_PLAN_OK`, or `FOLD_PLAN_ERR_ARGS`.

      integer, allocatable :: own(:), src(:), cls(:)
      integer, allocatable :: sn(:, :), rn(:, :), pidx(:)
      integer :: ncap, ncol, fam, r, i, p, k, ks, kr
      integer :: wmax, a, w

      status = FOLD_PLAN_OK
      if (px < 1 .or. ng < 1 .or. ni < px .or. rx < 0 .or. rx >= px) then
         status = FOLD_PLAN_ERR_ARGS
         return
      end if

      plan%ni = ni
      plan%px = px
      plan%ng = ng
      plan%rx = rx

      call fold_tile_extent(ni, px, 0, a, wmax)   ! tile 0 is the widest
      ncap = wmax + 2*ng + 1
      allocate (own(ncap), src(ncap), cls(ncap))
      ! Per-tile counts, indexed by tile x-coordinate 0..px-1.
      allocate (sn(0:px - 1, FOLD_NFAM), rn(0:px - 1, FOLD_NFAM))
      sn = 0
      rn = 0

      ! Pass 1: counts.  Receive: my own window, by owner.  Send: every
      ! receiver's window, the entries whose owner is me.
      do fam = 1, FOLD_NFAM
         do r = 0, px - 1
            call fold_receiver_entries(ni, px, ng, fam, r, ncol, own, src, cls)
            do i = 1, ncol
               if (r == rx) rn(own(i), fam) = rn(own(i), fam) + 1
               if (own(i) == rx) sn(r, fam) = sn(r, fam) + 1
            end do
         end do
      end do

      ! Peers: ascending tile order, union of send and receive partners.
      allocate (pidx(0:px - 1))
      pidx = 0
      plan%npeer = 0
      do r = 0, px - 1
         if (sum(sn(r, :)) + sum(rn(r, :)) > 0) then
            plan%npeer = plan%npeer + 1
            pidx(r) = plan%npeer
         end if
      end do
      allocate (plan%peer_rx(plan%npeer))
      allocate (plan%send_n(plan%npeer, FOLD_NFAM), plan%send_start(plan%npeer, FOLD_NFAM))
      allocate (plan%recv_n(plan%npeer, FOLD_NFAM), plan%recv_start(plan%npeer, FOLD_NFAM))
      do r = 0, px - 1
         if (pidx(r) > 0) then
            plan%peer_rx(pidx(r)) = r
            plan%send_n(pidx(r), :) = sn(r, :)
            plan%recv_n(pidx(r), :) = rn(r, :)
         end if
      end do
      plan%self_peer = pidx(rx)

      ! Offsets: family-major, then peer, into one flat array per side.
      ks = 0
      kr = 0
      do fam = 1, FOLD_NFAM
         do p = 1, plan%npeer
            plan%send_start(p, fam) = ks
            plan%recv_start(p, fam) = kr
            ks = ks + plan%send_n(p, fam)
            kr = kr + plan%recv_n(p, fam)
         end do
         plan%nsend(fam) = sum(plan%send_n(:, fam))
         plan%nrecv(fam) = sum(plan%recv_n(:, fam))
      end do
      plan%nmax = 0
      if (plan%npeer > 0) plan%nmax = max(maxval(plan%send_n), maxval(plan%recv_n))
      allocate (plan%send_col(max(ks, 1)), plan%send_peer(max(ks, 1)), plan%send_e(max(ks, 1)))
      allocate (plan%recv_col(max(kr, 1)), plan%recv_peer(max(kr, 1)), &
                plan%recv_e(max(kr, 1)), plan%recv_cls(max(kr, 1)))

      ! Pass 2: fill, in the canonical order (receiver's destination
      ! columns ascending).  `sn`/`rn` are reused as running cursors.
      sn = 0
      rn = 0
      do fam = 1, FOLD_NFAM
         do r = 0, px - 1
            call fold_receiver_entries(ni, px, ng, fam, r, ncol, own, src, cls)
            do i = 1, ncol
               if (r == rx) then
                  p = pidx(own(i))
                  rn(own(i), fam) = rn(own(i), fam) + 1
                  k = plan%recv_start(p, fam) + rn(own(i), fam)
                  plan%recv_col(k) = i
                  plan%recv_peer(k) = p
                  plan%recv_e(k) = rn(own(i), fam)
                  plan%recv_cls(k) = cls(i)
               end if
               if (own(i) == rx) then
                  p = pidx(r)
                  sn(r, fam) = sn(r, fam) + 1
                  k = plan%send_start(p, fam) + sn(r, fam)
                  plan%send_col(k) = src(i)
                  plan%send_peer(k) = p
                  plan%send_e(k) = sn(r, fam)
               end if
            end do
         end do
      end do
   end subroutine fold_plan_build