PDP-10 Archive: decus/20-0137/rvslpr/rvslpr.for from decus_20tap5

Trailing-Edge - PDP-10 Archives - decus_20tap5_198111 - decus/20-0137/rvslpr/rvslpr.for
There are 2 other files named rvslpr.for in the archive. Click here to see a list.
C	WESTERN MICHIGAN UNIVERSITY
C	RVSLPR.FOR (FILENAME ON LIBRARY DECTAPE)
C	RVSLPR, 2.2.5 (CALLING NAME, SUBLST #)
C	LINEAR PROG. (REVISED SIMPLEX METHOD)
C	ADAPTED FROM A PROGRAM LISTED IN "LP SUB - A FORTRAN 
C	 SUBROUTINE FOR SOLVING ANY STANDARD LINEAR PROGRAMMING 
C	 PROBLEM OF A SIZE COMPATIBLE WITH THE COMPUTER BEING USED."
C	 NAVAL RESEARCH LABORATORY, WASH., D.C., JAN. 1972.
C	THIS WAS PROGRAMMED BY C. M. DAVISSON.
C	THE ADAPTATION WAS DONE BY BILL GRANET, BOBBY HUNG, AND 
C	 DR. A WRIGHT.
C	APLB10 PROGS. USED:  IO
C	LIBRARY DECTAPE PROGS. USED:  USAGE.MAC
C	FORWMU PROGS. USED:  ALLCOR, TTYPTY, EXISTS, GES, DEVCHR,
C	 GETPPN, JOBNUM, PRINTS, RUNUUO, EXIST
C	INTERNAL SUBR. USED:  MAIN1, MAIN2
C	EXTERNAL SUBROUTINES USED:  SEGMT1, SEGMT2
C	ABOVE COMMENTS AND RIGHT ADJUSTED COMMENTS PUT IN BY WG
C
C	COMMON /IOB/ IS SHARED WITH SUBR. IO IN BNKLIB.FOR
C	TOL1 THRU TOLII ARE EXPLAINED IN SECTION 10.0 OF WRITE UPS
C	COMMON /IOB/, /IOD/, AND /NONDYN/ ARE SHARED WITH MAIN1,
C	 MAIN2,  SEGMT1, SEGMT2
	COMMON/IOD/NDEVO,DEVNAM,IDVO,IFLNMO,IPJ,IPG,IBNK,
	1NDEVI,IDVI,IFLNMI
	COMMON/IOB/LEFBK,IRTBK,IART,MAXPAG,IPAGE,IPAGCT,IDLG
	1,IRSP,ICODE,JDUMMY
	COMMON/NONDYN/NR,NC,NR2,NCFIN,JTYPE,TABLO,ICOND,ISWST
	1,FIRST1,FIRST2,ITERRI,FLAG1,FLAG2,LSTOP,FLAG,
	2TOL1,TOL2,TOL3,TOL4,TOL5,TOL6,TOL7,TOL8,IPHASE,
	3TOL9,TOL10,TOL11,GREAT,NEQUAL,ITERR
	DIMENSION A(1)
	TOL1=1.0E-5
	TOL2=1.0E-6
	TOL3=1.0E-7
	TOL4=1.0E+7
	TOL5=1.0E-7
	TOL6=1.0E-7
	TOL7=1.0E-7
	TOL8=1.0E-7
	TOL9=1.0E-7
	TOL10=1.0E-7
	TOL11=1.0E-5
C---------------TTYPTY RETURNS ZERO-TTYJOB,
C--------------- MINUS ONE-BATCH JOB
	CALL TTYPTY(ICODE)
	IDLG=-1
	IRSP=-4
	NDEVI=4
	NDEVO=6
	IPAGCT=-1
	WRITE(IDLG,1)
1	FORMAT(1X,'WMU LINEAR PROGRAMMING(REVISED SIMPLEX)'/)
C	CALL USAGE('RVSLPR')
C---------------1,0 NDEVO, NDEVI, ARE INPUT, OTHER ARGS. ARE RETURNED.
C--------------- 1 MEANS OUTPUT?  PRINTS.  0 MEANS INPUT?  PRINTS.
	CALL IO(1,NDEVO,DEVNAM,IDVO,IFLNMO,IPJ,IPG,IBNK)
	CALL TYPEON
13	CALL IO(0,NDEVI,DEVNAM,IDVI,IFLNMI,IPJ,IPG,IBNK)
2	WRITE(IDLG,6)
6	FORMAT(1X,'ENTER DIMENSIONS(FOR HELP TYPE HELP).'/)
C---------------# OF INEQS. AND UNKNOWNS MUST BE READ IN FIRST IN
C--------------- ORDER TO USE DYN. ALLOC. ON THE TABLEAUX BEING READ IN 
C--------------- SUBR. MAIN1.
14	READ(IRSP,42,ERR=5)NR,NC
42	FORMAT(2I)
	ITERR=0
	FIRST1=1
	FIRST2=1
	ISWST=0
	NCNR=NC*NR
	MAX=NCNR+2*NR
	CALL ALLCOR(MAX,IERR,I1,A)
	IF(IERR.EQ.0)GO TO 4
	WRITE(IDLG,3)
	GO TO 2
4	I2=I1+NR
	I3=I2+NR
	CALL MAIN1(A(I1),A(I2),A(I3),A)
	GO TO 13
5	WRITE(IDLG,7)
7	FORMAT(1X,'ENTER 2 INT. SEP. BY COMMA. FIRST IS NO. OF'/1X,
	1'INEQ. SECOND IS NO. OF VARS. NOT INCL. SLACK OR ART. VARS.'/)
	GO TO 2
3	FORMAT(1X,'NOT ABLE TO ALLOCATE CORE'/)
	END
C---------------BINIT, ISLACK, A ARE RETURNED.  B IS USED FOR
C--------------- DYN ALLOC. SEE DIM. ST. AND ST. 2-4.
	SUBROUTINE MAIN1(BINIT,ISLACK,A,B)
	COMMON/IOD/NDEVO,DEVNAM,IDVO,IFLNMO,IPJ,IPG,IBNK,
	1NDEVI,IDVI,IFLNMI
	COMMON/IOB/LEFBK,IRTBK,IART,MAXPAG,IPAGE,IPAGCT,IDLG
	1,IRSP,ICODE,JDUMMY
	COMMON/NONDYN/NR,NC,NR2,NCFIN,JTYPE,TABLO,ICOND,ISWST
	1,FIRST1,FIRST2,ITERRI,FLAG1,FLAG2,LSTOP,FLAG,
	2TOL1,TOL2,TOL3,TOL4,TOL5,TOL6,TOL7,TOL8,IPHASE,
	3TOL9,TOL10,TOL11,GREAT,NEQUAL,ITERR
	DIMENSION A(1),BINIT(1),ISLACK(1),B(1)
	IPHASE=0
	IEQUAL=0
	DO 171 I=1,NR
	BINIT(I)=0
	ISLACK(I)=0
171	CONTINUE
	IF(IDVI.EQ.'TTY')GO TO 10
	WRITE(IDLG,38)
38	FORMAT(1X,'DATA BEING PROCESSED'/)
	GO TO 14
10	WRITE(IDLG,6)
6	FORMAT(1X,'ENTER INEQUALITIES(FOR HELP TYPE HELP).'/)
14	READ(NDEVI,16,ERR=74,END=49)I
	IF(I.EQ.0)GO TO 49
16	FORMAT(I)
	INC=(I-1)*NC
77	READ(NDEVI,76,ERR=46)(A(INC+J),J=1,NC)
76	FORMAT(5F)
17	FORMAT(A2,1X,F)
19	READ(NDEVI,17,ERR=67)INEQ,BINIT(I)
	IF(INEQ.EQ.'GE')GO TO 21
	IF(INEQ.EQ.'LE')GO TO 23
	IF(INEQ.EQ.'EQ')GO TO 24
	IF(ICODE.EQ.-1)CALL EXIT
	WRITE(IDLG,26)
26	FORMAT(1X,'INVALID INEQUALITY SYMBOL,TRY AGAIN.'/)
	GO TO 19
46	IF(ICODE.EQ.-1)CALL EXIT
	WRITE(IDLG,78)
	WRITE(IDLG,47)
47	FORMAT(1X,'ERROR,REENTER INEQ. COEFFS.'/)
	GO TO 77
74	IF(ICODE.EQ.-1)CALL EXIT
	WRITE(IDLG,78)
78	FORMAT(1X,'EACH INEQ. IS PRECEDED BY SEQ. ID. COEFFS. ARE'/1X,
	1'ENTERED 5 PER LINE. AFTER LAST INEQ. ENTER 0 OR CTRL Z.'/)
	WRITE(IDLG,75)
75	FORMAT(1X,'ERROR,REENTER INEQ. IDENT.'/)
	GO TO 14
67	IF(ICODE.EQ.-1)CALL EXIT
	WRITE(IDLG,59)
	GO TO 19
59	FORMAT(1X,'INVALID B VALUE,TRY AGAIN.'/)
C---------------COMES HERE FROM ST. 19+1
21	ISLACK(I)=1
	GO TO 14
23	ISLACK(I)=-1
	GO TO 14
24	ISLACK(I)=0
	GO TO 14
C---------------COMES HERE FROM ST. 14, 14+1.  BINIT(I) READ IN ST. 19.
C---------------RT. HAND SIDES (BINIT(I)) MUST BE MADE POSITIVE. IF
C---------------  BINIT NEG., WE REVERSE SIGN OF BINIT, REVERSE THE
C--------------- INEQ., AND REVERSE THE SIGN OF TABLEAUX COEFFS. FOR ITH
C--------------- INEQ.
49	DO 108 I=1,NR
	IF(BINIT(I).GE.0)GO TO 108
	BINIT(I)=-BINIT(I)
	ISLACK(I)=-ISLACK(I)
	IJ=(I-1)*NC
	DO 106 J=1,NC
	IJ=IJ+1
	A(IJ)=-A(IJ)
106	CONTINUE
108	CONTINUE
C---------------NCFIN=NO. OF COLS. (NC) OF USER'S TABLEAUX+SLACKVARS.+
C--------------- ART.VARS. NCFIN IS AT MOST NC+2NR
	DO 170 I=1,NR
	IF(ISLACK(I))150,154,170
150	IPHASE=IPHASE+1
	GO TO 170
154	IEQUAL=IEQUAL+1
170	CONTINUE
	NCFIN=NC+2*NR-IPHASE-IEQUAL
	NCFNR=NCFIN*NR
	MAX=13*NR+8*NCFIN+NR*NR+2*NCFNR
	CALL ALLCOR(MAX,IERR,I1,B)
	IF(IERR.EQ.0)GO TO 1
	WRITE(IDLG,2)
	RETURN
1	I2=I1+NR
	I3=I2+NR
	I4=I3+NCFNR
	I5=I4+NR
	I6=I5+NR
	I7=I6+NR
	I8=I7+NCFIN
	I9=I8+NCFIN
	I10=I9+NCFIN
	I11=I10+NR
	I12=I11+NCFIN
	I13=I12+NR
	I14=I13+NR*NR
	I15=I14+NR
	I16=I15+NR
	I17=I16+NR
	I18=I17+NR
	I19=I18+NCFIN*2
	I20=I19+NCFIN
	I21=I20+NCFIN
	I22=I21+NR
	CALL MAIN2(B(I1),B(I2),B(I3),B(I4),B(I5),B(I6),B(I7),
	1B(I8),B(I9),B(I10),B(I11),B(I12),B(I13),B(I14),B(I15),
	2B(I16),B(I17),B(I18),B(I19),B(I20),B(I21),B(I22))
	RETURN
2	FORMAT(1X,'NOT ABLE TO ALLOCATE CORE'/)
	END
C---------------ALL ARGS. ARE SPACES RESERVED BY DYN ALLOC.
C---------------NR=NO. OF CONSTRAINTS
C---------------NC=NO. OF VARS. IN PROBLEM (BEFORE SLACK OR ART.VARS 
C--------------- HAVE BEEN ADDED.
C---------------AMAT=MATRIX FOR INITIAL TABLEAUX OF COEFFS. OF
C--------------- CONSTRAINT VARS.
C---------------BINIT - INITIAL VALUES OF CONSTRAINT CONSTANTS
C---------------COBJ - COEFFS. OF OBJ. FUNCTION
C---------------IBASIS=VARS. IN CURRENT BASIS
C---------------BCONST=VALUES OF BASIC VARS.
C---------------ZOBJ=VALUE OF OBJ FUNCTION
C---------------SHADPR=SHADOW PRICES. AT END THEIR OBS. VALUES ARE THE
C--------------- OPTIMAL VALUES OF THE VARS. IN THE DUAL OF THE INPUT
C--------------- PROBLEM.
C---------------CWOBJ=COEFF. OF INFEASIBILITY FORM (OBJ. FUNCTION OF
C--------------- PHASE 1) IMIN=ARRAY FOR THOSE VARS. HAVING THE SAME
C--------------- MIN. WHEN DETERMINING PIVOT ROW. USED IN THE
C--------------- RESOLUTION OF DEGENERACY.
C---------------ITEST=ARRAY OF INDICES USED IN CALCULATING REL.COST
C--------------- COEFFS.=1 MEANS VAR. IS NOT IN BASIS, =0 MEANS
C--------------- VAR. IS IN BASIS.
C---------------JPRINV=INDEX FOR COLS. OF INVERSE WHICH HAVE BEEN
C--------------- CHANGED DURING ITERATIONS.
C---------------NART-ARRAY OF THOSE CONSTRAINTS WHICH HAVE AN ART.VAR
C---------------PRINV=ARRAY FOR INVERSE
C---------------RELCOS=REL.COST COEFFS I.E. CURRENT COEFFS. OF BASIC
C--------------- VARS. IN OBJ. FUNCTION
C--------------- WSHAD-SHADOW PRICES DURING PHASE I
	SUBROUTINE MAIN2(BINIT,ISLACK,AMAT,IBASIS,SHADPR,WSHAD,COBJ,ITEST,
	1CWOBJ,NART,RELCOS,BCONST,PRINV,JPRINV,PIVCOL,BSTAR
	2,IMIN,NBASIS,NONBA,DCOS,ORIGBA,SENAN)
	COMMON /NONDYN/NR,NC,NR2,NCFIN,JTYPE,TABLO,ICOND,ISWST
	1,FIRST1,FIRST2,ITERRI,FLAG1,FLAG2,LSTOP,FLAG,
	2TOL1,TOL2,TOL3,TOL4,TOL5,TOL6,TOL7,TOL8,IPHASE,
	3TOL9,TOL10,TOL11,GREAT,NEQUAL,ITERR
	COMMON/IOD/NDEVO,DEVNAM,IDVO,IFLNMO,IPJ,IPG,IBNK,
	1NDEVI,IDVI,IFLNMI
	COMMON/IOB/LEFBK,IRTBK,IART,MAXPAG,IPAGE,IPAGCT,IDLG
	1,IRSP,ICODE,JDUMMY
	DOUBLE PRECISION NBASIS
	DIMENSION ID(4)
	DIMENSION AMAT(1),BINIT(1),IBASIS(1),SHADPR(1),WSHAD(1),
	1COBJ(1),ITEST(1),ISLACK(1),CWOBJ(1),NART(1),RELCOS(1),
	2BCONST(1),PRINV(1),JPRINV(1),PIVCOL(1),BSTAR(1),
	3IMIN(1),NBASIS(1),NONBA(1),DCOS(1),ORIGBA(1),SENAN(1)
	INTEGER PREVSO(19)
C---------------PRE SOLUTION OPTIONS
	DATA PREVSO/'OBJ','NAMES','START','MAX','MIN','TITLE','INOUT',
	1'HELP','TOL1','TOL2','TOL3','TOL4','TOL5','TOL6'
	2,'TOL7','TOL8','TOL9','TOL10','TOL11'/
	ISWST=0
	TABLO=0
C---------------ICOND=1 MEANS MAX. IF USER DOES NOT SPECIFY MAX OR 
C--------------- MIN. THEN DEFAULT IS MAX.
	ICOND=1
	FLAG1=0
	FLAG2=0
	NCOL=5
109	IPHASE=0
	IEQUAL=0
	NEQUAL=0
	DO 107 I=1,NR
	BCONST(I)=0
	ORIGBA(I)=0
	IBASIS(I)=0
	NART(I)=0
107	CONTINUE
	DO 106 I=1,NCFIN
	CWOBJ(I)=0
	ITEST(I)=1
106	CONTINUE
	DO 245 I=1,NR
	IF(ISLACK(I).EQ.0)NEQUAL=NEQUAL+1
245	CONTINUE
C---------------ISWST=1 MEANS POST SOL. OPTION "START" HAS BEEN USED.
C--------------- =2 MEANS POST SOL. OPTION "END" HAS BEEN USED.
C--------------- IF END HAS BEEN USED WE WOULD NOT BE HERE.  SEE
C--------------- ST. 271+4.  IF ISWST=0, WE GOT HERE FOR FIRST TIME.
	IF(ISWST.EQ.1)GO TO 110
	DO 1001 I=NR,2,-1
	IJ=I*NC
	IJNCF=(I-1)*NCFIN+NC
	DO 1001 J=NC,1,-1
	AMAT(IJNCF)=AMAT(IJ)
	IJNCF=IJNCF-1
	IJ=IJ-1
1001	CONTINUE
110	DO 1000 I=1,NR
	IJ=(I-1)*NCFIN+NC
	DO 1000 J=NC+1,NCFIN
	IJ=IJ+1
1000 	AMAT(IJ)=0
C---------------BETWEEN HERE AND ST. 270+1 WE PUT COL.ID OF INITIAL 
C--------------- BASIS VARS. INTO IBASIS(I) AND ORIGBA(I).  LATER
C--------------- IBASIS(I) IS MODIFIED FOR EACH PIVOT OF THE REVISED
C--------------- SIMPLEX PROCEDURE.  ORIGBA(I) IS USED WITH POST
C--------------- SOLUTION OPTIONS INEQ., OBJ., AND BVALU.
C--------------- IN BVALU IT IS REQUIRED THAT SIGN OF RT HAND SIDES ARE
C--------------- NOT CHANGED.  THIS ALLOWS THE USE OF THE ORIGINAL 
C--------------- INITIAL BASIS TO SOLVE A NEW PROBLEM.  NEXT(I)=I
C--------------- MEANS VAR. IS ART.  =0 MEANS IT IS NOT ART.
C---------------NBASIS(I) CONTAINS NAMES OF BASIS VAR. CWOB(I) ARE
C--------------- COEFFS. OF OBJ. FUNCTION IN PHASE 1 (INF. FORM).
	JA=1
	JS=1
	DO 270 I=1,NR
	IF(ISLACK(I))250,254,256
250	IPHASE=IPHASE+1
	ICY=NC+I-IEQUAL
	IICY=(I-1)*NCFIN+ICY
	AMAT(IICY)=1.0
	ENCODE(10,209,NBASIS(ICY))JS
	JS=JS+1
C---------------IBASIS, ITEST GET MODIFIED IN SUBR. SEGMT. ST. 407+3,+4.
	IBASIS(I)=ICY
	ORIGBA(I)=ICY
	NART(I)=0
	ITEST(ICY)=0
	GO TO 270
254	IEQUAL=IEQUAL+1
	GO TO 260
256	NG=NC-IEQUAL+I
	ING=(I-1)*NCFIN+NG
	AMAT(ING)=-1.0
	ENCODE(10,209,NBASIS(NG))JS
	JS=JS+1
260	NART(I)=I
	ICX=NC+NR-NEQUAL+I-IPHASE
	IICX=(I-1)*NCFIN+ICX
	AMAT(IICX)=1.0
	ENCODE(10,213,NBASIS(ICX))JA
	JA=JA+1
	CWOBJ(ICX)=1.0
	IBASIS(I)=ICX
	ORIGBA(I)=ICX
	ITEST(ICX)=0
270	CONTINUE
C---------------ISWST=1 MEANS POST SOL. OPTION START HAS BEEN USED,
C--------------- =0 MEANS WE GOT HERE FOR FIRST TIME.  WE WOULD NOT GET
C--------------- HERE IF ISWST = 2.
	IF(ISWST.EQ.1)GO TO 104
209	FORMAT('SL VAR#',I3)
213	FORMAT('ART VAR#',I2)
10	WRITE(IDLG,6)
6	FORMAT(1X,'ENTER OPTIONS'/)
14	WRITE(IDLG,43)
43	FORMAT(/' *',$)
4	READ(NDEVI,8)JTYPE
8	FORMAT(A5)
	IF(JTYPE.EQ.'TABLO'.OR.JTYPE.EQ.'TABLE')GO TO 103
	DO 28 I=1,19
	IF(PREVSO(I).EQ.JTYPE)
	1GO TO(13,35,111,32,33,37,39,44,1,2,3,5,7,
	212,15,16,17,18,19,108),I
28	CONTINUE
	IF(ICODE.EQ.-1)CALL EXIT
	WRITE(IDLG,9)JTYPE
9	FORMAT(1X,A5,3X,'IS NOT VALID.TRY AGAIN.'/)
	GO TO 14
13	READ(NDEVI,76,ERR=68)(COBJ(I),I=1,NC)
	FLAG1=1
	GO TO 14
76	FORMAT(5F)
68	IF(ICODE.EQ.-1)CALL EXIT
	WRITE(IDLG,69)
69	FORMAT(1X,'ERROR,REENTER THE OBJ. FUNCTION.'/)
	GO TO 13
C---------------READ USER SPEC. NAMES FOR LIN. PROG. VARS.
35	READ(NDEVI,105)(NBASIS(I),I=1,NC)
105	FORMAT(A10)
	FLAG2=1
	GO TO 14
C---------------ICOND=1 MEANS USER SPECIFIES MAX
32	ICOND=1
	GO TO 14
33	ICOND=0
	GO TO 14
C---------------READ OUTPUT ID
37	READ(NDEVI,11)(ID(I),I=1,4)
11	FORMAT(4A5)
	GO TO 14
C---------------ITERR=-1 MEANS USER CHOSE INOUT OPTION
39	ITERR=-1
	GO TO 14
44	WRITE(IDLG,45)
45	FORMAT(1X,'OPTIONS THAT MUST BE ENTERED ARE: NAMES,'/1X,
	1'OBJ, AND START. START MUST BE LAST.'/1X,
	2'ENTER MIN IF YOU DO NOT WANT MAXIMUM.'/1X,
	3'1)NAMES REQUIRES LABELS TO BE IDENTIFIED WITH UNKNOWNS.'/
	41X,'MAX. OF 10 CHARS., ONE PER LINE, AND IN SAME ORDER'/1X,
	5'CORRESP. COEFFS. ARE ENTERED WITH INEQ AND OBJ'/1X,
	6'2)OBJ REQUIRES COST COEFFS. OF OBJ. FUNCTION AT RATE '/1X,
	7'OF 5 PER LINE SEPARATED BY COMMAS.'/1X,
	8'3) START REQUIRES ONLY RETURN(CAUSES PROG. TO RUN).'/1X,
	1'NON REQUIRED OPTIONS ARE TITLE,INOUT,TABLO, AND TABLE.'/1X,
	2'1)TABLE OR TABLO PRINTS CURRENT TABLEAU.'/1X,
	3'2)TITLE -ENTER UP TO 20 CHARS. FOR OUTPUT ID.'/1X,
	4'3)INOUT PRINTS OBJ. FUNCTION, VAR. LEAVING BASIS AND '/1X,
	5'VAR. ENTERING BASIS FOR EACH PIVOT OF REV. SIMPL. PROC.'/)
	CALL TYPEON
	GO TO 14
1	READ(NDEVI,20)TOL1
20	FORMAT(E16.10)
	GO TO 14
2	READ(NDEVI,20)TOL2
	GO TO 14
3	READ(NDEVI,20)TOL3
	GO TO 14
5	READ(NDEVI,20)TOL4
	GO TO 14
7	READ(NDEVI,20)TOL5
	GO TO 14
12	READ(NDEVI,20)TOL6
	GO TO 14
15	READ(NDEVI,20)TOL7
	GO TO 14
16	READ(NDEVI,20)TOL8
	GO TO 14
17	READ(NDEVI,20)TOL9
	GO TO 14
18	READ(NDEVI,20)TOL10
	GO TO 14
19	READ(NDEVI,20)TOL11
	GO TO 14
108	READ(NDEVI,20)TOL12
	GO TO 14
111	IF(FLAG1.NE.1.OR.FLAG2.NE.1)GO TO 62
104	WRITE(NDEVO,36)(ID(I),I=1,4)
36	FORMAT(1X,4A5)
C---------------PRE SOLUTION OPTIONS
	CALL SEGMT1(BINIT,ISLACK,AMAT,IBASIS,SHADPR,WSHAD,COBJ,ITEST,
	1CWOBJ,NART,RELCOS,BCONST,PRINV,JPRINV,
	2PIVCOL,BSTAR,IMIN,NBASIS,NONBA,DCOS,ORIGBA)
C---------------LSTOP=1 MEANS SOLUTION IS UNBOUNDED OR PROBLEM HAS NO
C--------------- FEASIBLE SOLUTION, =0 MEANS SOLUTION HAS BEEN OBTAINED.
	IF(LSTOP.EQ.1)RETURN
C---------------POST SOLUTION OPTIONS
271	CALL SEGMT2(BINIT,ISLACK,AMAT,IBASIS,SHADPR,WSHAD,COBJ,ITEST,
	1CWOBJ,NART,RELCOS,BCONST,PRINV,JPRINV,PIVCOL,
	2BSTAR,IMIN,NBASIS,NONBA,DCOS,ORIGBA,SENAN)
C---------------ISWST=1 MEANS START OPTION HAS BEEN USED,
C--------------- =2 MEANS END OPTION HAS BEEN USED.
	IF(ISWST.EQ.1)GO TO 109
	RETURN
C---------------COMES HERE FROM ST. 8+1 TO PRINT TABLEAUX
103	WRITE(IRSP,700)
700	FORMAT(1X,'INITIAL COEFF. MATRIX'/)
710	FORMAT(1X,3X,9(3X,A10)/)
720	FORMAT(1X,I3,10(3X,E10.3))
740	NFIRST=1
	NLAST=NCOL
	IF(NLAST.GT.NC)NLAST=NC
760	WRITE(IRSP,710)(NBASIS(J),J=NFIRST,NLAST)
	DO 770 I=1,NR
	IJ=(I-1)*NCFIN
	WRITE(IRSP,720)I,(AMAT(IJ+J),J=NFIRST,NLAST)
770	CONTINUE
	IF(NLAST.GE.NC)GO TO 780
	NFIRST=NFIRST+NCOL
	NLAST=NLAST+NCOL
	IF(NLAST.GT.NC)NLAST=NC
	GO TO 760
780	NFIRST=NC+1
	NLAST=NC+NCOL
	IF(NLAST.GT.NCFIN)NLAST=NCFIN
772	WRITE(IRSP,710)(NBASIS(J),J=NFIRST,NLAST)
	IF(NLAST.GE.NCFIN)GO TO 771
	NFIRST=NFIRST+NCOL
	NLAST=NLAST+NCOL
	IF(NLAST.GT.NCFIN)NLAST=NCFIN
	GO TO 772
771	WRITE(IRSP,790)
790	FORMAT(1H0,3X,'INITIAL',/,5X,'BASIS',3X,'CONSTANTS'/)
	DO 810 I=1,NR
	II=ORIGBA(I)
	WRITE(IRSP,800)NBASIS(II),BINIT(I)
810	CONTINUE
800	FORMAT(5X,A10,' = ',E10.3)
	WRITE(IRSP,820)
820	FORMAT(1H0,'COEFFS.OF OBJECTIVE FUNCTION,Z')
	NFIRST=1
	NLAST=NCOL
830	IF(NLAST.GT.NCFIN)NLAST=NCFIN
840	WRITE(IRSP,850)(NBASIS(J),J=NFIRST,NLAST)
850	FORMAT(1H0,3X,9(3X,A10)/)
	WRITE(IRSP,860)(COBJ(J),J=NFIRST,NLAST)
860	FORMAT(4X,10(3X,E10.3))
	IF(NLAST.GE.NCFIN)GO TO 14
	NFIRST=NFIRST+NCOL
	NLAST=NLAST+NCOL
	IF(NLAST.GT.NCFIN)NLAST=NCFIN
	GO TO 840
62	IF(ICODE.EQ.-1)CALL EXIT
	WRITE(IDLG,64)
64	FORMAT(1X,'ENTER NAMES AND OBJ BEFORE START.'/)
	GO TO 14
	END