2 REM
3 REM      GLPSA1:  LINEAR PROGRAMMING - TWO PHASE SIMPLEX METHOD
4 REM
5 REM      36517  REV A
6 REM
7 REM **** CONTRIBUTED PROGAM *************************************************
8 REM LPSA1 - LP PROGRAM WHICH PERMITS SENSITIVITY AND PARAMETRIC
9 REM ANALYSES, WEE SEPARATE WRITEUP FOR INSTRUCTIONS
10 REM J. MOORE, SEPT., 1969
15 P4=0
100 OPEN'DATA.DAT'AS FILE1%:DIM #1%,A(30,70),B(30),D(40),F(30)
102 PRINT:PRINT:PRINT"TYPE '1' FOR MAXIMIZATION, OR '-1' FOR MINIMIZATION.'
120 INPUT Z:Z=-Z:PRINT"TYPE THE NUMBER OF CONSTRAINTS, NUMBER OF VARIABLES';
150 INPUT M,N
155 PRINT'NUMBER OF LESS THAN, EQUAL, GREATER THAN CONSTRAINTS.'
160 INPUT L,E,G
180 IF M=L+E+G THEN 210 ELSE PRINT'DATA ON CONSTRAINTS INCONSISTENT. TRY AGAIN.': GOTO 155
205 REM THIS IS INITIALIZATION ROUTINE
210 C=N+M+G:C1=C+1:C2=N+L+G:M1=M+1:M2=M+2
241 RESTORE:PRINT:MAT A=ZER(M2,C1):MAT B=ZER(M):FORI=1TOM:FORJ=1TON:
	READA(I,J):IFI<=LTHEN310
300 A(M1,J)=A(M1,J)-A(I,J)
310 NEXT J
320 IF I>L THEN 360
330 B(I)=N+I:A(I,N+I)=1:GOTO420
360 B(I)=N+G+I
370 A(I,N+G+I)=1
380 IF I>L+E THEN 400
390 GOTO 420
400 A(I,N+I-E)=-1:A(M1,N+I-E)=1
420 NEXT I
430 READ A(I,C1) FOR I=1 TO M:FOR J=1 TO N:READ A(M2,J):A(M2,J)=Z*A(M2,J):NEXT J:PRINT:P1=1:PRINT'YOUR VARIABLES 'P1'THROUGH'N:IF L=0 THEN 550
540 PRINT 'SLACK VARIABLES'N+1'THROUGH'N+L
550 IF G=0 THEN 570
560 PRINT'SURPLUS VARIABLES'N+L+1' THROUGH'C2
570 IF L=M THEN 670
580PRINT'ARTIFICIIAL VARIABLES'C2+1'THROUGH'C:M3=M1:GOSUB1000:
	PRINT:FORI1=1TOM:IFB(I1)<=C2THEN662
