!  Collision-free send implemented in F90 for 2-d source and destination.
!  Interprets dI and dJ as 0-origin subscripts.
!
!  In effect:  Dest[dI, dJ] = Src
!
!  Source file:  send.f90           Interfaces:  send.hI


!  Note that every entry of Dest is written if this is truly
!  collision-free.

      subroutine Send(Dest, Src, dI, dJ, M, N)
      integer M, N
      integer, dimension(0:M-1, 0:N-1) :: Dest, Src, dI, dJ

      integer, dimension(0:M*N-1) :: WD, WS, Ix

      WS = RESHAPE(   Src,    (/ M*N /))
      Ix = RESHAPE(dI + M*dJ, (/ M*N /))              ! 1-D address
      if ( minval(Ix) < 0 .or. maxval(Ix) >= M*N ) then
        print *, "Send has out-of-bounds addresses - Dest not altered."
      else
        WD(Ix) = WS
        Dest = RESHAPE(WD, (/ M, N /))
      end if
      end subroutine Send


!  Masked send.  Values are sent from positions where Msk is true.

      subroutine MaskedSend(Dest, Src, dI, dJ, Msk, M, N)
      integer M, N
      integer, dimension(0:M-1, 0:N-1) :: Dest, Src, dI, dJ
      logical, dimension(0:M-1, 0:N-1) :: Msk

      integer, dimension(0:M*N-1) :: WD, WS, Ix
      logical, dimension(0:M*N-1) :: Wmk

      WS  = RESHAPE(  Src,    (/ M*N /))
      WD  = RESHAPE(  Dest,    (/ M*N /))
      Wmk = RESHAPE(  Msk,    (/ M*N /))
      Ix = RESHAPE(dI + M*dJ, (/ M*N /))              ! 1-D address
      if (     minval(Ix, mask = Wmk) < 0  &
          .or. maxval(Ix, mask = Wmk) >= M*N ) then
        print *, "Send has out-of-bounds addresses - Dest not altered."
      else
        WHERE ( Wmk ) WD(Ix) = WS
        Dest = RESHAPE(WD, (/ M, N /))
      end if
      end subroutine MaskedSend
      
