A.6. A FORTRAN IV Listing of Program DAMBLD
219
SUBROUTINE NETFLO
Q
««»«««««««««««««*««««««
J
p
C«*»* OIMENSION * COMMON * INTEGER * REAL AND LOGICAL STATEMENTS
J
3
COMMON /UNO/ 1(250)* J<250)» COST(250)* L0(250)* FLOW(250)* PI(250
J
4
1)
J
5
COMMON /UNOSA/ HI(300)
J
6
COMMON /DOS/ NODES* ARCS* INFES• IRET
J
7
DIMENSION NA(300)t NB(300)
J
θ
LOGICAL INFES
J
9
INTEGER Α· AOK· C» COK* DEL* E* EPS* INF* LAB* N* NI* NJ» SRC* SNK
J
10
1* FLOW* PI* NA* NODES* ARCS* I* J* COST* HI* LO* NB
J
11
C*«#» CHECK FEASIBILITY OF FORMULATION
J
12
INFES = .TRUE.
J
13
DO 10 A S 1 * ARCS
J
14
IF (LO(A) .GT. HI(A)) GO TO 200
J
15
10
CONTINUE
J
16
C«*»* SET INF TO MAX AVAILABLE INTEGER
J
17
INF = 999999
J
18
AOK =0
J
19
C*»«* FIND OUT OF KRTFR ARC
J
20
20
DO 30 A = 1* ARCS
J
21
ΙΑ = Τ(A)SJA = J(A)
J
22
C = C0ST(A)*PI(IA)-PI(JA)
J
23
C«**» ARC IS IN STATE A1*B1 OR CI
IF ((FLOW(A) .LT. LO(A)) .OR. (C .LT. 0 .AND. FLOW(A) .LT. HI(A)))
J
24
1 GO TO 40
J
25
C«*»* ARC IS NI STATE A2*B2 OR C2
IF ((FLOW(A) .GT. HKA)) .OR. (C .GT. 0 .AND. FLOW(A) .GT. LO(A)))
J
26
1 GO ΓΟ 50
J
27
30
CONTINUE
J
28
C*»«* NO REMAINING OUT OF KILTER ARCS
J
29
GO TO 230
J
30
C«#*» FLOW MUST BE INCREASED IN THE ARC TO BRING IT INTO KILTER
40
SRC = J(A)
J
31
SNK s 1(A)
J
32
Ε = •1
J
33
GO TO 60
J
34
C*«** FLOW MUST BE DECREASED IN THE ARC TO BRING IT INTO KILTER
50
SRC = 1(A)
J
35
SNK = J(A)
J
36
Ε = -1
J
37
GO TO 60
J
38
C*««» ATTEMPT TO BRING OUT OF KILTER ARCS INTO KILTER
J
39
60
IF ((A .EQ. AOK) .AND. (NA(SRC) .NE. 0)) GO TO 80
J
40
AOK = A
J
41
DO 70 Ν = li NODES
J
42
ΝΑ(N) =0
J
43
70
NB(N) =0
J
44
NA(SRC) = IABS(SNK)*E
J
45
NB(SRC) = IABS(AOK)*E
J
46
80
COK = C
J
47
90
LAB =0
J
48
DO 120 A s 1* ARCS
J
49
ΙΑ = I (A)$JA = J(A)
J
50
C««*« BOTH NODES OF THE ARC ARE EITHER LABFLED OR UNLABELED
IF ((ΝΑ(IA) .EQ. 0 .AND. NA(JA) .EQ. 0) .OR. (NA(IA) .NE. 0 .. AND
J
51
l.NA(JA) .NE. 0)) GO TO 120
J
52
C = COST(A)*PI(IA)-PI(JA)
J
53
C*«»» I-TH NODE IS NOT LABELED
IF (NA(IA) .EQ. 0) GO TO 100
J
54
C«#«« ARC FLOW CANNOT BE INCREASED WITHOUT DRIVING IT (MORE) OUT OF KILTER
219
SUBROUTINE NETFLO
Q
««»«««««««««««««*««««««
J
p
C«*»* OIMENSION * COMMON * INTEGER * REAL AND LOGICAL STATEMENTS
J
3
COMMON /UNO/ 1(250)* J<250)» COST(250)* L0(250)* FLOW(250)* PI(250
J
4
1)
J
5
COMMON /UNOSA/ HI(300)
J
6
COMMON /DOS/ NODES* ARCS* INFES• IRET
J
7
DIMENSION NA(300)t NB(300)
J
θ
LOGICAL INFES
J
9
INTEGER Α· AOK· C» COK* DEL* E* EPS* INF* LAB* N* NI* NJ» SRC* SNK
J
10
1* FLOW* PI* NA* NODES* ARCS* I* J* COST* HI* LO* NB
J
11
C*«#» CHECK FEASIBILITY OF FORMULATION
J
12
INFES = .TRUE.
J
13
DO 10 A S 1 * ARCS
J
14
IF (LO(A) .GT. HI(A)) GO TO 200
J
15
10
CONTINUE
J
16
C«*»* SET INF TO MAX AVAILABLE INTEGER
J
17
INF = 999999
J
18
AOK =0
J
19
C*»«* FIND OUT OF KRTFR ARC
J
20
20
DO 30 A = 1* ARCS
J
21
ΙΑ = Τ(A)SJA = J(A)
J
22
C = C0ST(A)*PI(IA)-PI(JA)
J
23
C«**» ARC IS IN STATE A1*B1 OR CI
IF ((FLOW(A) .LT. LO(A)) .OR. (C .LT. 0 .AND. FLOW(A) .LT. HI(A)))
J
24
1 GO TO 40
J
25
C«*»* ARC IS NI STATE A2*B2 OR C2
IF ((FLOW(A) .GT. HKA)) .OR. (C .GT. 0 .AND. FLOW(A) .GT. LO(A)))
J
26
1 GO ΓΟ 50
J
27
30
CONTINUE
J
28
C*»«* NO REMAINING OUT OF KILTER ARCS
J
29
GO TO 230
J
30
C«#*» FLOW MUST BE INCREASED IN THE ARC TO BRING IT INTO KILTER
40
SRC = J(A)
J
31
SNK s 1(A)
J
32
Ε = •1
J
33
GO TO 60
J
34
C*«** FLOW MUST BE DECREASED IN THE ARC TO BRING IT INTO KILTER
50
SRC = 1(A)
J
35
SNK = J(A)
J
36
Ε = -1
J
37
GO TO 60
J
38
C*««» ATTEMPT TO BRING OUT OF KILTER ARCS INTO KILTER
J
39
60
IF ((A .EQ. AOK) .AND. (NA(SRC) .NE. 0)) GO TO 80
J
40
AOK = A
J
41
DO 70 Ν = li NODES
J
42
ΝΑ(N) =0
J
43
70
NB(N) =0
J
44
NA(SRC) = IABS(SNK)*E
J
45
NB(SRC) = IABS(AOK)*E
J
46
80
COK = C
J
47
90
LAB =0
J
48
DO 120 A s 1* ARCS
J
49
ΙΑ = I (A)$JA = J(A)
J
50
C««*« BOTH NODES OF THE ARC ARE EITHER LABFLED OR UNLABELED
IF ((ΝΑ(IA) .EQ. 0 .AND. NA(JA) .EQ. 0) .OR. (NA(IA) .NE. 0 .. AND
J
51
l.NA(JA) .NE. 0)) GO TO 120
J
52
C = COST(A)*PI(IA)-PI(JA)
J
53
C*«»» I-TH NODE IS NOT LABELED
IF (NA(IA) .EQ. 0) GO TO 100
J
54
C«#«« ARC FLOW CANNOT BE INCREASED WITHOUT DRIVING IT (MORE) OUT OF KILTER