Trailing-Edge
-
PDP-10 Archives
-
decuslib10-09
-
43,50466/cpm.f4
There are no other files named cpm.f4 in the archive.
C WESTERN MICHIGAN UNIVERSITY
C CPM.F4 (FILENAME ON LIBRARY DECTAPE)
C CPM, 4.1.1 (CALLING NAME, SUBLST #)
C CRITICAL PATH ANALYSIS
C PROGRAMMED BY SAM ANEMA, LATER MODIFIED BY R.R. BARR
C LIBRARY DECTAPE PROGS. USED: USAGE.MAC
C INTERNAL SUBR. USED: ERROR, MODIFY, AXEPT, ANALYS, COLAP,
C INPUT, OUTPUT, STORE, BG, COST
C FORWMU PROGS. USED: PROTEK
C ABOVE COMMENTS AND RIGHT ADJUSTED COMMENTS PUT BY WG
C
C---------------NAME (1,200) GIVES FIRST 5 CH. OF ACTIVITY DESC.,
C--------------- NAME (2,200) GIVES SECOND 5 CH. OF ACTIVITY DESC.;
C--------------- NODE1(200) GIVES INTEGER CORRESP. TO FIRST NODES OF AN
C--------------- ACTIVITY; NODE2(200) GIVES INTEGER CORRESP. TO SECOND
C--------------- NODES OF AN ACTIVITY; T(1,200) GIVES OPTIMISTIC TIME
C--------------- EST., T(2,200) GIVES MOST LIKELY TIME EST.,
C--------------- T(3,200) GIVES PESSIMISTIC TIME EST.
C---------------N JOBS = NO. OF ACTIVITIES AND IS PASSED BY SUBR. INPUT
C--------------- THRU COMMON. NADD=NO. OF ACTIVITIES ADDED AND IS PASSED
C---------------THRU COMMON BY SUBR. MODIFY.
C---------------TIME(200), VAR(200) ARE MEAN AND VARIANCE OF TIME
C--------------- ESTIMATES FOR EACH ACTIVITY
C---------------CT(200)=EARLIEST START TIME, ET(I)=MEAN TIME TO REACH NODE(I)
C--------------- (SEE SUBR. ANALYS ST. 503-1 AND WRITE UP PAGE 2).
DIMENSION ISW(8),KWORD(15),WORD(15),NT(10)
COMMON NAME(2,200),NODE1(200),NODE2(200),TIM(3,200),NJOBS,NADD
COMMON IF13,BT(0/200),ET(0/200),ESD(0/200),CT(200),DT(200)
COMMON TIME(200),VAR(200),CTIME,IN(83)
DIMENSION LS(3)
DATA LS(3)/'0,0'/
DOUBLE PRECISION KWORD
LOGICAL WORD
DATA KWORD/'TYPE ','PRINT ','GANTT ','TIME ',
1'REPLACE ','ADD ','DELETE ','CRITICAL ','SCHEDULE ',
2'STORE ','NETWORK ','ACTIVITY ','ENTER ','END ',
3'COST '/
NWORD=15
TYPE 9911
9911 FORMAT(/,' WMU CRITICAL PATH ANALYSIS')
C CALL USAGE('CPM')
6 INUM=0
ISW(1)=2
ISW(2)=1
ISW(4)=1
ISW(6)=1
ISW(7)=1
ISW(8)=1
DO 3 I=1,NWORD
3 WORD(I)=.FALSE.
TYPE 1
1 FORMAT(//' *',$)
ACCEPT 2,(IN(I),I=1,72)
2 FORMAT(72A1)
K=0
C---------------COMPRESS NON-BLANK CH. OF USER'S INPUT.
C--------------- K=NO. OF NON-BLANK CH. IN INPUT.
DO 4 I=1,72
IF(IN(I).EQ.' ')GO TO 4
K=K+1
KK=IN(I)
IN(I)=' '
IN(K)=KK
4 CONTINUE
C---------------FIND OUT WHAT OPTIONS USER CHOSE
DO 100 J=1,NWORD
DECODE(10,101,KWORD(J))(NT(I),I=1,10)
101 FORMAT(10A1)
DO 102I=1,10
IF(NT(I).EQ.' ')GO TO 103
102 CONTINUE
I=I+1
103 KS=I-1
C---------------KS=NO. OF NON BLANK CH. IN KWORD(J)
DO 104I=0,K-3
DO 105 L=1,KS
IF(IN(I+L).NE.NT(L))GO TO 104
105 CONTINUE
WORD(J)=.TRUE.
C---------------IF ACTIVITY IS INPUT, PICK UP ACITIVITY ID=INUM
IF(J.NE.12)GO TO 104
ENCODE(10,101,LS)(IN(KL),KL=I+KS+1,I+KS+10)
DECODE(15,201,LS)INUM
201 FORMAT(I)
104 CONTINUE
100 CONTINUE
C---------------WORD(1)...WORD(15) CORRESP. TO TYPE, PRINT,
C--------------- ... COST IN DATA VECTOR KWORD.
IF(WORD(1))ISW(1)=2
IF(WORD(2))ISW(1)=2
IF(WORD(11))ISW(2)=6
IF((WORD(1).AND.WORD(12)).OR.WORD(5).OR.WORD(6).OR.WORD(7))ISW(2)=
12
IF(WORD(3).OR.WORD(4).OR.WORD(8).OR.WORD(9).OR.WORD(15))ISW(2)=3
IF(WORD(10))ISW(2)=4
IF(WORD(13))ISW(2)=5
IF(WORD(14))ISW(2)=7
IF(WORD(5))ISW(4)=2
IF(WORD(6))ISW(4)=3
IF(WORD(7))ISW(4)=4
IF(WORD(1).AND.WORD(12))ISW(4)=5
IF(WORD(9))ISW(6)=2
IF(WORD(3))ISW(7)=2
IF(WORD(9).AND.WORD(8))ISW(6)=3
IF(WORD(3).AND.WORD(8))ISW(7)=3
IF(WORD(15))ISW(8)=2
GO TO (301,302,303,304,305,306,307),ISW(2)
301 CALL ERROR
GO TO 6
C---------------TYPE, REPLACE, ADD, DELETE OPTIONS
302 CALL MODIFY(ISW,INUM)
GO TO 6
C---------------GANTT, TIME, CRITICAL SCHEDULE, COST OPTIONS
303 CALL ANALYS(ISW)
GO TO 6
C---------------STORE OPTION
304 CALL STORE
GO TO 6
C---------------ENTER OPTION
305 CALL INPUT(ISW)
GO TO 6
C---------------NETWORK OPTION
306 CALL OUTPUT(ISW)
GO TO 6
307 CALL EXIT
END
C
C SUBROUTINE ERROR FOR CRITICAL PATH ANALYSIS
C
SUBROUTINE ERROR
TYPE 101
101 FORMAT(' YOU HAVE MADE AN ERROR IN THE INPUT STRING. TRY AGAIN.')
RETURN
END
C
C SUBROUTINE MODIFY FOR CRITICAL PATH ANALYSIS
C
C---------------ISW, INUM INPUT
SUBROUTINE MODIFY(ISW,INUM)
DIMENSION ISW(8)
COMMON NAME(2,200),NODE1(200),NODE2(200),TIM(3,200),NJOBS,NADD
COMMON IF13,BT(0/200),ET(0/200),ESD(0/200),CT(200),DT(200)
COMMON TIME(200),VAR(200),CTIME,IN(60)
C---------------NJOBS PASSED BY INPUT THRU COMMON
IF(NJOBS.EQ.0)GO TO 10
C---------------ISW(4)=3 MEANS USER CHOSE ADD OPTION. SEE
C--------------- ST. 301-9 IN MAIN PROG.
IF(ISW(4).EQ.3)GO TO 103
102 IF(INUM.GT.0)GO TO 210
C---------------GIVE USER ANOTHER CHANCE TO INETER ACTIVITY NO.
C--------------- USER WAS SUPPOSED TO ENTER ACTIVITY NO. IN
C--------------- MAIN PROG. ST. 1+1.
TYPE 201
201 FORMAT(' ACTIVITY NO. = ',$)
ACCEPT 203,INUM
203 FORMAT(I)
C---------------NADD IS SET TO 0 IN SUBR. INPUT. NADD=NO. OF
C--------------- ACTIVITIES ADDED.
210 IF(INUM.GT.NJOBS+NADD)GO TO 220
C---------------ISW(4)=2 MEANS REPLACE, =3 MEANS ADD, =4 MEANS
C--------------- DELETE, =5 MEANS TYPE ACTIVITY
GO TO (101,202,103,104,105),ISW(4)
101 CALL ERROR
RETURN
220 TYPE 221,INUM
221 FORMAT(' ACTIVITY',I3,' DOES NOT EXIST')
RETURN
202 TYPE 204
204 FORMAT(' ENTER ACTIVITY'/)
CALL AXEPT(NAME(1,INUM),NAME(2,INUM),NODE1(INUM),NODE2(INUM),
1TIM(1,INUM),TIM(2,INUM),TIM(3,INUM),IEND,5)
ISW(3)=0
RETURN
103 NADD=NADD+1
IL=NJOBS+NADD
TYPE 204
CALL AXEPT(NAME(1,IL),NAME(2,IL),NODE1(IL),NODE2(IL),
1TIM(1,IL),TIM(2,IL),TIM(3,IL),IEND,5)
ISW(3)=0
ISW(5)=0
RETURN
104 NAME(1,INUM)=' '
NAME(2,INUM)=' '
NODE1(INUM)=0
NODE2(INUM)=0
TIM(1,INUM)=0.0
TIM(2,INUM)=0.0
TIM(3,INUM)=0.0
ISW(3)=0
ISW(5)=0
RETURN
105 IF(NODE1(INUM).EQ.0) GO TO 106
TYPE 300,INUM,(NAME(I,INUM),I=1,2),NODE1(INUM),NODE2(INUM),
1TIM(1,INUM),TIM(2,INUM),TIM(3,INUM)
300 FORMAT(I3,')',2A5,2I5,3F10.2)
GO TO 107
106 TYPE 301,INUM
301 FORMAT(I3,')',20X,'(DELETED)')
107 RETURN
C---------------HERE FROM ST. 102-2
10 TYPE 11
11 FORMAT(' NO NETWORK PRESENT!'/)
RETURN
END
C
C SUBROUTINE AXEPT FOR CRITICAL PATH ANALYSIS
C---------------N1, N2, II, JJ, T1, T2, T3, IEND RETURNED, ICHN INPUT
C
SUBROUTINE AXEPT(N1,N2,II,JJ,T1,T2,T3,IEND,ICHN)
DIMENSION XX(12)
COMMON DUM1(1402),IF13,DUM2(1404),IN(60)
DATA XX(11),XX(12)/'0,0,0',',0,0 '/
READ(ICHN,206,END=350)(IN(I),I=1,60)
206 FORMAT(60A1)
DO 207 I=1,50
IF(IN(I).EQ.',')GO TO 208
207 CONTINUE
208 ICOM=I
IF(ICOM-11)203 ,300,209
203 ISH=11-ICOM
DO 210 I=50,12,-1
210 IN(I)=IN(I-ISH)
DO 211 I=ICOM,10
211 IN(I)=' '
IN(11)=','
GO TO 300
209 ISH=ICOM-11
DO 250 I=12,50
250 IN(I)=IN(I+ISH)
IN(11)=','
300 ENCODE(50,301,XX)(IN(I),I=1,50)
301 FORMAT(50A1)
DECODE(60,302,XX)N1,N2,II,JJ,T1,T2,T3
302 FORMAT(2A5,1X,2I,3F)
IEND=0
RETURN
350 IEND=1
RETURN
END
C
C SUBROUTINE ANALYS FOR CRITICAL PATH ANALYSIS
C---------------ISW INPUT
C
SUBROUTINE ANALYS(ISW)
COMMON NAME(2,200),NODE1(200),NODE2(200),TIM(3,200),NJOBS,NADD
COMMON IF13,BT(0/200),ET(0/200),ESD(0/200),CT(200),DT(200)
COMMON TIME(200),VAR(200),CTIME,IN(60)
COMMON/SAVE/KA(600),NADDR(200)
DIMENSION NO(200),NI(200),NB(20),NPATH(50)
DIMENSION NCH(50),NC(20)
DIMENSION ISW(8)
IF(NJOBS.EQ.0)GO TO 10
C---------------ISW(5) SET TO 0
IF(ISW(5).EQ.0)CALL COLAP(ISW)
FIRST=0.0
K=0
KK=0
DO 101 I=1,NJOBS
C---------------CALCULATE MEAN TIME AND VARIANCE OF TIME
C--------------- ESTIMATES AND STORE. SEE REF. 4 LAST PAGE OF
C--------------- WRITE UP PAGE 371.
TIME(I)=(TIM(1,I)+TIM(3,I)+4.0*TIM(2,I))/6.0
VAR(I)=((TIM(3,I)-TIM(1,I))/6.0)**2
NN=NODE1(I)
MM=NODE2(I)
C---------------KEEP TRACK OF NO. OF ACTIVITIES ENDING AT NODE(I)
C--------------- AND MAKING A LIST OF ACTIVITIES WHICH END AT
C--------------- NODE I
DO 102 J=1,NJOBS
IF(NODE2(J).NE.NN)GO TO 102
KK=KK+1
KA(KK)=J
102 CONTINUE
NADDR(I)=K+1
NI(I)=KK-K
K=KK
C---------------KEEP TRACK OF NO. OF ACTIVITIES BEGINNING AT NODE(I)
C--------------- AND MAKING A LIST OF ACTIVITIES
C--------------- BEGINNING AT NODE (I)
DO 103 J=1,NJOBS
IF(NODE1(J).NE.MM)GO TO 103
KK=KK+1
KA(KK)=J
103 CONTINUE
NO(I)=KK-K
K=KK
101 CONTINUE
DO 115 I=0,NJOBS
ESD(I)=0.0
115 ET(I)=FIRST
NNC=0
NNB=0
C---------------FIND OUT HOW MANY START AHD COMPLETION NODES THERE ARE.
DO 120 I=1,NJOBS
IF(NI(I).NE.0)GO TO 141
NNB=NNB+1
NB(NNB)=I
141 IF(NO(I).NE.0)GO TO 120
NNC=NNC+1
NC(NNC)=I
120 CONTINUE
DO 130 J=1,NNB
DO 131 I=1,50
C---------------NCH(I) ARE ACTIVITIES BEGINNING AT START NODE AND
C--------------- ENDING AT COMPLETION NODE. SEE LIMITATIONS SECTION
C--------------- OF WRITE UP.
131 NCH(I)=1
NWH=0
NPATH(1)=NB(J)
121 I=1
125 NPAT=NPATH(I)
IF(NCH(I)-NO(NPAT))122,123,124
122 NWH=I
123 K=KA(NADDR(NPAT)+NI(NPAT)+NCH(I)-1)
I=I+1
NPATH(I)=K
GO TO 125
124 JOBO=0
DO 128 K=1,I
JOB=NPATH(K)
TNT=ET(JOBO)+TIME(JOB)
SNT=ESD(JOBO)+VAR(JOB)
IF(ET(JOB)-TNT)602,607,128
602 IF(K.GE.I)GO TO 132
DO 126 L=1,NO(JOB)
KN=KA(NADDR(JOB)+NI(JOB)+L-1)
DO 129 II=1,NI(KN)
JIND=KA(NADDR(KN)+II-1)
ESD(JIND)=SNT
129 ET(JIND)=TNT
126 CONTINUE
GO TO 128
132 DO 133 II=1,NNC
JIND=NC(II)
ESD(JIND)=SNT
133 ET(JIND)=TNT
GO TO 128
607 IF(ESD(JOB).GE.SNT)GO TO 128
GO TO 602
128 JOBO=JOB
IF(NWH.EQ.0)GO TO 130
L=NWH
NCH(L)=NCH(L)+1
DO 127 II=L+1,50
127 NCH(II)=1
NWH=0
GO TO 121
130 CONTINUE
BT(0)=ET(NC(1))
CTIME=-1.E36
DO 201 I=1,NJOBS
IF(ET(I).GT.CTIME)CTIME=ET(I)
201 BT(I)=1.E36
DO 230 J=1,NNC
DO 231 I=1,50
231 NCH(I)=1
NWH=0
NPATH(1)=NC(J)
221 I=1
225 NPAT=NPATH(I)
IF(NCH(I)-NI(NPAT))222,223,224
222 NWH=I
223 K=KA(NADDR(NPAT)+NCH(I)-1)
I=I+1
NPATH(I)=K
GO TO 225
224 JOBO=0
DO 228 K=1,I
JOB=NPATH(K)
TNT=BT(JOBO)-TIME(JOB)
IF(BT(JOB).LE.TNT)GO TO 228
IF(K.GE.I)GO TO 232
DO 226 L=1,NI(JOB)
KN=KA(NADDR(JOB)+L-1)
DO 229 II=1,NO(KN)
229 BT(KA(NADDR(KN)+NI(KN)+II-1))=TNT
226 CONTINUE
GO TO 228
232 DO 233 II=1,NNB
233 BT(NB(II))=TNT
228 JOBO=JOB
IF(NWH.EQ.0)GO TO 230
NCH(NWH)=NCH(NWH)+1
DO 227 II=NWH+1,50
227 NCH(II)=1
NWH=0
GO TO 221
230 CONTINUE
DO 301 I=1,NJOBS
IF(NO(I).EQ.0)GO TO 302
DT(I)=BT(KA(NADDR(I)+NI(I)))
GO TO 303
302 DT(I)=ET(I)
303 IF(NI(I).EQ.0)GO TO 304
CT(I)=ET(KA(NADDR(I)))
GO TO 301
304 CT(I)=BT(I)
301 CONTINUE
IF(ISW(6).EQ.1)GO TO 505
C---------------SEE WRITE UP PAGE 2
WRITE(30,501)
501 FORMAT('1',28X,'ACTIVITY SCHEDULE'//49X,'ACTIVITY ENDING NODE'/
17X,'ACTIVITY ES LS EF LF TF MT SDT MT SDT
2'/)
DO 502 I=1,NJOBS
ES=CT(I)
SL=DT(I)-TIME(I)
EF=ES+TIME(I)
FL=SL+TIME(I)
TF=SL-ES
IF(ISW(6).EQ.2)GO TO 507
IF(ABS(TF).GE.0.00001)GO TO 502
507 SDT=SQRT(VAR(I))
XSDT=SQRT(ESD(I))
CRT=' '
C---------------CRT=* MEANS ACTIVITY IS CRITICAL. SEE WRITE
C--------------- UP BOTTOM PAGE 2
IF(ABS(TF).LT.0.00001)CRT='*'
WRITE(30,503)I,NAME(1,I),NAME(2,I),CRT,ES,SL,EF,FL,TF,TIME(I),
1SDT,ET(I),XSDT
503 FORMAT(I4,')',2A5,A1,9F6.2)
502 CONTINUE
505 IF(ISW(7).GT.1)CALL BG(ISW)
IF(ISW(8).EQ.2)CALL COST
RETURN
C---------------HERE FROM 102-14
10 TYPE 11
11 FORMAT(' NO NETWORK PRESENT!'/)
RETURN
END
C
C SUBROUTINE COLAP FOR CRITICAL PATH ANALYSIS
C---------------ISW OUTPUT
C
SUBROUTINE COLAP(ISW)
DIMENSION ISW(8)
COMMON NAME(2,200),NODE1(200),NODE2(200),TIM(3,200),NJOBS,NADD
K=0
DO 101 I=1,NJOBS+NADD
IF(NODE1(I).EQ.0)GO TO 103
102 K=K+1
NODE1(K)=NODE1(I)
NODE2(K)=NODE2(I)
NAME(1,K)=NAME(1,I)
NAME(2,K)=NAME(2,I)
DO 104 J=1,3
104 TIM(J,K)=TIM(J,I)
GO TO 101
103 IF(NODE2(I).NE.0)GO TO 102
101 CONTINUE
NJOBS=K
NADD=0
ISW(5)=1
RETURN
END
C
C SUBROUTINE INPUT FOR CRITICAL PATH ANALYSIS
C---------------ISW INPUT
C
SUBROUTINE INPUT(ISW)
DIMENSION ISW(8)
DOUBLE PRECISION INA
C---------------MAX. NO. OF ACTIVITIES=200, MAX. NO OF ACITIVITIES
C--------------- ON A SINGLE PATH=50 MAX. NO. OF ACTIVITIES AT
C--------------- TIME ZERO=20.
COMMON NAME(2,200),NODE1(200),NODE2(200),TIM(3,200),NJOBS,NADD
COMMON IF13,BT(0/200),ET(0/200),ESD(0/200),CT(200),DT(200)
COMMON TIME(200),VAR(200),CTIME,IN(60)
DIMENSION DUMP(1403)
EQUIVALENCE(DUMP(1),NAME(1,1))
100 TYPE 101
101 FORMAT(' IS THE NETWORK STORED?'/)
ACCEPT 102,IFS
102 FORMAT(A3)
IF(IFS.EQ.'YES')GO TO 105
IF(IFS.EQ.'NO')GO TO 110
GO TO 100
105 TYPE 106
106 FORMAT(' FILE NAME?'/)
ACCEPT 107,INA
107 FORMAT(A10)
TYPE 108
108 FORMAT(' PROJECT-PROGRAMMER NUMBER?'/)
ACCEPT 109,IPROJ,IPROG
109 FORMAT(2O)
CALL DEFINE FILE(1,0,NEVER,INA,IPROJ,IPROG)
ICHN=1
GO TO 1110
110 TYPE 111
111 FORMAT(' ENTER ACTIVITIES'/)
ICHN=5
1110 NADD=0
NJOBS=0
112 NJOBS=NJOBS+1
CALL AXEPT(NAME(1,NJOBS),NAME(2,NJOBS),NODE1(NJOBS),NODE2(NJOBS),
1TIM(1,NJOBS),TIM(2,NJOBS),TIM(3,NJOBS),IEND,ICHN)
IF(IEND.EQ.1)GO TO 113
GO TO 112
113 NJOBS=NJOBS-1
ISW(5)=1
ISW(3)=0
CALL RELEAS(1)
RETURN
END
C
C SUBROUTINE OUTPUT FOR CRITICAL PATH ANALYSIS
C---------------ISW INPUT
C
SUBROUTINE OUTPUT(ISW)
DIMENSION ISW(8)
COMMON NAME(2,200),NODE1(200),NODE2(200),TIM(3,200),NJOBS,NADD
COMMON IF13,BT(0/200),ET(0/200),ESD(0/200),CT(200),DT(200)
COMMON TIME(200),VAR(200),CTIME,IN(60)
IF(NJOBS.EQ.0)GO TO 14
GO TO (101,102,101),ISW(1)
101 DO 110 I=1,NJOBS+NADD
IF((NODE1(I).EQ.0).AND.(NODE2(I).EQ.0))GO TO 111
WRITE(20,113)I,(NAME(J,I),J=1,2),NODE1(I),NODE2(I),TIM(1,I),
1TIM(2,I),TIM(3,I)
113 FORMAT(I5,')',2A5,2I6,3F10.2)
GO TO 110
111 WRITE(20,114)I
114 FORMAT(I5,')',10X,'(DELETED)')
110 CONTINUE
IF(ISW(1).EQ.3)GO TO 102
RETURN
102 TYPE 103
103 FORMAT('1',18X,'BEGIN',2X,'END'/7X,'ACTIVITY NODE NODE OPTIM
1ISTIC LIKELY PESSIMISTIC'/)
DO 120 I=1,NJOBS+NADD
IF((NODE1(I).EQ.0).AND.(NODE2(I).EQ.0))GO TO 121
TYPE 113,I,(NAME(J,I),J=1,2),NODE1(I),NODE2(I),TIM(1,I),TIM(2,I)
1,TIM(3,I)
GO TO 120
121 TYPE 114,I
120 CONTINUE
RETURN
14 TYPE 15
15 FORMAT(' NO NETWORK PRESENT'/)
RETURN
END
C
C SUBROUTINE STORE FOR CRITICAL PATH ANALYSIS
C
SUBROUTINE STORE
COMMON NAME(2,200),NODE1(200),NODE2(200),TIM(3,200),NJOBS,NADD
COMMON IF13
DOUBLE PRECISION INA
IF(NJOBS.EQ.0)GO TO 14
TYPE 101
101 FORMAT(' FILE NAME?'/)
ACCEPT 102,INA
102 FORMAT(A10)
CALL DEFINE FILE(1,0,NEVER,INA,0,0)
NJ=NJOBS+NADD
DO 17 J=1,NJ
17 WRITE(1,18)(NAME(I,J),I=1,2),NODE1(J),NODE2(J),(TIM(I,J),I=1,3)
18 FORMAT(2A5,2(',',I3),3(',',F9.4))
CALL RELEAS(1)
CALL PROTEK("155,INA)
RETURN
14 TYPE 15
15 FORMAT(' NO NETWORK PRESENT'/)
RETURN
END
C
C SUBROUTINE BG FOR CRITICAL PATH ANALYSIS
C
SUBROUTINE BG(ISW)
COMMON NAME(2,200),NODE1(200),NODE2(200),TIM(3,200),NJOBS,NADD
COMMON IF13,BT(0/200),ET(0/200),ESD(0/200),CT(200),DT(200)
COMMON TIME(200),VAR(200),CTIME,SP(61)
DIMENSION ISW(8),SPC(7)
SC=60./CTIME
TYPE 302
302 FORMAT('1',25X,'GANTT CHART'/)
DO 100 I=1,NJOBS
ES=CT(I)
SL=DT(I)-TIME(I)
EF=ES+TIME(I)
FL=SL+TIME(I)
IF(ISW(7).EQ.2)GO TO 201
IF(ABS(ES-SL).LT.0.00001)GO TO 201
GO TO 100
201 DO 101 J=1,60
101 SP(J)=' '
IST=IFIX(ES*SC)+1
LST=IFIX(FL*SC)+1
MST=IFIX(EF*SC)+1
DO 102 J=IST,MST
IF(J.EQ.IST)GO TO 104
SP(J)='X'
GO TO 102
104 SP(J)='I'
102 CONTINUE
DO 103 J=MST,LST
IF(J.EQ.MST)GO TO 105
IF(J.EQ.LST)GO TO 105
SP(J)='-'
GO TO 103
105 SP(J)='I'
103 CONTINUE
TYPE 1000,I,(SP(J),J=1,LST)
1000 FORMAT(' ',I3,')',61A1)
100 CONTINUE
SPC(1)=0.0
DO 303 I=1,6
303 SPC(I+1)=SPC(I)+CTIME/6.0
TYPE 301
301 FORMAT(5X,'I',6('---------I'))
TYPE 304,(SPC(I),I=1,7)
304 FORMAT(F8.2,6F10.2)
RETURN
END
C
C SUBROUTINE COST FOR CRITICAL PATH ANALYSIS
C
SUBROUTINE COST
COMMON NAME(2,200),NODE1(200),NODE2(200),TIM(3,200),NJOBS,NADD
COMMON IF13,BT(0/200),ET(0/200),ESD(0/200),CT(200),DT(200)
COMMON TIME(200),VAR(200),CTIME,IN(60)
DIMENSION INS(60)
COMMON/SAVE/VCT(400),CST(200),NWH(200)
NL=0
TYPE 14
14 FORMAT('1ENTER COST PER UNIT OF TIME REDUCED FOR THE FOLLOWING ACT
1IVITIES'/)
DO 10 I=1,NJOBS
IF(ABS(DT(I)-CT(I)-TIME(I)).GE.0.00001)GO TO 10
NL=NL+1
NWH(NL)=I
DT(NL)=DT(I)
CT(NL)=CT(I)
VCT(2*NL-1)=CT(NL)
VCT(2*NL)=DT(NL)
IF(NAME(1,I).EQ.'DUMMY')GO TO 536
TYPE 15,I,NAME(1,I),NAME(2,I)
15 FORMAT(I4,')',2A5,3X,$)
ACCEPT 16,CST(NL)
16 FORMAT(F)
GO TO 10
536 CST(NL)=1.0E36
10 CONTINUE
DO 20 I=2,2*NL
DO 21 J=1,I-1
IF(VCT(I).GE.VCT(J))GO TO 21
TMP=VCT(I)
VCT(I)=VCT(J)
VCT(J)=TMP
21 CONTINUE
20 CONTINUE
VCT(2*NL+1)=1.0E36
K=0
DO 22 I=1,2*NL
IF((VCT(I+1)-VCT(I)).LT.0.00001)GO TO 22
K=K+1
VCT(K)=VCT(I)
22 CONTINUE
XMIN=1.0E36
DO 25 I=1,K-1
XMT=(VCT(I)+VCT(I+1))/2.0
COST=0.0
L=0
DO 26 J=1,NL
IF(XMT.GT.DT(J))GO TO 26
IF(XMT.LT.CT(J))GO TO 26
COST=COST+CST(J)
L=L+1
IN(L)=J
26 CONTINUE
IF(COST.GE.XMIN)GO TO 25
XMIN=COST
DO 27 J=1,L
27 INS(J)=IN(J)
LS=L
25 CONTINUE
TYPE 30
30 FORMAT(/' FOR THE SMALLEST INCREASE IN COST, REDUCE TIME'/
1' EQUALLY ON THE FOLLOWING JOB(S):'/)
DO 45 I=1,LS
JN=NWH(INS(I))
45 TYPE 31,JN,NAME(1,JN),NAME(2,JN)
31 FORMAT(I4,')',2A5)
RETURN
END