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}}}
C     C{{{  npts
      INTEGER npts
      PARAMETER (npts = 8)
C     C}}}
      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)
      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 '(F8.5,A,F8.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 '(F8.5,A,F8.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}}}
      REAL datum(0:1)
      INTEGER Isize, Icoord, intlog, bitrev
      LOGICAL odd
      INTEGER partner, p, b, n, d
      LOGICAL oddsite
      REAL import(0:1)
      n = Isize(x)
      d = intlog (n)
C{{{  worker body
      call IN1D (chan, x, datum, 2, tcpx)
C     C{{{  bit reverse
      partner = bitrev (Icoord(x), d)
      call PDSI (x, datum, 2, partner, partner)
C     C}}}
      p = 1
      DO 60, b = 0, d-1
C       C{{{  twiddle if need be
        oddsite = odd (Icoord(x) / p)
        IF (oddsite) THEN
          call twiddle (datum, MOD(Icoord(x), p), p)
        ENDIF
C       C}}}
        call PXOR (x, import, 2, datum, 2, p)
C       C{{{  set datum(0) and (1)
        IF (oddsite) THEN
          datum (0) = import (0) -  datum (0)
          datum (1) = import (1) -  datum (1)
        ELSE
          datum (0) =  datum (0) + import (0)
          datum (1) =  datum (1) + import (1)
        ENDIF
C       C}}}
        p = p * 2
60    CONTINUE
      datum (0) = datum (0) / n
      datum (1) = datum (1) / n
      call OU1D (chan, x, datum, 2, 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}}}
