*DECK SPLPMN SUBROUTINE SPLPMN (USRMAT, MRELAS, NVARS, COSTS, PRGOPT, DATTRV, + BL, BU, IND, INFO, PRIMAL, DUALS, AMAT, CSC, COLNRM, ERD, ERP, + BASMAT, WR, RZ, RG, RPRIM, RHS, WW, LMX, LBM, IBASIS, IBB, + IMAT, IBRC, IPR, IWR) C***BEGIN PROLOGUE SPLPMN C***SUBSIDIARY C***PURPOSE Subsidiary to SPLP C***LIBRARY SLATEC C***TYPE SINGLE PRECISION (SPLPMN-S, DPLPMN-D) C***AUTHOR (UNKNOWN) C***DESCRIPTION C C MARVEL OPTION(S).. OUTPUT=YES/NO TO ELIMINATE PRINTED OUTPUT. C THIS DOES NOT APPLY TO THE CALLS TO THE ERROR PROCESSOR. C C MAIN SUBROUTINE FOR SPLP PACKAGE. C C***SEE ALSO SPLP C***ROUTINES CALLED IVOUT, LA05BS, PINITM, PNNZRS, PRWPGE, SASUM, C SCLOSM, SCOPY, SDOT, SPINCW, SPINIT, SPLPCE, C SPLPDM, SPLPFE, SPLPFL, SPLPMU, SPLPUP, SPOPT, C SVOUT, XERMSG C***COMMON BLOCKS LA05DS C***REVISION HISTORY (YYMMDD) C 811215 DATE WRITTEN C 890531 Changed all specific intrinsics to generic. (WRB) C 890605 Corrected references to XERRWV. (WRB) C 890605 Removed unreferenced labels. (WRB) C 891009 Removed unreferenced variable. (WRB) C 891214 Prologue converted to Version 4.0 format. (BAB) C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) C 900328 Added TYPE section. (WRB) C 900510 Convert XERRWV calls to XERMSG calls. (RWC) C***END PROLOGUE SPLPMN REAL ABIG,AIJ,AMAT(*),ANORM,ASMALL,BASMAT(*), * BL(*),BU(*),COLNRM(*),COSTS(*),COSTSC,CSC(*),DATTRV(*), * DIRNRM,DUALS(*),DULNRM,EPS,TUNE,ERD(*),ERDNRM,ERP(*),FACTOR,GG, * ONE,PRGOPT(*),PRIMAL(*),RESNRM,RG(*),RHS(*),RHSNRM,ROPT(07), * RPRIM(*),RPRNRM,RZ(*),RZJ,SCALR,SCOSTS,SIZE,SMALL,THETA, * TOLLS,UPBND,UU,WR(*),WW(*),XLAMDA,XVAL,ZERO,RDUM(01),TOLABS C INTEGER IBASIS(*),IBB(*),IBRC(LBM,2),IMAT(*),IND(*), * IPR(*),IWR(*),INTOPT(08),IDUM(01) C C ARRAY LOCAL VARIABLES C NAME(LENGTH) DESCRIPTION C C COSTS(NVARS) COST COEFFICIENTS C PRGOPT( ) OPTION VECTOR C DATTRV( ) DATA TRANSFER VECTOR C PRIMAL(NVARS+MRELAS) AS OUTPUT IT IS PRIMAL SOLUTION OF LP. C INTERNALLY, THE FIRST NVARS POSITIONS HOLD C THE COLUMN CHECK SUMS. THE NEXT MRELAS C POSITIONS HOLD THE CLASSIFICATION FOR THE C BASIC VARIABLES -1 VIOLATES LOWER C BOUND, 0 FEASIBLE, +1 VIOLATES UPPER BOUND C DUALS(MRELAS+NVARS) DUAL SOLUTION. INTERNALLY HOLDS R.H. SIDE C AS FIRST MRELAS ENTRIES. C AMAT(LMX) SPARSE FORM OF DATA MATRIX C IMAT(LMX) SPARSE FORM OF DATA MATRIX C BL(NVARS+MRELAS) LOWER BOUNDS FOR VARIABLES C BU(NVARS+MRELAS) UPPER BOUNDS FOR VARIABLES C IND(NVARS+MRELAS) INDICATOR FOR VARIABLES C CSC(NVARS) COLUMN SCALING C IBASIS(NVARS+MRELAS) COLS. 1-MRELAS ARE BASIC, REST ARE NON-BASIC C IBB(NVARS+MRELAS) INDICATOR FOR NON-BASIC VARS., POLARITY OF C VARS., AND POTENTIALLY INFINITE VARS. C IF IBB(J).LT.0, VARIABLE J IS BASIC C IF IBB(J).GT.0, VARIABLE J IS NON-BASIC C IF IBB(J).EQ.0, VARIABLE J HAS TO BE IGNORED C BECAUSE IT WOULD CAUSE UNBOUNDED SOLN. C WHEN MOD(IBB(J),2).EQ.0, VARIABLE IS AT ITS C UPPER BOUND, OTHERWISE IT IS AT ITS LOWER C BOUND C COLNRM(NVARS) NORM OF COLUMNS C ERD(MRELAS) ERRORS IN DUAL VARIABLES C ERP(MRELAS) ERRORS IN PRIMAL VARIABLES C BASMAT(LBM) BASIS MATRIX FOR HARWELL SPARSE CODE C IBRC(LBM,2) ROW AND COLUMN POINTERS FOR BASMAT(*) C IPR(2*MRELAS) WORK ARRAY FOR HARWELL SPARSE CODE C IWR(8*MRELAS) WORK ARRAY FOR HARWELL SPARSE CODE C WR(MRELAS) WORK ARRAY FOR HARWELL SPARSE CODE C RZ(NVARS+MRELAS) REDUCED COSTS C RPRIM(MRELAS) INTERNAL PRIMAL SOLUTION C RG(NVARS+MRELAS) COLUMN WEIGHTS C WW(MRELAS) WORK ARRAY C RHS(MRELAS) HOLDS TRANSLATED RIGHT HAND SIDE C C SCALAR LOCAL VARIABLES C NAME TYPE DESCRIPTION C C LMX INTEGER LENGTH OF AMAT(*) C LPG INTEGER LENGTH OF PAGE FOR AMAT(*) C EPS REAL MACHINE PRECISION C TUNE REAL PARAMETER TO SCALE ERROR ESTIMATES C TOLLS REAL RELATIVE TOLERANCE FOR SMALL RESIDUALS C TOLABS REAL ABSOLUTE TOLERANCE FOR SMALL RESIDUALS. C USED IF RELATIVE ERROR TEST FAILS. C IN CONSTRAINT EQUATIONS C FACTOR REAL .01--DETERMINES IF BASIS IS SINGULAR C OR COMPONENT IS FEASIBLE. MAY NEED TO C BE INCREASED TO 1.E0 ON SHORT WORD C LENGTH MACHINES. C ASMALL REAL LOWER BOUND FOR NON-ZERO MAGN. IN AMAT(*) C ABIG REAL UPPER BOUND FOR NON-ZERO MAGN. IN AMAT(*) C MXITLP INTEGER MAXIMUM NUMBER OF ITERATIONS FOR LP C ITLP INTEGER ITERATION COUNTER FOR TOTAL LP ITERS C COSTSC REAL COSTS(*) SCALING C SCOSTS REAL TEMP LOC. FOR COSTSC. C XLAMDA REAL WEIGHT PARAMETER FOR PEN. METHOD. C ANORM REAL NORM OF DATA MATRIX AMAT(*) C RPRNRM REAL NORM OF THE SOLUTION C DULNRM REAL NORM OF THE DUALS C ERDNRM REAL NORM OF ERROR IN DUAL VARIABLES C DIRNRM REAL NORM OF THE DIRECTION VECTOR C RHSNRM REAL NORM OF TRANSLATED RIGHT HAND SIDE VECTOR C RESNRM REAL NORM OF RESIDUAL VECTOR FOR CHECKING C FEASIBILITY C NZBM INTEGER NUMBER OF NON-ZEROS IN BASMAT(*) C LBM INTEGER LENGTH OF BASMAT(*) C SMALL REAL EPS*ANORM USED IN HARWELL SPARSE CODE C LP INTEGER USED IN HARWELL LA05*() PACK AS OUTPUT C FILE NUMBER. SET=I1MACH(4) NOW. C UU REAL 0.1--USED IN HARWELL SPARSE CODE C FOR RELATIVE PIVOTING TOLERANCE. C GG REAL OUTPUT INFO FLAG IN HARWELL SPARSE CODE C IPLACE INTEGER INTEGER USED BY SPARSE MATRIX CODES C IENTER INTEGER NEXT COLUMN TO ENTER BASIS C NREDC INTEGER NO. OF FULL REDECOMPOSITIONS C KPRINT INTEGER LEVEL OF OUTPUT, =0-3 C IDG INTEGER FORMAT AND PRECISION OF OUTPUT C ITBRC INTEGER NO. OF ITERS. BETWEEN RECALCULATING C THE ERROR IN THE PRIMAL SOLUTION. C NPP INTEGER NO. OF NEGATIVE REDUCED COSTS REQUIRED C IN PARTIAL PRICING C JSTRT INTEGER STARTING PLACE FOR PARTIAL PRICING. C LOGICAL COLSCP,SAVEDT,CONTIN,CSTSCP,UNBND, * FEAS,FINITE,FOUND,MINPRB,REDBAS, * SINGLR,SIZEUP,STPEDG,TRANS,USRBAS,ZEROLV,LOPT(08) CHARACTER*8 XERN1, XERN2 EQUIVALENCE (CONTIN,LOPT(1)),(USRBAS,LOPT(2)), * (SIZEUP,LOPT(3)),(SAVEDT,LOPT(4)),(COLSCP,LOPT(5)), * (CSTSCP,LOPT(6)),(MINPRB,LOPT(7)),(STPEDG,LOPT(8)), * (IDG,INTOPT(1)),(IPAGEF,INTOPT(2)),(ISAVE,INTOPT(3)), * (MXITLP,INTOPT(4)),(KPRINT,INTOPT(5)),(ITBRC,INTOPT(6)), * (NPP,INTOPT(7)),(LPRG,INTOPT(8)),(EPS,ROPT(1)),(ASMALL,ROPT(2)), * (ABIG,ROPT(3)),(COSTSC,ROPT(4)),(TOLLS,ROPT(5)),(TUNE,ROPT(6)), * (TOLABS,ROPT(7)) C C COMMON BLOCK USED BY LA05 () PACKAGE.. COMMON /LA05DS/ SMALL,LP,LENL,LENU,NCP,LROW,LCOL EXTERNAL USRMAT C C SET LP=0 SO NO ERROR MESSAGES WILL PRINT WITHIN LA05 () PACKAGE. C***FIRST EXECUTABLE STATEMENT SPLPMN LP=0 C C THE VALUES ZERO AND ONE. ZERO=0.E0 ONE=1.E0 FACTOR=0.01E0 LPG=LMX-(NVARS+4) IOPT=1 INFO=0 UNBND=.FALSE. JSTRT=1 C C PROCESS USER OPTIONS IN PRGOPT(*). C CHECK THAT ANY USER-GIVEN CHANGES ARE WELL-DEFINED. CALL SPOPT(PRGOPT,MRELAS,NVARS,INFO,CSC,IBASIS,ROPT,INTOPT,LOPT) IF (.NOT.(INFO.LT.0)) GO TO 20002 GO TO 30001 20002 IF (.NOT.(CONTIN)) GO TO 20003 GO TO 30002 20006 GO TO 20004 C C INITIALIZE SPARSE DATA MATRIX, AMAT(*) AND IMAT(*). 20003 CALL PINITM(MRELAS,NVARS,AMAT,IMAT,LMX,IPAGEF) C C UPDATE MATRIX DATA AND CHECK BOUNDS FOR CONSISTENCY. 20004 CALL SPLPUP(USRMAT,MRELAS,NVARS,PRGOPT,DATTRV, * BL,BU,IND,INFO,AMAT,IMAT,SIZEUP,ASMALL,ABIG) IF (.NOT.(INFO.LT.0)) GO TO 20007 GO TO 30001 C C++ CODE FOR OUTPUT=YES IS ACTIVE 20007 IF (.NOT.(KPRINT.GE.1)) GO TO 20008 GO TO 30003 20011 CONTINUE C++ CODE FOR OUTPUT=NO IS INACTIVE C++ END C C INITIALIZATION. SCALE DATA, NORMALIZE BOUNDS, FORM COLUMN C CHECK SUMS, AND FORM INITIAL BASIS MATRIX. 20008 CALL SPINIT(MRELAS,NVARS,COSTS,BL,BU,IND,PRIMAL,INFO, * AMAT,CSC,COSTSC,COLNRM,XLAMDA,ANORM,RHS,RHSNRM, * IBASIS,IBB,IMAT,LOPT) IF (.NOT.(INFO.LT.0)) GO TO 20012 GO TO 30001 C 20012 NREDC=0 ASSIGN 20013 TO NPR004 GO TO 30004 20013 IF (.NOT.(SINGLR)) GO TO 20014 NERR=23 CALL XERMSG ('SLATEC', 'SPLPMN', + 'IN SPLP, A SINGULAR INITIAL BASIS WAS ENCOUNTERED.', NERR, + IOPT) INFO=-NERR GO TO 30001 20014 ASSIGN 20018 TO NPR005 GO TO 30005 20018 ASSIGN 20019 TO NPR006 GO TO 30006 20019 ASSIGN 20020 TO NPR007 GO TO 30007 20020 IF (.NOT.(USRBAS)) GO TO 20021 ASSIGN 20024 TO NPR008 GO TO 30008 20024 IF (.NOT.(.NOT.FEAS)) GO TO 20025 NERR=24 CALL XERMSG ('SLATEC', 'SPLPMN', + 'IN SPLP, AN INFEASIBLE INITIAL BASIS WAS ENCOUNTERED.', NERR, + IOPT) INFO=-NERR GO TO 30001 20025 CONTINUE 20021 ITLP=0 C C LAMDA HAS BEEN SET TO A CONSTANT, PERFORM PENALTY METHOD. ASSIGN 20029 TO NPR009 GO TO 30009 20029 ASSIGN 20030 TO NPR010 GO TO 30010 20030 ASSIGN 20031 TO NPR006 GO TO 30006 20031 ASSIGN 20032 TO NPR008 GO TO 30008 20032 IF (.NOT.(.NOT.FEAS)) GO TO 20033 C C SET LAMDA TO INFINITY BY SETTING COSTSC TO ZERO (SAVE THE VALUE OF C COSTSC) AND PERFORM STANDARD PHASE-1. IF(KPRINT.GE.2)CALL IVOUT(0,IDUM,'('' ENTER STANDARD PHASE-1'')', *IDG) SCOSTS=COSTSC COSTSC=ZERO ASSIGN 20036 TO NPR007 GO TO 30007 20036 ASSIGN 20037 TO NPR009 GO TO 30009 20037 ASSIGN 20038 TO NPR010 GO TO 30010 20038 ASSIGN 20039 TO NPR006 GO TO 30006 20039 ASSIGN 20040 TO NPR008 GO TO 30008 20040 IF (.NOT.(FEAS)) GO TO 20041 C C SET LAMDA TO ZERO, COSTSC=SCOSTS, PERFORM STANDARD PHASE-2. IF(KPRINT.GT.1)CALL IVOUT(0,IDUM,'('' ENTER STANDARD PHASE-2'')', *IDG) XLAMDA=ZERO COSTSC=SCOSTS ASSIGN 20044 TO NPR009 GO TO 30009 20044 CONTINUE 20041 GO TO 20034 C CHECK IF ANY BASIC VARIABLES ARE STILL CLASSIFIED AS C INFEASIBLE. IF ANY ARE, THEN THIS MAY NOT YET BE AN C OPTIMAL POINT. THEREFORE SET LAMDA TO ZERO AND TRY C TO PERFORM MORE SIMPLEX STEPS. 20033 I=1 N20046=MRELAS GO TO 20047 20046 I=I+1 20047 IF ((N20046-I).LT.0) GO TO 20048 IF (PRIMAL(I+NVARS).NE.ZERO) GO TO 20045 GO TO 20046 20048 GO TO 20035 20045 XLAMDA=ZERO ASSIGN 20050 TO NPR009 GO TO 30009 20050 CONTINUE 20034 CONTINUE C 20035 ASSIGN 20051 TO NPR011 GO TO 30011 20051 IF (.NOT.(FEAS.AND.(.NOT.UNBND))) GO TO 20052 INFO=1 GO TO 20053 20052 IF (.NOT.((.NOT.FEAS).AND.(.NOT.UNBND))) GO TO 10001 NERR=1 CALL XERMSG ('SLATEC', 'SPLPMN', + 'IN SPLP, THE PROBLEM APPEARS TO BE INFEASIBLE', NERR, IOPT) INFO=-NERR GO TO 20053 10001 IF (.NOT.(FEAS .AND. UNBND)) GO TO 10002 NERR=2 CALL XERMSG ('SLATEC', 'SPLPMN', + 'IN SPLP, THE PROBLEM APPEARS TO HAVE NO FINITE SOLUTION.', + NERR, IOPT) INFO=-NERR GO TO 20053 10002 IF (.NOT.((.NOT.FEAS).AND.UNBND)) GO TO 10003 NERR=3 CALL XERMSG ('SLATEC', 'SPLPMN', + 'IN SPLP, THE PROBLEM APPEARS TO BE INFEASIBLE AND TO HAVE ' // + 'NO FINITE SOLUTION.', NERR, IOPT) INFO=-NERR 10003 CONTINUE 20053 CONTINUE C IF (.NOT.(INFO.EQ.(-1) .OR. INFO.EQ.(-3))) GO TO 20055 SIZE=SASUM(NVARS,PRIMAL,1)*ANORM SIZE=SIZE/SASUM(NVARS,CSC,1) SIZE=SIZE+SASUM(MRELAS,PRIMAL(NVARS+1),1) I=1 N20058=NVARS+MRELAS GO TO 20059 20058 I=I+1 20059 IF ((N20058-I).LT.0) GO TO 20060 NX0066=IND(I) IF (NX0066.LT.1.OR.NX0066.GT.4) GO TO 20066 GO TO (20062,20063,20064,20065), NX0066 20062 IF (.NOT.(SIZE+ABS(PRIMAL(I)-BL(I))*FACTOR.EQ.SIZE)) GO TO 20068 GO TO 20058 20068 IF (.NOT.(PRIMAL(I).GT.BL(I))) GO TO 10004 GO TO 20058 10004 IND(I)=-4 GO TO 20067 20063 IF (.NOT.(SIZE+ABS(PRIMAL(I)-BU(I))*FACTOR.EQ.SIZE)) GO TO 20071 GO TO 20058 20071 IF (.NOT.(PRIMAL(I).LT.BU(I))) GO TO 10005 GO TO 20058 10005 IND(I)=-4 GO TO 20067 20064 IF (.NOT.(SIZE+ABS(PRIMAL(I)-BL(I))*FACTOR.EQ.SIZE)) GO TO 20074 GO TO 20058 20074 IF (.NOT.(PRIMAL(I).LT.BL(I))) GO TO 10006 IND(I)=-4 GO TO 20075 10006 IF (.NOT.(SIZE+ABS(PRIMAL(I)-BU(I))*FACTOR.EQ.SIZE)) GO TO 10007 GO TO 20058 10007 IF (.NOT.(PRIMAL(I).GT.BU(I))) GO TO 10008 IND(I)=-4 GO TO 20075 10008 GO TO 20058 20075 GO TO 20067 20065 GO TO 20058 20066 CONTINUE 20067 GO TO 20058 20060 CONTINUE 20055 CONTINUE C IF (.NOT.(INFO.EQ.(-2) .OR. INFO.EQ.(-3))) GO TO 20077 J=1 N20080=NVARS GO TO 20081 20080 J=J+1 20081 IF ((N20080-J).LT.0) GO TO 20082 IF (.NOT.(IBB(J).EQ.0)) GO TO 20084 NX0091=IND(J) IF (NX0091.LT.1.OR.NX0091.GT.4) GO TO 20091 GO TO (20087,20088,20089,20090), NX0091 20087 BU(J)=BL(J) IND(J)=-3 GO TO 20092 20088 BL(J)=BU(J) IND(J)=-3 GO TO 20092 20089 GO TO 20080 20090 BL(J)=ZERO BU(J)=ZERO IND(J)=-3 20091 CONTINUE 20092 CONTINUE 20084 GO TO 20080 20082 CONTINUE 20077 CONTINUE C++ CODE FOR OUTPUT=YES IS ACTIVE IF (.NOT.(KPRINT.GE.1)) GO TO 20093 ASSIGN 20096 TO NPR012 GO TO 30012 20096 CONTINUE 20093 CONTINUE C++ CODE FOR OUTPUT=NO IS INACTIVE C++ END GO TO 30001 C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C PROCEDURE (COMPUTE RIGHT HAND SIDE) 30010 RHS(1)=ZERO CALL SCOPY(MRELAS,RHS,0,RHS,1) J=1 N20098=NVARS+MRELAS GO TO 20099 20098 J=J+1 20099 IF ((N20098-J).LT.0) GO TO 20100 NX0106=IND(J) IF (NX0106.LT.1.OR.NX0106.GT.4) GO TO 20106 GO TO (20102,20103,20104,20105), NX0106 20102 SCALR=-BL(J) GO TO 20107 20103 SCALR=-BU(J) GO TO 20107 20104 SCALR=-BL(J) GO TO 20107 20105 SCALR=ZERO 20106 CONTINUE 20107 IF (.NOT.(SCALR.NE.ZERO)) GO TO 20108 IF (.NOT.(J.LE.NVARS)) GO TO 20111 I=0 20114 CALL PNNZRS(I,AIJ,IPLACE,AMAT,IMAT,J) IF (.NOT.(I.LE.0)) GO TO 20116 GO TO 20115 20116 RHS(I)=RHS(I)+AIJ*SCALR GO TO 20114 20115 GO TO 20112 20111 RHS(J-NVARS)=RHS(J-NVARS)-SCALR 20112 CONTINUE 20108 GO TO 20098 20100 J=1 N20119=NVARS+MRELAS GO TO 20120 20119 J=J+1 20120 IF ((N20119-J).LT.0) GO TO 20121 SCALR=ZERO IF(IND(J).EQ.3.AND.MOD(IBB(J),2).EQ.0) SCALR=BU(J)-BL(J) IF (.NOT.(SCALR.NE.ZERO)) GO TO 20123 IF (.NOT.(J.LE.NVARS)) GO TO 20126 I=0 20129 CALL PNNZRS(I,AIJ,IPLACE,AMAT,IMAT,J) IF (.NOT.(I.LE.0)) GO TO 20131 GO TO 20130 20131 RHS(I)=RHS(I)-AIJ*SCALR GO TO 20129 20130 GO TO 20127 20126 RHS(J-NVARS)=RHS(J-NVARS)+SCALR 20127 CONTINUE 20123 GO TO 20119 20121 CONTINUE GO TO NPR010, (20030,20038) C PROCEDURE (PERFORM SIMPLEX STEPS) 30009 ASSIGN 20134 TO NPR013 GO TO 30013 20134 ASSIGN 20135 TO NPR014 GO TO 30014 20135 IF (.NOT.(KPRINT.GT.2)) GO TO 20136 CALL SVOUT(MRELAS,DUALS,'('' BASIC (INTERNAL) DUAL SOLN.'')',IDG) CALL SVOUT(NVARS+MRELAS,RZ,'('' REDUCED COSTS'')',IDG) 20136 CONTINUE 20139 ASSIGN 20141 TO NPR015 GO TO 30015 20141 IF (.NOT.(.NOT. FOUND)) GO TO 20142 GO TO 30016 20145 CONTINUE 20142 IF (.NOT.(FOUND)) GO TO 20146 IF (KPRINT.GE.3) CALL SVOUT(MRELAS,WW,'('' SEARCH DIRECTION'')', *IDG) GO TO 30017 20149 IF (.NOT.(FINITE)) GO TO 20150 GO TO 30018 20153 ASSIGN 20154 TO NPR005 GO TO 30005 20154 GO TO 20151 20150 UNBND=.TRUE. IBB(IBASIS(IENTER))=0 20151 GO TO 20147 20146 GO TO 20140 20147 ITLP=ITLP+1 GO TO 30019 20155 GO TO 20139 20140 CONTINUE GO TO NPR009, (20029,20037,20044,20050) C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C PROCEDURE (RETRIEVE SAVED DATA FROM FILE ISAVE) 30002 LPR=NVARS+4 REWIND ISAVE READ(ISAVE) (AMAT(I),I=1,LPR),(IMAT(I),I=1,LPR) KEY=2 IPAGE=1 GO TO 20157 20156 IF (NP.LT.0) GO TO 20158 20157 LPR1=LPR+1 READ(ISAVE) (AMAT(I),I=LPR1,LMX),(IMAT(I),I=LPR1,LMX) CALL PRWPGE(KEY,IPAGE,LPG,AMAT,IMAT) NP=IMAT(LMX-1) IPAGE=IPAGE+1 GO TO 20156 20158 NPARM=NVARS+MRELAS READ(ISAVE) (IBASIS(I),I=1,NPARM) REWIND ISAVE GO TO 20006 C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C PROCEDURE (SAVE DATA ON FILE ISAVE) C C SOME PAGES MAY NOT BE WRITTEN YET. 30020 IF (.NOT.(AMAT(LMX).EQ.ONE)) GO TO 20159 AMAT(LMX)=ZERO KEY=2 IPAGE=ABS(IMAT(LMX-1)) CALL PRWPGE(KEY,IPAGE,LPG,AMAT,IMAT) C C FORCE PAGE FILE TO BE OPENED ON RESTARTS. 20159 KEY=AMAT(4) AMAT(4)=ZERO LPR=NVARS+4 WRITE(ISAVE) (AMAT(I),I=1,LPR),(IMAT(I),I=1,LPR) AMAT(4)=KEY IPAGE=1 KEY=1 GO TO 20163 20162 IF (NP.LT.0) GO TO 20164 20163 CALL PRWPGE(KEY,IPAGE,LPG,AMAT,IMAT) LPR1=LPR+1 WRITE(ISAVE) (AMAT(I),I=LPR1,LMX),(IMAT(I),I=LPR1,LMX) NP=IMAT(LMX-1) IPAGE=IPAGE+1 GO TO 20162 20164 NPARM=NVARS+MRELAS WRITE(ISAVE) (IBASIS(I),I=1,NPARM) ENDFILE ISAVE C C CLOSE FILE, IPAGEF, WHERE PAGES ARE STORED. THIS IS NEEDED SO THAT C THE PAGES MAY BE RESTORED AT A CONTINUATION OF SPLP(). GO TO 20317 C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C PROCEDURE (DECOMPOSE BASIS MATRIX) C++ CODE FOR OUTPUT=YES IS ACTIVE 30004 IF (.NOT.(KPRINT.GE.2)) GO TO 20165 CALL IVOUT(MRELAS,IBASIS, *'('' SUBSCRIPTS OF BASIC VARIABLES DURING REDECOMPOSITION'')', *IDG) C++ CODE FOR OUTPUT=NO IS INACTIVE C++ END C C SET RELATIVE PIVOTING FACTOR FOR USE IN LA05 () PACKAGE. 20165 UU=0.1 CALL SPLPDM( *MRELAS,NVARS,LMX,LBM,NREDC,INFO,IOPT, *IBASIS,IMAT,IBRC,IPR,IWR,IND,IBB, *ANORM,EPS,UU,GG, *AMAT,BASMAT,CSC,WR, *SINGLR,REDBAS) IF (.NOT.(INFO.LT.0)) GO TO 20168 GO TO 30001 20168 CONTINUE GO TO NPR004, (20013,20204,20242) C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C PROCEDURE (CLASSIFY VARIABLES) C C DEFINE THE CLASSIFICATION OF THE BASIC VARIABLES C -1 VIOLATES LOWER BOUND, 0 FEASIBLE, +1 VIOLATES UPPER BOUND. C (THIS INFO IS STORED IN PRIMAL(NVARS+1)-PRIMAL(NVARS+MRELAS)) C TRANSLATE VARIABLE TO ITS UPPER BOUND, IF .GT. UPPER BOUND 30007 PRIMAL(NVARS+1)=ZERO CALL SCOPY(MRELAS,PRIMAL(NVARS+1),0,PRIMAL(NVARS+1),1) I=1 N20172=MRELAS GO TO 20173 20172 I=I+1 20173 IF ((N20172-I).LT.0) GO TO 20174 J=IBASIS(I) IF (.NOT.(IND(J).NE.4)) GO TO 20176 IF (.NOT.(RPRIM(I).LT.ZERO)) GO TO 20179 PRIMAL(I+NVARS)=-ONE GO TO 20180 20179 IF (.NOT.(IND(J).EQ.3)) GO TO 10009 UPBND=BU(J)-BL(J) IF (J.LE.NVARS) UPBND=UPBND/CSC(J) IF (.NOT.(RPRIM(I).GT.UPBND)) GO TO 20182 RPRIM(I)=RPRIM(I)-UPBND IF (.NOT.(J.LE.NVARS)) GO TO 20185 K=0 20188 CALL PNNZRS(K,AIJ,IPLACE,AMAT,IMAT,J) IF (.NOT.(K.LE.0)) GO TO 20190 GO TO 20189 20190 RHS(K)=RHS(K)-UPBND*AIJ*CSC(J) GO TO 20188 20189 GO TO 20186 20185 RHS(J-NVARS)=RHS(J-NVARS)+UPBND 20186 PRIMAL(I+NVARS)=ONE 20182 CONTINUE CONTINUE 10009 CONTINUE 20180 CONTINUE 20176 GO TO 20172 20174 CONTINUE GO TO NPR007, (20020,20036) C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C PROCEDURE (COMPUTE ERROR IN DUAL AND PRIMAL SYSTEMS) 30005 NTRIES=1 GO TO 20195 20194 NTRIES=NTRIES+1 20195 IF ((2-NTRIES).LT.0) GO TO 20196 CALL SPLPCE( *MRELAS,NVARS,LMX,LBM,ITLP,ITBRC, *IBASIS,IMAT,IBRC,IPR,IWR,IND,IBB, *ERDNRM,EPS,TUNE,GG, *AMAT,BASMAT,CSC,WR,WW,PRIMAL,ERD,ERP, *SINGLR,REDBAS) IF (.NOT.(.NOT. SINGLR)) GO TO 20198 C++ CODE FOR OUTPUT=YES IS ACTIVE IF (.NOT.(KPRINT.GE.3)) GO TO 20201 CALL SVOUT(MRELAS,ERP,'('' EST. ERROR IN PRIMAL COMPS.'')',IDG) CALL SVOUT(MRELAS,ERD,'('' EST. ERROR IN DUAL COMPS.'')',IDG) 20201 CONTINUE C++ CODE FOR OUTPUT=NO IS INACTIVE C++ END GO TO 20193 20198 IF (NTRIES.EQ.2) GO TO 20197 ASSIGN 20204 TO NPR004 GO TO 30004 20204 CONTINUE GO TO 20194 20196 CONTINUE 20197 NERR=26 CALL XERMSG ('SLATEC', 'SPLPMN', + 'IN SPLP, MOVED TO A SINGULAR POINT. THIS SHOULD NOT HAPPEN.', + NERR, IOPT) INFO=-NERR GO TO 30001 20193 CONTINUE GO TO NPR005, (20018,20154,20243) C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C PROCEDURE (CHECK FEASIBILITY) C C SEE IF NEARBY FEASIBLE POINT SATISFIES THE CONSTRAINT C EQUATIONS. C C COPY RHS INTO WW(*), THEN UPDATE WW(*). 30008 CALL SCOPY(MRELAS,RHS,1,WW,1) J=1 N20206=MRELAS GO TO 20207 20206 J=J+1 20207 IF ((N20206-J).LT.0) GO TO 20208 IBAS=IBASIS(J) XVAL=RPRIM(J) C C ALL VARIABLES BOUNDED BELOW HAVE ZERO AS THAT BOUND. IF (IND(IBAS).LE.3) XVAL=MAX(ZERO,XVAL) C C IF THE VARIABLE HAS AN UPPER BOUND, COMPUTE THAT BOUND. IF (.NOT.(IND(IBAS).EQ.3)) GO TO 20210 UPBND=BU(IBAS)-BL(IBAS) IF (IBAS.LE.NVARS) UPBND=UPBND/CSC(IBAS) XVAL=MIN(UPBND,XVAL) 20210 CONTINUE C C SUBTRACT XVAL TIMES COLUMN VECTOR FROM RIGHT-HAND SIDE IN WW(*) IF (.NOT.(XVAL.NE.ZERO)) GO TO 20213 IF (.NOT.(IBAS.LE.NVARS)) GO TO 20216 I=0 20219 CALL PNNZRS(I,AIJ,IPLACE,AMAT,IMAT,IBAS) IF (.NOT.(I.LE.0)) GO TO 20221 GO TO 20220 20221 WW(I)=WW(I)-XVAL*AIJ*CSC(IBAS) GO TO 20219 20220 GO TO 20217 20216 IF (.NOT.(IND(IBAS).EQ.2)) GO TO 20224 WW(IBAS-NVARS)=WW(IBAS-NVARS)-XVAL GO TO 20225 20224 WW(IBAS-NVARS)=WW(IBAS-NVARS)+XVAL 20225 CONTINUE 20217 CONTINUE 20213 CONTINUE GO TO 20206 C C COMPUTE NORM OF DIFFERENCE AND CHECK FOR FEASIBILITY. 20208 RESNRM=SASUM(MRELAS,WW,1) FEAS=RESNRM.LE.TOLLS*(RPRNRM*ANORM+RHSNRM) C C TRY AN ABSOLUTE ERROR TEST IF THE RELATIVE TEST FAILS. IF(.NOT. FEAS)FEAS=RESNRM.LE.TOLABS IF (.NOT.(FEAS)) GO TO 20227 PRIMAL(NVARS+1)=ZERO CALL SCOPY(MRELAS,PRIMAL(NVARS+1),0,PRIMAL(NVARS+1),1) 20227 CONTINUE GO TO NPR008, (20024,20032,20040) C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C PROCEDURE (INITIALIZE REDUCED COSTS AND STEEPEST EDGE WEIGHTS) 30014 CALL SPINCW( *MRELAS,NVARS,LMX,LBM,NPP,JSTRT, *IBASIS,IMAT,IBRC,IPR,IWR,IND,IBB, *COSTSC,GG,ERDNRM,DULNRM, *AMAT,BASMAT,CSC,WR,WW,RZ,RG,COSTS,COLNRM,DUALS, *STPEDG) C GO TO NPR014, (20135,20246) C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C PROCEDURE (CHECK AND RETURN WITH EXCESS ITERATIONS) 30019 IF (.NOT.(ITLP.GT.MXITLP)) GO TO 20230 NERR=25 ASSIGN 20233 TO NPR011 GO TO 30011 C++ CODE FOR OUTPUT=YES IS ACTIVE 20233 IF (.NOT.(KPRINT.GE.1)) GO TO 20234 ASSIGN 20237 TO NPR012 GO TO 30012 20237 CONTINUE 20234 CONTINUE C++ CODE FOR OUTPUT=NO IS INACTIVE C++ END IDUM(1)=0 IF(SAVEDT) IDUM(1)=ISAVE WRITE (XERN1, '(I8)') MXITLP WRITE (XERN2, '(I8)') IDUM(1) CALL XERMSG ('SLATEC', 'SPLPMN', * 'IN SPLP, MAX ITERATIONS = ' // XERN1 // * ' TAKEN. UP-TO-DATE RESULTS SAVED ON FILE NO. ' // XERN2 // * '. IF FILE NO. = 0, NO SAVE.', NERR, IOPT) INFO=-NERR GO TO 30001 20230 CONTINUE GO TO 20155 C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C PROCEDURE (REDECOMPOSE BASIS MATRIX AND TRY AGAIN) 30016 IF (.NOT.(.NOT.REDBAS)) GO TO 20239 ASSIGN 20242 TO NPR004 GO TO 30004 20242 ASSIGN 20243 TO NPR005 GO TO 30005 20243 ASSIGN 20244 TO NPR006 GO TO 30006 20244 ASSIGN 20245 TO NPR013 GO TO 30013 20245 ASSIGN 20246 TO NPR014 GO TO 30014 20246 CONTINUE C C ERASE NON-CYCLING MARKERS NEAR COMPLETION. 20239 I=MRELAS+1 N20247=MRELAS+NVARS GO TO 20248 20247 I=I+1 20248 IF ((N20247-I).LT.0) GO TO 20249 IBASIS(I)=ABS(IBASIS(I)) GO TO 20247 20249 ASSIGN 20251 TO NPR015 GO TO 30015 20251 CONTINUE GO TO 20145 C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C PROCEDURE (COMPUTE NEW PRIMAL) C C COPY RHS INTO WW(*), SOLVE SYSTEM. 30006 CALL SCOPY(MRELAS,RHS,1,WW,1) TRANS = .FALSE. CALL LA05BS(BASMAT,IBRC,LBM,MRELAS,IPR,IWR,WR,GG,WW,TRANS) CALL SCOPY(MRELAS,WW,1,RPRIM,1) RPRNRM=SASUM(MRELAS,RPRIM,1) GO TO NPR006, (20019,20031,20039,20244,20275) C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C PROCEDURE (COMPUTE NEW DUALS) C C SOLVE FOR DUAL VARIABLES. FIRST COPY COSTS INTO DUALS(*). 30013 I=1 N20252=MRELAS GO TO 20253 20252 I=I+1 20253 IF ((N20252-I).LT.0) GO TO 20254 J=IBASIS(I) IF (.NOT.(J.LE.NVARS)) GO TO 20256 DUALS(I)=COSTSC*COSTS(J)*CSC(J) + XLAMDA*PRIMAL(I+NVARS) GO TO 20257 20256 DUALS(I)=XLAMDA*PRIMAL(I+NVARS) 20257 CONTINUE GO TO 20252 C 20254 TRANS=.TRUE. CALL LA05BS(BASMAT,IBRC,LBM,MRELAS,IPR,IWR,WR,GG,DUALS,TRANS) DULNRM=SASUM(MRELAS,DUALS,1) GO TO NPR013, (20134,20245,20267) C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C PROCEDURE (FIND VARIABLE TO ENTER BASIS AND GET SEARCH DIRECTION) 30015 CALL SPLPFE( *MRELAS,NVARS,LMX,LBM,IENTER, *IBASIS,IMAT,IBRC,IPR,IWR,IND,IBB, *ERDNRM,EPS,GG,DULNRM,DIRNRM, *AMAT,BASMAT,CSC,WR,WW,BL,BU,RZ,RG,COLNRM,DUALS, *FOUND) GO TO NPR015, (20141,20251) C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C PROCEDURE (CHOOSE VARIABLE TO LEAVE BASIS) 30017 CALL SPLPFL( *MRELAS,NVARS,IENTER,ILEAVE, *IBASIS,IND,IBB, *THETA,DIRNRM,RPRNRM, *CSC,WW,BL,BU,ERP,RPRIM,PRIMAL, *FINITE,ZEROLV) GO TO 20149 C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C PROCEDURE (MAKE MOVE AND UPDATE) 30018 CALL SPLPMU( *MRELAS,NVARS,LMX,LBM,NREDC,INFO,IENTER,ILEAVE,IOPT,NPP,JSTRT, *IBASIS,IMAT,IBRC,IPR,IWR,IND,IBB, *ANORM,EPS,UU,GG,RPRNRM,ERDNRM,DULNRM,THETA,COSTSC,XLAMDA,RHSNRM, *AMAT,BASMAT,CSC,WR,RPRIM,WW,BU,BL,RHS,ERD,ERP,RZ,RG,COLNRM,COSTS, *PRIMAL,DUALS,SINGLR,REDBAS,ZEROLV,STPEDG) IF (.NOT.(INFO.EQ.(-26))) GO TO 20259 GO TO 30001 C++ CODE FOR OUTPUT=YES IS ACTIVE 20259 IF (.NOT.(KPRINT.GE.2)) GO TO 20263 GO TO 30021 20266 CONTINUE C++ CODE FOR OUTPUT=NO IS INACTIVE C++ END 20263 CONTINUE GO TO 20153 C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C PROCEDURE(RESCALE AND REARRANGE VARIABLES) C C RESCALE THE DUAL VARIABLES. 30011 ASSIGN 20267 TO NPR013 GO TO 30013 20267 IF (.NOT.(COSTSC.NE.ZERO)) GO TO 20268 I=1 N20271=MRELAS GO TO 20272 20271 I=I+1 20272 IF ((N20271-I).LT.0) GO TO 20273 DUALS(I)=DUALS(I)/COSTSC GO TO 20271 20273 CONTINUE 20268 ASSIGN 20275 TO NPR006 GO TO 30006 C C REAPPLY COLUMN SCALING TO PRIMAL. 20275 I=1 N20276=MRELAS GO TO 20277 20276 I=I+1 20277 IF ((N20276-I).LT.0) GO TO 20278 J=IBASIS(I) IF (.NOT.(J.LE.NVARS)) GO TO 20280 SCALR=CSC(J) IF(IND(J).EQ.2)SCALR=-SCALR RPRIM(I)=RPRIM(I)*SCALR 20280 GO TO 20276 C C REPLACE TRANSLATED BASIC VARIABLES INTO ARRAY PRIMAL(*) 20278 PRIMAL(1)=ZERO CALL SCOPY(NVARS+MRELAS,PRIMAL,0,PRIMAL,1) J=1 N20283=NVARS+MRELAS GO TO 20284 20283 J=J+1 20284 IF ((N20283-J).LT.0) GO TO 20285 IBAS=ABS(IBASIS(J)) XVAL=ZERO IF (J.LE.MRELAS) XVAL=RPRIM(J) IF (IND(IBAS).EQ.1) XVAL=XVAL+BL(IBAS) IF (IND(IBAS).EQ.2) XVAL=BU(IBAS)-XVAL IF (.NOT.(IND(IBAS).EQ.3)) GO TO 20287 IF (MOD(IBB(IBAS),2).EQ.0) XVAL=BU(IBAS)-BL(IBAS)-XVAL XVAL = XVAL+BL(IBAS) 20287 PRIMAL(IBAS)=XVAL GO TO 20283 C C COMPUTE DUALS FOR INDEPENDENT VARIABLES WITH BOUNDS. C OTHER ENTRIES ARE ZERO. 20285 J=1 N20290=NVARS GO TO 20291 20290 J=J+1 20291 IF ((N20290-J).LT.0) GO TO 20292 RZJ=ZERO IF (.NOT.(IBB(J).GT.ZERO .AND. IND(J).NE.4)) GO TO 20294 RZJ=COSTS(J) I=0 20297 CALL PNNZRS(I,AIJ,IPLACE,AMAT,IMAT,J) IF (.NOT.(I.LE.0)) GO TO 20299 GO TO 20298 20299 CONTINUE RZJ=RZJ-AIJ*DUALS(I) GO TO 20297 20298 CONTINUE 20294 DUALS(MRELAS+J)=RZJ GO TO 20290 20292 CONTINUE GO TO NPR011, (20051,20233) C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C++ CODE FOR OUTPUT=YES IS ACTIVE C PROCEDURE (PRINT PROLOGUE) 30003 IDUM(1)=MRELAS CALL IVOUT(1,IDUM,'(''1NUM. OF DEPENDENT VARS., MRELAS'')',IDG) IDUM(1)=NVARS CALL IVOUT(1,IDUM,'('' NUM. OF INDEPENDENT VARS., NVARS'')',IDG) CALL IVOUT(1,IDUM,'('' DIMENSION OF COSTS(*)='')',IDG) IDUM(1)=NVARS+MRELAS CALL IVOUT(1,IDUM, '('' DIMENSIONS OF BL(*),BU(*),IND(*)'' */'' PRIMAL(*),DUALS(*) ='')',IDG) CALL IVOUT(1,IDUM,'('' DIMENSION OF IBASIS(*)='')',IDG) IDUM(1)=LPRG+1 CALL IVOUT(1,IDUM,'('' DIMENSION OF PRGOPT(*)='')',IDG) CALL IVOUT(0,IDUM, * '('' 1-NVARS=INDEPENDENT VARIABLE INDICES.''/ * '' (NVARS+1)-(NVARS+MRELAS)=DEPENDENT VARIABLE INDICES.''/ * '' CONSTRAINT INDICATORS ARE 1-4 AND MEAN'')',IDG) CALL IVOUT(0,IDUM, * '('' 1=VARIABLE HAS ONLY LOWER BOUND.''/ * '' 2=VARIABLE HAS ONLY UPPER BOUND.''/ * '' 3=VARIABLE HAS BOTH BOUNDS.''/ * '' 4=VARIABLE HAS NO BOUNDS, IT IS FREE.'')',IDG) CALL SVOUT(NVARS,COSTS,'('' ARRAY OF COSTS'')',IDG) CALL IVOUT(NVARS+MRELAS,IND, * '('' CONSTRAINT INDICATORS'')',IDG) CALL SVOUT(NVARS+MRELAS,BL, *'('' LOWER BOUNDS FOR VARIABLES (IGNORE UNUSED ENTRIES.)'')',IDG) CALL SVOUT(NVARS+MRELAS,BU, *'('' UPPER BOUNDS FOR VARIABLES (IGNORE UNUSED ENTRIES.)'')',IDG) IF (.NOT.(KPRINT.GE.2)) GO TO 20302 CALL IVOUT(0,IDUM, * '(''0NON-BASIC INDICES THAT ARE NEGATIVE SHOW VARIABLES'' * '' EXCHANGED AT A ZERO''/'' STEP LENGTH'')',IDG) CALL IVOUT(0,IDUM, * '('' WHEN COL. NO. LEAVING=COL. NO. ENTERING, THE ENTERING '' * ''VARIABLE MOVED''/'' TO ITS BOUND. IT REMAINS NON-BASIC.''/ * '' WHEN COL. NO. OF BASIS EXCHANGED IS NEGATIVE, THE LEAVING''/ * '' VARIABLE IS AT ITS UPPER BOUND.'')',IDG) 20302 CONTINUE GO TO 20011 C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C PROCEDURE (PRINT SUMMARY) 30012 IDUM(1)=INFO CALL IVOUT(1,IDUM,'('' THE OUTPUT VALUE OF INFO IS'')',IDG) IF (.NOT.(MINPRB)) GO TO 20305 CALL IVOUT(0,IDUM,'('' THIS IS A MINIMIZATION PROBLEM.'')',IDG) GO TO 20306 20305 CALL IVOUT(0,IDUM,'('' THIS IS A MAXIMIZATION PROBLEM.'')',IDG) 20306 IF (.NOT.(STPEDG)) GO TO 20308 CALL IVOUT(0,IDUM,'('' STEEPEST EDGE PRICING WAS USED.'')',IDG) GO TO 20309 20308 CALL IVOUT(0,IDUM,'('' MINIMUM REDUCED COST PRICING WAS USED.'')', * IDG) 20309 RDUM(1)=SDOT(NVARS,COSTS,1,PRIMAL,1) CALL SVOUT(1,RDUM, * '('' OUTPUT VALUE OF THE OBJECTIVE FUNCTION'')',IDG) CALL SVOUT(NVARS+MRELAS,PRIMAL, * '('' THE OUTPUT INDEPENDENT AND DEPENDENT VARIABLES'')',IDG) CALL SVOUT(MRELAS+NVARS,DUALS, * '('' THE OUTPUT DUAL VARIABLES'')',IDG) CALL IVOUT(NVARS+MRELAS,IBASIS, * '('' VARIABLE INDICES IN POSITIONS 1-MRELAS ARE BASIC.'')',IDG) IDUM(1)=ITLP CALL IVOUT(1,IDUM,'('' NO. OF ITERATIONS'')',IDG) IDUM(1)=NREDC CALL IVOUT(1,IDUM,'('' NO. OF FULL REDECOMPS'')',IDG) GO TO NPR012, (20096,20237) C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C PROCEDURE (PRINT ITERATION SUMMARY) 30021 IDUM(1)=ITLP+1 CALL IVOUT(1,IDUM,'(''0ITERATION NUMBER'')',IDG) IDUM(1)=IBASIS(ABS(ILEAVE)) CALL IVOUT(1,IDUM, * '('' INDEX OF VARIABLE ENTERING THE BASIS'')',IDG) IDUM(1)=ILEAVE CALL IVOUT(1,IDUM,'('' COLUMN OF THE BASIS EXCHANGED'')',IDG) IDUM(1)=IBASIS(IENTER) CALL IVOUT(1,IDUM, * '('' INDEX OF VARIABLE LEAVING THE BASIS'')',IDG) RDUM(1)=THETA CALL SVOUT(1,RDUM,'('' LENGTH OF THE EXCHANGE STEP'')',IDG) IF (.NOT.(KPRINT.GE.3)) GO TO 20311 CALL SVOUT(MRELAS,RPRIM,'('' BASIC (INTERNAL) PRIMAL SOLN.'')', * IDG) CALL IVOUT(NVARS+MRELAS,IBASIS, * '('' VARIABLE INDICES IN POSITIONS 1-MRELAS ARE BASIC.'')',IDG) CALL IVOUT(NVARS+MRELAS,IBB,'('' IBB ARRAY'')',IDG) CALL SVOUT(MRELAS,RHS,'('' TRANSLATED RHS'')',IDG) CALL SVOUT(MRELAS,DUALS,'('' BASIC (INTERNAL) DUAL SOLN.'')',IDG) 20311 CONTINUE GO TO 20266 C++ CODE FOR OUTPUT=NO IS INACTIVE C++ END C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C PROCEDURE (RETURN TO USER) 30001 IF (.NOT.(SAVEDT)) GO TO 20314 GO TO 30020 20317 CONTINUE 20314 IF(IMAT(LMX-1).NE.(-1)) CALL SCLOSM(IPAGEF) C C THIS TEST IS THERE ONLY TO AVOID DIAGNOSTICS ON SOME FORTRAN C COMPILERS. RETURN END