10 '-----------------------------------------------------------------
12 REM		SCHECALC.BAS	18 June 83 thru 10 Jul 83
14 REM				derived from
15 REM		SCHEDULE.BAS	15 Aug thru 10 Sep 82
16 REM
18 REM		Author: Hurle F. Priser
20 '-----------------------------------------------------------------
22 %INCLUDE SCHEDCOM
98 REM		fall through to calculations


1000 '-----------------------------------------
1002 REM	program director
1004 '-----------------------------------------
1010 GOSUB 3000:GOSUB 3100:GOSUB 3200:M=5	'call calculate
1200 CHAIN "SCHEMENU"


3000 '------------------------------------------
3002 REM	COMPUTATIONS
3004 '------------------------------------------
3006 PRINT CLS$:PRINT FNAT$(10,20),"COMPUTING, PLEASE WAIT";
3008 '------------------------------------------
3010 REM	COMPUTE latest EARLY STARTS
3012 '------------------------------------------
3014 REM	ENTER:
3016 REM		P(J,K)=PREDECESSOR TABLE
3018 REM		L(J)=LENGTH OF JOB


3020 REM	EXIT:
3022 REM		S(J,1)=latest EARLY STARTS
3024 REM		E(J)=END TIMES


3026 'SET THE STAGE BY FINDING THE LENGTHS OF ALL JOBS WITH NO PREDECESSORS.
3028 'LET THEIR END TIMES EQUAL THEIR LENGTHS AND THEIR START TIMES =0.


3030 FOR J=1 TO NJ:S(J,1)=0:E(J)=0:NEXT J 	'ZERO BEFORE USING


3032 FOR J=1 TO LJ
3034 FOR K=1 TO LJ
3036   IF P(J,K)<>0 THEN 3042'...SKIP TO NEXT J
3038 NEXT K					'FALL THRU IF ALL ZEROS
3040 S(J,1)=1 : E(J)=L(J)+S(J,1)-1		'FIRST JOBS
3042 NEXT J


3044 'NEXT FIND EACH PREDECESSOR FOR WHICH AN END VALUE HAS BEEN PREVIOUSLY
3046 'CALCULATED.  THIS IS JOB K.  THEN LOCATE EACH OF K'S SUCCESSORS IN
3048 'TURN.  IF A SUCCESSOR HAS A START TIME WHICH IS LATER THAN K'S END
3050 'TIME, THEN LEAVE IT ALONE.  ELSE, THE SUCCESSORS START TIME EQUALS
3052 'K'S END TIME PLUS 1.  AND, THE SUCCESSOR'S END TIME = K'S START
3054 'TIME PLUS K'S LENGTH. SEVERAL PASSES MAY BE REQUIRED.


3056 SW=0					'SWITCH
3058 FOR K=1 TO LJ				'SEARCH PREDECESSORS
3060 IF E(K)=0 THEN 3072'...SKIP JOBS WITHOUT END TIMES


3062 FOR J=1 TO LJ				'FIND SUCCESSORS
3064 IF P(J,K)=1 AND S(J,1)<=E(K) THEN 3066ELSE 3070
3066 S(J,1)=E(K)+1:E(J)=S(J,1)+L(J)-1
3068 SW=1					'A CHANGE WAS MADE
3070 NEXT J
3072 NEXT K
3074 IF SW=1 THEN 3056				'NOT DONE, A CHANGE WAS MADE
3076 RETURN


3100 '------------------------------------------
3102 REM	COMPUTE earliest LATE STARTS
3104 '------------------------------------------
3106 REM	ENTER:
3108 REM		C=COMPLETION TIME
3110 REM		P(J,K)=PREDECESSOR TABLE
3112 REM		S(J,1)=JOB START TIMES
3114 REM		L(J)=LENGTH OF JOBS


3116 REM	EXIT:

			S(J,2)=earliest LATE STARTS


3118 C=0

     :FOR J=1 TO LJ

	:IF C< S(J,1)+L(J) THEN C=S(J,1)+L(J)	'C=Project end
3120 NEXT J


3122 'FOR EACH PREDECESSOR K, FIND IT'S EARLIEST IMMEDIATE SUCCESSOR.
3124 'K'S EARLIEST LATE START S(K,2) =  IT'S EARLIEST SUCCESSOR'S START
3126 'TIME S(J,1) MINUS K'S LENGTH L(K).


3128 FOR J=1 TO NJ:S(J,2)=0:NEXT J		'ZERO BEFORE USING