630IFA(I1,C1)<=.00001 THEN 655
640 PRINT'THE PROBLEM HAS NO FEASIBLE SOLUTIION.':GOTO9999
655 FOR J1=1TOC2:IFABS(A(I1,J1))<=.00001THEN661
657 R=I1:S=J1:GOSUB 1180:GOTO662
661 NEXT  J1
662 NEXT I1
670P1=2:PRINT:M3=M2:GOSUB 1000:GOSUB 700:IFP4=3THEN698
693 GOSUB 2000:PRINT:GOSUB 3000:PRINT:PRINT
698 GOSUB 4000
699 GOTO 9999
700 PRINT:PRINT'ANSWERS:':PRINT'PRIMAL VARIABLES:':PRINT'VARIABLES','VALUE':FORJ=1TOC2:FORI=1TOM:IFB(I)<>JTHEN790
770 PRINTJ,A(I,C1):GOTO800
790 NEXT I
800 NEXT J
810 PRINT'DUAL VARIABLES:':PRINT'VARIABLE','VALUE':IFL=0THEN860
830FORI=1TOL:PRINTI,-Z*A(M2,N+I):NEXTI
860 PRINTI,-Z*A(M2,N+I+G)FORI=L+1TOM:PRINT'VALUE OF OBJECTIVE FUNCTION  ';-Z*A(M2,C1):PRINT:PRINT:PRINT:RETURN
1000 REM THIS IS OPTIMIZING ROUTINE
1005 REM FIRST PRICE OUT THE COLUMNS
1010P=-.00001:FORJ=1TOC2:IFA(M3,J)>=PTHEN1060
1040S=J:P=A(M3,J)
1060 NEXT J
1070IF P=-.00001 THEN 1370
1072GOSUB 1075:GOSUB 1150
1075 REM NOW WE FIND WHICH VARIABBLE LEAVES BASIS
1080 Q=1.E+38:FORI=1TOM:IFA(I,S)<=.00001 THEN 1140
1110 IF A(I,C1)/A(I,S)>=QTHEN1140
1120 R=I:Q=A(I,C1)/A(I,S)
1140 NEXT I
1145 RETURN
1150 IF Q=1.E+38 THEN 1160
1152 GOSUB 1180:GOTO1010
1160 PRINT'THE SOLUTION IS UNBOUNDED.':GOTO9999
1180 REM NO PERFORM THE PIVOTING
1185 P=A(R,S):FORI=1TOM2:IFI=RTHEN1270
1210FORJ=1TOC1:IFJ=STHEN1260
1230 A(I,J)=A(I,J)-A(I,S)*A(R,J)/P
1240 IF ABS(A(I,J))>=.00001 THEN 1260
1250A(I,J)=0
1260 NEXT J
1270 NEXT I
1280 FOR J=1 TO C1:A(R,J)=A(R,J)/P:NEXT J
1310 FOR I=1 TO M2:A(I,S)=0:NEXT I:A(R,S)=1:B(R)=S:RETURN
1370 RETURN
1380 GOTO9999
2000 REM SUBROUTINE FOR SENSITIVITY ANALYSIS ON RHS
2005 PRINT'YOU CAN NOW DO SENSITIVITY ANALYSIS ON THE RIGHT HAND SIDE.'
2010 PRINT:PRINT:PRINT'HOW MANY CAPACITIES DO YOU WISH TO CHANGE';
2020 INPUT R:IFR=0 THEN 2400
2030 PRINT'WHICH CAPACITIES DO YOU WISH TO CHANGE';:MAT INPUT D(R):FORI=1TOR:IFD(I)<=MTHEN2090
2070 PRINT'CONSTRAINT.'D(I)'DOES NOT EXIST. TRY AGAIN.':GOTO2010
2090 NEXT I
2100 R1=-1.E+38:R2=1.E+38:FORI=1TOM:D1=0:FORJ=1TOR:IFD(J)>LTHEN2190
2170 D1=D+A(I,D(J)+N) :GOTO 2200
2190 D1=D1+A(I,D(J)+G+N)
2200 NEXT J:IFABS(D1)<=.00001THEN2300
2210IFD1>0THEN2270
2220 D1=-A(I,C1)/D1:IFD1>=R2THEN2300
2240R2=D1:S2=B(I):GOTO2300
2270 D1=-A(I,C1)/D1:IFD1<=R1THEN2300
2290R1=D1:S1=B(I)
2300 NEXT I
2310 IF R1=-1.E+38 THEN 2340
2320 PRINT'THE BOUND ON THE DECREASE IS ';-1*R1:
	PRINT'  AT WHICH POINT VARIABLE 'S1'  GOES TO ZERO.':GOTO2350
2340 PRINT'THERE IS NO BOUND ON THE DECREASE.'
2350 IF R2=1.E+38 THEN 2380
2360 PRINT'THE BOUND ON THE INCREASE IS 'R2;:PRINT'  AT WHICH OINT VARIABLE 'S2'  GOES TO ZERO.':GOTO2010
2380 PRINT'THERE IS NO BOUND ON THE INCREASE.':GOTO2010
2400 RETURN
2410 GOTO 9999
3000 REM SUBROUTINE FOR SENSITIVITY ANALYSIS ON OBJ FCHCOEFFICIENTS
3005 PRINT'YOU MAY NOW DO SENSITIVITY ANALYSIS ON THE COST FACTORS.'
3010 PRINT:PRINT:INPUT'HOW MANY COSTS DO YOU WISH TO CHANGE';R:IFR=0THEN3500
3040 PRINT'WHICH COSTS DO YOU WISH TO CHANGE';:MAT INPUT D(R):FORJ=1TOR:
	IFD(J)<=NTHEN3100
3080 PRINT'VARIABLE' D(J)'  IS NOT ONE OF YOUR VARIABLES. TRY AGAIN.':GOTO3010
3100 NEXT J
3110 R1=-1.E+38:R2=1.E+38:FORJ=1TOC2:FORI=1TOM:IFB(I)=JTHEN3360
3160NEXT I
3170D1=0:FORI=1TOR:IFD(I)<>JTHEN3210
3200D1=D1-1
3210 NEXT I
3220FORI=1TOR:FORK=1TOM:IFB(K)<>D(I)THEN3270
3250D1=D1+A(K,J):GOTO3280
3270 NEXT K
3280 NEXT I
3285 IF D1=0THEN3360
3300IFD1*R1<=A(M2,J)THEN3330
3310 R1=A(M2,J)/D1:S1=J
3330 IF D1*R2<=A(M2,J) THEN 3360
3340R2=A(M2,J)/D1:S2=J
3360 NEXT J
3362 IF Z=1 THEN 3368
3364 A$='INCREASE':B$='INCREASE':GOTO 3370
3368 A$='DECREASE':B$='INCREASE'
3370 IF R1=-1.E+38 THEN 3420
3380 PRINT'THE BOUND ON THE ';A$;' IS ';-1*R1;' .':S=S1:
	PRINT'  AT THIS POINT VARIABLE ';S;' CAN ENTER THE BASIS.'
