C{{{  master.occ
C{{{  SUBROUTINE display
      SUBROUTINE display (source, rows, columns)
      IMPLICIT NONE
      INTEGER source, rows, columns
      INTEGER data(0:50)
C     C{{{  tags
      INTEGER tend, tint, tr32, tstr, tuntagged
      PARAMETER (tuntagged = -1)
      PARAMETER (tend = 0)
      PARAMETER (tint = 1)
      PARAMETER (tr32 = 2)
      PARAMETER (tstr = 3)
C     C}}}
C  Read a stream of 'rows' * 'columns' real numbers from 'source',
C  and print as a table.
      DO 70, i = 0, rows-1
        DO 80, j = 0, columns-1
          call INPUT(source, data(j), 1, tr32)
80      CONTINUE
        print '(50(i3, ''  ''))', (data(j), j =0, columns-1)
70    CONTINUE
      END
C}}}
C
C{{{  REAL FUNCTION forcing term
      REAL FUNCTION forcingterm (i, j, k)
      IMPLICIT NONE
      INTEGER i, j, k
C  Arbitrary function (proportional to BOX x(1-x) y(1-y) z(1-z))
      REAL x, y, z, tx, ty, tz
      x = interval * i
      y = interval * j
      z = interval * k
      tx = x * (1.0 - x)
      ty = y * (1.0 - y)
      tz = z * (1.0 - z)
      forcingterm = (- 8192.0) * (tx * ty + ty * tz + tz * tx)
      END
C}}}
C
C{{{  SUBROUTINE solve
      SUBROUTINE solve (chan, size)
      IMPLICIT NONE
      INTEGER chan, size
      REAL interval
      REAL forcingterm
      INTEGER tag, iter
C     C{{{  tags
      INTEGER tend, tint, tr32, tstr, tuntagged
      PARAMETER (tuntagged = -1)
      PARAMETER (tend = 0)
      PARAMETER (tint = 1)
      PARAMETER (tr32 = 2)
      PARAMETER (tstr = 3)
C     C}}}
C  Solve 3d equation.
      interval = 1.0 / (size - 1)
C  *** debug ***
      print *, 'outputting forcing term'
C  output forcing term
      DO 10, i = 0, size-1
        DO 20, j = 0, size-1
          DO 30, k = 0, size-1
            call OUTPUT(chan, forcingterm(i, j, k), 1, tr32)
C           *** debug ***
            print *, 'output forcing term ok'
30        CONTINUE
20      CONTINUE
10    CONTINUE
C{{{  monitor convergence
40    CONTINUE
      call INTAG(chan, tag)
      IF (tag .EQ. tint) THEN
        call INPUT(chan, iter, 1, tuntagged)
        print *, 'Iteration = ', iter
        GOTO 40
      ENDIF
C}}}
      DO 50, i = 0, size-1
        call display (chan, size, size)
50    CONTINUE
      END
C}}}
C
C{{{  master
      SUBROUTINE master (nchans, chan)
      IMPLICIT NONE
      INTEGER nchans, chan, tag
C     C{{{  tags
      INTEGER tend, tint, tr32, tstr, tuntagged
      PARAMETER (tuntagged = -1)
      PARAMETER (tend = 0)
      PARAMETER (tint = 1)
      PARAMETER (tr32 = 2)
      PARAMETER (tstr = 3)
C     C}}}
60    CONTINUE
      call OUTAG(chan, tag)
      IF (tag .EQ. tint) THEN
        call INPUT(chan, size, 1, tuntagged)
        call solve (chan, size)
        GOTO 60
      ENDIF
      END
C}}}
C}}}
C
C{{{  worker.occ
C{{{  LOGICAL FUNCTION gand3d (VAL LOGICAL data)
      LOGICAL FUNCTION gand3d (data, x, y, z)
      IMPLICIT NONE
      LOGICAL result, data
      INTEGER x, y, z
      result = GAND (x,   data)
      result = GAND (y, result)
      gand3d = GAND (z, result)
      END
C}}}
C
C{{{  SUBROUTINE worker
      SUBROUTINE worker (nchans, chan, nranks, rank)
      IMPLICIT NONE
      INTEGER nchans, chan, nranks, rank(0:nranks-1)
      INTEGER x, y, z
C  Simple relaxation for Poisson equation.
C     C{{{  tags
      INTEGER tend, tint, tr32, tstr, tuntagged
      PARAMETER (tuntagged = -1)
      PARAMETER (tend = 0)
      PARAMETER (tint = 1)
      PARAMETER (tr32 = 2)
      PARAMETER (tstr = 3)
C     C}}}
C  12^3 problem (variable number of elements per process).
C     C{{{
      INTEGER L, a, asqd, epsilon
      PARAMETER(L = 12)
      PARAMETER(a = 1.0 / (L - 1))
      PARAMETER(asqd = a * a)
      PARAMETER(epsilon = 0.001)
      PARAMETER(P = 5)
      REAL u(0:2, 0:2, 0:2), f(0:2, 0:2, 0:2)
      INTEGER ssx, ssy, ssz
C     C}}}
      INTEGER iter, i, j, k, LmodP
      LOGICAL converged, ok
      REAL neixn, neixp, neiyn, neiyp, neizn, neizp, new
      INTEGER Icoord
C  Define local segment size.
C  (Note: for this implementation must have L >= P, otherwise some
C  segments would vanish, and getting neighbours by simple shift
C  would fail.)
C     C{{{  set up x, y, z
      x = rank(0)
      y = rank(1)
      z = rank(2)
C     C}}}
C     C{{{  set up ssx, ssy, ssz
      LmodP = MOD(L, P)
      IF (Icoord(x) .LT. LmodP) THEN
        ssx = (L / P) + 1
      ELSE
        ssx =  L / P
      ENDIF
      IF (Icoord(y) .LT. LmodP) THEN
        ssy = (L / P) + 1
      ELSE
        ssy =  L / P
      ENDIF
      IF (Icoord(z) .LT. LmodP) THEN
        ssz = (L / P) + 1
      ELSE
        ssz =  L / P
      ENDIF
C     C}}}
C     C{{{  Tell master problem size
      call OUTPUT (chan, size, 1, tint)
C     C}}}
C{{{  Get forcing term from master
      call IN3DAR(chan, x, y, z, ssx, ssy, ssz, f, 1, tr32)
C  Initialise 'u' (includes zeroing boundaries).
      DO 100, i = 0, ssx-1
        DO 110, j = 0, ssy-1
          DO 120, k = 0, ssz-1
            u(i, j, k) = 0.0
120       CONTINUE
110     CONTINUE
100   CONTINUE
C}}}
C{{{  Main loop
      iter = 1
      converged = .FALSE.
130   CONTINUE
      call OUTPUT (chan, iter, 1, tint)
      ok = .TRUE.
      DO 140, i = 0, ssx-1
        DO 150, j = 0, ssy-1
          DO 160, k = 0, ssz-1
C             C{{{  do shifts and get neighbours
              IF (i .EQ. 0) THEN
                call PSHFT(x, neixn, 1, u(ssx-1, j, k),  1)
              ELSE
                neixn = u (i - 1, j, k)
              ENDIF
              IF (i .EQ. (ssx - 1)) THEN
                call PSHFT(x, neixp, 1, u(0, j, k), -1)
              ELSE
                neixp = u (i + 1, j, k)
              ENDIF
              IF (j .EQ. 0) THEN
                call PSHFT(y, neiyn, 1, u(i, ssy-1, k),  1, 1)
              ELSE
                neiyn = u (i, j - 1, k)
              ENDIF
              IF (j .EQ. (ssy - 1)) THEN
                call PSHFT(y, neiyp, 1, u(i, 0, k), 1, -1)
              ELSE
                neiyp = u (i, j + 1, k)
              ENDIF
              IF (k .EQ. 0) THEN
                call PSHFT(z, neizn, 1,  u(i, j, ssz-1),  1, 1)
              ELSE
                neizn = u (i, j, k - 1)
              ENDIF
              IF (k .EQ. (ssz - 1)) THEN
                call PSHFT(z, neizp, 1, u(i, j, 0), 1, -1)
              ELSE
                neizp = u (i, j, k + 1)
              ENDIF
C             C}}}
C             C{{{  look up coordinates
              xx = Icoord (x)
              yy = Icoord (y)
              zz = Icoord (z)
C             C}}}
              IF (((0 .LT. xx)       .OR. (0 .LT. i)) .AND.
     :            ((xx .LT. (P - 1)) .OR. (i .LT. (ssx - 1))) .AND.
     :            ((0 .LT. yy)       .OR. (0 .LT. j)) .AND.
     :            ((yy .LT. (P - 1)) .OR. (j .LT. (ssy - 1))) .AND.
     :            ((0 .LT. zz)       .OR. (0 .LT. k)) .AND.
     :            ((zz .LT. (P - 1)) .OR. (k .LT. (ssz - 1)))) THEN
                new = neixn + neixp + neiyn + neiyp + neizn + neizp -
     :                    (asqd * f(i, j, k))) / 6.0
                ok  = ok .AND. (ABS(u(i, j, k) - new) .LT. epsilon)
                u(i, j, k) = new
              ENDIF
160       CONTINUE
150     CONTINUE
140   CONTINUE
      iter = iter + 1
      converged = gand3d(ok, x, y, z)
      IF (.NOT. converged) GOTO 130
      call OUTAG (chan, tend)
C}}}
C     C{{{  Ouput result
      call OU3DAR (chan, x, y, z, ssx, ssy, ssz, u, 1, tr32)
C     C}}}
C     C{{{  Tell master we've finished
      call OUTAG (chan, tend)
C     C}}}
      END
C}}}
C}}}
C
C{{{  configuration
      IMPLICIT NONE
      EXTERNAL master, worker
      INTEGER xid, yid, zid
      INTEGER xsize, ysize, zsize
      INTEGER chan, null
      INTEGER rank (3)
      PARAMETER (xid   = 0, yid   = 1, zid = 2)
      PARAMETER (xsize = 2, ysize = 2, zsize = 2)
      PARAMETER (chan = 0)
      DATA rank /xid, yid, zid/
      CALL acbegn ()
      CALL acindx (xid, xsize)
      CALL acindx (yid, ysize)
      CALL acindx (zid, zsize)
      CALL acchan (chan, 0)
      CALL acarry (master, 1, chan, 0, null)
      CALL acarry (worker, 1, chan, 3, rank)
      CALL acdone ()
      END
C}}}
