C program to test out the features of the ACL libraries
C{{{  master
      SUBROUTINE master (nchans, chan)
      IMPLICIT NONE
      INTEGER nchans, chan(nchans)
      INTEGER psize, qsize, rsize
      LOGICAL ok
      INTEGER i, j, k, t
C     C{{{  declare tags
      INTEGER tend, tint, tcpx
      PARAMETER (tend = 0)
      PARAMETER (tint = 1)
      PARAMETER (tcpx = 3)
C     C}}}
      print *, 'Master has started'
C     C{{{  get sizes
      call INPUT(chan(1), psize, 1, tint)
      print *, 'First index of size ', psize
      call INPUT(chan(1), qsize, 1, tint)
      print *, 'Second index of size ', qsize
      call INPUT(chan(1), rsize, 1, tint)
      print *, 'Third index of size ', rsize
C     C}}}
C{{{  1D stuff
C{{{  send array
      DO 10 i = 0, psize-1
        call OUTPUT(chan(1), i, 1, tint)
10    CONTINUE
C}}}
C{{{  check element
      call INPUT(chan(1), t, 1, tint)
      IF (t .NE. 1) THEN
        print *, 'Received ', t, ' expecting 1'
        STOP "Error in OU1DEL or OU1D"
      ENDIF
      t = 42
      call OUTPUT(chan(1), t, 1, tint)
      print *, 'OU1DEL checks OK'
C}}}
C{{{  read array back in
      ok = .TRUE.
      DO 20 i = 0, psize-1
        call INPUT(chan(1), t, 1, tint)
        IF (t .NE. i) THEN
          ok = .FALSE.
        ENDIF
20    CONTINUE
      IF (.NOT. ok) THEN
        STOP " Error in OU1D or IN1D"
      ENDIF
      print *, 'OU1D and IN1D checked OK'
C}}}
C{{{  send array
      DO 30 i = 0, psize-1
        call OUTPUT(chan(1), -i, 1, tint)
30    CONTINUE
C}}}
C{{{  read array back in
      ok = .TRUE.
      DO 40 i = 0, psize-1
        call INPUT(chan(1), t, 1, tint)
        IF (t .NE. -i) THEN
          ok = .FALSE.
        ENDIF
40    CONTINUE
      IF (.NOT. ok) THEN
        STOP " Error in OU1DAR or IN1DAR"
      ENDIF
      print *, 'OU1DAR and IN1DAR checked OK'
C}}}
C}}}
C{{{  2D stuff
C{{{  send array
      DO 110 i = 0, psize-1
        DO 115 j = 0, qsize-1
          call OUTPUT(chan(1), qsize*i + j , 1, tint)
115     CONTINUE
110   CONTINUE
C}}}
C{{{  check element
      call INPUT(chan(1), t, 1, tint)
      IF (t .NE. 1) THEN
        print *, 'Received ', t, ' expecting 1'
        STOP "Error in OU2DEL or OU2D"
      ENDIF
      t = 42
      call OUTPUT(chan(1), t, 1, tint)
      print *, 'OU2DEL checks OK'
C}}}
C{{{  read array back in
      ok = .TRUE.
      DO 120 i = 0, psize-1
        DO 125 j = 0, qsize-1
          call INPUT(chan(1), t, 1, tint)
          IF (t .NE. (qsize*i+j)) THEN
            print *, 'received ', t, 'expecting ', (qsize*i+j)
            ok = .FALSE.
          ENDIF
125     CONTINUE
120   CONTINUE
      IF (.NOT. ok) THEN
        STOP " Error in OU2D or IN2D"
      ENDIF
      print *, 'OU2D and IN2D checked OK'
C}}}
C{{{  send array
      DO 130 i = 0, psize-1
        DO 135 j = 0, qsize-1
          call OUTPUT(chan(1), -(qsize*i+j), 1, tint)
135     CONTINUE
130   CONTINUE
C}}}
C{{{  read array back in
      ok = .TRUE.
      DO 140 i = 0, psize-1
        DO 145 j = 0, qsize-1
          call INPUT(chan(1), t, 1, tint)
          IF (t .NE. -(qsize*i+j)) THEN
            ok = .FALSE.
            print *, 'Got ', t, ' expecting ', -(qsize*i+j)
          ENDIF
145     CONTINUE
140   CONTINUE
      IF (.NOT. ok) THEN
        STOP " Error in OU2DAR or IN2DAR"
      ENDIF
      print *, 'OU2DAR and IN2DAR checked OK'
C}}}
C}}}
C{{{  3D stuff
C{{{  send array
      DO 210 i = 0, psize-1
        DO 215 j = 0, qsize-1
          DO 217 k = 0, rsize-1
            call OUTPUT(chan(1), (qsize*i+j)*rsize+k , 1, tint)
217       CONTINUE
215     CONTINUE
210   CONTINUE
C}}}
C{{{  check element
      call INPUT(chan(1), t, 1, tint)
      IF (t .NE. (rsize*qsize + 1)) THEN
        print *, 'Received ', t, ' expecting ', rsize * qsize + 1
        STOP "Error in OU3DEL or OU3D"
      ENDIF
      t = 42
      call OUTPUT(chan(1), t, 1, tint)
      print *, 'OU3DEL checks OK'
C}}}
C{{{  read array back in
      ok = .TRUE.
      DO 220 i = 0, psize-1
        DO 225 j = 0, qsize-1
          DO 227 k = 0, rsize-1
            call INPUT(chan(1), t, 1, tint)
            IF (t .NE. ((qsize*i+j)*rsize+k)) THEN
              print *, 'Got ', t, 'expecting ',
     :                 ((qsize*i+j)*rsize+k)
              ok = .FALSE.
            ENDIF
227       CONTINUE
225     CONTINUE
220   CONTINUE
      IF (.NOT. ok) THEN
        STOP " Error in OU3D or IN3D"
      ENDIF
      print *, 'OU3D and IN3D checked OK'
C}}}
C{{{  send array
      DO 230 i = 0, psize-1
        DO 235 j = 0, qsize-1
          DO 237 k = 0, rsize-1
            call OUTPUT(chan(1), -((qsize*i+j)*rsize+k), 1, tint)
237       CONTINUE
235     CONTINUE
230   CONTINUE
C}}}
C{{{  read array back in
      ok = .TRUE.
      DO 240 i = 0, psize-1
        DO 245 j = 0, qsize-1
          DO 247 k = 0, rsize-1
            call INPUT(chan(1), t, 1, tint)
            IF (t .NE. -((qsize*i+j)*rsize+k)) THEN
              ok = .FALSE.
            ENDIF
247       CONTINUE
245     CONTINUE
240   CONTINUE
      IF (.NOT. ok) THEN
        STOP " Error in OU3DAR or IN3DAR"
      ENDIF
      print *, 'OU3DAR and IN3DAR checked OK'
C}}}
C}}}
C
      END
C}}}
C
C{{{  worker1
      SUBROUTINE worker1 (nchans, chan, ndims, dims)
      IMPLICIT NONE
      INTEGER nchans, chan, ndims, dims(0:ndims-1)
C     C{{{  declare tags
      INTEGER tend, tint, tcpx
      PARAMETER (tend = 0)
      PARAMETER (tint = 1)
      PARAMETER (tcpx = 3)
C     C}}}
      INTEGER data(0:0), previous
      INTEGER Icoord, Isize
      call OUTPUT(chan, Isize(dims(0)), 1, tint)
      call OUTPUT(chan, Isize(dims(1)), 1, tint)
      call OUTPUT(chan, Isize(dims(2)), 1, tint)
C{{{  1D stuff
      call IN1D(chan, dims(0), data, 1, tint)
      call OU1DEL(chan, dims(0), data, 1, 1, tint)
      call IN1DEL(chan, dims(0), data, 1, 1, tint)
      IF (Icoord(dims(0)) .EQ. 1) THEN
        IF (data(0) .EQ. 42) THEN
          print *, 'IN1DEL checks OK'
          data(0) = 1
        ELSE
          STOP "Error in IN1DEL"
        ENDIF
      ENDIF
      call OU1D(chan, dims(0), data, 1, tint)
      previous = data(0)
      call IN1DAR(chan, dims(0), 1, data, 1, 1, tint)
      IF (data(0) .NE. -previous) THEN
        print *, 'worker got ', data(0), 'expecting ', -previous
      ENDIF
      call OU1DAR(chan, dims(0), 1, data, 1, 1, tint)
C}}}
C{{{  2D stuff
      call IN2D(chan, dims(0), dims(1), data, 1, tint)
      call OU2DEL(chan, dims(0), dims(1), data, 1, 1, 0, tint)
      call IN2DEL(chan, dims(0), dims(1), data, 1, 1, 0, tint)
      IF ((Icoord(dims(0)) .EQ. 1) .AND. (Icoord(dims(1)) .EQ. 0)) THEN
        IF (data(0) .EQ. 42) THEN
          print *, 'IN2DEL checks OK'
          data(0) = 1
        ELSE
          STOP "Error in IN2DEL"
        ENDIF
      ENDIF
      call OU2D(chan, dims(0), dims(1), data, 1, tint)
      previous = data(0)
      call IN2DAR(chan, dims(0), dims(1), 1, 1, data, 1, 1, 1, tint)
      IF (data(0) .NE. -previous) THEN
        print *, 'worker got ', data(0), ' expecting ', -previous
      ENDIF
      call OU2DAR(chan, dims(0), dims(1), 1, 1, data, 1, 1, 1, tint)
C}}}
C{{{  3D stuff
      call IN3D(chan, dims(0), dims(1), dims(2), data, 1, tint)
      previous = data(0)
      call OU3DEL(chan, dims(0), dims(1), dims(2),
     :            data, 1, 1, 0, 1, tint)
      call IN3DEL(chan, dims(0), dims(1), dims(2),
     :            data, 1, 1, 0, 1, tint)
      IF ((Icoord(dims(0)) .EQ. 1) .AND. (Icoord(dims(1)) .EQ. 0) .AND.
     :    (Icoord(dims(2)) .EQ. 1)) THEN
        IF (data(0) .EQ. 42) THEN
          print *, 'IN3DEL checks OK'
          data(0) = previous
        ELSE
          STOP "Error in IN3DEL"
        ENDIF
      ENDIF
      call OU3D(chan, dims(0), dims(1), dims(2), data, 1, tint)
      previous = data(0)
      call IN3DAR(chan, dims(0), dims(1), dims(2), 1, 1, 1,
     :            data, 1, 1, 1, 1, tint)
      IF (data(0) .NE. -previous) THEN
        print *, 'worker got ', data(0), ' expecting ', -previous
      ENDIF
      call OU3DAR(chan, dims(0), dims(1), dims(2), 1, 1, 1,
     :            data, 1, 1, 1, 1, tint)
C}}}
      END
C}}}
C
C{{{  configuration
      IMPLICIT NONE
      EXTERNAL master, worker
      INTEGER pid, qid, rid
      INTEGER psize, qsize, rsize
      INTEGER chan1, null
      INTEGER rank(3)
      EXTERNAL worker1
      PARAMETER (pid = 0, qid = 1, rid = 2)
      PARAMETER (psize = 3, qsize = 1, rsize = 2)
      PARAMETER (chan1 = 0)
      DATA rank /pid, qid, rid/
      CALL acbegn ()
      CALL acindx (pid, psize)
      CALL acindx (qid, qsize)
      CALL acindx (rid, rsize)
      CALL acchan (chan1, 0)
      CALL acarry (master, 1, chan1, 0, null)
      CALL acarry (worker1, 1, chan1, 3, rank)
      CALL acdone ()
      END
C}}}
