C{{{  master
C{{{  SUBROUTINE display
      SUBROUTINE display (source, rows, columns)
      IMPLICIT NONE
C     C{{{  declare tags
      INTEGER tend, tint, tr32, tstr, tuntagged
      PARAMETER (tuntagged = -1)
      PARAMETER (tend = 0)
      PARAMETER (tint = 1)
      PARAMETER (tr32 = 2)
      PARAMETER (tstr = 3)
C     C}}}
      INTEGER source, rows, columns
C Read a stream of 'rows' * 'columns' real numbers from 'source',
C and print as a table.
      INTEGER i, j
      REAL data(0:50)
      DO 10, i = 0, rows-1
        DO 20, j = 0, columns-1
          call INPUT(source, data(j), 1, tr32)
20      CONTINUE
        print '(50(F7.3, '' ''))', (data(j), j =0, columns-1)
10      CONTINUE
      END
C}}}
C
C{{{  SUBROUTINE invert
      SUBROUTINE invert (chan, size)
      IMPLICIT NONE
C     C{{{  declare tags
      INTEGER tend, tint, tr32, tstr, tuntagged
      PARAMETER (tuntagged = -1)
      PARAMETER (tend = 0)
      PARAMETER (tint = 1)
      PARAMETER (tr32 = 2)
      PARAMETER (tstr = 3)
C     C}}}
      INTEGER chan, size, i, j
      DO 30, i = 0, size-1
        DO 40, j = 0, size-1
          call OUTPUT(chan, REAL(ABS(i - j)), 1, tr32)
40      CONTINUE
30    CONTINUE
      print *, 'matrix'
      call display (chan, size, size)
      print *, 'inverse'
      call display (chan, size, size)
      END
C}}}
C
C{{{  SUBROUTINE master
      SUBROUTINE master (nchans, chan)
      IMPLICIT NONE
      INTEGER nchans, chan
C     C{{{  declare tags
      INTEGER tend, tint, tr32, tstr, tuntagged
      PARAMETER (tuntagged = -1)
      PARAMETER (tend = 0)
      PARAMETER (tint = 1)
      PARAMETER (tr32 = 2)
      PARAMETER (tstr = 3)
C     C}}}
      INTEGER tag, size
50    CONTINUE
        call INTAG(chan, tag)
        IF (tag .EQ. tint) THEN
          call INPUT(chan, size, 1, tuntagged)
          call invert (chan, size)
          GOTO 50
        ENDIF
      END
C}}}
C}}}
C
C{{{  worker
C{{{  INTEGER FUNCTION findlargest
      INTEGER FUNCTION findlargest (vector, len)
      IMPLICIT NONE
      INTEGER len
      REAL vector(0:len-1)
C Find location of largest absolute value element in 'vector'.
      INTEGER loc, i
      REAL val
      loc = -1
      val = -1.0
      DO 60, i = 0, len-1
        IF (ABS(vector(i) .GT. val)) THEN
          loc = i
          val = vector(i)
        ENDIF
60    CONTINUE
      findlargest = loc
      END
C}}}
C
C{{{  INTEGER function findpivot
      INTEGER FUNCTION findpivot (x, mat, L, col)
      INTEGER x, L, col
      REAL mat(0:L-1)
      IMPLICIT NONE
C  Calc pivot for column 'col', and broadcast it.
      INTEGER pivot, temp
      INTEGER findlargest, Icoord
      IF (Icoord(x) .EQ. col) THEN
        temp = col + findlargest (mat(col), L-col)
      ENDIF
      call BCSTEL (x, pivot, 1, temp, 1, col)
      findpivot = pivot
      END
C}}}
C
C{{{  SUBROUTINE reduc1
      SUBROUTINE reduc1 (x, mat, L, stage, rhs, rlen)
      IMPLICIT NONE
      INTEGER x, L, stage, rlen
      REAL mat(0:L-1), rhs(0:rlen)
      INTEGER pivot, i
C     C{{{  set maxL
      INTEGER maxL
      PARAMETER (maxL = 50)
C     C}}}
      REAL firstcol(0:maxL-1), t
      INTEGER findpivot, Icoord
      pivot = findpivot (x, mat, L, stage)
C{{{  Do pivot
      t = mat (stage)
      mat (stage) = mat (pivot)
      mat (pivot) = t
      t = rhs (stage)
      rhs (stage) = rhs (pivot)
      rhs (pivot) = t
C}}}
C{{{  Broadcast "first" column
      call BCSTEL (x, firstcol(stage), L-stage, mat(stage),
     :             L-stage, stage)
C}}}
      IF (Icoord(x) .GT. stage) THEN
        mat (stage) = mat (stage) / firstcol (stage)
        DO 80, i = stage + 1, L-1
          mat (i) = mat (i) - (firstcol (i) * mat (stage))
80      CONTINUE
      ENDIF
      END
C}}}
C
C{{{  SUBROUTINE ludecompose
      SUBROUTINE ludecompose (x, A, L, rhs, rlen)
      INTEGER x, L, rlen
      REAL A(0:L-1), rhs(0:rlen-1)
      IMPLICIT NONE
      INTEGER r
      DO 90, r = 0, L-1
        call reduc1 (x, A, L, r, rhs, rlen)
90    CONTINUE
      END
C}}}
C
C{{{  SUBROUTINE reduc2
      SUBROUTINE reduc2 (x, mat, L, stage, sol, slen)
      INTEGER x, L, stage, slen
      REAL mat(0:L-1), sol(0:slen-1)
      IMPLICIT NONE
C     C{{{  set maxL
      INTEGER maxL
      PARAMETER (maxL = 50)
C     C}}}
      REAL firstcol(0:maxL-1)
      INTEGER i
C{{{  Broadcast "first" column
      call BCSTEL (x, firstcol(stage), L-stage, mat(stage),
     :             L-stage, stage)
C}}}
      sol (stage) = sol (stage) / firstcol (stage)
      DO 110, i = stage + 1, L-1
        sol (i) = sol (i) - (firstcol (i) * sol (stage))
110   CONTINUE
      END
C}}}
C
C{{{  SUBROUTINE solvelower
      SUBROUTINE solvelower (x, A, L, sol, slen)
      IMPLICIT NONE
      INTEGER x, L, slen
      REAL A(0:L-1), sol(0:slen-1)
      INTEGER r
      DO 120, r = 0, L-1
        call reduc2 (x, A, L, r, sol, slen)
120   CONTINUE
      END
C}}}
C
C{{{  SUBROUTINE reduc3
      SUBROUTINE reduc3 (x, mat, L, stage, sol, slen)
      IMPLICIT NONE
      INTEGER x, L, stage, slen
      REAL mat(0:L-1), sol(0:slen-1)
C     C{{{  set maxL
      INTEGER maxL
      PARAMETER (maxL = 50)
C     C}}}
      REAL lastcol(0:maxL-1)
      INTEGER i
C     C{{{  Broadcast "last" column
      IF (stage .GT. 0) THEN
        call BCSTEL (x, lastcol, stage, mat, stage, stage)
      ENDIF
C     C}}}
      DO 140, i = 0, stage-1
        sol(i) = sol(i) - (lastcol(i) * sol(stage))
140   CONTINUE
      END
C}}}
C
C{{{  SUBROUTINE solveupper
      SUBROUTINE solveupper (x, A, L, sol, slen)
      INTEGER x, L, slen
      REAL A(0:L-1), sol(0:slen-1)
      IMPLICIT NONE
      INTEGER i
      DO 150, i = 1, L
        call reduc3 (x, A, L, L-i, sol, slen)
150   CONTINUE
      END
C}}}
C
C{{{  worker
      SUBROUTINE worker (nchans, chan, ndim, x)
      INTEGER nchans, chan, ndim, x
      IMPLICIT NONE
C Column-oriented LU Decomposition.
C     C{{{  declare 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{{{  set L
C 5 * 5 problem (one element per process).
      INTEGER L
      PARAMETER (L = 5)
C  should have L = SIZE x
C}}}
      REAL A(0:L-1), sol(0:L-1)
      INTEGER i
      INTEGER Icoord
C     C{{{  Tell master problem size
      call OUTPUT (chan, L, 1, tint)
C     C}}}
C{{{  Get matrix from master
      DO 160, i = 0, L-1
        call IN1D (chan, x, A(i), 1, tr32)
160   CONTINUE
C}}}
C{{{  Output original matrix
      DO 170, i = 0, L-1
        call OU1D (chan, x, A(i), 1, tr32)
170   CONTINUE
C}}}
C{{{  Initialize "solution" vectors to form unit matrix
      DO 180, i = 0, L-1
        sol(i) = 0.0
180   CONTINUE
      sol(Icoord (x)) = 1.0
C}}}
      call ludecompose (x, A, L, sol, L)
      call solvelower  (x, A, L, sol, L)
      call solveupper  (x, A, L, sol, L)
C{{{  Output inverted matrix
      DO 190, i = 0, L-1
        call OU1D (chan, x,  sol(i), 1, tr32)
190   CONTINUE
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
      INTEGER xsize
      INTEGER chan, null
      INTEGER rank (1)
      PARAMETER (xid   = 0)
      PARAMETER (xsize = 5)
      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}}}
