Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-05 - decus/20-0137/cpm/cpm.for
There is 1 other file named cpm.for in the archive. Click here to see a list.
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