Trailing-Edge
-
PDP-10 Archives
-
decus_20tap5_198111
-
decus/20-0137/linpro/linpro.for
There is 1 other file named linpro.for in the archive. Click here to see a list.
00100 C WESTERN MICHIGAN UNIVERSITY
00200 C LINPRO.F4 (FILENAME ON LIBRARY DECTAPE)
00300 C LINPRO, 2.13.1 (CALLING NAME SUBLST #)
00400 C LINEAR PROGRAMMING MANIPULATION PROGRAM
00500 C LINPRO.F4 WAS PROGRAMMED BY A. H. WRIGHT (MATH DEPT. WMU)
00600 C MODIFIED BY R.R. BARR
00700 C LIBRARY DECTAPE PROGRAMS USED: USAGE.MAC
00800 C INTERNAL SUBR. USED: MATOUT, COND
00900 C ABOVE COMMENTS AND RIGHT ADJUSTED COMMENTS PUT IN BY WG
01000 C
01100 C THIS IS A INTERACTIVE TUTORIAL PROGRAM TO TEACH THE SIMPLEX METHOD
01200 C OF LINEAR PROGRAMMING. IT WILL WORK WITH ANY METHOD OF
01300 C LINEAR PROGRAMMING WHICH USES THE STANDARD SIMPLEX TABLEAU
01400 C AND STANDARD PIVOT OPERATIONS. THE USER MUST CHOOSE THE PIVOT
01500 C ENTRY OF THE TABLEAU, AND THE PROGRAM WILL DO THE PIVOT COMPUTATIONS.
01600 C
01700 C THE USER HAS THE CHOICE OF FOUR DIFFERENT TABLEAU FORMATS.
01800 C THE OBJECTIVE FUNCTION ROW MAY BE ON THE TOP OR BOTTOM OF
01900 C THE TABLEAU, AND THE CONSTANT COLUMN MAY BE ON THE RIGHT OR
02000 C ON THE LEFT.
02100 C
02200 C IN ADDITION THE THE OPTIONS FOR PIVOTING AND FOR PRINTING
02300 C THE TABLEAU, THERE ARE A NUMBER OF EDITING OPTIONS. A LIST
02400 C OF OPTIONS MAY BE OBTAINED BY TYPING HELP WHEN THE COMPUTER
02500 C ASKS FOR AN OPTION.
02600 C
02700 C *******************************************************************
02800 C
02900 C REQUIRED SUBROUTINES:
03000 C
03100 C MATOUT(INTERN.) PRINTS TABLEAU
03200 C COND(INTERN.) DETERMINES COLUMNS OF THE TABLEAU WHICH CONTAIN
03300 C ONLY ZEROS, ONES, AND MINUS ONES
03400 C USAGEB APPLICATIONS ROUTINE(APLIB)
03500 C
03600 C *******************************************************************
03700 C
03800 C LOAD PROCEDURE: LOA LINPRO,USAGE
03900 C
04000 C *******************************************************************
04100 C
04200 C LIST OF IMPORTANT VARIABLES:
04300 C
04400 C J IS ALWAYS USED AS A ROW INDEX
04500 C P IS THE HIGHEST INDEX OF A ROW
04600 C P0 IS THE LOWEST INDEX OF A ROW
04700 C P00 IS THE INDEX OF THE OBJECTIVE FUNCTION ROW
04800 C
04900 C I IS ALWAYS USED AS A COLUMN INDEX
05000 C N IS THE HIGHEST INDEX OF A COLUMN
05100 C N0 IS THE LOWEST INDEX OF A COLUMN
05200 C N00 IS THE INDEX OF THE CONSTANT COLUMN
05300 C
05400 C T STORES THE TABLEAU
05500 C TOLD SAVES THE TABLEAU FOR THE "RETURN" OPTION
05600 C TSAVE SAVES THE TABLEAU FOR THE "SAVE" AND THE "RECALL" OPTIONS
05700 C
05800 C IND(J) A LOGICAL VARIABLE WHICH IS TRUE IF COLUMN I
05900 C CONTAINS ONLY ZEROS, ONES, AND MINUS ONES.
06000 C OTHERWISE IT IS FALSE.
06100 C
06200 C
06300 LOGICAL IND,INDSAVE,INDOLD,IP,IN
06400 INTEGER P,POLD,PSAVE,P0,P00,P9
06500 DIMENSION T(0/35,0/35),IND(0/35),TOLD(0/35,0/35),
06600 1 INDOLD(0/35),TSAVE(0/35,0/35),INDSAVE(0/35)
06700 COMMON N0,P0,N00,P00
06800 C *******************************************************************
06900 C
07000 C THIS SECTION SETS UP THE TABLEAU FORMAT AND INPUTS THE TABLEAU
07100 C
07200 C *********************************************************************
07300 WRITE(5,8)
07400 8 FORMAT(' TABLEAU OPTIONS')
07500 C CALL USAGEB('LINPRO')
07600 400 WRITE(5,401)
07700 401 FORMAT(' OBJECTIVE FUNCTION (TOP OR BOTTOM)?'$)
07800 499 READ(5,402)ANS,ANS1
07900 402 FORMAT(2A5)
08000 IF(ANS.EQ.3HTOP.OR.ANS.EQ.5H"TOP")GO TO 405
08100 IF((ANS.EQ.5HBOTTO.AND.ANS1.EQ.1HM).OR.(ANS.EQ.5H"BOTT.AND.ANS1
08200 1 .EQ.3HOM"))GO TO 410
08300 WRITE(5,403)
08400 403 FORMAT(' IF YOU WANT THE ROW FOR THE OBJECTIVE FUNCTION TO
08500 1 BE PRINTED ON THE'/' TOP OF THE TABLEAU, ANSWER "TOP".
08600 2 IF YOU WANT THE ROW FOR THE OBJECTIVE'/' FUNCTION TO BE PRINTED
08700 3 AT THE BOTTOM OF THE TABLEAU, ANSWER "BOTTOM".')
08800 GO TO 499
08900 405 P0 = 0
09000 P00 = 0
09100 IP = .FALSE.
09200 GO TO 450
09300 410 P0 = 1
09400 IP = .TRUE.
09500 450 WRITE(5,451)
09600 451 FORMAT(' CONSTANT COLUMN (RIGHT OR LEFT)?'$)
09700 READ(5,452)ANS,ANS1
09800 452 FORMAT(2A5)
09900 IF((ANS.EQ.5HRIGHT).OR.(ANS.EQ.5H"RIGH.AND.ANS1.EQ.2HT"))GO TO 460
10000 IF((ANS.EQ.4HLEFT).OR.(ANS.EQ.5H"LEFT))GO TO 455
10100 WRITE(5,453)
10200 453 FORMAT(' IF THE WANT THE COLUMN OF CONSTANTS IN THE TABLEAU
10300 1 TO BE PRINTED ON THE'/' LEFT SIDE OF THE TABLEAU, ANSWER
10400 2 "LEFT". IF YOU WANT THE COLUMN OF CONSTANTS TO '/' BE PRINTED
10500 3 ON THE RIGHT SIDE OF THE TABLEAU, ANSWER "LEFT".')
10600 455 NO = 0
10700 NOO = 0
10800 IN = .FALSE.
10900 GO TO 1
11000 460 N0 = 1
11100 IN = .TRUE.
11200 1 IF(IP)GO TO 2
11300 WRITE(5,5)
11400 5 FORMAT(' INPUT THE NUMBER OF CONSTRAINTS?'$)
11500 READ(5,6)P
11600 6 FORMAT(I)
11700 GO TO 15
11800 2 WRITE(5,3)
11900 3 FORMAT(' INPUT THE NUMBER OF ROWS?'$)
12000 READ(5,6)P
12100 P00 = P
12200 15 IF(IN)GO TO 22
12300 WRITE(5,16)
12400 16 FORMAT(' INPUT THE NUMBER OF VARIABLES?'$)
12500 READ(5,6)N
12600 GO TO 29
12700 22 WRITE(5,17)
12800 17 FORMAT(' INPUT THE NUMBER OF COLUMNS?'$)
12900 READ(5,6)N
13000 N00 = N
13100 29 WRITE(5,10)
13200 10 FORMAT(' INPUT TABLEAU'/)
13300 DO 11 J = P0,P
13400 WRITE(5,30)J
13500 30 FORMAT('+ROW',I2,'?',$)
13600 11 READ(5,21)(T(J,I),I = N0,N)
13700 21 FORMAT(35F)
13800 39 CALL COND(T,IND,P,N)
13900 C *********************************************************************
14000 C
14100 C THIS SECTION CHOSSES THE OPTION
14200 C
14300 C *********************************************************************
14400 40 WRITE(5,41)
14500 41 FORMAT(' OPTION?'$)
14600 READ(5,42)OPT
14700 42 FORMAT(A5)
14800 IF(OPT.EQ.'PIV '.OR.OPT.EQ.'PIVOT')GO TO 49
14900 IF(OPT.EQ.'STOP ')GO TO 1000
15000 IF(OPT.EQ.'P'.OR.OPT.EQ.'PRINT')GO TO 300
15100 IF(OPT.EQ.'CROW ')GO TO 2000
15200 IF(OPT.EQ.'CCOL ')GO TO 3000
15300 IF(OPT.EQ.'DROW ')GO TO 5000
15400 IF(OPT.EQ.'DCOL')GO TO 5500
15500 IF(OPT.EQ.'PROW')GO TO 6000
15600 IF(OPT.EQ.'PCOL')GO TO 6500
15700 IF(OPT.EQ.'AROW')GO TO 7000
15800 IF(OPT.EQ.'ACOL')GO TO 7500
15900 IF(OPT.EQ.'CENT')GO TO 3400
16000 IF(OPT.EQ.'PENT')GO TO 3600
16100 IF(OPT.EQ.'RETUR')GO TO 8000
16200 IF(OPT.EQ.'SAVE')GO TO 8200
16300 IF(OPT.EQ.'RECAL')GO TO 8400
16400 IF(OPT.EQ.'HELP '.OR.OPT.EQ.'H '.OR.OPT.EQ.'"HELP')GO TO 4000
16500 WRITE(5,44)
16600 44 FORMAT(' TYPE "HELP" FOR A LIST OF OPTIONS')
16700 GO TO 40
16800 C *********************************************************************
16900 C
17000 C PIVOT OPTION SECTION
17100 C
17200 C *********************************************************************
17300 49 POLD = P
17400 NOLD = N
17500 DO 55 I = N0,N
17600 INDOLD(I) = IND(I)
17700 DO 55 J = P0,P
17800 55 TOLD(J,I) = T(J,I)
17900 WRITE(5,50)
18000 50 FORMAT(' INPUT THE PIVOT COLUMN?'$)
18100 READ(5,60,ERR=8998)I0
18200 60 FORMAT(I)
18300 IF(I0.EQ.N00)GO TO 64
18400 IF(I0.GE.N0.AND.I0.LE.N)GO TO 65
18500 WRITE(5,9001)
18600 GO TO 40
18700 64 WRITE(5,63)N00
18800 63 FORMAT(' ARE YOU SURE YOU WANT TO PIVOT IN COLUMN',I2 ,'?'$)
18900 READ(5,62,ERR=8998)ANS
19000 62 FORMAT(A5)
19100 IF(ANS.EQ.'NO')GO TO 49
19200 65 WRITE(5,70)
19300 70 FORMAT('+DO YOU WANT RATIOS PRINTED (YES OR NO)?'$)
19400 READ(5,80,ERR=8998)ANS
19500 80 FORMAT(A3)
19600 IF(ANS.EQ.2HNO)GO TO 100
19700 IF(ANS.EQ.3HYES)GO TO 71
19800 WRITE(5,72)
19900 72 FORMAT(' ANSWER YES OR NO'/)
20000 GO TO 65
20100 71 DO 90 J = 1,P
20200 IF(J.EQ.P00)GO TO 90
20300 IF(T(J,I0).NE.0.)GO TO 81
20400 WRITE(5,82)
20500 82 FORMAT(' DIVISION BY ZERO')
20600 GO TO 90
20700 81 QUOT = T(J,N00)/T(J,I0)
20800 WRITE(5,85)QUOT
20900 85 FORMAT(1X,G9.3)
21000 90 CONTINUE
21100 WRITE(5,99)
21200 99 FORMAT()
21300 100 WRITE(5,110)
21400 110 FORMAT('+INPUT THE PIVOT ROW?'$)
21500 READ(5,120,ERR=8998)J0
21600 120 FORMAT(I)
21700 IF(J0.EQ.P00)GO TO 128
21800 IF(J0.GE.P0.AND.J0.LE.P)GO TO 129
21900 WRITE(5,9000)
22000 GO TO 40
22100 128 WRITE(5,124)P00
22200 124 FORMAT(' ARE YOU SURE YOU WANT TO PIVOT IN ROW',I2,'?'$)
22300 READ(5,123,ERR=8998)ANS
22400 123 FORMAT(A5)
22500 IF(ANS.EQ.'NO')GO TO 100
22600 129 DO 180 I = N0,N
22700 IF(.NOT.IND(I))GO TO 180
22800 IF(T(J0,I).EQ.-1.OR.T(J0,I).EQ.1)IND(I) = .FALSE.
22900 180 CONTINUE
23000 IND(I0) = .TRUE.
23100 PIV = T(J0,I0)
23200 IF(PIV.NE.0.)GO TO 349
23300 WRITE(5,348)
23400 348 FORMAT(' YOU CANNOT PIVOT AT A ZERO ENTRY IN THE TABLEAU')
23500 GO TO 40
23600 349 DO 350 I = N0,N
23700 350 T(J0,I) = T(J0,I)/PIV
23800 DO 200 J = P0,P
23900 IF(J.EQ.J0)GO TO 200
24000 E = T(J,I0)
24100 DO 190 I = N0,N
24200 190 T(J,I) = T(J,I)-E*T(J0,I)
24300 200 CONTINUE
24400 DO 210 J=P0,P
24500 DO 210 I=N0,N
24600 IF(ABS(T(J,I)).GE.2E-7)GO TO 201
24700 T(J,I) = 0.
24800 GO TO 210
24900 201 IF(ABS(T(J,I)-1.).GE.2E-7)GO TO 202
25000 T(J,I) = 1.
25100 GO TO 210
25200 202 IF(ABS(T(J,I)+1.).GE.2E-7)GO TO 210
25300 T(J,I) = -1
25400 210 CONTINUE
25500 GO TO 40
25600 C *********************************************************************
25700 C
25800 C PRINT SECTION (PRINTS TABLEAU)
25900 C
26000 C *********************************************************************
26100 300 CALL MATOUT (T,IND,P,N)
26200 GO TO 40
26300 C *********************************************************************
26400 C
26500 C STOP OPTION SECTION
26600 C
26700 C *********************************************************************
26800 1000 WRITE(5,1010)
26900 1010 FORMAT(' DO YOU WANT TO DO ANOTHER PROBLEM?'$)
27000 READ(5,1020,ERR=8998)ANS
27100 1020 FORMAT(A5)
27200 IF(ANS.EQ.'YES ')GO TO 1
27300 STOP
27400 C *********************************************************************
27500 C
27600 C CROW (CHANGE ROW) OPTION SECTION
27700 C
27800 C *********************************************************************
27900 2000 WRITE(5,2010)
28000 2010 FORMAT(' INPUT THE NUMBER OF THE ROW YOU WANT TO CHANGE?'$)
28100 READ(5,2020,ERR=8998)J0
28200 2020 FORMAT(I)
28300 IF(J0.GE.P0.AND.J0.LE.P)GO TO 2021
28400 WRITE(5,9000)
28500 GO TO 40
28600 2021 WRITE(5,2030)J0
28700 2030 FORMAT(' INPUT ROW',I3,/' ?'$)
28800 READ(5,2040,ERR=8998)(T(J0,I),I=N0,N)
28900 2040 FORMAT(35F)
29000 CALL COND(T,IND,P,N)
29100 GO TO 40
29200 C *********************************************************************
29300 C
29400 C CCOL (CHANGE COLUMN) OPTION SECTION
29500 C
29600 C *********************************************************************
29700 3000 WRITE(5,3010)
29800 3010 FORMAT(' INPUT THE NUMBER OF THE COLUMN YOU WANT TO CHANGE?'$)
29900 READ(5,3020,ERR=8998)I0
30000 3020 FORMAT(I)
30100 IF(I0.GE.N0.AND.I0.LE.N)GO TO 3021
30200 WRITE(5,9001)
30300 GO TO 40
30400 3021 WRITE(5,3030)I0
30500 3030 FORMAT(' INPUT COLUMN',I3,' (IN A ROW)'/' ?'$)
30600 READ(5,3040,ERR=8998)(T(J,I0),J=P0,P)
30700 3040 FORMAT(35F)
30800 IF(N.GT.8)CALL COND(T,IND,P,N)
30900 GO TO 40
31000 C *********************************************************************
31100 C
31200 C CENT (CHANGE ENTRY) OPTION SECTION
31300 C
31400 C *********************************************************************
31500 3400 WRITE(5,3410)
31600 3410 FORMAT(' INPUT THE ROW AND COLUMN INDICES OF THE ENTRY YOU',
31700 1 ' WANT TO CHANGE?'$)
31800 READ(5,3420,ERR=8998)J0,I0
31900 3420 FORMAT(2I)
32000 IF(J0.GE.P0.AND.J0.LE.P)GO TO 3425
32100 WRITE(5,9000)
32200 GO TO 40
32300 3425 IF(I0.GE.N0.AND.I0.LE.N)GO TO 3429
32400 WRITE(5,9001)
32500 GO TO 40
32600 3429 WRITE(5,3430)
32700 3430 FORMAT(' INPUT THE NEW ENTRY?'$)
32800 READ(5,3440,ERR=8998)T(J0,I0)
32900 3440 FORMAT(F)
33000 GO TO 39
33100 C *********************************************************************
33200 C
33300 C PENT (PRINT ENTRY) OPTION SECTION
33400 C
33500 C *********************************************************************
33600 3600 WRITE(5,3610)
33700 3610 FORMAT(' INPUT THE ROW AND COLUMN INDICES OF THE ENTRY YOU',
33800 1 ' WANT TO PRINT?'$)
33900 READ(5,3620,ERR=8998)J0,I0
34000 3620 FORMAT(2I)
34100 IF(J0.GE.P0.AND.J0.LE.P)GO TO 3625
34200 WRITE(5,9000)
34300 GO TO 40
34400 3625 IF(I0.GE.N0.AND.I0.LE.N)GO TO 3629
34500 WRITE(5,9001)
34600 GO TO 40
34700 3629 WRITE(5,3630)J0,I0,T(J0,I0)
34800 3630 FORMAT(' THE ENTRY IN ROW',I3,' AND COLUMN',I3,' IS',G15.7)
34900 GO TO 40
35000 C *********************************************************************
35100 C
35200 C HELP (LIST OF OPTIONS) OPTION SECTION
35300 C
35400 C *********************************************************************
35500 4000 WRITE(5,4010)
35600 4010 FORMAT(' LIST OF OPTIONS:'/' PRINT',T25,'PRINTS TABLEAU'/
35700 1 ' PIV',T25,'ALLOWS USER TO DO A PIVOT OPERATION'/
35800 2 ' CROW',T25,'ALLOWS USER TO CHANGE A ROW OF THE TABLEAU'/
35900 3 ' CCOL',T25,'ALLOWS USER TO CHANGE A COLUMN'/
36000 4 ' DROW',T25,'ALLOWS USER TO DELETE A ROW OF THE TABLEAU'/
36100 5 ' DCOL',T25,'ALLOWS USER TO DELETE A COLUMN OF THE TABLEAU'/
36200 6 ' PROW',T25,'ALLOWS USER TO PRINT A ROW OF THE TABLEAU'/
36300 7 ' PCOL',T25,'ALLOWS USER TO PRINT A COLUMN OF THE TABLEAU'/
36400 8 T35,'(TO SIX SIGNIFICANT FIGURE ACCURACY)')
36500 WRITE(5,4020)
36600 4020 FORMAT(' AROW',T25,'ALLOWS USER TO ADD A NEW ROW'/
36700 1 ' ACOL',T25,'ALLOWS USER TO ADD A NEW COLUMN'/
36800 2 ' CENT',T25,'ALLOWS USER TO CHANGE ONE ENTRY OF THE TABLEAU'/
36900 3 ' PENT',T25,'ALLOWS USER TO PRINT ONE ENTRY OF THE TABLEAU'/
37000 4 T35,'(TO SEVEN SIGNIFICANT FIGURE ACCURACY)'/
37100 5 ' RETURN',T25,'RETURNS TABLEAU TO WHAT IT WAS'/
37200 6 T35,'BEFORE THE LAST PIVOT'/
37300 7 ' SAVE',T25,'SAVES TABLEAU'/
37400 7 ' RECALL',T25,'RECALLS TABLEAU SAVED BY SAVE OPTION'/
37500 8 ' STOP',T25,'STOP')
37600 GO TO 40
37700 C *********************************************************************
37800 C
37900 C DROW (DELETE ROW) OPTION SECTION
38000 C
38100 C *********************************************************************
38200 5000 WRITE(5,5010)
38300 5010 FORMAT(' INPUT THE NUMBER OF THE ROW TO BE DELETED?',$)
38400 READ(5,5020,ERR=8998)J0
38500 5020 FORMAT(I)
38600 IF(J0.GE.P0.AND.J0.LE.P)GO TO 5021
38700 WRITE(5,9000)
38800 GO TO 40
38900 5021 DO 5030 J = J0+1,P
39000 DO 5030 I = N0,N
39100 5030 T(J-1,I) = T(J,I)
39200 P = P-1
39300 IF(IP)P00 = P
39400 GO TO 40
39500 5500 WRITE(5,5510)
39600 5510 FORMAT(' INPUT THE NUMBER OF THE COLUMN TO BE DELETED?',$)
39700 READ(5,5520,ERR=8998)I0
39800 5520 FORMAT(I)
39900 IF(I0.GE.N0.AND.I0.LE.N)GO TO 5521
40000 WRITE(5,9001)
40100 GO TO 40
40200 5521 DO 5530 I = I0+1,N
40300 IND(I-1)=IND(I)
40400 DO 5530 J = P0,P
40500 5530 T(J,I-1) = T(J,I)
40600 N = N-1
40700 IF(IN)N00 = N
40800 GO TO 40
40900 C *********************************************************************
41000 C
41100 C PROW (PRINT ROW) OPTION SECTION
41200 C
41300 C *********************************************************************
41400 6000 WRITE(5,6010)
41500 6010 FORMAT(' INPUT THE NUMBER OF THE ROW TO BE PRINTED?',$)
41600 READ(5,6020,ERR=8998)J0
41700 6020 FORMAT(I)
41800 IF(J0.GE.P0.AND.J0.LE.P)GO TO 6021
41900 WRITE(5,9000)
42000 GO TO 40
42100 6021 WRITE(5,6030)(T(J0,I),I=N0,N)
42200 6030 FORMAT(5(1X,G10.4,1X))
42300 GO TO 40
42400 C *********************************************************************
42500 C
42600 C PCOL (PRINT COLUMN) OPTION SECTION
42700 C
42800 C *********************************************************************
42900 6500 WRITE(5,6510)
43000 6510 FORMAT(' INPUT THE NUMBER OF THE COLUMN TO BE PRINTED?',$)
43100 READ(5,6520,ERR=8998)I0
43200 6520 FORMAT(I)
43300 IF(I0.GE.N0.AND.I0.LE.N)GO TO 6521
43400 WRITE(5,9001)
43500 GO TO 40
43600 6521 WRITE(5,6530)(T(J,I0),J=P0,P)
43700 6530 FORMAT(1X,G12.6)
43800 GO TO 40
43900 C *********************************************************************
44000 C
44100 C AROW (ADD ROW) OPTION SECTION
44200 C
44300 C *********************************************************************
44400 7000 P9 = P0-1
44500 WRITE(5,7010)P9
44600 7010 FORMAT(' INPUT THE NUMBER OF THE ROW
44700 1 JUST BEFORE THE ROW YOU
44800 2 WANT TO ADD,'/' (INPUT',I3,' IF YOU WANT A NEW FIRST ROW)?',$)
44900 READ(5,7020,ERR=8998)J0
45000 7020 FORMAT(I)
45100 IF(J0.GE.P9.AND.J0.LE.P)GO TO 7030
45200 WRITE(5,9000)
45300 GO TO 40
45400 7030 DO 7040 J= P,J0+1,-1
45500 DO 7040 I = N0,N
45600 7040 T(J+1,I) = T(J,I)
45700 WRITE(5,7050)
45800 7050 FORMAT(' INPUT THE NEW ROW?'$)
45900 READ(5,7060,ERR=8998)(T(J0+1,I),I=N0,N)
46000 7060 FORMAT(35F)
46100 P = P+1
46200 IF(IP)P00 = P
46300 CALL COND(T,IND,P,N)
46400 GO TO 40
46500 C *********************************************************************
46600 C
46700 C ACOL (ADD COLUMN) OPTION SECTION
46800 C
46900 C *********************************************************************
47000 7500 N9 =N0-1
47100 WRITE(5,7510)N9
47200 7510 FORMAT(' INPUT THE NUMBER OF THE COLUMN JUST BEFORE THE
47300 1 COLUMN YOU WANT TO ADD,'/' (INPUT',I3,' IF YOU WANT A NEW
47400 2 FIRST COLUMN)?',$)
47500 READ(5,7520,ERR=8998)I0
47600 7520 FORMAT(I)
47700 IF(I0.GE.N9.AND.I0.LE.N)GO TO 7530
47800 WRITE(5,9001)
47900 GO TO 40
48000 7530 DO 7540 I = N,I0+1,-1
48100 DO 7540 J = P0,P
48200 7540 T(J,I+1) = T(J,I)
48300 WRITE(5,7550)
48400 7550 FORMAT(' INPUT THE NEW COLUMN (IN A ROW)?'$)
48500 READ(5,7560,ERR=8998)(T(J,I0+1),J=P0,P)
48600 7560 FORMAT(35F)
48700 N = N+1
48800 IF(IN)N00 = N
48900 CALL COND(T,IND,P,N)
49000 GO TO 40
49100 C *********************************************************************
49200 C
49300 C RETURN (TO TABLEAU BEFORE LAST PIVOT) OPTION SECTION
49400 C
49500 C *********************************************************************
49600 8000 P = POLD
49700 N = NOLD
49800 IF(IP)P00 = P
49900 IF(IN)N00 = N
50000 DO 8001 I = N0,N
50100 IND(I) = INDOLD(I)
50200 DO 8001 J = P0,P
50300 8001 T(J,I) = TOLD(J,I)
50400 GO TO 40
50500 C *********************************************************************
50600 C
50700 C SAVE (TABLEAU) OPTION SECTION
50800 C
50900 C *********************************************************************
51000 8200 PSAVE = P
51100 NSAVE = N
51200 DO 8201 I = N0,N
51300 INDSAVE(I) = IND(I)
51400 DO 8201 J = P0,P
51500 8201 TSAVE(J,I) = T(J,I)
51600 GO TO 40
51700 C *********************************************************************
51800 C
51900 C RECALL (SAVED TABLEAU) OPTION SECTION
52000 C
52100 C *********************************************************************
52200 8400 P = PSAVE
52300 N = NSAVE
52400 IF(IP)P00 = P
52500 IF(IN)N00 = N
52600 DO 8401 I = N0,N
52700 IND(I) = INDSAVE(I)
52800 DO 8401 J = P0,P
52900 8401 T(J,I) = TSAVE(J,I)
53000 GO TO 40
53100 8998 WRITE(5,8999)
53200 8999 FORMAT(' INPUT DATA NOT IN CORECT FORM. START OVER.')
53300 GO TO 40
53400 9000 FORMAT(' ILLEGAL ROW NUMBER')
53500 9001 FORMAT(' ILLEGAL COLUMN NUMBER')
53600 END
53700 C *********************************************************************
53800 C
53900 C---------------T=TABLEAU ARRAY, IND INDICATES WHICH COLS. HAVE ONLY
54000 C--------------- ZEROS, ONES, AND MINUS ONES, P=HIGHEST INDEX OF A ROW,
54100 C--------------- N=HIGHEST INDEX OF A COL. SEE LIST OF IMPORTANT VARS.
54200 C--------------- ON FIRST PAGE.
54300 C---------------ALL ARGS ARE INPUT. N0, N00, P0 ARE INPUT THRU COMMON.
54400 C SUBROUTINE MATOUT FOR MAIN PROGRAM LINPRO.F4
54500 C
54600 C *********************************************************************
54700 SUBROUTINE MATOUT(T,IND,P,N)
54800 LOGICAL IND,INDSAVE,INDOLD
54900 COMMON N0,P0,N00,P00
55000 INTEGER P,P0,P00
55100 DIMENSION T(0/35,0/35),IND(0/35)
55200 60 N1 = N0
55300 61 M=0
55400 DO 66 I = N1,N
55500 M = M+4
55600 IF(.NOT.IND(I))M = M+6
55700 IF(M.GT.72)GO TO 69
55800 66 CONTINUE
55900 N2 = N
56000 GO TO 68
56100 69 N2 = I-1
56200 68 DO 99 I = N1,N2
56300 IF(I.EQ.N00)GO TO 77
56400 IF(IND(I))GO TO 72
56500 IF(I.GT.9)GO TO 97
56600 WRITE (5,75)I
56700 75 FORMAT(3H+ X,I1,7X,$)
56800 GO TO 99
56900 97 WRITE(5,78)I
57000 78 FORMAT(3H+ X,I2,6X,$)
57100 GO TO 99
57200 72 IF(I.GT.9)GO TO 95
57300 WRITE(5,93)I
57400 93 FORMAT(3H+ X,I1,1X,$)
57500 GO TO 99
57600 95 WRITE(5,96)I
57700 96 FORMAT(3H+ X,I2,$)
57800 GO TO 99
57900 77 IF(IND(I))GO TO 88
58000 WRITE(5,86)
58100 86 FORMAT(3H+ B,8X,$)
58200 GO TO 99
58300 88 WRITE(5,76)
58400 76 FORMAT(3H+ B,2X$)
58500 99 CONTINUE
58600 DO 70 J = P0,P
58700 WRITE(5,80)
58800 80 FORMAT(/)
58900 DO 70 I = N1,N2
59000 IF(IND(I))GO TO 62
59100 WRITE(5,65)T(J,I)
59200 65 FORMAT(1H+,G9.3,1X,$)
59300 GO TO 70
59400 62 WRITE(5,63)T(J,I)
59500 63 FORMAT(1H+,F3.0,1X,$)
59600 70 CONTINUE
59700 WRITE(5,80)
59800 IF(N2.GE.N)RETURN
59900 N1 = N2+1
60000 WRITE(5,401)
60100 401 FORMAT()
60200 GO TO 61
60300 END
60400 C *********************************************************************
60500 C
60600 C---------------SEE DEP. OF T, IND, P, N IN SUBR. MATOUT JUST ABOVE
60700 C--------------- THIS SUBR. IS CALLED BY MAIN PROG. ST. 39 (SECTION
60800 C--------------- THAT SETS UP TABLEAU FORMAT AND INPUTS TABLEAU), CROW
60900 C--------------- OPTION, CCOL OPTION, AROW OPTION, ACOL OPTION. THIS
61000 C--------------- SUBR. UPDATES IND(I) AFTER USER INPUTS TABLEAU, AND/OR
61100 C--------------- ROWS AND/OR COLS.
61200 C---------------N,P,T ARE INPUT. IND IS RETURNED. N0, P0 ARE INPUT
61300 C--------------- THRU COMMON
61400 C SUBROUTINE COND FOR MAIN PROGRAM LINPRO.F4
61500 C
61600 C *********************************************************************
61700 SUBROUTINE COND(T,IND,P,N)
61800 LOGICAL IND,INDOLD,INDSAVE
61900 COMMON N0,P0,N00,P00
62000 INTEGER P,P0,P00
62100 DIMENSION T(0/35,0/35),IND(0/35)
62200 DO 30 I = N0,N
62300 IND(I) = .TRUE.
62400 DO 10 J = P0,P
62500 IF(T(J,I).NE.0..AND.T(J,I).NE.1..AND.T(J,I).NE.-1.)GO TO 20
62600 10 CONTINUE
62700 GO TO 30
62800 20 IND(I) = .FALSE.
62900 30 CONTINUE
63000 END