C  The Application Library: Distributed channel operations.
C  Originally written by D.B. Carpenter in Occam. Ported to
C  Fortran + PARMACS by James Allwright, December 1991
C
C{{{  simple input
C{{{  SUBROUTINE INPUT
      SUBROUTINE INPUT (chan, result, rlen, tag)
      INTEGER chan, rlen, tag
      INTEGER result(0:rlen-1)
      IMPLICIT LOGICAL(A-Z)
      INTEGER INULL(0:0)
C   Input a global variable.
      CALL IOpre (chan)
      CALL IOrank(chan, INULL, 0)
      CALL IOtin (chan, tag)
      CALL IOin (chan, rlen, result, rlen, INULL, 0)
      END
C}}}
C{{{  SUBROUTINE INTAG
      SUBROUTINE INTAG (chan, tag)
      INTEGER chan, tag
C   Input a global tag.
      IMPLICIT LOGICAL(A-Z)
      INTEGER INULL(0:0)
      CALL IOpre (chan)
      CALL IOrank(chan, INULL, 0)
      tag = 0
      CALL IOin (chan, 1, tag, 1, INULL, 0)
      END
C}}}
C}}}
C{{{  SUBROUTINE glsub (used internally)
      SUBROUTINE glsub (lset, llen, coords, clen, codim, data)
C   was GLOBALISE.SUBSET
      IMPLICIT LOGICAL(A-Z)
      INTEGER llen, clen, codim, data
      INTEGER lset(0:llen-1, 0:1)
      INTEGER coords(0:clen-1)
C  Broadcast a value 'data' which is global to all sites with
C  coordinates [coords FROM 0 FOR codim], over the forwarding
C  paths for those sites.
      INTEGER ptr, limit
      LOGICAL going
      IF (codim .EQ. rs) THEN
        CALL IOfwdo (chan, data, 1, coords, rs)
      ELSE
        ptr = codim
        limit = lset(ptr, 0) + lset(ptr, 1)
        coords(ptr) = lset(ptr, 0)
        going = .TRUE.
15      CONTINUE
          IF (coords(ptr) .EQ.limit) THEN
C{{{  Pop
              IF (ptr .EQ.codim) THEN
                going = .FALSE.
              ELSE
C               C{{{
                ptr = ptr - 1
                limit = lset(ptr, 0) + lset(ptr, 1)
                coords(ptr) = coords(ptr) + 1
C               C}}}
              ENDIF
C}}}
          ELSE
            IF (ptr .EQ.(rs - 1)) THEN
C{{{  The business
              CALL IOfwdo (chan, data, 1, coords, rs)
              coords(ptr) = coords(ptr) + 1
C}}}
            ELSE
C{{{  Push
              ptr = ptr + 1
              limit = lset(ptr, 0) + lset(ptr, 1)
              coords(ptr) = lset(ptr, 0)
C}}}
            ENDIF
          ENDIF
          IF (going) GOTO 15
      ENDIF
      END
C}}}
C{{{  array input
C{{{  dd
C  Generic dimensionality distribution inputs.  See the 1d and 2d special
C  cases below for simpler illustrations of the logic.
C{{{  SUBROUTINE INDD
      SUBROUTINE INDD (chan, rank, rs, result, rlen, tag)
      PARAMETER (maxdim = 8)
      INTEGER chan, rs, rlen, tag
      INTEGER rank(0:rs-1)
      INTEGER result(0:rlen-1)
C   Input a whole distribution over rank 'rank'.
C     #INCLUDE "acsizehdr.inc"
      IMPLICIT LOGICAL(A-Z)
      INTEGER INULL(0:0)
      INTEGER lset(0:maxdim-1, 0:1), gset(0:maxdim-1, 0:1)
      INTEGER ptr, limit, i
      INTEGER coords(0:maxdim-1)
      LOGICAL going
      CALL IOpre (chan)
      DO 10, i = 0,rs-1
        gset(i, 0) = 0
        gset(i, 1) = Isize (rank(i))
10      CONTINUE
      CALL IOpre (chan)
      CALL IOrank(chan, rank, rs)
      CALL IOlset (chan, lset, gset, rs)
C{{{  Traverse lset
      IF (rs .EQ.0) THEN
        CALL IOtin (chan, tag)
        CALL IOin (chan, rlen, result, rlen, INULL, 0)
      ELSE
        ptr = 0
        coords(ptr) = lset(ptr, 0)
        limit = lset(ptr, 0) + lset(ptr, 1)
        going = .TRUE.
25      CONTINUE
          IF (coords(ptr) .EQ.limit) THEN
C           C{{{  Pop
            IF (ptr .EQ. 0) THEN
              going = .FALSE.
            ELSE
              ptr = ptr - 1
              coords(ptr) = lset(ptr, ptr) + 1
              limit = lset(ptr, 0) + lset(ptr, 1)
            ENDIF
C           C}}}
          ELSE
C           C{{{
            IF (ptr .EQ.(rs - 1)) THEN
C             C{{{  The business
              CALL IOtin (chan, tag)
              CALL IOin (chan, rlen, result, rlen, coords, rs)
              coords(ptr) = coords(ptr) + 1
C             C}}}
            ELSE
C             C{{{  Push
              ptr = ptr + 1
              coords(ptr) = lset(ptr, 0)
              limit = lset(ptr, 0) + lset(ptr, 1)
C             C}}}
            ENDIF
C           C}}}
          ENDIF
          IF (going) GOTO 25
      ENDIF
C}}}
      CALL IOpost (chan)
      END
C}}}
C{{{  SUBROUTINE INDDEL
      SUBROUTINE INDDEL (chan, rank, rs, result, rlen, dsts, dlen, tag)
      INTEGER chan, rs, rlen, dlen, tag
      INTEGER rank(0:rs-1), result(0:rlen-1), dsts(0:dlen-1)
C   Input element at 'dsts' of a d-dimensional distribution
C   over 'rank'.
      IMPLICIT LOGICAL(A-Z)
      CALL IOpre (chan)
      CALL IOrank (chan, rank, rs)
      CALL IOtin (chan, tag)
      CALL IOin(chan, rlen, result, rlen, dsts, dlen)
      CALL IOpost (chan)
      END
C}}}
C{{{  SUBROUTINE INDDAR
      SUBROUTINE INDDAR (chan, rank, rs, ssizes, sslen,
     :                   strides, len, result, rlen, tag)
      PARAMETER (maxdim = 8)
      INTEGER chan, rs, sslen, len, rlen, tag
      INTEGER rank(0:rs-1), ssizes(0:sslen-1), strides(0:len-1)
      INTEGER result(0:rlen-1)
      IMPLICIT LOGICAL(A-Z)
      INTEGER INULL(0:0), i
C{{{  explanation

C  Input a d-dimensional distribution of d-dimensional arrays,
C  in the same order as if the arrays formed one big distribution.
C
C  Packing of logical multi-dimensional array is
C      array [i.x] [i.y] ... = [result FROM len * offset FOR len],
C  where
C      offset = (strides [0] * i.x) + (strides [1] * i.y) + ...
C
C  Note that the the sizes of the local array segments needn't be
C  global --'ssizes [0]' can be a distribution over {x},
C  'ssizes [1]' over {y}, etc.
C}}}
C   #INCLUDE "acsizehdr.inc"
C{{{  variables
      INTEGER lset(0:maxdim-1, 0:1)
      INTEGER gset(0:maxdim-1, 0:1)
      INTEGER  ptr, limit
      LOGICAL internal
      INTEGER coords(0:maxdim-1), iseg(0:maxdim-1), sscoords(0:maxdim-1)
      INTEGER  offset
      LOGICAL going
C}}}
      CALL IOpre (chan)
      DO 20,i = 0, rs-1
        gset (i, 0) = 0
        gset (i, 1) = Isize (rank (i))
20      CONTINUE
      CALL IOrank(chan, rank, rs)
      CALL IOlset (chan, lset, gset, rs)
C   Traverse 'lset' * 'segment', last coordinate
C   most-rapidly-varying.
      IF (rs .EQ. 0) THEN
        CALL IOtin (chan, tag)
        CALL IOin (chan, len, result, len, INULL, 0)
      ELSE
C{{{
        ptr   = 0
        internal = .FALSE.
        limit  = lset(ptr, 0) + lset(ptr, 1)
        coords(ptr) = lset(ptr, 0)
        offset = 0
        going = .TRUE.
35      CONTINUE
          IF (internal) THEN
            IF (iseg(ptr) .EQ.limit) THEN
C{{{  Pop
              offset   = offset - (limit * strides(ptr))
              internal = .FALSE.
              limit = lset(ptr, 0) + lset(ptr, 1)
              coords(ptr) = coords(ptr) + 1
C}}}
            ELSE
              IF (ptr .EQ.(rs - 1)) THEN
C{{{  The business
                CALL IOtin (chan, tag)
                CALL IOin (chan, len, result(len * offset),
     :                     len, coords, rs)
                iseg(ptr) = iseg(ptr) + 1
                offset = offset + strides(ptr)
C}}}
              ELSE
C{{{  Push
                ptr = ptr + 1
                internal = .FALSE.
                limit = lset(ptr, 0) + lset(ptr, 1)
                coords(ptr) = lset(ptr, 0)
C}}}
              ENDIF
            ENDIF
          ELSE
            IF (coords(ptr) .EQ.limit) THEN
C{{{  Pop
              IF (ptr .EQ. 0) THEN
                  going = .FALSE.
              ELSE
                ptr = ptr - 1
                internal = .TRUE.
                limit  = sscoords(ptr)
                iseg(ptr) = iseg(ptr) + 1
                offset = offset + strides(ptr)
              ENDIF
C}}}
            ELSE
C{{{  Push
              internal = .TRUE.
              limit = ssizes(ptr)
              CALL glsub (lset, maxdim, coords, maxdim, ptr + 1, limit)
              sscoords(ptr) = limit
              iseg(ptr)  = 0
C}}}
            ENDIF
          ENDIF
          IF (going) GOTO 35
C}}}
      ENDIF
      CALL IOpost (chan)
      END
C}}}
C}}}
C  Following 1d and 2d cases *could* be expressed in terms of
C  generic routines above.  They're coded individually partly
C  for efficiency, partly to illustrate use of the base library
C  primitives in simple cases.
C{{{  1d
C{{{  SUBROUTINE IN1D
      SUBROUTINE IN1D (chan, x, result, rlen, tag)
      INTEGER chan, x, rlen, tag
      INTEGER result(0:rlen-1)
C   Input a whole one-dimensional distribution over {x}.
C   Size of 'result' array should be global across processes.
      IMPLICIT LOGICAL(A-Z)
      INTEGER lset(0:0, 0:1), gset(0:0, 0:1)
      INTEGER i
      gset(0, 0) = 0
      gset(0, 1) = Isize(x)
      CALL IOpre (chan)
      CALL IOrank(chan, x, 1)
      CALL IOlset (chan, lset, gset, 1 )
      DO 30,i = lset(0, 0), (lset(0, 1)+lset(0,0))-1
        CALL IOtin (chan, tag)
        CALL IOin (chan, rlen, result, rlen, (i), 1)
30      CONTINUE
      CALL IOpost (chan)
      END
C}}}
C{{{  SUBROUTINE IN1DEL
      SUBROUTINE IN1DEL (chan, x, result, rlen, dstx, tag)
      INTEGER chan, x, rlen, dstx, tag
      INTEGER result(0:rlen-1)
C   Input element at 'dstx' of a one-dimensional distribution over {x}.
C   Size of 'result' array should be global across processes.
      IMPLICIT LOGICAL(A-Z)
      CALL IOpre (chan)
      CALL IOrank (chan, x, 1)
      CALL IOtin (chan, tag)
      CALL IOin(chan, rlen, result, rlen, dstx, 1)
      CALL IOpost (chan)
      END
C}}}
C{{{  SUBROUTINE IN1DAR
      SUBROUTINE IN1DAR (chan, x, ssx, result, ssx1, tag)
      INTEGER chan, x, ssx, ssx1, tag
      INTEGER result(0:ssx-1, 0:ssx1-1)
      IMPLICIT LOGICAL(A-Z)
C{{{  comments
C  Input a 1d distribution of 1d arrays, in the same order as if the arrays
C  formed one big distribution.
C
C  Note that the the sizes of the local array segments needn't be
C  global---'ssx' can be a distribution over {x}.
C}}}
      INTEGER gset(0:0, 0:1)
      INTEGER lset(0:0, 0:1)
      INTEGER segxi, i, iseg
      gset(0, 0) = 0
      gset(0, 1) = Isize (x)
      CALL IOpre (chan)
      CALL IOrank(chan, x, 1)
      CALL IOlset (chan, lset, gset, 1)
      DO 40, i = lset(0, 0), (lset(0, 1)+lset(0,0))-1
        segxi = ssx
        CALL IOfwdo (chan, segxi, 1, i, 1)
        DO 50, iseg = 0, segxi-1
          CALL IOtin (chan, tag)
          CALL IOin (chan, ssx1, result(iseg, 0), ssx1, i, 1)
50        CONTINUE
40      CONTINUE
      CALL IOpost (chan)
      END
C}}}
C}}}
C{{{  2d
C{{{  SUBROUTINE IN2D
      SUBROUTINE IN2D (chan, x, y, result, rlen, tag)
      INTEGER chan, x, y, rlen, tag
      INTEGER result(0:rlen-1)
C   Input a whole two-dimensional distribution over {x, y}.
      IMPLICIT LOGICAL(A-Z)
      INTEGER lset(0:1, 0:1)
      INTEGER gset(0:1, 0:1)
      INTEGER table(0:1), i, j
      gset(0,0) = 0
      gset(0,1) = Isize(x)
      gset(1,0) = 0
      gset(0,1) = Isize(y)
      CALL IOpre (chan)
      table(0) = x
      table(1) = y
      CALL IOrank(chan, table, 2)
      CALL IOlset (chan, lset, gset, 2 )
      DO 60, i = lset (0,0), (lset (0,1)+lset(0,0))-1
        table(0) = i
        DO 70, j = lset (1,0), (lset (1,1)+lset(0,0))-1
          CALL IOtin (chan, tag)
          table(1) = j
          CALL IOin (chan, rlen, result, rlen, table, 2)
70        CONTINUE
60      CONTINUE
      CALL IOpost (chan)
      END
C}}}
C{{{  SUBROUTINE IN2DEL
      SUBROUTINE IN2DEL (chan, x, y, result, rlen, dstx, dsty, tag)
      INTEGER chan, x, y, rlen, dstx, dsty, tag
      INTEGER result(0:rlen-1), table(0:1)
C   Input element at (dstx, dsty) of a two-dimensional distribution
C   over {x, y}.
      IMPLICIT LOGICAL(A-Z)
      CALL IOpre (chan)
      table(0) = x
      table(1) = y
      CALL IOrank (chan, table, 2)
      CALL IOtin (chan, tag)
      table(0) = dstx
      table(1) = dsty
      CALL IOin(chan, rlen, result, rlen, table, 2)
      CALL IOpost (chan)
      END
C}}}
C{{{  SUBROUTINE IN2DAR
      SUBROUTINE IN2DAR (chan, x, y,
     :                   ssx, ssy, result, ssy1, tag)
      INTEGER chan, x, y, ssx, ssy, ssy1, tag
      INTEGER result(0:ssx-1, 0:ssy-1, 0:ssy1-1)
      IMPLICIT LOGICAL(A-Z)
C{{{  explanation
C  Input a 2d distribution of 2d arrays, in the same order as if the arrays
C  formed one big distribution.
C  Note that the the sizes of the local array segments needn't be
C  global---'ssx' can be a distribution over {x},
C  'ssy' a distribution over {y}.
C
C}}}
      INTEGER lset(0:1, 0:1)
      INTEGER gset(0:1, 0:1)
      INTEGER segxi, segyj
      INTEGER table(0:1), i, j, iseg, jseg
      gset(0,0) = 0
      gset(0,1) = Isize(x)
      gset(1,0) = 0
      gset(1,1) = Isize (y)
      CALL IOpre (chan)
      table(0) = x
      table(1) = y
      CALL IOrank(chan, table, 2)
      CALL IOlset (chan, lset, gset, 2)
C   Globalise 'segxi'---value of 'ssx' at x=i---over
C   all forwarding paths used in loops below.
      DO 80, i = lset(0,0), (lset(0,1)+lset(0,0))-1
        table(0) = i
C{{{
        segxi = ssx
        DO 90, j = lset (1,0), (lset (1,1)+lset(1,0))-1
          table(1) = j
          CALL IOfwdo (chan, segxi, 1, table, 2)
90        CONTINUE
        DO 100, iseg = 0, segxi-1
          DO 110, j = lset(1,0), (lset(1, 1)+lset(1,0))-1
            table(1) = j
C           Globalise 'segyj' over forwarding path used below.
            segyj = ssy
            CALL IOfwdo (chan, segyj, 1, table, 2)
            DO 120, jseg = 0, segyj-1
              CALL IOtin (chan, tag)
              CALL IOin (chan, ssy1, result(iseg, jseg, 0),
     :                   ssy1, table, 2)
120           CONTINUE
110         CONTINUE
100       CONTINUE
C}}}
80      CONTINUE
      CALL IOpost (chan)
      END
C}}}
C}}}
C{{{  3d
C  These 3d routines illustate usage of the generic routines.
C{{{  SUBROUTINE IN3D
      SUBROUTINE IN3D (chan, x, y, z, result, rlen, tag)
      INTEGER chan, x, y, z, rlen, tag
      INTEGER result(0:rlen-1), table(0:2)
C   Input a whole two-dimensional distribution over {x, y, z}.
      IMPLICIT LOGICAL(A-Z)
      table(0) = x
      table(1) = y
      table(2) = z
      CALL INDD (chan, table, result, tag)
      END
C}}}
C{{{  SUBROUTINE IN3DEL
      SUBROUTINE IN3DEL (chan, x, y, z, result, rlen,
     :                   dstx, dsty, dstz, tag)
      INTEGER chan, x, y, z, rlen, dstx, dsty, dstz, tag
      INTEGER result(0:rlen-1), table(0:2), dtable(0:3)
C   Input element at (dstx, dsty, dstz) of a three-dimensional distribution
C   over {x, y, z}.
      IMPLICIT LOGICAL(A-Z)
      table(0) = x
      table(1) = y
      table(2) = z
      dtable(0) = dstx
      dtable(1) = dsty
      dtable(2) = dstz
      CALL INDDEL (chan, table, result, dtable, tag)
      END
C}}}
C{{{  SUBROUTINE IN3DAR
      SUBROUTINE IN3DAR (chan, x, y, z,
     :                   ssx, ssy, ssz, result, ssz1, tag)
      INTEGER chan, x, y, z, ssx, ssy, ssz, ssz1, tag
      INTEGER result(0:ssx-1, 0:ssy-1, 0:ssz-1, 0:ssz1-1)
      INTEGER table1(0:2), table2(0:2), table3(0:2)
      IMPLICIT LOGICAL(A-Z)
C{{{  explanation
C  Input a 3d distribution of 3d arrays, in the same order as if the arrays
C  formed one big distribution.
C
C  Note that the the sizes of the local array segments needn't be
C  global---'ssx' can be a distribution over {x},
C  'ssy' a distribution over {y}, and 'ssz' over {z}.
C}}}
C     C{{{  set up tables
      table1(0) = x
      table1(1) = y
      table1(2) = z
      table2(0) = ssx
      table2(1) = ssy
      table2(2) = ssz
      table3(0) = ssy * ssz
      table3(1) = ssz
      table3(2) = 1
C     C}}}
      CALL INDDAR (chan, table1, table2, table3, ssz1,
     :             result, tag)
      END
C}}}
C}}}
C}}}
C{{{  simple output
C{{{  SUBROUTINE OUTPUT
      SUBROUTINE OUTPUT (chan, data, dlen, tag)
      INTEGER chan, dlen, tag
      INTEGER data(0:dlen-1)
C   Output a global variable.
      IMPLICIT LOGICAL(A-Z)
      INTEGER INULL(0:0)
      CALL IOrank (chan, INULL, 0)
      CALL IOtout (chan, tag)
      CALL IOout (chan, dlen, data, dlen, INULL, 0)
      CALL IOpost (chan)
      END
C}}}
C{{{  SUBROUTINE OUTAG
      SUBROUTINE OUTAG (chan, tag)
      INTEGER chan, tag
C   Output a global tag.
      IMPLICIT LOGICAL(A-Z)
      INTEGER INULL(0:0)
      CALL IOrank (chan, INULL, 0)
      CALL IOout (chan, 1, tag, 1, INULL, 0)
      CALL IOpost (chan)
      END
C}}}
C}}}
C{{{  array output
C{{{  dd
C{{{  SUBROUTINE OUDD
      SUBROUTINE OUDD (chan, rank, rs, data, dlen, tag)
      PARAMETER (maxdim = 8)
      INTEGER chan, rs, dlen, tag
      INTEGER rank(0:rs-1), data(0:dlen-1)
C   Input a whole distribution over rank 'rank'.
      IMPLICIT LOGICAL(A-Z)
      INTEGER INULL(0:0)
C   #INCLUDE "acsizehdr.inc"
C   VAL rs IS SIZE rank
      INTEGER lset(0:maxdim-1, 0:1), gset(0:maxdim-1, 0:1)
      INTEGER ptr
      INTEGER coords(0: maxdim-1)
      INTEGER range(0:1), i
      CALL IOpre (chan)
      DO 130, i = 0, rs-1
        gset (i, 0) = 0
        gset (i, 1) = Isize (rank(i))
130     CONTINUE
      CALL IOrank(chan, rank, rs)
      CALL IOlset (chan, lset, gset, rs)
C   Traverse 'lset', last coordinate most-rapidly-varying.
C{{{  Traverse 'lset'
      IF (rs .EQ.0) THEN
        CALL IOtout (chan, tag)
        CALL IOout (chan, dlen, data, dlen, INULL, 0)
      ELSE
        DO 140, i = 0, rs-1
          coords (i) = lset (i,0)
140       CONTINUE
        ptr = rs - 1
45      CONTINUE
        IF (ptr .GE. 0) GOTO 55
          range(0) = lset(ptr, 0)
          range(1) = lset(ptr, 1)
          IF (coords(ptr) .EQ.(range (0) + range (1))) THEN
            coords(ptr) = range (0)
            ptr = ptr - 1
          ELSE
            CALL IOtout (chan, tag)
            CALL IOout (chan, dlen, data, dlen, coords, rs)
            ptr = rs - 1
          ENDIF
          IF (ptr .GE. 0) coords(ptr) = coords(ptr) + 1
          IF (ptr .GE. 0) GOTO 45
55        CONTINUE
      ENDIF
C}}}
      CALL IOpost (chan)
      END
C}}}
C{{{  SUBROUTINE OUDDEL
      SUBROUTINE OUDDEL (chan, rank, rs, data, dlen, srcs, slen, tag)
      INTEGER chan, rs, dlen, slen, tag
      INTEGER rank(0:rs-1), data(0:dlen-1), srcs(0:slen-1)
C   Output element at 'srcs' of a d-dimensional distribution
C   over 'rank'.
      IMPLICIT LOGICAL(A-Z)
      CALL IOpre (chan)
      CALL IOrank (chan, rank, rs)
      CALL IOtout (chan, tag)
      CALL IOout (chan, dlen, data, dlen, srcs, slen)
      CALL IOpost (chan)
      END
C}}}
C{{{  SUBROUTINE OUDDAR
      SUBROUTINE OUDDAR (chan, rank, rs, ssizes, sslen,
     :                   strides, len, data, dlen, tag)
      PARAMETER (maxdim = 8)
      INTEGER chan, rs, sslen, len, dlen, tag
      INTEGER rank(0:rs-1), ssizes(0:sslen-1)
      INTEGER strides(0:len-1), data(0:dlen-1)
      IMPLICIT LOGICAL(A-Z)
      INTEGER INULL(0:0)
C{{{  explanation
C  Output a d-dimensional distribution of d-dimensional arrays,
C  in the same order as if the arrays formed one big distribution.
C  Packing of logical multi-dimensional array is
C      array [i.x] [i.y] ... = [data FROM len * offset FOR len],
C  where
C      offset = (strides [0] * i.x) + (strides [1] * i.y) + ...
C  Note that the the sizes of the local array segments needn't be
C  global---'ssizes [0]' can be a distribution over {x},
C  'ssizes [1]' over {y}, etc.
C}}}
C   #INCLUDE "acsizehdr.inc"
C   VAL rs IS SIZE rank
      INTEGER lset(0:maxdim-1, 0:1), gset(0:maxdim-1, 0:1), i
C{{{  variables
      INTEGER  ptr, limit
      LOGICAL internal
      INTEGER coords(0:maxdim-1), iseg(0:maxdim-1), sscoords(0:maxdim-1)
      INTEGER  offset
      LOGICAL going
C}}}
      CALL IOpre (chan)
      DO 150, i = 0, rs-1
        gset (i, 0) = 0
        gset (i, 1) = Isize (rank (i))
150     CONTINUE
      CALL IOrank(chan, rank, rs)
      CALL IOlset (chan, lset, gset, rs)
C   Traverse 'lset' * 'segment', last coordinate
C   most-rapidly-varying.
      IF (rs .EQ. 0) THEN
        CALL IOtout (chan, tag)
        CALL IOout (chan, len, data, len, INULL, 0)
      ELSE
        ptr   = 0
        internal = .FALSE.
        limit  = lset(ptr, 0) + lset(ptr, 1)
        coords(ptr) = lset(ptr, 0)
        offset = 0
        going  = .TRUE.
65        CONTINUE
          IF (internal) THEN
            IF (iseg(ptr) .EQ.limit) THEN
C{{{  Pop
              offset   = offset - (limit * strides(ptr))
              internal = .FALSE.
              limit  = lset(ptr, 0) + lset(ptr, 1)
              coords(ptr) = coords(ptr) + 1
C}}}
            ELSE
              IF (ptr .EQ.(rs - 1)) THEN
C{{{  The business
                CALL IOtout (chan, tag)
                CALL IOout (chan, len, data(len * offset),
     :                      len, coords, rs)
                iseg(ptr) = iseg(ptr) + 1
                offset = offset + strides(ptr)
C}}}
              ELSE
C{{{  Push
                ptr   = ptr + 1
                internal = .FALSE.
                limit  = lset(ptr, 0) + lset(ptr, 1)
                coords(ptr) = lset(ptr, 0)
C}}}
              ENDIF
            ENDIF
          ELSE
C{{{
            IF (coords(ptr) .EQ.limit) THEN
C{{{  Pop
              IF (ptr .EQ.0) THEN
                going = .FALSE.
              ELSE
                ptr   = ptr - 1
                internal = .TRUE.
                limit  = sscoords(ptr)
                iseg(ptr) = iseg(ptr) + 1
                offset = offset + strides(ptr)
              ENDIF
C}}}
            ELSE
C{{{  Push
              internal = .TRUE.
              limit = ssizes(ptr)
              CALL glsub (lset, coords, maxdim, ptr + 1, limit)
              sscoords(ptr) = limit
              iseg(ptr)  = 0
C}}}
            ENDIF
C}}}
          ENDIF
          IF (going) GOTO 65
      ENDIF
      CALL IOpost (chan)
      END
C}}}
C}}}
C{{{  1d
C{{{  SUBROUTINE OU1D
      SUBROUTINE OU1D (chan, x, data, dlen, tag)
      INTEGER chan, x, dlen, tag
      INTEGER data(0:dlen-1)
C   Output a whole one-dimensional distribution over {x}.
C   Size of 'data' array should be global across processes.
      IMPLICIT LOGICAL(A-Z)
      INTEGER lset(0:0, 0:1)
      INTEGER gset(0:0, 0:1)
      INTEGER i
      gset(0, 0) = 0
      gset(0, 1) = Isize (x)
      CALL IOpre (chan)
      CALL IOrank(chan, x, 1)
      CALL IOlset (chan, lset, gset, 1)
      DO 160, i = lset(0,0), (lset (0,1)+lset(0,0))-1
        CALL IOtout (chan, tag)
        CALL IOout (chan, dlen, data, dlen, i, 1)
160     CONTINUE
      CALL IOpost (chan)
      END
C}}}
C{{{  SUBROUTINE OU1DEL
      SUBROUTINE OU1DEL (chan, x, data, dlen, srcx, tag)
      INTEGER chan, x, dlen, srcx, tag
      INTEGER data(0:dlen-1)
C   Output element at 'srcx' of a one-dimensional distribution over {x}.
C   Size of 'data' array should be global across processes.
      IMPLICIT LOGICAL(A-Z)
      CALL IOpre (chan)
      CALL IOrank (chan, x, 1)
      CALL IOtout (chan, tag)
      CALL IOout (chan, dlen, data, dlen, srcx, 1)
      CALL IOpost (chan)
      END
C}}}
C{{{  SUBROUTINE OU1DAR
      SUBROUTINE OU1DAR (chan, x, ssx, data, ssx1, tag)
      INTEGER chan, x, ssx, ssx1, tag
      INTEGER data(0:ssx-1, 0:ssx1-1)
      IMPLICIT LOGICAL(A-Z)
C   Output a 1d distribution of 1d arrays, in the same order as if the arrays
C   formed one big distribution.
C   Note that the the sizes of the local array segments needn't be
C   global---'ssx' can be a distribution over {x}.
      INTEGER lset(0:0, 0:1)
      INTEGER gset(0:0, 0:1)
      INTEGER i, iseg
      INTEGER segxi
      gset(0,0) = 0
      gset(0,0) = Isize (x)
      CALL IOpre (chan)
      CALL IOrank(chan, x, 1)
      CALL IOlset (chan, lset, gset, 1)
      DO 170, i = lset (0,0), (lset (0,1)+lset(0,0))-1
C       Globalise 'segxi' over forwarding path used below.
        segxi = ssx
        CALL IOfwdo (chan, segxi, 1, i, 1)
        DO 180, iseg = 0, segxi-1
          CALL IOtout (chan, tag)
          CALL IOout (chan, ssx1, data(iseg, 0), ssx1, i, 1)
180       CONTINUE
170     CONTINUE
      CALL IOpost (chan)
      END
C}}}
C}}}
C{{{  2d
C{{{  SUBROUTINE OU2D
      SUBROUTINE OU2D (chan, x, y, data, dlen, tag)
      INTEGER chan, x, y, dlen, tag
      INTEGER data(0:dlen-1)
C   Output a whole two-dimensional distribution over {x, y}.
      IMPLICIT LOGICAL(A-Z)
      INTEGER lset(0:1, 0:1)
      INTEGER gset(0:1, 0:1), table(0:1), i, j
      gset(0, 0) = 0
      gset(0, 1) = Isize (x)
      gset(1, 0) = 0
      gset(1, 1) = Isize (y)
      CALL IOpre (chan)
      table(0) = x
      table(1) = y
      CALL IOrank(chan, table, 1)
      CALL IOlset (chan, lset, gset, 2)
      DO 180, i = lset (0,0), (lset(0,1)+lset(0,0))-1
        table(0) = i
        DO 190, j = lset (1,0), (lset(1,1)+lset(1,0))-1
          table(1) = j
          CALL IOtout (chan, tag)
          CALL IOout (chan, dlen, data, dlen, table, 2)
190       CONTINUE
180     CONTINUE
      CALL IOpost (chan)
      END
C}}}
C{{{  SUBROUTINE OU2DEL
      SUBROUTINE OU2DEL (chan, x, y, data, dlen, srcx, srcy, tag)
      INTEGER chan, x, y, dlen, srcx, srcy, tag
      INTEGER data(0:dlen-1)
C   Output element at (srcx, srcy) of a two-dimensional distribution
C   over {x, y}.
      IMPLICIT LOGICAL(A-Z)
      INTEGER rank(0:1), srcs(0:1)
      rank(0) = x
      rank(1) = y
      srcs(0) = srcx
      srcs(1) = srcy
      CALL IOpre (chan)
      CALL IOrank (chan, rank, 2)
      CALL IOtout (chan, tag)
      CALL IOout (chan, dlen, data, dlen, srcs, 2)
      CALL IOpost (chan)
      END
C}}}
C{{{  SUBROUTINE OU2DAR
      SUBROUTINE OU2DAR (chan, x, y, ssx, ssy, data, ssy1, tag)
      INTEGER chan, x, y, ssx, ssy, ssy1, tag
      INTEGER data(0:ssx-1, 0:ssy-1, 0:ssy1-1)
      IMPLICIT LOGICAL(A-Z)
C{{{  explanation
C  Output a 2d distribution of 2d arrays, in the same order as if the arrays
C  formed one big distribution.
C  Note that the the sizes of the local array segments needn't be
C  global---'ssx' can be a distribution over {x},
C  'ssy' a distribution over {y}.
C}}}
      INTEGER lset(0:1, 0:1)
      INTEGER gset(0:1, 0:1), table(0:1)
      INTEGER segxi, segyj, i, j, iseg, jseg
      gset(0, 0) = 0
      gset(1, 0) = Isize(x)
      gset(0, 1) = 0
      gset(1, 0) = Isize(y)
      table(0) = x
      table(1) = y
      CALL IOpre (chan)
      CALL IOrank(chan, table, 2)
      CALL IOlset (chan, lset, gset, 2)
      DO 200, i = lset (0,0), (lset (0,1)+lset(0,0))-1
        table(0) = i
C       Globalise 'segxi'---value of 'ssx' at x=i---over
C       all forwarding paths used in loops below.
        segxi = ssx
        DO 210, j = lset (1,0), (lset(1,1)+lset(1,0))-1
          table(1) = j
          CALL IOfwdo (chan, segxi, 1, table, 2)
210       CONTINUE
        DO 220 iseg = 0, segxi-1
          DO 230, j = lset(1,0), (lset(1,1)+lset(1,0))-1
C   Globalise 'segyj' over forwarding path used below.
            table(1) = j
            segyj = ssy
            CALL IOfwdo (chan, segyj, 1, table, 2)
            DO 240, jseg = 0, segyj
              CALL IOtout (chan, tag)
              CALL IOout (chan, ssy1,
     :                    data(iseg, jseg, 0), ssy1, table, 2)
240           CONTINUE
230         CONTINUE
220       CONTINUE
200     CONTINUE
      CALL IOpost (chan)
      END
C}}}
C}}}
C{{{  3d
C{{{  SUBROUTINE OU3D
      SUBROUTINE OU3D (chan, x, y, z, data, dlen, tag)
      INTEGER chan, x, y, z, dlen, tag
      INTEGER data(0:dlen-1)
C   Output a whole three-dimensional distribution over {x, y, z}.
      IMPLICIT LOGICAL(A-Z)
      INTEGER rank(0:2)
      rank(0) = x
      rank(1) = y
      rank(2) = z
      CALL OUDD (chan, rank, data, tag)
      END
C}}}
C{{{  SUBROUTINE OU3DEL
      SUBROUTINE OU3DEL (chan, x, y, z, data, dlen,
     :                   srcx, srcy, srcz, tag)
      INTEGER chan, x, y, z, dlen, srcx, srcy, srcz, tag
      INTEGER data(0:dlen-1)
      IMPLICIT LOGICAL(A-Z)
C   Output element at (srcx, srcy, srcz) of a three-dimensional
C   distribution over {x, y, z}.
      INTEGER rank(0:2), srcs(0:2)
C     C{{{  set up rank
      rank(0) = x
      rank(1) = y
      rank(2) = z
C     C}}}
C     C{{{  set up srcs
      srcs(0) = srcx
      srcs(1) = srcy
      srcs(2) = srcz
C     C}}}
      CALL OUDDEL (chan, rank, data, srcs, tag)
      END
C}}}
C{{{  SUBROUTINE OU3DAR
      SUBROUTINE OU3DAR (chan, x, y, z,
     :                   ssx, ssy, ssz, data, ssz1, tag)
      INTEGER chan, x, y, z, ssx, ssy, ssz, ssz1, tag
      INTEGER data(0:ssx-1, 0:ssy-1, 0:ssz-1, 0:ssz1-1)
      IMPLICIT LOGICAL(A-Z)
C   Output a 3d distribution of 3d arrays, in the same order as
C   if the arrays formed one big distribution.
C   Note that the the sizes of the local array segments needn't be
C   global---'ssx' can be a distribution over {x},
C   'ssy' a distribution over {y}, and 'ssz' over {z}.
      INTEGER rank(0:2), ssizes(0:2), strides(0:2)
C     C{{{  set up rank
      rank(0) = x
      rank(1) = y
      rank(2) = z
C     C}}}
C     C{{{  set up ssizes
      ssizes(0) = ssx
      ssizes(1) = ssy
      ssizes(2) = ssz
C     C}}}
C     C{{{  set up strides
      strides(0) = ssy*ssz
      strides(1) = ssz
      strides(2) = 1
C     C}}}
      CALL OUDDAR (chan, rank, ssizes, strides, ssz1, data, tag)
      END
C}}}
C}}}
C}}}
