C     -------------------------------------------------------------------------
C     --
C     -- path.f                                             Wolfgang Schreiner
C     -- all pairs shortest paths problem
C     --
C     -- In:  N x N matrix W such that
C     --      W(i,j) = weight of edge from i to j (or infinity, if none)
C     --
C     -- Out: N x N matrix W such that
C     --      W(i,j) = length of shortest path from i to j (or infinity)
C     --
C     -------------------------------------------------------------------------
C
C     -------------------------------------------------------------------------
C     -- initialize W
C     -------------------------------------------------------------------------
      SUBROUTINE init(W)
C
      INTEGER N, L, D, MAX, INF
      PARAMETER (N = 256, L = 8, D = 1, MAX = 100, INF = N*MAX+1)
      INTEGER srand 
C
      REAL W(N,N)
      INTEGER i,j
C
      DO i=1,N
        DO j=1,N
          IF (MOD(irand(0),100/D) .EQ. 0) THEN
C           -- weight of edge between i and j
	    W(i,j) = MOD(irand(0), MAX)
          ELSE
C           -- no edge between i and j
            W(i,j) = INF
          ENDIF
        ENDDO
      ENDDO
      DO i=1,N
        W(i,i) = 0
      ENDDO
C
      END
C
C     -------------------------------------------------------------------------
C     -- print W
C     -------------------------------------------------------------------------
      SUBROUTINE print(W)
C
      INTEGER N, L, D, MAX, INF
      PARAMETER (N = 256, L = 8, D = 1, MAX = 100, INF = N*MAX+1)
C
      REAL W(N,N)
      INTEGER i,j,k
C
      k = 0
      DO I=1,N
        DO J=1,N
          IF (W(i,j) .EQ. INF) THEN
C           PRINT *, ' '
          ELSE
	    k = k+1
C           PRINT *, '.'
          ENDIF
        ENDDO
      ENDDO
      PRINT *, '***', k, ' paths ***'
C
      END
C
C     -------------------------------------------------------------------------
C     -- square A yielding B using MIN and + instead of + and *
C     -------------------------------------------------------------------------
      SUBROUTINE square(A, B)
C
      INTEGER N, L, D, MAX, INF
      PARAMETER (N = 256, L = 8, D = 1, MAX = 100, INF = N*MAX+1)
C
      REAL A(N,N), B(N,N)
      INTEGER i, j, k
C
      DO j=1,N
        DO i=1,N
          B(i,j) = A(i,j)
          DO k=1,N
            B(i,j) = MIN(B(i,j), A(i,k) + A(k,j))
          ENDDO
        ENDDO
      ENDDO
C
      END
C
C     -------------------------------------------------------------------------
C     -- copy A to B
C     -------------------------------------------------------------------------
      SUBROUTINE copy(A, B)
C
      INTEGER N, L, D, MAX, INF
      PARAMETER (N = 256, L = 8, D = 1, MAX = 100, INF = N*MAX+1)
C
      REAL A(N,N), B(N,N)
      INTEGER i, j
C
      DO i=1,N
        DO j=1,N
          B(i,j) = A(i,j)
        ENDDO
      ENDDO
C
      END
C
C     -------------------------------------------------------------------------
C     -- compute all pairs shortest paths
C     -------------------------------------------------------------------------
      SUBROUTINE path(W)
C
      INTEGER N, L, D, MAX, INF
      PARAMETER (N = 256, L = 8, D = 1, MAX = 100, INF = N*MAX+1)
C
      REAL W(N,N)
      REAL V(N,N)
      INTEGER s, t
C
      t = 0
      DO s=1,L-1
        IF (t .EQ. 0) THEN
          CALL square(W, V)
        ELSE
          CALL square(V, W)
        ENDIF
        t = 1 - t
      ENDDO
      IF (t .EQ. 1) CALL copy(V, W)
C
      END
C
C     -------------------------------------------------------------------------
C     -- main program
C     -------------------------------------------------------------------------
      PROGRAM main
C
      INTEGER N, L, D, MAX, INF
      PARAMETER (N = 256, L = 8, D = 1, MAX = 100, INF = N*MAX+1)
C
C     -- weight matrix
      REAL W(N,N)
C
C     -- initialize matrix
      CALL init(W)
C     -- print input
      CALL print(W)
C     -- compute all shortest paths
      CALL path(W)
C     -- print result
      CALL print(W)
C
      END
C
C     -------------------------------------------------------------------------
C     -- end of path.f
C     -------------------------------------------------------------------------
