! Modified by: Aleksandar Donev, July 2001 ! These routines are old F77 routines borrowed from: ! ************************************************************ ! *** S. PALLOTTINO AND C. RUGGERI *** ! *** C.N.R.-I.A.C., ROMA, ITALY. *** ! ************************************************************ ! I have modified them to suit a Fortran 90 environment in a quick-and-dirty way ! SUBROUTINE ShortestPaths_F77 (A, ND, LNGT, D, P, ARR1, ARR2, NMAX, MMAX, N, R, ORD) INTEGER A, D, P, ARR1, R, U, V, DV, ARR2, DP1, HP1, HP2, HP3 DIMENSION A (:), D (:), P (:), ARR1 (:), ARR2 (:), ND (:), LNGT (:) CHARACTER ORD ! Some of these require initialization before calling (I am not certain of details!): P=0 ARR1=0 ARR2=0 IF((ORD=='L').OR.(ORD=='l')) THEN CALL SORD2(A, ND, LNGT, D, P, ARR1, ARR2, NMAX, MMAX, N, HUGE(1), R) ELSE IF((ORD=='H').OR.(ORD=='h')) THEN CALL SHEAP(A, ND, LNGT, D, P, ARR1, ARR2, NMAX, MMAX, N, HUGE(1), R) ELSE CALL SDKSTR(A, ND, LNGT, D, P, ARR1, NMAX, MMAX, N, HUGE(1), R) END IF CONTAINS SUBROUTINE SDKSTR (A, ND, LNGT, D, P, Q, NMAX, MMAX, N, INF, R) !*********************************************************************** ! ! ROUTINE SDKSTR ! ! 1) FINDS A SHORTEST PATH TREE ROOTED AT NODE R AND THE SHORTEST ! DISTANCES ! 2) IS BASED ON DIJKSTRA'S METHOD, WITH PRIORITY QUEUE Q IMPLEMENTED ! AS AN UNORDERED LIST ! ! MEANING OF THE INPUT PARAMETERS: ! ! A(I) = POINTER TO ARC-LIST OF NODE I, I=1,2,...,N+1 ! ND(J) =ENDING NODE OF ARC J, J=1,2,...,M ! LNGT(J) = LENGTH OF ARC J, J=1,2,...,M ! NMAX = DIMENSION OF ARRAYS A(.), D(.), P(.), Q(.), HP(.) ! MMAX = DIMENSION OF ARRAYS ND(.), LNGT(.) ! N = NUMBER OF NODES ! INF = VERY LARGE INTEGER VALUE (INFINITY) ! R = ROOT ! ! MEANING OF THE OUTPUT PARAMETERS: ! ! D(I) = SHORTEST DISTANCE FROM R TO I, I=1,2,...,N ! P(I) = PREDECESSOR NODE OF I IN THE SHORTEST PATH TREE, I=1,2,...,N ! ! MEANING OF THE MAIN INTERNAL PARAMETERS: ! ! Q(I) = LIST OF THE CANDIDATE NODES: = 0 IF NODE I IS NOT IN Q ! J IF NODE I PRECEDES NODE J IN Q ! NN = N+1 ! U = CURRENT NODE ! V = ENDING NODE OF THE CURRENT ARC ! INIT = START-POINTER TO THE ARC-LIST OF THE CURRENT NODE ! IFIN = END-POINTER TO THE ARC-LIST OF THE CURRENT NODE ! DV = TENTATIVE LABEL OF NODE V ! ! ALL THE PARAMETERS ARE INTEGER ! !*********************************************************************** INTEGER A, D, P, Q, R, U, V, DV, VAL DIMENSION A (:), D (:), P (:), Q (:), ND (:), LNGT (:) ! ! INITIALIZE ! DO 10 I = 1, N D (I) = INF 10 END DO D (R) = 0 P (R) = 0 NN = N + 1 Q (NN) = NN U = R ! ! EXPLORE THE FORWARD STAR OF U ! 20 INIT = A (U) IFIN = A (U + 1) - 1 IF (IFIN.LT.INIT) GOTO 40 ! WRITE(*,*) "From node:", U, " with distance:", D(U) DO 30 J = INIT, IFIN V = ND (J) DV = D (U) + LNGT (J) ! WRITE(*,*) "-->neighbour", V, "-->distance:", DV ! ! CHECK WHETHER THE LABEL OF V CAN BE IMPROVED ! IF (D (V) .LE.DV) GOTO 30 D (V) = DV P (V) = U ! ! IF V IS NOT IN Q, INSERT V AT THE HEAD OF Q ! IF (Q (V) .NE.0) THEN ! WRITE(*,*) "Node", V," rejected because taken" GOTO 30 END IF ! WRITE(*,*) "Adding ", V, " to queue:" Q (V) = Q (NN) Q (NN) = V 30 END DO ! ! CHECK WHETHER THE LIST IS EMPTY ! 40 IF (Q (NN).EQ.NN) THEN ! WRITE(*,*) "Queue is empty:", NN, Q(NN) GOTO 70 END IF ! SEARCH THE MINIMUM LABEL NODE IN Q ! K = 0 I = NN VAL = INF 50 JJQ = Q (I) IF (D (JJQ) .GE.VAL) GOTO 60 VAL = D (JJQ) K = I 60 I = Q (I) IF (Q (I) .NE.NN) GOTO 50 ! ! REMOVE THE NEW CURRENT NODE U FROM Q ! ! WRITE(*,*) "Removing ", U, " from queue" U = Q (K) Q (K) = Q (U) Q (U) = 0 GOTO 20 70 CONTINUE RETURN END SUBROUTINE SDKSTR !*********************************************************************** ! ! ROUTINE SORD2 ! ! 1) FINDS A SHORTEST PATH TREE ROOTED AT NODE R AND THE SHORTEST ! DISTANCES ! 2) IS BASED ON DJKSTRA'S METHOD, WITH THE PRIORITY QUEUE Q IMPLEMENTED ! AS AN ORDERED TWO-WAY LINKED LIST ! ! MEANING OF THE INPUT PARAMETERS: ! ! A(I) = POINTER TO ARC-LIST OF NODE I, I=1,2,...,N+1 ! ND(J) = ENDING NODE OF ARC J, J=1,2,...,M ! LNGT(J) = LENGTH OF ARC J, J=1,2,...,M ! NMAX = DIMENSION OF ARRAYS A(.), D(.), P(.), UP(.), DOWN(.) ! MMAX = DIMENSION OF ARRAYS ND(.), LNGT(.) ! N = NUMBER OF NODES ! INF = VERY LARGE INTEGER VALUE (INFINITY) ! R = ROOT ! ! MEANING OF THE OUTPUT PARAMETERS: ! ! D(I) = SHORTEST DISTANCE FROM R TO I, I=1,2,...,N ! P(I) = PREDECESSOR NODE OF I IN THE SHORTEST PATH TREE, I=1,2,...,N ! ! MEANING OF THE MAIN INTERNAL PARAMETERS: ! ! UP(I)= 0 IF I DOES NOT BELONG TO THE LIST ! = J IF J PRECEDES I IN THE LIST ! DOWN(I)= 0 IF I DOES NOT BELONG TO THE LIST ! J IF J FOLLOWS I IN THE LIST ! NN = N+1 ! U = CURRENT NODE ! V = ENDING NODE OF THE CURRENT ARC ! INIT = START-POINTER TO THE ARC-LIST OF THE CURRENT NODE ! IFIN = END-POINTER TO THE ARC-LIST OF THE CURRENT NODE ! PNTR = POINTER TO THE PORTION OF THE LIST TO BE SCANNED. IT MOVES ! BOTTOM-UP ! DV = TENTATIVE LABEL OF NODE V ! ! ALL THE PARAMETERS ARE INTEGER ! !*********************************************************************** SUBROUTINE SORD2 (A, ND, LNGT, D, P, UP, DOWN, NMAX, MMAX, N, INF, R) INTEGER A, D, P, R, U, V, UP, DOWN, DV, PNTR DIMENSION D (:), P (:), UP (:), DOWN (:), A (:), ND (:), LNGT (:) ! ! INITIALIZE ! DO 10 I = 1, N D (I) = INF 10 END DO D (R) = 0 P (R) = 0 NN = N + 1 D (NN) = - 1 UP (NN) = NN DOWN (NN) = NN U = R ! ! EXPLORE OF THE FORWARD STAR OF U ! 20 INIT = A (U) IFIN = A (U + 1) - 1 IF (INIT.GT.IFIN) GOTO 80 ! ! RESET PNTR TO THE BOTTOM OF THE LIST ! PNTR = UP (NN) DO 70 J = INIT, IFIN V = ND (J) DV = D (U) + LNGT (J) ! ! CHECK WHETHER THE LABEL OF V CAN BE IMPROVED ! IF (D (V) .LE.DV) GOTO 70 ! ! RESET THE POINTER ! IF (D (V) .LT.D (PNTR) .AND.UP (V) .GT.0) PNTR = V ! ! FIND THE INSERTION POINT FOR V ! 30 IF (D (PNTR) .LE.DV) GOTO 40 PNTR = UP (PNTR) GOTO 30 40 IF (DOWN (PNTR) .EQ.V) GOTO 60 ! ! REMOVE V FROM UP(.) AND DOWN(.) IF NECESSARY ! IF (UP (V) .EQ.0) GOTO 50 IUV = UP (V) IDV = DOWN (V) DOWN (IUV) = IDV UP (IDV) = IUV ! ! INSERT V INTO UP(.) AND DOWN(.) ! 50 IDV = DOWN (PNTR) DOWN (V) = IDV DOWN (PNTR) = V UP (IDV) = V UP (V) = PNTR 60 D (V) = DV P (V) = U 70 END DO ! ! REMOVE THE NEW CURRENT NODE U ! 80 U = DOWN (NN) IDU = DOWN (U) DOWN (NN) = IDU UP (IDU) = NN UP (U) = 0 ! ! CHECK WHETHER THE LIST IS EMPTY ! IF (U.LE.N) GOTO 20 RETURN END SUBROUTINE SORD2 !*********************************************************************** ! ! ROUTINE SHEAP ! ! 1) FINDS A SHORTEST PATH TREE ROOTED AT NODE R AND THE SHORTEST ! DISTANCES ! 2) IS BASED ON DIJKSTRA'S METHOD, WITH PRIORITY QUEUE Q IMPLEMENTED ! AS A BINARY HEAP ! ! MEANING OF THE INPUT PARAMETERS: ! ! A(I) = POINTER TO ARC-LIST OF NODE I, I=1,2,...,N+1 ! ND(J) = ENDING NODE OF ARC J, J=1,2,...,M ! LNGT(J) = LENGTH OF ARC J, J=1,2,...,M ! NMAX = DIMENSION OF ARRAYS A(.), D(.), P(.), Q(.), HP(.) ! MMAX = DIMENSION OF ARRAYS ND(.), LNGT(.) ! N = NUMBER OF NODES ! INF = VERY LARGE INTEGER VALUE (INFINITY) ! R = ROOT ! ! MEANING OF THE OUTPUT PARAMETERS: ! ! D(I) = SHORTEST DISTANCE FROM R TO I, I=1,2,...,N ! I IN THE SHORTEST PATH TREE, I=1,2,...,N ! ! MEANING OF THE MAIN INTERNAL PARAMETERS: ! ! Q(I) = DICTIONARY OF THE HEAP: Q(I) GIVES THE POSITION OF NODE ! I IN THE HEAP HP(.), I=1,2,...,N ! HP(I)= I-TH NODE IN THE HEAP, I=1,2,...,NHP ! NHP = NUMBER OF NODES IN THE HEAP (NHP<=N) ! NN = N+1 ! U = CURRENT NODE ! V = ENDING NODE OF THE CURRENT ARC ! INIT = START-POINTER TO THE ARC-LIST OF THE CURRENT NODE ! IFIN = END-POINTER TO THE ARC-LIST OF THE CURRENT NODE ! DV = TENTATIVE LABEL OF NODE V ! ! ALL THE PARAMETERS ARE INTEGER ! !*********************************************************************** SUBROUTINE SHEAP(A, ND, LNGT, D, P, Q, HP, NMAX, MMAX, N, INF, R) INTEGER A, D, P, Q, R, U, V, DV, HP, DP1, HP1, HP2, HP3 DIMENSION A (:), D (:), P (:), Q (:), HP (:), ND (:), LNGT (:) ! ! INITIALIZE ! DO 10 I = 1, N D (I) = INF 10 ENDDO NHP = 0 D (R) = 0 P (R) = 0 NN = N + 1 U = R ! ! EXPLORE THE FORWARD STAR OF U ! 20 INIT = A (U) IFIN = A (U+1) - 1 IF (IFIN .LT. INIT) GO TO 70 DO 60 J = INIT, IFIN V = ND (J) DV = D (U) + LNGT (J) ! ! CHECK WHETHER THE LABEL OF V CAN BE IMPROVED ! IF (D(V) .LE. DV) GO TO 60 D (V) = DV P (V) = U IF (Q(V) .NE. 0) GO TO 30 ! ! INSERT NODE V INTO THE HEAP ! NHP = NHP + 1 Q (V) = NHP ! ! UPDATE THE HEAP ! 30 K = Q (V) 40 K2 = K / 2 IF (K2 .LE. 0) GO TO 50 HP2 = HP (K2) IF (DV .GE. D(HP2)) GO TO 50 HP (K) = HP2 Q (HP2) = K K = K2 GO TO 40 50 HP (K) = V Q (V) = K 60 ENDDO ! ! REMOVE THE NEW CURRENT NODE U FROM THE HEAP ! 70 U = HP (1) Q (U) = 0 NHP = NHP - 1 ! ! CHECK WHETHER THE HEAP IS EMPTY ! IF (NHP) 130, 20, 80 ! ! UPDATE THE HEAP ! 80 HP1 = HP (NHP+1) DP1 = D (HP1) K = 1 90 K2 = 2 * K HP2 = HP (K2) IF (K2-NHP) 100, 110, 120 100 HP3 = HP (K2+1) IF (D(HP2) .LT. D(HP3)) GO TO 110 HP2 = HP3 K2 = K2 + 1 110 IF (DP1 .LE. D(HP2)) GO TO 120 HP (K) = HP2 Q (HP2) = K K = K2 GO TO 90 120 HP (K) = HP1 Q (HP1) = K GO TO 20 130 CONTINUE RETURN END SUBROUTINE SHEAP END SUBROUTINE ShortestPaths_F77 SUBROUTINE MinCut_F77(DNFROM, DNTO, DNGCAP, NMASK, NODES, NARCS, & ISOURC, ISINK, MAXFLO, NNCUT, NACUT, IRETN) ! INTEGER :: DNFROM (:), DNTO (:), DNGCAP(:) INTEGER :: NODES, NARCS, ISOURC, ISINK, MAXFLO, NNCUT, NACUT, IRETN LOGICAL(1) :: NMASK(:) ! T for S nodes, F for T nodes ! ! DNFAPT: THE ORIGINAL DNFAPT(.) WITH SOME OF ITS ELEMENTS ! NEGATED TO MARK THE NODES THAT ARE ON THE SINK SIDE OF ! THE MINIMUM CUT, I.E. DNFAPT(I)<0 IMPLIES THAT NODE I IS ! ON THE SINK SIDE OF CUT, ELSE, IT IS ON THE source SIDE. ! ! This array can be used later to guess the initial flow (not used yet): ! DNFLOW: NARCS-LONG INTEGER *4 ARRAY WHICH GIVES FLOWS ON ARCS, IN ! FORWARD ADJACENCY ORDER. ! ! DIMENSION THESE TO AT LEAST MAX NUMBER OF NODES + 2: INTEGER , ALLOCATABLE :: DNLIST (:), DNDIST (:) INTEGER , ALLOCATABLE :: DNFAPT (:), DNPTRF (:), DNBAPT (:), DNFLAB (:), DNPTRB (:) ! DIMENSION THESE TO AT LEAST MAX NUMBER OF ARCS + 1: INTEGER , ALLOCATABLE :: DNFADJ (:), DNBADJ (:) INTEGER , ALLOCATABLE :: DNCAP (:), DNFLOW (:), DNBTOF (:) INTEGER :: DNELTM, DNARC, DNFVA, DNAUG, DNLFVA, DNLAUG, DNSTGE, DNIBIG, & DNNODE,DNSRCE,DNSINK,DNNOP2 INTEGER :: NUMAUG, NUMSTG, ITEMP REAL :: ELTIM ! ALLOCATE(DNLIST (NODES+2), DNDIST (NODES+2), & DNFAPT (NODES+2), DNPTRF (NODES+2), DNBAPT (NODES+2), & DNFLAB (NODES+2), DNPTRB (NODES+2)) ALLOCATE(DNFADJ (NARCS+1), DNBADJ (NARCS+1), & DNCAP (NARCS+1), DNFLOW (NARCS+1), DNBTOF (NARCS+1)) ! CALL DNFWD (NODES, NARCS, IRETN) IF(IRETN/=0) THEN WRITE(*,*) "Format conversion failed in MinCut_F77" RETURN END IF ! CALL DNSUB (NODES, NARCS, ISOURC, ISINK, MAXFLO, NUMAUG, NUMSTG, NNCUT, NACUT, ELTIM, IRETN) IF(IRETN/=0) THEN WRITE(*,*) "Min cut not found correctly" RETURN END IF ! Added by A. Donev DO ITEMP=1, NODES NMASK(ITEMP)=(DNFAPT(ITEMP)>=0) END DO RETURN ! CONTAINS ! SUBROUTINE DNFWD (NODES, NARCS, IRETN) ! INTEGER NODES, NARCS, IRETN ! INTEGER NODP12, I2, II2, K2, J2, IHEAD2, ITAIL2, QHEAD2, QTAIL2, KP2, KSAT2, LAYMAX, K2DST, & & K2DP1, MAXD2 ! !*********************************************************************** ! ! CALLING CONDITIONS: ! USER CALLABLE; BEFORE CALLING DNSUB. ! INPUT: ! IN CALLING SEQUENCE (ALL INTEGER *4): ! NODES= NUMBER OF NODES, INCLUDING source AND SINK ! NARCS= NUMBER OF ARCS. ! ! IN COMMON, PROVIDE THREE ARC LISTS WITH ARCS IN ANY ORDER: ! DNFROM= THE LIST OF TAILS. (INTEGER *2) ! DNTO= THE LIST OF HEADS. (INTEGER *2) ! DNGCAP= THE LIST OF CAPACITIES. (INTEGER *4). ! ! SCRATCH ARRAY (IN COMMON): ! DNLIST ! OUTPUT: ! IN CALLING SEQUENCE (INTEGER *4): ! IRETN=0 NO ERRORS; =1 ERROR DETECTED, CHECK INPUT. ! IN COMMON, ARRAYS: ! DNFAPT,DNFADJ,DNCAP (I.E. THE FWD ADJACENCY INPUT DATA STRUCTURE ! THAT IS REQUIRED AS INPUT TO SUBROUTINE DNSUB). ! !*********************************************************************** ! ! USING THE THREE ARC LISTS DNFROM(.), DNTO(.), DNGCAP(.), THIS ! SUBROUTINE CONSTRUCTS THE FORWARD ADJACENCY ARRAYS DNFAPT(.), ! DNFADJ(.), AND DNCAP(.), AS THE INPUT REQUIRED BY SUBROUTINE DNSUB. ! !*********************************************************************** ! ! INITIALIZE: IRETN = 0 NODP1 = NODES + 1 DO 100 I2 = 1, NODP1 DNFAPT (I2) = 0 100 DNLIST (I2) = 0 ! TEMPORARILY STORE IN DNFAPT(.) NUMBER OF ARCS OUT OF EACH NODE: DO 200 I4 = 1, NARCS JJDN = DNFROM (I4) 200 DNFAPT (JJDN) = DNFAPT (JJDN) + 1 ! CONSTRUCT DNFAPT(.): ITPI4 = DNFAPT (1) DNFAPT (1) = 1 DO 300 I2 = 1, NODES ITPSV4 = ITPI4 + DNFAPT (I2) ITPI4 = DNFAPT (I2+1) 300 DNFAPT (I2+1) = ITPSV4 ! CONSTRUCT DNFADJ(.) AND DNCAP(.): DO 400 I4 = 1, NARCS ITAIL2 = DNFROM (I4) ITPUT4 = DNFAPT (ITAIL2) + DNLIST (ITAIL2) IF (ITPUT4 .LE. 0) GOTO500 DNFADJ (ITPUT4) = DNTO (I4) DNLIST (ITAIL2) = DNLIST (ITAIL2) + 1 DNCAP (ITPUT4) = DNGCAP (I4) 400 CONTINUE RETURN 500 IRETN = 1 RETURN END SUBROUTINE ! SUBROUTINE DNSUB (NODES, NARCS, ISOURC, ISINK, MAXFLO, NUMAUG, NUMSTG, NNCUT, NACUT, ELTIM, IRETN) INTEGER NODES, NARCS, ISOURC, ISINK, MAXFLO, NUMAUG, NUMSTG, NNCUT, NACUT, IRETN REAL ELTIM ! !************START DNSUB STANDARD USER XFACE DECLARATION BLOCK********* ! ! USER MUST INCLUDE THIS BLOCK IN HIS/HER CALLING PROGRAM. ! ! THESE DECLARATIONS ACCOUNT FOR THE ENTIRE ARRAY STORAGE USED BY ! THE DNSUB SUBROUTINES, INCLUDING WHAT IS NECESSARY TO STORE THE ! INPUT DATA. IT AMOUNTS TO 6*NODES + 5*ARCS WORDS, BUT IT MAY BE ! STATED MORE PRECISELY AS FOLLOWS: ! ! 1) FOR SOLVING PROBLEMS WITH UP TO 32,765 NODES AND 2,147,483,647 ! ARCS, AND WITH FLOW VALUES OF UP TO 2,147,483,647, IT SUFFICES ! TO DECLARE ARRAYS AS SHOWN UNDER 'STD ARRANGEMENT' IN THE ! TABLE BELOW. THIS ARRANGEMENT IS THE ONE USED IN THE RELEASE ! VERSION OF THE DNSUB SUBROUTINES. ! ! 2) IN ORDER TO HANDLE PROBLEMS WITH MORE THAN 32,765 NODES, ALL ! INTEGER *2 DECLARATIONS BELOW MUST BE CHANGED TO INTEGER *4 AND ! THE DNSUB SUBROUTINES AND USER CALLING PROGRAMS MUST BE COMPILED ! AND LINKED. (SEE ALTERNATE 1 BELOW.) ! ! 3) FOR SOLVING ONLY PROBLEMS WITH AT MOST 32,765 NODES, 32,767 ! ARCS, AND WITH FLOWS NOT EXCEEDING 32,767, ALL INTEGER *4 ! DECLARATIONS BELOW MAY BE CHANGED TO INTEGER *2, AND THE DNSUB ! SUBROUTINES AND USER CALLING PROGRAMS MUST BE COMPILED AND ! LINKED. (SEE ALTERNATE 2 BELOW.) IT IS ALSO NECESSARY TO ! ACTIVATE THE STATEMENT DNIBIG=32767 in subroutine dnsub, and to ! include 'implicit INTEGER *2 (i-n)' statements in each program ! unit. THIS ARRANGEMENT, WHICH USES THE LEAST AMOUNT OF MEMORY ! AND IS THE FASTEST when executed on 16-BIT PROCESSORS, IS ONLY ! USEFUL FOR A SET OF VERY SPECIAL APPLICATIONS. ITS general ! use is not recommended. OTHER ALTERNATES ARE ALSO POSSIBLE. ! ! ----------------------------------------------------------------- ! ! STD ARRANGEMENT ALTERNATE 1 ALTERNATE 2 ! (not recommended) ! --------------- --------------- ---------------- ! ARRAY LENGTH TYPE EQV'D TYPE TYPE EQV'D TYPE TYPE EQV'D TYPE ! ------ ----- ---- ------- ---- ----- ---- ---- ----- ----- ! DNFAPT N 4 4 2 ! DNFADJ A 2 4 2 ! DNCAP A 4 4 2 ! DNBAPT N 4 4 2 ! DNBADJ A 2 DNFROM 2 4 DNFROM 4 2 DNFROM 2 ! DNFLOW A 4 DNTO 2 4 DNTO 4 2 DNTO 2 ! DNBTOF A 4 DNGCAP 4 4 DNGCAP 4 2 DNGCAP 2 ! DNPTRF N 4 4 2 ! DNPTRB N 4 4 2 ! DNLIST N 2 4 2 ! DNFLAB N 4 DNDIST 2 4 DNDIST 4 2 DNDIST 2 ! ----------------------------------------------------------------- ! ! TOTAL BYTES: 22*N + 16*A 24*N + 20*A 12*N + 10*A ! (N=NODES, A=ARCS) ! ----------------------------------------------------------------- ! ! INTEGER NODP12, I2, II2, K2, J2, IHEAD2, ITAIL2, QHEAD2, QTAIL2, KP2, KSAT2, LAYMAX, K2DST, & & K2DP1, MAXD2 ! !************END DNSUB STANDARD USER XFACE DECLARATION BLOCK*********** !*********************************************************************** ! ! CALLING CONDITIONS: ! USER CALLABLE WITH INPUT DATA AS FOLLOWS. ! INPUT: ! SCALARS (IN CALLING SEQUENCE; ALL INTEGER *4): ! NODES: NUMBER OF NODES (INCLUDING SOURCE AND SINK) ! NARCS: NUMBER OF ARCS ! ISOURC: NODE NUMBER FOR SOURCE ! ISINK: NODE NUMBER FOR SINK ! ! ARRAYS (IN COMMON): ! DNFAPT: (NODES+1)-LONG INTEGER *4 POINTER ARRAY FOR FORWARD ADJA- ! CENCY LISTS (I.E. THE FORWARD ADJACENCY LIST OF A NODE I ! IS THE SET OF ARCS ! {(I,DNFADJ(J)) :J=DNFAPT(I),...,DNFAPT(I+1)-1 } ! NOTE: MUST HAVE DNFAPT(NODES+1) = NARCS+1. ! ! DNFADJ: NARCS-LONG INTEGER *2 ARRAY GIVING THE LIST OF NODES IN ! THE FORWARD ADJACENCY LIST DNFADJ(J) FOR EACH NODE J, ! AS DESCRIBED ABOVE. ! ! DNCAP: NARCS-LONG INTEGER *4 ARRAY GIVING THE ARC CAPACITIES, IN ! THE ORDER PRESCRIBED BY DNFAPT(.) AND DNFADJ(.). ALL ARC ! CAPACITIES MUST BE GIVEN AS POSITIVE INTEGERS. ! ! NOTE: FOR TRANSFORMING UNORDERED ARC LISTS TO THE ABOVE INPUT ! DATA STRUCTURE,USE SUBROUTINE DNFWD BEFORE CALLING DNSUB ! ! OUTPUT: ! ! SCALARS (IN CALLING SEQUENCE): ! MAXFLO: VALUE OF MAXIMUM FLOW (INTEGER *4). ! NUMAUG: NUMBER OF FLOW AUGMENTATIONS (INTEGER *4). ! NUMSTG: NUMBER OF STAGES (LAYERED NETWORKS CREATED; INTEGER *4). ! NNCUT: NUMBER OF NODES ON source SIDE OF FINAL CUT (INTEGER *4) ! NACUT: NUMBER OF SATURATED ARCS IN THE FINAL CUT (INTEGER *4) ! ELTIM: EXECUTION TIME, IN SECONDS (SEE NOTE 3 BELOW) (REAL*4). ! IRETN: NONZERO IF THERE ARE ERRORS IN INPUT DATA. ! ! ARRAYS (IN COMMON:): ! DNFAPT: THE ORIGINAL DNFAPT(.) WITH SOME OF ITS ELEMENTS ! NEGATED TO MARK THE NODES THAT ARE ON THE SINK SIDE OF ! THE MINIMUM CUT, I.E. DNFAPT(I)<0 IMPLIES THAT NODE I IS ! ON THE SINK SIDE OF CUT, ELSE, IT IS ON THE source SIDE. ! ! DNFADJ: THE ORIGINAL DNFADJ(.) WITH SOME OF ITS ELEMENTS NEGATED ! TO MARK THOSE SATURATED ARCS THAT ARE IN THE MIN CUT ! FOUND BY THE ALGORITHM, I.E. DNFADJ(I)<0 IMPLIES THAT ! THE I-TH ARC IN FORWARD ADJACENY ORDER IS IN THE CUT; ! THE FOLLOWING CODE SEGMENT PRINTS THESE ARCS: ! ! DO 2 K=1,NODES ! IBEG=IABS(DNFAPT(K)) ! IEND=IABS(DNFAPT(K+1))-1 ! DO 1 I=IBEG,IEND ! IF(DNFADJ(I).LT.0)PRINT THE ARC ! 1 CONTINUE ! 2 CONTINUE ! ! (SEE NOTE 1 BELOW). ! ! DNCAP: THE ORIGINAL CAPACITIES, UNALTERED. ! ! DNFLOW: NARCS-LONG INTEGER *4 ARRAY WHICH GIVES FLOWS ON ARCS, IN ! FORWARD ADJACENCY ORDER. ! ! DNBAPT: (NODES+1)-LONG INTEGER *4 POINTER ARRAY FOR BACKWARD ! ADJACENCY LISTS (I.E. THE FORWARD ADJACENCY LIST OF ! NODE I IS THE SET OF ARCS ! {(DNBADJ(J),J): J=DNBAPT(I),...,DNBAPT(I+1)-1 }. ! NOTE: WE MUST HAVE DNBAPT(NODES+1) = NARCS+1. ! ! DNBADJ: NARCS-LONG INTEGER *2 ARRAY GIVING THE BACKWARD ADJACENCY ! LIST OF EACH NODE J, ONE AFTER THE OTHER, AS DESCRIBED ! ABOVE (ALSO SEE NOTE 2 BELOW). ! ! DNBTOF: NARCS-LONG INTEGER *4 ARRAY GIVING THE BACKWARD ADJACENCY ! TO FORWARD ADJACENCY MAPPING, I.E. THE J-TH ARC ! IN THE BACKWARD ADJACENCY ORDER IS THE DNBTOF(J)-TH ! ARC IN THE FORWARD ADJACENCY ORDER. ! !*********************************************************************** ! ! INTERNAL SCRATCH ARRAYS (IN COMMON): ! ! DNLIST: (NODES+1)-LONG INTEGER *2 ARRAY USED AS FOLLOWS: ! 1) AS THE QUEUE IN BFS SEARCH FOR CONSTRUCTING THE ! LAYERED GRAPH (SUBR. DNBFS). ! 2) AS THE "PARENT" ARRAY IN DFS SEARCH OF LAYERED ! GRAPH (SUBR: DNDFS, DNPUSH). ! 3) AS SCRATCH IN CONSTRUCTING FWD ADJACENCIES ! (SUBR DNFWD), AND BWD ADJACENCIES (SUBR. DNSUB). ! ! DNFLAB: NODES-LONG INTEGER *4 ARRAY USED IN DFS SEARCH OF ! LAYERED GRAPH TO STORE THE FLOW LABEL FOR EACH NODE ! (SEE ARRAY DNDIST() ). ! ! DNDIST: NODES-LONG INTEGER *2 ARRAY USED IN CONSTRUCTING THE ! LAYERED GRAPH BY BFS, STORING THE DISTANCE OF EACH ! NODE FROM THE SOURCE; DNDIST(ISOURC)=0 (EQUIVALENCED ! TO THE INTEGER *4 ARRAY DNFLAB() ). ! ! DNPTRF: NODES-LONG INTEGER *4 STATUS AND POINTER ARRAY, I.E. ! DNPTRF(K)=0 IF THERE ARE NO OPEN ARCS LEAVING NODE K ! IN THE REPRESENTATION OF THE LAYERED ! NETWORK. ! >0 THE ARC INDEX, IN 'FA' ORDER, THAT ! CORRESPONDS TO THE LAST ARC IN THE ! FWD ADJACENCY OF K WHICH IS SCANNED ! BACKWARD. ! ! DNPTRB: NODES-LONG INTEGER *4 STATUS AND POINTER ARRAY, I.E. ! DNPTRB(K)=0 IF THERE ARE NO OPEN ARCS ENTERING NODE K ! IN THE REPRESENTATION OF THE LAYERED ! NETWORK. ! >0 THE ARC INDEX (IN 'BA' ORDER) OF THE FIRST ! ARC IN THE BWD ADJACENCY OF K TO BE ! SCANNED IN LIFO ORDER. ! !*********************************************************************** ! ! NOTES:1) DNFADJ(J) IS INTERNALLY NEGATED TO MARK THE J-TH ARC (IN ! FORWARD ADJACENCY ORDER) AS 'CLOSED'. BEFORE RETURNING ! TO THE CALLING PGM, THESE MARKINGS ARE DISCARDED, AND SOME ! ELEMENTS OF DNFADJ(.) ARE NEGATED TO REFLECT THE OUTPUT ! SPECIFICATION DESCRIBED ABOVE. ! ! 2) DNBADJ(J) IS INTERNALLY NEGATED TO MARK THE J-TH ARC ! (IN BACKWARD ADJACENCY ORDER) AS 'CLOSED'. ! ! 3) THE USER MUST PROVIDE A TIMING SUBROUTINE THAT RETURNS ! THE CURRENT TIME IN VARIABLE ' T ', IN SECONDS. SUCH ! A SUBROUTINE IS INSTALLATION-DEPENDENT AND IS NOT GIVEN HERE. ! IF THIS CANNOT BE DONE, PROVIDE THE FOLLOWING SUBROUTINE AND ! FORGET THE EXECUTION TIMING INFORMATION: ! ! SUBROUTINE GETIME(T) ! REAL T ! T=0.0 ! RETURN ! END ! !*********************************************************************** ! ! SUBROUTINES CALLED: DNBFS, DNDFS, DNCUT, GETIME,DNCLEA ! !*********************************************************************** ! ! NAMES COLLECTIVELY RESERVED BY ALL DNSUB SUBROUTINES: ! ! DN00, DN01, DN02, DN03, DN04, DN05, DN06, DN08, DN09, DN10, DN11, ! DN12, DNARC, DNAUG, DNBADJ, DNBAPT, DNBFS, DNBTOF, DNCAP, DNCLEA, ! DNCUT, DNDFS, DNDIST, DNFADJ, DNPUSH, DNFAPT, DNFLAB, DNFLOW, ! DNFROM, DNFVA, DNFWD, DNGCAP, DNIBIG, DNLAUG, DNLFVA, DNLIST, ! DNNODE, DNNOP2, DNOUT, DNPTRB, DNPTRF, DNSINK, DNSRCE, DNSTGE, ! DNSUB, DNELTM, DNTO. ! !********************************************************************** ! INITIALIZATION: ! TIMBEG=0.0 IRETN = 0 DNIBIG = 2147483647 ! DNIBIG=32767 DNARC = NARCS DNNODE = NODES DNNOP2 = DNNODE + 2 DNSRCE = ISOURC DNSINK = ISINK DO 200 I4 = 1, DNARC 200 DNFLOW (I4) = 0 !*********************************************************************** ! ! USING THE FORWARD ADJACENCY ARRAYS DNFAPT(.) AND DNFADJ(.) (IN ! COMMON), CREATE THE BACKWARD ADJACENCY ARRAYS DNBAPT(.), DNBADJ(.) ! AND THE BACKWARD TO FORWARD ADJACENCY MAPPING DNBTOF(.). DNLIST(.) IS ! USED HERE AS A SCRATCH ARRAY. ! NODP12 = DNNODE + 1 DO 210 I2 = 1, NODP12 DNLIST (I2) = 0 210 DNBAPT (I2) = 0 ! TEMPORARILY STORE IN DNBAPT(.) NUMBER OF ARCS INTO EACH NODE: DO 230 I2 = 1, DNNODE IBEG4 = DNFAPT (I2) IEND4 = DNFAPT (I2+1) - 1 DO 220 I4 = IBEG4, IEND4 JJDN = DNFADJ (I4) 220 DNBAPT (JJDN) = DNBAPT (JJDN) + 1 230 CONTINUE ! CONSTRUCT DNBAPT(.): IHPI4 = DNBAPT (1) DNBAPT (1) = 1 DO 240 I2 = 1, DNNODE IHPSV4 = IHPI4 + DNBAPT (I2) IHPI4 = DNBAPT (I2+1) 240 DNBAPT (I2+1) = IHPSV4 ! CONSTRUCT DNBADJ(.) AND DNBTOF(.): DO 260 I2 = 1, DNNODE IBEG4 = DNFAPT (I2) IEND4 = DNFAPT (I2+1) - 1 DO 250 I4 = IBEG4, IEND4 IHEAD2 = DNFADJ (I4) IHPUT4 = DNBAPT (IHEAD2) + DNLIST (IHEAD2) IF (IHPUT4 .LE. 0) GOTO1900 DNBADJ (IHPUT4) = I2 DNBTOF (IHPUT4) = I4 250 DNLIST (IHEAD2) = DNLIST (IHEAD2) + 1 260 CONTINUE ! !*********************************************************************** ! DNFVA = 0 DNAUG = 0 DNSTGE = 1 ! ! STAGE LOOP: 300 CONTINUE ! FORM NEW LAYERED NETWORK W.R.T. CURRENT FEASIBLE FLOW. CALL DNBFS (LAYMAX) IF (LAYMAX .GT. 0) GOTO1500 ! COMPUTE A MAXIMAL FLOW IN THIS LAYERED NET: CALL DNDFS ! UPDATE FLOW VALUE: DNFVA = DNFVA + DNLFVA DNAUG = DNAUG + DNLAUG DNSTGE = DNSTGE + 1 ! ERASE MARKINGS THAT DEFINE LAYERED NETWORK: CALL DNCLEA GOTO300 !*********************************************************************** ! ! CURRENT FLOW IS MAXIMUM: 1500 MAXFLO = DNFVA NUMAUG = DNAUG NUMSTG = DNSTGE CALL DNCLEA ! MARK EXECUTION TIME: TIMEND=0.0 DNELTM = TIMEND - TIMBEG ELTIM = DNELTM ! ! MARK THE MIN CUT-SET IN DNFAPT(.) AND DNFADJ(.): CALL DNCUT (NNCUT, NACUT) ! RETURN ! 1900 IRETN = 1 RETURN END SUBROUTINE ! SUBROUTINE DNBFS (LAYMAX) ! INTEGER LAYMAX ! INTEGER NODP12, I2, II2, K2, J2, IHEAD2, ITAIL2, QHEAD2, QTAIL2, KP2, KSAT2, K2DST, & & K2DP1, MAXD2 ! !******************************************************************* ! ! CALLING CONDITIONS: ! INTERNAL CALL FROM DNSUB ONLY. ! INPUT ARRAYS: ! DNFAPT, DNBAPT, DNFADJ, DNBADJ, DNBTOF, DNCAP, DNFLOW ! SCRATCH ARRAYS: ! DNLIST ! OUTPUT: ! IN CALLING SEQUENCE (INTEGER *2): ! LAYMAX: 0 (LAYERED NET COMPLETE WITH SINK IN LAST LAYER.) ! 1 (LAST LAYER IS EMPTY; CURRENT FLOW IN ORIGINAL ! NETWORK IS MAXIMUM.) ! IN COMMON (ARRAYS): ! DNPTRF, DNPTRB, DNDIST !*********************************************************************** ! ! THIS SUBROUTINE CONSTRUCTS THE LAYERED NETWORK OF THE RESIDUAL ! NETWORK W.R.T. THE CURRENT FLOW. THE RESIDUAL NETWORK IS ! INFERRED, AND THE LAYERED NETWORK IS ONLY RECORDED BY TEMPORARY ! MARKERS ON THE ORIGINAL GRAPH. THE SUBROUTINE IMPLEMENTS A ! BREADTH-FIRST SEARCH ON THE RESIDUAL NETWORK, I.E. NODES ARE ! PROCESSED AS IN A QUEUE. SUCH A SEARCH PARTITIONS THE NODES INTO ! A SET OF 'LAYERS', ACCORDING TO THEIR CARDNALITY DISTANCE FROM ! THE source. THE DNDIST(.) ARRAY IS USED TO RECORD THESE DISTANCES, ! AND THUS DEFINES THE LAYERS (NOTE: DNDIST(ISOURC)=0). ! ! IN SELECTING ARCS OF THE RESIDUAL NETWORK THAT ARE DIRECTED FROM ! ONE LAYER TO THE NEXT, WE SHALL MARK THE ARCS IN THE ORIGINAL ! NETWORK AS 'OPEN' OR 'CLOSED'. A 'CLOSED' ARC (V,W) IN THE ! LAYERED NETWORK IS EITHER AN ARC I=(V,W) THAT IS SATURATED IN THE ! ORIGINAL NETWORK, OR AN ARC I=(W,V) OF THE ORIGINAL NETWORK WITH ! ZERO FLOW. IN THE FORMER CASE, THE ABSENCE OF THIS ARC FROM THE ! LAYERED NETWORK IS MARKED BY NEGATING DNFADJ(I), AND IN THE LATTER ! CASE, BY NEGATING DNBADJ(I). AN 'OPEN' ARC I=(V,W) FOR THE LAYERED ! NETWORK EITHER HAS POSITIVE RESIDUAL CAPACITY, OR ARC (W,V) HAS ! POSITIVE FLOW, IN THE ORIGINAL NETWORK. IF A NODE V HAS NO OPEN ! ARCS IN THE LAYERED NETWORK THAT ARE IN THE FORWARD ADJACENCY LIST ! OF V IN THE ORIGINAL NETWORK, THEN WE SET DNPTRF(V)=0; AND IF IT HAS ! NO OPEN ARCS THAT ARE IN THE BACKWARD ADJACENCY LIST OF V IN THE ! ORIGINAL NETWORK, WE SET DNPTRB(V)=0. ! ! IN THIS BFS SEARCH WE ONLY USE OPEN ARCS THAT LEAD US TO NEW ! NODES, OR TO NODES THAT HAVE ALREADY BEEN PLACED IN THE NEXT ! LAYER. INITIALLY, THE QUEUE CONTAINS ONLY THE source. AS THE ! VERTICES ARE POPPED FROM THE QUEUE AND SCANNED, NEW NODES ARE ! INJECTED INTO THE QUEUE. EVENTUALLY, EITHER THE SINK IS REACHED, ! OR SOME VERTICES ARE NOT REACHABLE WITH OPEN ARCS FROM THE ! CURRENT LAYER. IN THE FORMER CASE THE LAYERED NETWORK FOR THE ! CURRENT STAGE IS COMPLETE, AND THUS A FLOW AUGMENTATION IS ! POSSIBLE. IN THE LATTER CASE, THE CURRENT FLOW ON THE ORIGINAL ! NETWORK IS MAXIMUM, AND THE RUN TERMINATES. ! ! THE QUEUE IS MAINTAINED IN THE LIST DNLIST(.) WITH TWO POINTERS, ! AS SHOWN: ! ------------------------------------------- ! ARRAY | NODES TO BE SCANNED | ! DNLIST(.): ... | | ! ------------------------------------------- ! ^ ^ ! | | ! QHEAD2 QTAIL2 !******************************************************************* ! ! INITIALIZE: DO 10 I2 = 1, DNNODE DNPTRF (I2) = 0 DNPTRB (I2) = 0 10 DNDIST (I2) = DNNOP2 DNDIST (DNSRCE) = 0 ! PUT source INTO QUEUE: QHEAD2 = 0 QTAIL2 = 1 DNLIST (1) = DNSRCE MAXD2 = DNNODE - 1 ! ! SCAN EACH NODE IN QUEUE: ! !--------------- ! 100 IF (QHEAD2 .EQ. QTAIL2) GOTO2000 QHEAD2 = QHEAD2 + 1 ! POP NODE IN FRONT OF QUEUE: K2 = DNLIST (QHEAD2) K2DST = DNDIST (K2) IF (K2DST .GE. MAXD2) GOTO100 K2DP1 = K2DST + 1 ! ! SCAN NODE K2, I.E. SEARCH OVER FWD ADJACENCY OF K2 AND FOR ARCS ! (K2,J2) SUCH THAT J2 IS UNSCANNED AND J2 IS NOT IN THE QUEUE AND ! ARC (K2,J2) HAS POSITIVE RESIDUAL CAPACITY IN ORIGINAL NETWORK. ! 'J2 UNSCANNED' IS CHECKED BY THE CONDITION: 'DNDIST(J2)>=DNDIST(K2)'. ! 'J2 NOT IN QUEUE' IS CHECKED BY THE CONDITION ! 'DNDIST(J2)=DNDIST(K2)+1 FOR A SCANNED J2'. ! IBEG4 = DNFAPT (K2) IEND4 = DNFAPT (K2+1) - 1 IF (IBEG4 .GT. IEND4) GOTO1000 DO 400 I4 = IBEG4, IEND4 J2 = DNFADJ (I4) IF (DNDIST(J2) .LE. K2DST) GOTO300 IF (DNCAP(I4) .LE. DNFLOW(I4)) GOTO300 ! (IMPLICITLY) MARK ARC (K2,J2) AS OPEN IN LAYERED NETWORK; ALSO, ! SAVE ITS INDEX IN DNPTRF(.): DNPTRF (K2) = I4 IF (J2 .NE. DNSINK) GOTO200 ! J2=SINK: MAXD2 = K2DP1 DNDIST (J2) = MAXD2 GOTO400 ! APPEND NODE J2 TO THE QUEUE, IF NOT ALREADY THERE: 200 IF (DNDIST(J2) .EQ. K2DP1) GOTO400 DNDIST (J2) = K2DP1 QTAIL2 = QTAIL2 + 1 DNLIST (QTAIL2) = J2 GOTO400 ! (EXPLICITLY) MARK ARC (K2,J2) AS CLOSED IN LAYERED NETWORK: 300 DNFADJ (I4) = - DNFADJ (I4) 400 CONTINUE ! !--------------- ! ! IF SINK WAS REACHED, DON'T NEED TO SCAN BACKWARD ARCS INTO ITS LAYER: 1000 IF (DNDIST(DNSINK) .NE. DNNOP2) GOTO100 ! ! ELSE, CONTINUE SCAN OVER FORWARD ARCS OUT OF K2 IN THE RESIDUAL ! NETWORK (WHICH ARE BACKWARD ARCS OF THE ORIGINAL NETWORK WITH ! POSITIVE FLOW). THIS CODE SEGMENT IS ANALOGOUS TO THE ONE ABOVE: ! IBEG4 = DNBAPT (K2) IEND4 = DNBAPT (K2+1) - 1 IF (IBEG4 .GT. IEND4) GOTO100 DO 1400 I4 = IBEG4, IEND4 J2 = DNBADJ (I4) IF (DNDIST(J2) .LE. K2DST) GOTO1300 JJDN = DNBTOF (I4) IF (DNFLOW(JJDN) .LE. 0) GOTO1300 DNPTRB (K2) = I4 IF (DNDIST(J2) .EQ. K2DP1) GOTO1400 DNDIST (J2) = K2DP1 QTAIL2 = QTAIL2 + 1 DNLIST (QTAIL2) = J2 GOTO1400 1300 DNBADJ (I4) = - DNBADJ (I4) 1400 CONTINUE GOTO100 ! !--------------- ! 2000 LAYER2 = LAYER2 + 1 LAYP12 = LAYER2 + 1 ! HERE, ALL NODES IN QUEUE HAVE BEEN PROCESSED. ! IF THE SINK WAS REACHED, THE LAYERED NETWORK IS COMPLETE: LAYMAX = 0 IF (DNDIST(DNSINK) .NE. DNNOP2) RETURN ! ELSE, THE CURRENT FLOW IS MAXIMUM: LAYMAX = 1 RETURN ! END SUBROUTINE ! SUBROUTINE DNDFS ! INTEGER NODP12, I2, II2, K2, J2, IHEAD2, ITAIL2, QHEAD2, QTAIL2, KP2, KSAT2, LAYMAX, K2DST, & & K2DP1, MAXD2 ! !*********************************************************************** ! ! THIS SUBROUTINE FINDS A MAXIMAL FLOW IN THE LAYERED NETWORK. IT ! USES A DEPTH-FIRST SEARCH STARTING FROM THE SOURCE AND RECORDS ! THE DFS TREE BY THE PREDECESSOR ARRAY DNLIST(.) AND FLOW LABEL ! ARRAY DNFLAB(.). LAYERED NETWORK ARCS THAT ARE FORWARD IN THE ! ORIGINAL NETWORK ARE SEARCHED BEFORE BACKWARD ARCS. THE ! FORWARD AND BACKWARD ADJACENCIES OF A NODE K2 ARE SCANNED IN LIFO ! ORDER, STARTING FROM THE LAST ARC THAT WAS VISITED DURING A ! PREVIOUS SCAN OF K2. THUS, WITH THE AID OF THE TWO POINTER LISTS ! DNPTRF(.) AND DNPTRB(.), THE ADJACENCY LISTS OF THE ORIGINAL ! NETWORK ARE SCANNED ONLY ONCE BY THIS SUBROUTINE. DNPTRF(K2)=0 ! IMPLIES THAT NODE K2 HAS NO OUTGOING UNSCANNED ARCS; DNPTRB(K2)=0 ! IMPLIES THAT NODE K2 HAS NO INCOMING UNSCANNED ARCS; A 'CLOSED' ! NODE IS DETECTED BY THE CONDITION DNPTRF(K2)=DNPTRB(K2)=0. ! !*********************************************************************** ! ! CALLING CONDITIONS: ! INTERNAL CALL FROM DNSUB ONLY. ! INPUT ARRAYS: ! DNPTRB, DNPTR, DNBTOF, DNCAP, DNFLOW, DNBADJ, DNFADJ ! OUTPUT ARRAYS: ! DNPTRF, DNPTRB, DNLIST, DNFLAB. !*********************************************************************** ! ! SUBROUTINES CALLED: DNPUSH ! !*********************************************************************** ! K2 = DNSRCE DNLFVA = 0 DNLAUG = 0 DNFLAB (K2) = DNIBIG ! !----------- ! ! SCAN NODE K2: ! 100 IF (DNPTRF(K2) .EQ. 0) GOTO1000 ! FIND AN OPEN ARC FROM K2 TO SOME NODE J2: SCAN THE ! FORWARD ADJACENCY LIST OF K2, STARTING FROM DNPTRF(K2) AND ! PROCEEDING BACKWARD ON DNFADJ() TOWARD DNFAPT(K2): I4 = DNPTRF (K2) IPT4 = DNFAPT (K2) 300 J2 = DNFADJ (I4) IF (J2 .GE. 0) GOTO600 400 I4 = I4 - 1 IF (I4 .GE. IPT4) GOTO300 ! NO OPEN ARCS OUT OF K2; MARK K2 AS CLOSED: DNPTRF (K2) = 0 GOTO1000 ! AN OPEN ARC FOUND; MOVE POINTER DNPTRF() TO THIS ARC; ! EXTEND DFS TREE TO NODE J2: 600 DNPTRF (K2) = I4 DNFLAB (J2) = DNFLAB (K2) IF (DNCAP(I4)-DNFLOW(I4) .LT. DNFLAB(J2)) DNFLAB (J2) = DNCAP (I4) - DNFLOW (I4) DNLIST (J2) = K2 K2 = J2 ! IF NODE K2 (FORMERLY J2) IS THE SINK, AUGMENT FLOW; GET NEW K2: IF (K2 .EQ. DNSINK) CALL DNPUSH (K2) GOTO100 ! !----------- ! 1000 IF (DNPTRB(K2) .EQ. 0) GOTO2000 ! SCAN BACKWARD ARCS INTO K2 TO FIND AN OPEN ARC: I4 = DNPTRB (K2) IPT4 = DNBAPT (K2) 1300 J2 = DNBADJ (I4) IF (J2 .GE. 0) GOTO1600 I4 = I4 - 1 IF (I4 .GE. IPT4) GOTO1300 ! NO OPEN ARC INTO K2: DNPTRB (K2) = 0 GOTO2000 ! AN OPEN ARC FOUND; EXTEND DFS TREE TO NODE J2: 1600 DNPTRB (K2) = I4 DNFLAB (J2) = DNFLAB (K2) JJDN = DNBTOF (I4) IFL4 = DNFLOW (JJDN) IF (IFL4 .LT. DNFLAB(J2)) DNFLAB (J2) = IFL4 DNLIST (J2) = - K2 K2 = J2 GOTO100 ! !----------- ! ! K2 IS 'CLOSED' NODE; IF IT IS THE source, THEN WE HAVE A MAXIMAL ! FLOW IN LAYERED NETWORK: 2000 IF (K2 .EQ. DNSRCE) RETURN ! ELSE, BACK UP ONE NODE FROM K2 IN DFS TREE: KP2 = DNLIST (K2) K2 = KP2 IF (K2 .LT. 0) K2 = - K2 IF (KP2 .GE. 0) GOTO2200 I4 = DNPTRB (K2) DNBADJ (I4) = - DNBADJ (I4) GOTO100 2200 I4 = DNPTRF (K2) DNFADJ (I4) = - DNFADJ (I4) GOTO100 ! !----------- END SUBROUTINE ! SUBROUTINE DNPUSH (K2) ! INTEGER NODP12, I2, II2, K2, J2, IHEAD2, ITAIL2, QHEAD2, QTAIL2, KP2, KSAT2, LAYMAX, K2DST, & & K2DP1, MAXD2 ! !*********************************************************************** ! ! AUGMENT FLOW ALONG FLOW AUGMENTING PATH DEFINED SUBROUTINE DNDFS, I.E. ! USING THE PREDECESSOR ARRAY DNLIST(.), START FROM THE SINK AND ! TRAVERSE TO THE SOURCE ARC FLOWS AND FLOW LABELS BY AN AMOUNT EQUAL ! TO DNFLAB(DNSINK). MARK SATURATED FORWARD (FROM S TO T) ARCS, AND ! BACKWARD ARCS HAVING ZERO FLOW, AS CLOSED. ! !*********************************************************************** ! ! CALLING CONDITIONS: ! INTERNAL CALL FROM DNDFS ONLY. ! INPUT ARRAYS: ! DNFLAB,DNLIST,DNPTRB,DNPTRF,DNBTOF,DNCAP,DNFLOW,DNBADJ,DNFADJ ! OUTPUT ARRAYS: ! DNFLAB,DNFLOW,DNBADJ,DNFADJ !*********************************************************************** ! KSAT2 = 0 J2 = DNSINK INCRE4 = DNFLAB (J2) DNLFVA = DNLFVA + INCRE4 DNLAUG = DNLAUG + 1 ! 100 K2 = J2 J2 = DNLIST (K2) DNFLAB (K2) = DNFLAB (K2) - INCRE4 IF (J2 .GT. 0) GOTO200 ! ! DECREASE FLOW ON BACKWARD ARC (K2,J2): J2 = - J2 I4 = DNPTRB (J2) II4 = DNBTOF (I4) DNFLOW (II4) = DNFLOW (II4) - INCRE4 IF (DNFLOW(II4) .NE. 0) GOTO100 ! FLOW IS ZERO; MARK ARC AS 'CLOSED' IN LAYERED NETWORK: DNBADJ (I4) = - DNBADJ (I4) KSAT2 = J2 GOTO100 ! ! INCREASE FLOW ON FORWARD ARC (J2,K2): 200 I4 = DNPTRF (J2) DNFLOW (I4) = DNFLOW (I4) + INCRE4 IF (DNCAP(I4) .NE. DNFLOW(I4)) GOTO300 ! ARC IS NOW SATURATED; MARK IS AS 'CLOSED' IN LAYERED NET DNFADJ (I4) = - DNFADJ (I4) KSAT2 = J2 300 IF (J2 .NE. DNSRCE) GOTO100 ! ! RETURN TO RESUME SEARCH FROM K2 (NODE CLOSEST TO source OF ! THE ARC CLOSED LAST) IF (KSAT2 .EQ. 0) STOP K2 = KSAT2 RETURN END SUBROUTINE ! SUBROUTINE DNCLEA ! INTEGER NODP12, I2, II2, K2, J2, IHEAD2, ITAIL2, QHEAD2, QTAIL2, KP2, KSAT2, LAYMAX, K2DST, & & K2DP1, MAXD2 ! !******************************************************************* ! CALLING CONDITIONS: ! INTERNAL CALL FROM DNSUB ONLY. ! INPUT (IN COMMON): ! SCALARS: DNARC ! ARRAYS: DNFADJ, DNBADJ ! OUTPUT: ! ARRAYS (IN COMMON): DNFADJ, DNBADJ !******************************************************************** ! ! CLEAR MARKINGS IN ARRAYS DNFADJ() AND DNBADJ().: DO 100 I4 = 1, DNARC IF (DNBADJ(I4) .LT. 0) DNBADJ (I4) = - DNBADJ (I4) IF (DNFADJ(I4) .LT. 0) DNFADJ (I4) = - DNFADJ (I4) 100 CONTINUE RETURN END SUBROUTINE ! SUBROUTINE DNCUT (NNCUT, NACUT) ! INTEGER NNCUT, NACUT ! INTEGER NODP12, I2, II2, K2, J2, IHEAD2, ITAIL2, QHEAD2, QTAIL2, KP2, KSAT2, LAYMAX, K2DST, & & K2DP1, MAXD2 ! !*********************************************************************** ! CALLING CONDITIONS: ! ONLY AFTER A SUCCESSFUL RETURN FROM A CALL TO DNSUB. ! INPUT ARRAYS: ! DNFAPT, DNFADJ, DNCAP,DNFLOW, DNDIST ! OUTPUT ARRAYS: ! DNFAPT,DNFADJ ! PASSED IN CALLING SEQUENCE: ! NNCUT: NUMBER OF NODES ON source SIDE OF FINAL CUT (INTEGER *4) ! NACUT: NUMBER OF ARCS IN THE FINAL CUT (INTEGER *4) !*********************************************************************** ! ! NEGATE DNFAPT(.) FOR NODES ON SINK SIDE OF CUT: NNCUT = 0 DO 1700 I2 = 1, DNNODE IF (DNDIST(I2) .NE. DNNOP2) GOTO1650 DNFAPT (I2) = - IABS (DNFAPT(I2)) GOTO1700 1650 NNCUT = NNCUT + 1 1700 CONTINUE ! NEGATE DNFADJ(.) FOR THOSE SATURATED ARCS IN MIN CUT: NACUT = 0 DO 1900 I2 = 1, DNNODE IF (DNFAPT(I2) .LT. 0) GOTO1900 ! NODE I2 IS ON source SIDE: IBEG4 = IABS (DNFAPT(I2)) IEND4 = IABS (DNFAPT(I2+1)) - 1 DO 1800 I4 = IBEG4, IEND4 JJDN = DNFADJ (I4) IF (DNFAPT(JJDN) .GT. 0) GOTO1800 ! NODE DNFADJ(I4) ON SINK SIDE: IF (DNFLOW(I4) .NE. DNCAP(I4)) GOTO1800 II2 = DNFADJ (I4) DNFADJ (I4) = - IABS (II2) NACUT = NACUT + 1 1800 CONTINUE 1900 CONTINUE RETURN END SUBROUTINE END SUBROUTINE MinCut_F77 SUBROUTINE SDKSTR (A, ND, LNGT, D, P, Q, NMAX, MMAX, N, INF, R) !*********************************************************************** ! ! ROUTINE SDKSTR ! ! 1) FINDS A SHORTEST PATH TREE ROOTED AT NODE R AND THE SHORTEST ! DISTANCES ! 2) IS BASED ON DIJKSTRA'S METHOD, WITH PRIORITY QUEUE Q IMPLEMENTED ! AS AN UNORDERED LIST ! ! MEANING OF THE INPUT PARAMETERS: ! ! A(I) = POINTER TO ARC-LIST OF NODE I, I=1,2,...,N+1 ! ND(J) =ENDING NODE OF ARC J, J=1,2,...,M ! LNGT(J) = LENGTH OF ARC J, J=1,2,...,M ! NMAX = DIMENSION OF ARRAYS A(.), D(.), P(.), Q(.), HP(.) ! MMAX = DIMENSION OF ARRAYS ND(.), LNGT(.) ! N = NUMBER OF NODES ! INF = VERY LARGE INTEGER VALUE (INFINITY) ! R = ROOT ! ! MEANING OF THE OUTPUT PARAMETERS: ! ! D(I) = SHORTEST DISTANCE FROM R TO I, I=1,2,...,N ! P(I) = PREDECESSOR NODE OF I IN THE SHORTEST PATH TREE, I=1,2,...,N ! ! MEANING OF THE MAIN INTERNAL PARAMETERS: ! ! Q(I) = LIST OF THE CANDIDATE NODES: = 0 IF NODE I IS NOT IN Q ! J IF NODE I PRECEDES NODE J IN Q ! NN = N+1 ! U = CURRENT NODE ! V = ENDING NODE OF THE CURRENT ARC ! INIT = START-POINTER TO THE ARC-LIST OF THE CURRENT NODE ! IFIN = END-POINTER TO THE ARC-LIST OF THE CURRENT NODE ! DV = TENTATIVE LABEL OF NODE V ! ! ALL THE PARAMETERS ARE INTEGER ! !*********************************************************************** INTEGER A, D, P, Q, R, U, V, DV, VAL DIMENSION A (NMAX), D (NMAX), P (NMAX), Q (NMAX), ND (MMAX), & LNGT (MMAX) ! ! INITIALIZE ! DO 10 I = 1, N D (I) = INF 10 END DO D (R) = 0 P (R) = 0 NN = N + 1 Q (NN) = NN U = R ! ! EXPLORE THE FORWARD STAR OF U ! 20 INIT = A (U) IFIN = A (U + 1) - 1 ! WRITE(*,*) A ! WRITE(*,*) "Root:", U, INIT, IFIN IF (IFIN.LT.INIT) GOTO 40 DO 30 J = INIT, IFIN V = ND (J) DV = D (U) + LNGT (J) ! WRITE(*,*) V, DV, D(V) ! ! CHECK WHETHER THE LABEL OF V CAN BE IMPROVED ! IF (D (V) .LE.DV) GOTO 30 D (V) = DV P (V) = U ! ! IF V IS NOT IN Q, INSERT V AT THE HEAD OF Q ! IF (Q (V) .NE.0) GOTO 30 Q (V) = Q (NN) Q (NN) = V 30 END DO ! ! CHECK WHETHER THE LIST IS EMPTY ! 40 IF (Q (NN) .EQ.NN) THEN ! WRITE(*,*) "Que is empty!" GOTO 70 END IF ! ! SEARCH THE MINIMUM LABEL NODE IN Q ! K = 0 I = NN VAL = INF 50 JJQ = Q (I) IF (D (JJQ) .GE.VAL) GOTO 60 VAL = D (JJQ) K = I 60 I = Q (I) IF (Q (I) .NE.NN) GOTO 50 ! ! REMOVE THE NEW CURRENT NODE U FROM Q ! U = Q (K) Q (K) = Q (U) Q (U) = 0 GOTO 20 70 CONTINUE RETURN END SUBROUTINE SDKSTR