C WESTERN MICHIGAN UNIVERSITY C SG2RVS.FOR (FILENAME ON LIBRARY DECTAPE) C CALLED BY SUBR. MAIN2 IN RVSLPR.FOR C ABOVE COMMENTS AND RIGHT ADJUSTED COMMENTS PUT IN BY WG C COMMON /IOB/, /IOD/, AND /NONDVN/ SHARED BY MAIN PROG., C MAIN1, MAIN2, AND SEGMT1. C SENAN IS SPACE RESERVED BY DYN. ALLOC. OTHER ARGS. ARE INPUT. C ISWST RETURNED BY SUBR. SEGMT2 THRU COMMON /NONDYN/ C SUBROUTINE SEGMT2(BINIT,ISLACK,AMAT,IBASIS,SHADPR,WSHAD,COBJ, 1ITEST,CWOBJ,NART,RELCOS,BCONST,PRINV,JPRINV, 2PIVCOL,BSTAR,IMIN,NBASIS,NONBA,DCOS,ORIGBA,SENAN) 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 DOUBLE PRECISION NBASIS,TEMP1,TEMP2,TEMP3 DIMENSION AMAT(1),BINIT(1),IBASIS(1),SHADPR(1),WSHAD(1), 1COBJ(1),ITEST(1),ISLACK(1),CWOBJ(1),NART(1),RELCOS(1) 2,BCONST(1),PRINV(1),JPRINV(1),PIVCOL(1),BSTAR(1), 3IMIN(1),NBASIS(1),NONBA(1),DCOS(1),ORIGBA(1),SENAN(1) INTEGER POSTOP(13) C---------------POST SOLUTION OPTIONS DATA POSTOP/'RELCO','INVER','BASEN','NBSEN','BVSEN','HELP', 1'TABLE','TABLO','START','END', 2'INEQ','OBJ','BVALU'/ NCOL=5 10 WRITE(IDLG,6) 6 FORMAT(1X,'ENTER POST SOLUTION OPTION(S).'/) 14 WRITE(IDLG,43) 43 FORMAT(/' *',$) 4 READ(NDEVI,8)JTYPE KKK=0 8 FORMAT(A5) DO 28 I=1,13 IF(POSTOP(I).EQ.JTYPE) 1GO TO(13,35,32,33,34,37,103,103,104,105,44,45,46),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 C---------------RELCO OPTION 13 WRITE(NDEVO,2510) 2510 FORMAT(1X,'RELATIVE COST COEFFS'/) NFIRST=1 NLAST=NCOL NCF=NCFIN IF(NLAST.GT.NCF)NLAST=NCF 2525 WRITE(NDEVO,2560)(NBASIS(J),J=NFIRST,NLAST) 2560 FORMAT(1H0,10(3X,A10)) WRITE(NDEVO,2570)(RELCOS(J),J=NFIRST,NLAST) IF(NLAST.GE.NCF)GO TO 14 NFIRST=NFIRST+NCOL NLAST=NLAST+NCOL IF(NLAST.GT.NCF)NLAST=NCF GO TO 2525 2570 FORMAT(1X,10(3X,E10.3)) WRITE(NDEVO,1000) 1000 FORMAT(1X,'INVERSE',///) C---------------INVER OPTION 35 NUMIN=1 NUMEND =NCOL IF(NUMEND.GT.NR)NUMEND=NR 5013 WRITE(NDEVO,5014)(J,J=NUMIN,NUMEND) 5014 FORMAT(/,7X,I4,9(9X,I4)) DO 5015 I=1,NR IJ=(I-1)*NR WRITE(NDEVO,5016)(PRINV(IJ+J),J=NUMIN,NUMEND) 5015 CONTINUE 5016 FORMAT(1X,10(3X,E10.3)) NUMIN=NUMIN+NCOL NUMEND=NUMEND+NCOL IF(NUMIN.GT.NR)GO TO 14 IF(NUMEND.GT.NR)NUMEND=NR GO TO 5013 C---------------BASEN OPTION 32 IF(KKK.EQ.1)GO TO 5034 LL=1 GO TO 5033 C---------------NBSEN OPTION 33 IF(KKK.EQ.1)GO TO 5035 LL=2 5033 K=1 DO 5022 I=1,NCFIN IF(ITEST(I).EQ.0.OR.ABS(DCOS(I)).GT.TOL1)GO TO 5022 NONBA(K)=I K=K+1 5022 CONTINUE IF((K-1).EQ.0)GO TO 5085 KLIM=K-1 GO TO 5086 5085 WRITE(NDEVO,5087) 5087 FORMAT(1X,'ALL NONBASIC VARIABLES ARE ARTIFICIAL.', 1' THIS SENSITIVITY ANALYSIS OMITTED.'/) GO TO 14 5086 DO 5020 K=1,KLIM KK=NONBA(K) DO 5020 I=1,NR TEMP=0 IJ=(I-1)*NR C---------------MULTIPLY INVERSE BY COLS. OF ORIG. TABLEAUX C--------------- WHICH ARE NOT IN BASIS AND WHOSE PHASE 1 REL.COST C--------------- COEFF. ARE LE TOL1. SEE ST. 5033+2. ALSO SEE C--------------- BOOK BY DANTZIG "LIN. PROG. & EXTENSIONS" DO 5021 J=1,NR IJ=IJ+1 JKK=(J-1)*NCFIN+KK 5021 TEMP=PRINV(IJ)*AMAT(JKK)+TEMP IK=(I-1)*KLIM+K 5020 SENAN(IK)=TEMP KKK=1 GO TO(5034,5035),LL C---------------COME FROM ST. 32 5034 WRITE(NDEVO,5030) 5030 FORMAT(1X,'SENSITIVITY ANAL. TABLE FOR BASIS', 1' (SOLUTION) VARIABLES'//) WRITE(NDEVO,5044) 5044 FORMAT(1X,62(1H-)/11X,1HI,10X,1HI, 214X,1HI,10X,1HI/' VAR. NAM. ', 1HI,'L.L. VAR. ',1HI, 3' LOW LIMIT ', 41HI,'TOP L. VAR',1HI,'TOP LIMIT'/11X,1HI,10X,1HI,14X,1HI,10X, 51HI,/1X,62(1H-)/11X,1HI,10X,1HI,14X,1HI,10X,1HI) JJ=1 DO 5028 I=1,NR UPPER=-GREAT UNDER=GREAT K1=1 K2=1 IB=IBASIS(I) IK=(I-1)*KLIM DO 5023 K=1,KLIM IK=IK+1 II=NONBA(K) IF(SENAN(IK).EQ.0)GO TO 5023 RATIO=RELCOS(II)/SENAN(IK) IF(SENAN(IK))5024,5023,5025 5025 IF(RATIO-UNDER)5026,5026,5023 5026 UNDER=RATIO K1=K GO TO 5023 5024 IF(RATIO-UPPER)5023,5027,5027 5027 UPPER=RATIO K2=K 5023 CONTINUE TEMP1=NBASIS(NONBA(K1)) TEMP2=NBASIS(NONBA(K2)) TEMP3=NBASIS(IB) UNLIM=-COBJ(IB)-UNDER UPLIM=-COBJ(IB)-UPPER GO TO 5066 5028 CONTINUE 5029 FORMAT(1X,A10,'I',A10,'I',G14.8,'I',A10,'I',G14.8) GO TO 14 C---------------COME FROM ST. 33. 5035 WRITE(NDEVO,5043) 5043 FORMAT(//1X,'SENSITIVITY ANAL. TABLE FOR NON', 1'BASIS VARIABLES'//) JJ=2 WRITE(NDEVO,5044) DO 5036 J=1,KLIM UPLIM=GREAT UNLIM=-GREAT K1=1 K2=1 DO 5037 I=1,NR IJ=(I-1)*KLIM+J IF(SENAN(IJ))5038,5037,5038 5038 RATIO=BCONST(I)/SENAN(IJ) IF(SENAN(IJ))5039,5037,5040 5039 IF(RATIO-UNLIM)5037,5041,5041 5041 UNLIM=RATIO K1=I GO TO 5037 5040 IF(RATIO-UPLIM)5042,5042,5037 5042 UPLIM=RATIO K2=I 5037 CONTINUE TEMP1=NBASIS(IBASIS(K1)) TEMP2=NBASIS(IBASIS(K2)) TEMP3=NBASIS(NONBA(J)) GO TO 5066 5036 CONTINUE GO TO 14 5066 IF(UNLIM.NE.-GREAT.AND.UPLIM.NE.GREAT)GO TO 5067 IF(UNLIM.NE.-GREAT)GO TO 5068 TEMP1='NONE ' 5068 IF(UPLIM.NE.GREAT)GO TO 5067 TEMP2='NONE ' 5067 WRITE(NDEVO,5029)TEMP3,TEMP1,UNLIM,TEMP2,UPLIM GO TO(5028,5036),JJ C---------------BVSEN OPTION 34 WRITE(NDEVO,5054) 5054 FORMAT(1X,'SENSITIVITY ANAL. TABLE FOR THE', 1' B VALUES'//) WRITE(NDEVO,5055) 5055 FORMAT(1X,62(1H-)/15X,1HI,10X,1HI, 114X,1HI,10X,1HI/5X,'B VALUES ',1HI,'L.L. VAR. ',1HI 2,' LOW LIMIT ', 31HI,'TOP L. VAR',1HI,'TOP LIMIT',/15X,1HI,10X,1HI,14X,1HI,10X, 41HI/1X,62(1H-)/15X,1HI,10X,1HI,14X,1HI,10X,1HI) DO 5045 J=1,NR UPPER=GREAT UNDER=-GREAT K1=1 K2=1 DO 5046 I=1,NR IJ=(I-1)*NR+J IF(PRINV(IJ))5047,5046,5047 5047 RATIO=BCONST(I)/PRINV(IJ) IF(PRINV(IJ))5049,5046,5050 5049 IF(RATIO-UNDER)5046,5051,5051 5051 UNDER=RATIO K1=I GO TO 5046 5050 IF(RATIO-UPPER)5052,5052,5046 5052 UPPER=RATIO K2=I 5046 CONTINUE BMAX=BINIT(J)+ABS(UNDER) BMIN=BINIT(J)-UPPER IB1=IBASIS(K1) IB2=IBASIS(K2) TEMP1=NBASIS(IB2) TEMP2=NBASIS(IB1) IF(BMIN.NE.-GREAT.AND.BMAX.NE.GREAT)GO TO 5045 IF(BMIN.NE.-GREAT)GO TO 5070 TEMP1='NONE ' 5070 IF(BMAX.NE.GREAT)GO TO 5045 TEMP2='NONE ' 5045 WRITE(NDEVO,5048)BINIT(J),TEMP1,BMIN,TEMP2,BMAX 5048 FORMAT(1X,G14.8,1HI,A10,1HI,G14.8,1HI,A10,1HI,G14.8) GO TO 14 C---------------HELP OPTION 37 WRITE(NDEVO,5059) 5059 FORMAT(1X,'AVAILABLE OPTIONS ARE RELCO,INVER,BASEN,NBSEN,'/1X, 1'BVSEN,TABLO,TABLE,INEQ,OBJ,BVALU,START,AND END.'/1X, 2'1)END MUST BE LAST OPTION. IT IS ONLY REQUIRED OPTION.'/1X, 3'IT CAUSES EXIT FROM PROG.'/1X, 4'2)RELCO PRINTS RELATIVE COST COEFFS.'/1X, 5'3)INVER PRINTS INVERSE OF BASIS MATRIX.'/1X, 6'4)BASEN PRINTS SENS. ANAL. TABLE FOR BASIS VARS.'/1X, 7'5)NBSEN PRINTS SENS. ANAL. TABLE FOR NON-BASIS VARS.'/1X, 8'6)BVSEN PRINTS SENS. ANAL. TABLE FOR CONTRAINT CONSTANTS.'/1X, 9'7)TABLO OR TABLE PRINTS CURRENT TABLEAU.'/1X, 1'WE MAY CHANGE TABLEAU VALUES AND RERUN AS BELOW:'/1X, 2'1)AFTER INEQ ENTER 3 VALUES SEPARATED BY 2 COMMAS.'/1X, 3'FIRST IS SEQ. ID. I OF INEQ. SECOND IS SEQ. ID. J OF '/1X, 4'UNKNOWN. THIRD IS NEW COEFF. A(I,J). AFTER LAST CHANGE,'/1X, 5'ENTER 0 OR CTRL Z.'/1X, 6'2)AFTER OBJ ENTER 2 VALUES SEP. BY COMMA. FIRST IS SEQ.'/1X, 7'ID. J OF COST COEFF. SECOND IS NEW COST COEFF.'/1X, 8'3)AFTER BVALU ENTER 2 VALUES SEP. BY COMMA. FIRST IS SEQ.') WRITE(IDLG,200) 200 FORMAT(1X,'ID. I OF INEQ. SECOND IS NEW CONSTRAINT'/1X, 1'CONSTANT B(I) OF ITH INEQ.'/1X, 2'DO NOT CHANGE SIGN OF BVALU.'/1X, 3'4)START CAUSES NEW PROB. TO BE SOLVED.'/) CALL TYPEON GO TO 14 C---------------INEQ OPTION 44 IE=1 5100 READ(NDEVI,5078,ERR=5077,END=14)I,J,VALUE IJ=(I-1)*NCFIN+J IF(I.EQ.0)GO TO 14 IF(I.LT.1.OR.I.GT.NR.OR.J.LT.1.OR.J.GT.NC)GO TO 5077 IF(BINIT(I).GE.0)GO TO 5082 AMAT(IJ)=-VALUE GO TO 5100 5082 AMAT(IJ)=VALUE GO TO 5100 5077 WRITE(IDLG,5079) 5079 FORMAT(1X,'ERROR IN INPUT DATA;TRY AGAIN.'/) GO TO(44,45,46),IE C---------------OBJ OPTION OPTION 45 IE=2 5101 READ(NDEVI,5076,ERR=5077,END=14)J,VALUE IF(J.EQ.0)GO TO 14 IF(J.GT.NC.OR.J.LT.1)GO TO 5077 IF(ICOND.NE.0)COBJ(J)=-VALUE GO TO 5101 5076 FORMAT(I,F) 5078 FORMAT(2I,F) C---------------BVALU OPTION 46 IE=3 47 READ(NDEVI,5076,ERR=5077,END=14)I,VALUE IF(I.EQ.0)GO TO 14 IF(I.LT.1.OR.I.GT.NR)GO TO 5077 SGN1=SIGN(1.0,VALUE) SGN2=SIGN(1.0,BINIT(I)) IF(SGN1.NE.SGN2)GO TO 5083 IF(BINIT(I).GE.0)GO TO 5080 BINIT(I)=-VALUE GO TO 47 5080 BINIT(I)=VALUE GO TO 47 5083 WRITE(IDLG,5084) 5084 FORMAT(1X,'SIGN OF NEW B VALUE MUST EQUAL SIGN OF', 1' OLD VALUE.'/) GO TO 14 C---------------START OPTION 104 ISWST=1 RETURN C---------------END OPTION 105 ISWST=2 RETURN C---------------TABLE, TABLO OPTIONS 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 END