C ------------------------------------------------------------------------- C -- C -- path.c Wolfgang Schreiner C -- all pairs shortest path 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(srand(0),100/D) .EQ. 0) THEN C -- weight of edge between i and j W(i,j) = MOD(srand(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) REAL m INTEGER i, j, k C DO j=1,N DO i=1,N m = A(i,j) DO k=1,N m = MIN(m, A(i,k) + A(k,j)) ENDDO B(i,j) = m 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 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 pathes CALL path(W) C -- print result CALL print(W) C END C C ------------------------------------------------------------------------- C -- end of pathf.f C -------------------------------------------------------------------------