C FFT with multiple elements per process.
C{{{  master
      SUBROUTINE master (nchans, chan)
      IMPLICIT NONE
      INTEGER nchans, chan, i
C     C{{{  declare tags
      INTEGER tend, tint, tcpx
      PARAMETER (tend = 0)
      PARAMETER (tint = 1)
      PARAMETER (tcpx = 3)
C     C}}}
      INTEGER npts
      REAL zero, one, four, pi
C     C{{{  set up parameters
      PARAMETER (zero = 0.0)
      PARAMETER (one  = 1.0)
      PARAMETER (four = 4.0)
      PARAMETER (pi   = 3.1415926)
C     C}}}
      REAL N, x, y, cosec
      REAL datum(0:1)
      call INPUT(chan, npts, 1, tint)
      print *, 'data...'
C{{{  calculate and send data
      DO 10, i = 0, npts-1
C       C{{{  arbitrary test function
        N = npts
        x = i
        y = x + (N / four)
        IF (y .EQ. N) THEN
          datum(0) = (N * N) / four
          datum(1) = zero
        ELSE
          IF (IAND(i, 1) .EQ. 1) THEN
            cosec = one / SIN ((pi * y) / N)
            datum(0) = - (cosec * cosec)
            datum(1) =  zero
          ELSE
            datum(0) = zero
            datum(1) = zero
          ENDIF
        ENDIF
C       C}}}
        print '(F10.5,A,F10.5)', datum(0), '  ', datum(1)
        call OUTPUT(chan, datum, 2, tcpx)
10    CONTINUE
C}}}
      print *, 'transform...'
C{{{  receive data
      DO 20, i = 0, npts-1
        call INPUT(chan, datum, 2, tcpx)
        print '(F10.5,A,F10.5)', datum(0), '  ', datum(1)
20    CONTINUE
C}}}
      END
C}}}
C
C{{{  worker
C{{{  INTEGER FUNCTION intlog
      INTEGER FUNCTION intlog (x)
      IMPLICIT NONE
      INTEGER x, y, result
      result = 0
      y = x
      IF (y. LE. 1) GOTO 40
30    CONTINUE
        result = result + 1
        y =  y / 2
      IF (y .GT. 1) GOTO 30
40    CONTINUE
      intlog = result
      END
C}}}
C
C{{{  INTEGER FUNCTION bitrev
      INTEGER FUNCTION bitrev (x, d)
      IMPLICIT NONE
      INTEGER x, d, rev, y, i
      rev = 0
      y = x
      DO 50, i = 0, d-1
        rev = IOR( rev*2 , IAND(y, 1))
        y = y / 2
50    CONTINUE
      bitrev = rev
      END
C}}}
C
C{{{  PROC twiddle
      SUBROUTINE twiddle (datum, k, p)
      IMPLICIT NONE
      REAL datum(0:1)
      INTEGER k, p
      REAL COS, SIN
      REAL arg, cosarg, sinarg, re, im
      arg = (3.1415926 * k) / p
      cosarg = COS (arg)
      sinarg = - SIN (arg)
      re = datum (0)
      im = datum (1)
      datum (0) = (cosarg * re) - (sinarg * im)
      datum (1) = (sinarg * re) + (cosarg * im)
      END
C}}}
C
C{{{  LOGICAL FUNCTION odd
      LOGICAL FUNCTION odd (x)
      INTEGER x
        odd = (IAND(x, 1) .NE. 0)
      END
C}}}
C
C{{{  worker
      SUBROUTINE worker (nchans, chan, ndims, x)
      IMPLICIT NONE
      INTEGER nchans, chan, ndims, x
C     C{{{  declare tags
      INTEGER tend, tint, tcpx
      PARAMETER (tend = 0)
      PARAMETER (tint = 1)
      PARAMETER (tcpx = 3)
C     C}}}
C{{{  set up s, seg
      INTEGER s, seg
      PARAMETER (s = 2)
      PARAMETER (seg = 2**s)
C   seg = (1 << s)
C}}}
      REAL data(0:1, 0:seg-1), transform(0:1, 0:seg-1)
      INTEGER Isize, Icoord, bitrev, intlog
      LOGICAL odd
      INTEGER p, b, n, d
      INTEGER i, xi, yj, j, y, partner
      INTEGER srccoord(0:seg-1), srcaddr(0:seg-1)
      INTEGER dstcoord(0:seg-1), dstaddr(0:seg-1)
      LOGICAL oddsite(0:seg-1)
      REAL import(0:1, 0:seg-1)
C{{{  main code
C     C{{{  Tell master problem size
      n = Isize(x)
      d = intlog(n)
      call OUTPUT (chan, n * seg, 1, tint)
      call IN1DAR (chan, x, seg, data, 2, seg, tcpx)
C     C}}}
C{{{  bit reverse
      DO 60, i = 0, seg-1
        xi = Icoord(x) * seg + i
        yj = bitrev(xi, d+s)
        y = yj / seg
        j = MOD(yj, seg)
        srccoord(i) = y
        dstcoord(i) = y
        srcaddr(i) = j
        dstaddr(i) = j
60    CONTINUE
      call RELD(x, seg, transform, 2, seg, data, srccoord, srcaddr,
     :          dstcoord, dstaddr)
C}}}
      DO 70, b = 0, d + s - 1
C{{{
        p = 2**b
        DO 80, i = 0, seg-1
          xi = (Icoord(x) * seg) + i
          oddsite(i) = odd (xi / p)
          IF (oddsite(i)) THEN
            call twiddle (transform(0, i), MOD(xi, p), p)
          ENDIF
80      CONTINUE
        IF (b .LT. s) THEN
          DO 90, i = 0, seg-1
            partner = IEOR(i, p)
            import(0, i) = transform(0, partner)
            import(1, i) = transform(1, partner)
90        CONTINUE
        ELSE
          call PXOR (x, import, 2 * seg, transform, 2 * seg, 2**(b - s))
        ENDIF
        DO 100, i = 0, seg-1
C         C{{{  change transform
          IF (oddsite(i)) THEN
            transform(0, i) = import(0, i) - transform(0, i)
            transform(1, i) = import(1, i) - transform(1, i)
          ELSE
            transform(0, i) = transform(0, i) + import(0, i)
            transform(1, i) = transform(1, i) + import(1, i)
          ENDIF
C         C}}}
100     CONTINUE
C}}}
70    CONTINUE
      DO 110, i = 0, seg-1
        transform (0, i) = transform (0, i) / (REAL (n * seg))
        transform (1, i) = transform (1, i) / (REAL (n * seg))
110   CONTINUE
      call OU1DAR (chan, x, seg, transform, 2, seg, tcpx)
C}}}
      END
C}}}
C}}}
C
C{{{  configuration
      IMPLICIT NONE
      EXTERNAL master, worker
      INTEGER xid
      INTEGER xsize
      INTEGER chan, null
      INTEGER rank (1)
      PARAMETER (xid   = 0)
      PARAMETER (xsize = 8)
      PARAMETER (chan = 0)
      DATA rank /xid/
      CALL acbegn ()
      CALL acindx (xid, xsize)
      CALL acchan (chan, 0)
      CALL acarry (master, 1, chan, 0, null)
      CALL acarry (worker, 1, chan, 1, rank)
      CALL acdone ()
      END
C}}}