3400 GOSUB 1075:GOSUB 3600:GOTO3430
3420 PRINT'THE ';A$;' IS NOT BOUNDED.'
3430 IF R2=1.E+38 THEN 3480
3440 PRINT'THE BOUND ON THE ';B$;' IS ';R2;' .':S=S2:
	PRINT'  AT THIS POINT VARIABLE ';S;' CAN ENTER THE BASIS.'
3460 GOSUB 1075:GOSUB 3600:GOTO3490
3480 PRINT 'THE ';B$;' IS NOT BOUNDED.'
3490 GOTO 3010
3500 RETURN
3510 GOTO9999
3600 IF Q=1.E+38 THEN 3630
3610 PRINT'VARIABLE ';B(R);' WILL LEAVE THE BASIS,':GOTO3640
3630 PRINT'VARIABLE';S;' IS UNBLOCKED. THE PROBLEM IS UNBOUNDED.'
3640 RETURN
3650 GOTO9999
4000 REM SUBROUTINE FOR SENSITIVITY ANALYYSIS ON RHS
4010 PRINT'YOU CAN NOW DO PARAMETRIC ANALYSIS ON THE RIGHT HAND SIDE.'
4020 PRINT:PRINT:PRINT'HOW MANY CAPACITIES DO YOU WISH TO CHANGE';
4050 INPUT T:IFT=0THEN4720
4070 PRINT'WHICH CAPACITIES DO YOU WISH TO CHANGE';:MAT INPUT D(T):
	FORI=1TOT:IFABS(D(I))<=MTHEN4130
4110PRINT'CONSTRAINT 'ABS(D(I))'DOES NOT EXIST. TRY AGIN.'
4120GOTO4020
4130 NEXT I
4140 R1=1.E+38
4150 FOR I=1 TO M2:F(I)=0:FORJ=1TOT:E=ABS(D(J))/D(J)
4190 IFE*D(J)>LTHEN4220
4200 F(I)=F(I)+E*A(I,E*D(J)+N):GOTO4230
4220 F(I)=F(I)+E*A(I,E*D(J)+G+N)
4230 NEXT J
4235 IF I>M THEN 4290
4240 IF F(I)>=-.00001 THEN 4290
4250 D1=-A(I,C1)/F(I):IFD1>=R1THEN4290
4270R1=D1:R=I
4290 NEXT I
4300 IF R1<1.E+38 THEN 4330
4310 PRINT'THERE IS NO FURTHER BOUND ON THE CHANGE.':GOTO4560
4330 PRINT'THE NEXT BOUND ON THE CHANGE IS ';R1;'. VARIABLE ';B(R):PRINT'WILL GO TO ZERO.':FORI=1TOM2:A(I,C1)=A(I,C1)+F(I)*R1:NEXTI
4375A(R,C1)=0:R1=-1.E+38:FORJ=1TOC2:FORI=1TOM:IFB(I)=JTHEN4470
4420 NEXT I
4430 IF A(R,J)>=-.00001 THEN 4470
4440 IF A(M3,J)/A(R,J)<=R1 THEN 4470
4450 R1=A(M3,J)/A(R,J):S=J
4470 NEXT J
4480 IF R1>-1.E+38 THEN 4510
4490 PRINT'BEYOND THIS POINT THE PROBLEM IS NOT FEASIBLE':GOTO4560
4510 PRINT'VARIABLE ';S;' WILL ENTER THE BASIS.':GOSUB 1180:PRINT'THE NEW OPTIMAL SOLUTION IS:':GOSUB 700:GOTO4140
4560 PRINT:PRINT"TYPE A '1' TO REVERSE THE PREVIOUS PARAMETRIC ANALYSIS,"
4580 PRINT"A '2' TO START ANOTHER PARAMETRIC ANALYSIS AT THIS POINT"
4590PRINT"      OR A '3' TO DO ANOTHER PARAMETRIC ANALYSIS ON THE"
4600PRINT"ORIGINAL CAPACITIES. TYPE A '0' TO QUIT."
4610 INPUT P4
4620 IF P4=0 THEN 4720
4630IFP4=2THEN4020
4640IFP4=3THEN241
4650IFP4=1THEN4680
4660PRINT P4' IS NOT A LEGAL CODE. TRY AGAIN.'
4670 GOTO 4560
4680 FOR I=1 TO T
4690 D(I)=-D(I)
4700 NEXT I
4710 GOTO 4140
4720 RETURN
4730 GOTO 9999
5000 DATA 4,9,7,10
5010 DATA 1,1,3,40
5020 DATA 4000,6000
5030 DATA 12,20,18,40
9999 CLOSE1%:KILL'DATA.DAT':END