3130 L=C
3132 FOR K=1 TO LJ+1				'PREDECESSORS
3134 FOR J=1 TO LJ				'SUCCESSORS
3136 IF P(J,K)=1 AND L>S(J,1) THEN L=S(J,1)	'L=EARLIEST SUCCESSOR START
3138 NEXT J
3140 S(K,2)=L-L(K):L=C				'PREDECESSORS LATE START
3142 NEXT K
3144 RETURN


3200 '------------------------------------------
3202 REM	COMPUTE CRITICAL PATH(S)
3204 '------------------------------------------


3206 REM	ENTER:	S(J,1) = EARLY STARTS
3208 REM		S(J,2) = LATE STARTS
3210 REM		P(J,K) = PREDECESSOR/SUCCESSOR TABLE
3212 REM		BL(P) = FIRST JOB OF BRANCH FORWARD LEGS
3214 REM		BF(P) = BEGIN FIRST JOB OF BRANCH BACK LEG
3216 REM		SK(Q) = STACK FOR JOBS IN EACH LEG
3218 REM		C = COMPLETION TIME


3220 REM	EXIT:	P(J,CP) = CRITICAL PATH JOBS = 1 (CP=LJ+1)


3222 ' ZERO CRITICAL PATH JOB ARRAY COLUMN IN THE PREDECESSOR TABLE P(J,CP).


3224 ' FIND ALL JOBS WITHOUT SLACK TIME AND PRIME THE LIST WITH THESE JOBS
3226 ' BY SETTING A 1 IN P(J,CP).


3228 ' PURGE THE LIST BY DELETING JOBS THAT DO NOT CONNECT TO THE CRITICAL
3230 ' PATH ON BOTH ENDS.  EXCEPTIONS ARE FIRST AND LAST JOBS.


3232 CP=LJ+1:P=0


3234 FOR J=1 TO NJ:P(J,CP)=0:NEXT J		'ZERO CRITICAL PATH JOB ARRAY


3236 FOR J=1 TO LJ
3238   IF S(J,1) < S(J,2) THEN 3242		'SKIP JOBS WITH SLACK
3240    P(J,CP)=1				'PRIME LIST WITH OTHERS
3242 NEXT J


3244 'ENTER HERE TO PURGE THE CP LIST OF NON-CRITICAL LEG ELEMENTS:
3246 'COME DOWN THE LIST OF CP JOBS.  CHECK EACH ONE TO SEE IF IT HAS A
3248 'CRITICAL PATH PREDECESSOR AND SUCCESSOR. EXCEPTION IS FIRST AND LAST
3250 'JOBS ON CP.  IF A JOB DOES NOT HAVE BOTH CP PREDECESSOR AND SUCCESSOR,
3252 'THEN ZERO IT.


3254 N=0:FOR J=1 TO LJ		'COME DOWN THE LIST, GET P(J,CP)=1
3256 IF P(J,CP)=1 THEN 3262	'IF IN CP LIST, GO CHECK PREDS. AND SUCCS.
3258 NEXT J			'IF N=1, DO AGAIN, ELSE FALL THRU.


3260 IF N=1 THEN 3254 ELSE 3288	'IF A CHANGE WAS MADE REPEAT PASS ELSE EXIT


3262 IF P(J,NJ)=1 THEN 3274	'IF A FIRST JOB THEN SKIP NEXT TEST


3264 FOR K=1 TO LJ		'CHECK FOR IMMEDIATE PREDECESSORS (I.P.)
3266 IF P(J,K)=1 AND S(K,2)+L(K)=S(J,1) THEN 3268 ELSE 3270 '...IF I.P.
3268 IF P(K,CP)=1 THEN 3274	'IF CRITICAL PREDECESSOR THEN SKIP
3270 NEXT K
3272 P(J,CP)=0:N=1:GOTO 3258	'NOT ON CP, ZERO, FLAG CHANGE, NEXT JOB


3274 IF P(LJ+1,J)=1 THEN 3258	'IF END JOB THEN SKIP TO NEXT JOB
3276 IF E(J)+1=C THEN 3258	'IF JOB REACHES END THEN SKIP


3278 FOR K=1 TO LJ		'CHECK FOR IMMEDIATE SUCCESSORS (I.S.)
3280 IF P(K,J)=1 AND S(J,2)+L(J)=S(K,1) THEN 3282 ELSE 3284 '...IF I.S.
3282 IF P(K,CP)=1 THEN 3258	'IF CRITICAL SUCCESSOR THEN SKIP
3284 NEXT K
3286 P(J,CP)=0:N=1:GOTO 3258	'NOT ON CP, ZERO, FLAG CHANGE, NEXT JOB


3288 RETURN
10000 END
CESSOR THEN SKIP
3284 NEXT K
3286 P(J,CP)=0:N=1:GOTO 3258	'NOT ON CP, ZERO, FLAG CHANGE, NEXT JOB