*DECK SPOPT SUBROUTINE SPOPT (PRGOPT, MRELAS, NVARS, INFO, CSC, IBASIS, ROPT, + INTOPT, LOPT) C***BEGIN PROLOGUE SPOPT C***SUBSIDIARY C***PURPOSE Subsidiary to SPLP C***LIBRARY SLATEC C***TYPE SINGLE PRECISION (SPOPT-S, DPOPT-D) C***AUTHOR (UNKNOWN) C***DESCRIPTION C C THE EDITING REQUIRED TO CONVERT THIS SUBROUTINE FROM SINGLE TO C DOUBLE PRECISION INVOLVES THE FOLLOWING CHARACTER STRING CHANGES. C C USE AN EDITING COMMAND (CHANGE) /STRING-1/(TO)STRING-2/. C /REAL (12 BLANKS)/DOUBLE PRECISION/, C /R1MACH/D1MACH/,/E0/D0/ C C REVISED 821122-1045 C REVISED YYMMDD-HHMM C C THIS SUBROUTINE PROCESSES THE OPTION VECTOR, PRGOPT(*), C AND VALIDATES ANY MODIFIED DATA. C C***SEE ALSO SPLP C***ROUTINES CALLED R1MACH, XERMSG C***REVISION HISTORY (YYMMDD) C 811215 DATE WRITTEN C 890531 Changed all specific intrinsics to generic. (WRB) C 890605 Removed unreferenced labels. (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***END PROLOGUE SPOPT REAL ABIG,ASMALL,COSTSC,CSC(*),EPS,ONE,PRGOPT(*), * ROPT(07),TOLLS,TUNE,ZERO,R1MACH,TOLABS INTEGER IBASIS(*),INTOPT(08) LOGICAL CONTIN,USRBAS,SIZEUP,SAVEDT,COLSCP,CSTSCP,MINPRB, * STPEDG,LOPT(8) C C***FIRST EXECUTABLE STATEMENT SPOPT IOPT=1 ZERO=0.E0 ONE=1.E0 GO TO 30001 20002 CONTINUE GO TO 30002 C 20003 LOPT(1)=CONTIN LOPT(2)=USRBAS LOPT(3)=SIZEUP LOPT(4)=SAVEDT LOPT(5)=COLSCP LOPT(6)=CSTSCP LOPT(7)=MINPRB LOPT(8)=STPEDG C INTOPT(1)=IDG INTOPT(2)=IPAGEF INTOPT(3)=ISAVE INTOPT(4)=MXITLP INTOPT(5)=KPRINT INTOPT(6)=ITBRC INTOPT(7)=NPP INTOPT(8)=LPRG C ROPT(1)=EPS ROPT(2)=ASMALL ROPT(3)=ABIG ROPT(4)=COSTSC ROPT(5)=TOLLS ROPT(6)=TUNE ROPT(7)=TOLABS RETURN C C C PROCEDURE (INITIALIZE PARAMETERS AND PROCESS USER OPTIONS) 30001 CONTIN = .FALSE. USRBAS = .FALSE. SIZEUP = .FALSE. SAVEDT = .FALSE. COLSCP = .FALSE. CSTSCP = .FALSE. MINPRB = .TRUE. STPEDG = .TRUE. C C GET THE MACHINE REL. FLOATING POINT ACCURACY VALUE FROM THE C LIBRARY SUBPROGRAM, R1MACH( ). EPS=R1MACH(4) TOLLS=R1MACH(4) TUNE=ONE TOLABS=ZERO C C DEFINE NOMINAL FILE NUMBERS FOR MATRIX PAGES AND DATA SAVING. IPAGEF=1 ISAVE=2 ITBRC=10 MXITLP=3*(NVARS+MRELAS) KPRINT=0 IDG=-4 NPP=NVARS LPRG=0 C LAST = 1 IADBIG=10000 ICTMAX=1000 ICTOPT= 0 20004 NEXT=PRGOPT(LAST) IF (.NOT.(NEXT.LE.0 .OR. NEXT.GT.IADBIG)) GO TO 20006 C C THE CHECKS FOR SMALL OR LARGE VALUES OF NEXT ARE TO PREVENT C WORKING WITH UNDEFINED DATA. NERR=14 CALL XERMSG ('SLATEC', 'SPOPT', + 'IN SPLP, THE USER OPTION ARRAY HAS UNDEFINED DATA.', NERR, + IOPT) INFO=-NERR RETURN 20006 IF (.NOT.(NEXT.EQ.1)) GO TO 10001 GO TO 20005 10001 IF (.NOT.(ICTOPT.GT.ICTMAX)) GO TO 10002 NERR=15 CALL XERMSG ('SLATEC', 'SPOPT', + 'IN SPLP, OPTION ARRAY PROCESSING IS CYCLING.', NERR, IOPT) INFO=-NERR RETURN 10002 CONTINUE KEY = PRGOPT(LAST+1) C C IF KEY = 50, THIS IS TO BE A MAXIMIZATION PROBLEM C INSTEAD OF A MINIMIZATION PROBLEM. IF (.NOT.(KEY.EQ.50)) GO TO 20010 MINPRB = PRGOPT(LAST+2).EQ.ZERO LDS=3 GO TO 20009 20010 CONTINUE C C IF KEY = 51, THE LEVEL OF OUTPUT IS BEING MODIFIED. C KPRINT = 0, NO OUTPUT C = 1, SUMMARY OUTPUT C = 2, LOTS OF OUTPUT C = 3, EVEN MORE OUTPUT IF (.NOT.(KEY.EQ.51)) GO TO 20013 KPRINT=PRGOPT(LAST+2) LDS=3 GO TO 20009 20013 CONTINUE C C IF KEY = 52, REDEFINE THE FORMAT AND PRECISION USED C IN THE OUTPUT. IF (.NOT.(KEY.EQ.52)) GO TO 20016 IF (PRGOPT(LAST+2).NE.ZERO) IDG=PRGOPT(LAST+3) LDS=4 GO TO 20009 20016 CONTINUE C C IF KEY = 53, THE ALLOTTED SPACE FOR THE SPARSE MATRIX C STORAGE AND/OR SPARSE EQUATION SOLVING HAS BEEN CHANGED. C (PROCESSED IN SPLP(). THIS IS TO COMPUTE THE LENGTH OF PRGOPT(*).) IF (.NOT.(KEY.EQ.53)) GO TO 20019 LDS=5 GO TO 20009 20019 CONTINUE C C IF KEY = 54, REDEFINE THE FILE NUMBER WHERE THE PAGES C FOR THE SPARSE MATRIX ARE STORED. IF (.NOT.(KEY.EQ.54)) GO TO 20022 IF(PRGOPT(LAST+2).NE.ZERO) IPAGEF = PRGOPT(LAST+3) LDS=4 GO TO 20009 20022 CONTINUE C C IF KEY = 55, A CONTINUATION FOR A PROBLEM MAY BE REQUESTED. IF (.NOT.(KEY .EQ. 55)) GO TO 20025 CONTIN = PRGOPT(LAST+2).NE.ZERO LDS=3 GO TO 20009 20025 CONTINUE C C IF KEY = 56, REDEFINE THE FILE NUMBER WHERE THE SAVED DATA C WILL BE STORED. IF (.NOT.(KEY.EQ.56)) GO TO 20028 IF(PRGOPT(LAST+2).NE.ZERO) ISAVE = PRGOPT(LAST+3) LDS=4 GO TO 20009 20028 CONTINUE C C IF KEY = 57, SAVE DATA (ON EXTERNAL FILE) AT MXITLP ITERATIONS OR C THE OPTIMUM, WHICHEVER COMES FIRST. IF (.NOT.(KEY.EQ.57)) GO TO 20031 SAVEDT=PRGOPT(LAST+2).NE.ZERO LDS=3 GO TO 20009 20031 CONTINUE C C IF KEY = 58, SEE IF PROBLEM IS TO RUN ONLY A GIVEN C NUMBER OF ITERATIONS. IF (.NOT.(KEY.EQ.58)) GO TO 20034 IF (PRGOPT(LAST+2).NE.ZERO) MXITLP = PRGOPT(LAST+3) LDS=4 GO TO 20009 20034 CONTINUE C C IF KEY = 59, SEE IF USER PROVIDES THE BASIS INDICES. IF (.NOT.(KEY .EQ. 59)) GO TO 20037 USRBAS = PRGOPT(LAST+2) .NE. ZERO IF (.NOT.(USRBAS)) GO TO 20040 I=1 N20043=MRELAS GO TO 20044 20043 I=I+1 20044 IF ((N20043-I).LT.0) GO TO 20045 IBASIS(I) = PRGOPT(LAST+2+I) GO TO 20043 20045 CONTINUE 20040 CONTINUE LDS=MRELAS+3 GO TO 20009 20037 CONTINUE C C IF KEY = 60, SEE IF USER HAS PROVIDED SCALING OF COLUMNS. IF (.NOT.(KEY .EQ. 60)) GO TO 20047 COLSCP = PRGOPT(LAST+2).NE.ZERO IF (.NOT.(COLSCP)) GO TO 20050 J=1 N20053=NVARS GO TO 20054 20053 J=J+1 20054 IF ((N20053-J).LT.0) GO TO 20055 CSC(J)=ABS(PRGOPT(LAST+2+J)) GO TO 20053 20055 CONTINUE 20050 CONTINUE LDS=NVARS+3 GO TO 20009 20047 CONTINUE C C IF KEY = 61, SEE IF USER HAS PROVIDED SCALING OF COSTS. IF (.NOT.(KEY .EQ. 61)) GO TO 20057 CSTSCP = PRGOPT(LAST+2).NE.ZERO IF (CSTSCP) COSTSC = PRGOPT(LAST+3) LDS=4 GO TO 20009 20057 CONTINUE C C IF KEY = 62, SEE IF SIZE PARAMETERS ARE PROVIDED WITH THE DATA. C THESE WILL BE CHECKED AGAINST THE MATRIX ELEMENT SIZES LATER. IF (.NOT.(KEY .EQ. 62)) GO TO 20060 SIZEUP = PRGOPT(LAST+2).NE.ZERO IF (.NOT.(SIZEUP)) GO TO 20063 ASMALL = PRGOPT(LAST+3) ABIG = PRGOPT(LAST+4) 20063 CONTINUE LDS=5 GO TO 20009 20060 CONTINUE C C IF KEY = 63, SEE IF TOLERANCE FOR LINEAR SYSTEM RESIDUAL ERROR IS C PROVIDED. IF (.NOT.(KEY .EQ. 63)) GO TO 20066 IF (PRGOPT(LAST+2).NE.ZERO) TOLLS = MAX(EPS,PRGOPT(LAST+3)) LDS=4 GO TO 20009 20066 CONTINUE C C IF KEY = 64, SEE IF MINIMUM REDUCED COST OR STEEPEST EDGE C DESCENT IS TO BE USED FOR SELECTING VARIABLES TO ENTER BASIS. IF (.NOT.(KEY.EQ.64)) GO TO 20069 STPEDG = PRGOPT(LAST+2).EQ.ZERO LDS=3 GO TO 20009 20069 CONTINUE C C IF KEY = 65, SET THE NUMBER OF ITERATIONS BETWEEN RECALCULATING C THE ERROR IN THE PRIMAL SOLUTION. IF (.NOT.(KEY.EQ.65)) GO TO 20072 IF (PRGOPT(LAST+2).NE.ZERO) ITBRC=MAX(ONE,PRGOPT(LAST+3)) LDS=4 GO TO 20009 20072 CONTINUE C C IF KEY = 66, SET THE NUMBER OF NEGATIVE REDUCED COSTS TO BE FOUND C IN THE PARTIAL PRICING STRATEGY. IF (.NOT.(KEY.EQ.66)) GO TO 20075 IF (.NOT.(PRGOPT(LAST+2).NE.ZERO)) GO TO 20078 NPP=MAX(PRGOPT(LAST+3),ONE) NPP=MIN(NPP,NVARS) 20078 CONTINUE LDS=4 GO TO 20009 20075 CONTINUE C IF KEY = 67, CHANGE THE TUNING PARAMETER TO APPLY TO THE ERROR C ESTIMATES FOR THE PRIMAL AND DUAL SYSTEMS. IF (.NOT.(KEY.EQ.67)) GO TO 20081 IF (.NOT.(PRGOPT(LAST+2).NE.ZERO)) GO TO 20084 TUNE=ABS(PRGOPT(LAST+3)) 20084 CONTINUE LDS=4 GO TO 20009 20081 CONTINUE IF (.NOT.(KEY.EQ.68)) GO TO 20087 LDS=6 GO TO 20009 20087 CONTINUE C C RESET THE ABSOLUTE TOLERANCE TO BE USED ON THE FEASIBILITY C DECISION PROVIDED THE RELATIVE ERROR TEST FAILED. IF (.NOT.(KEY.EQ.69)) GO TO 20090 IF(PRGOPT(LAST+2).NE.ZERO)TOLABS=PRGOPT(LAST+3) LDS=4 GO TO 20009 20090 CONTINUE CONTINUE C 20009 ICTOPT = ICTOPT+1 LAST = NEXT LPRG=LPRG+LDS GO TO 20004 20005 CONTINUE GO TO 20002 C C PROCEDURE (VALIDATE OPTIONALLY MODIFIED DATA) C C IF USER HAS DEFINED THE BASIS, CHECK FOR VALIDITY OF INDICES. 30002 IF (.NOT.(USRBAS)) GO TO 20093 I=1 N20096=MRELAS GO TO 20097 20096 I=I+1 20097 IF ((N20096-I).LT.0) GO TO 20098 ITEST=IBASIS(I) IF (.NOT.(ITEST.LE.0 .OR.ITEST.GT.(NVARS+MRELAS))) GO TO 20100 NERR=16 CALL XERMSG ('SLATEC', 'SPOPT', + 'IN SPLP, AN INDEX OF USER-SUPPLIED BASIS IS OUT OF RANGE.', + NERR, IOPT) INFO=-NERR RETURN 20100 CONTINUE GO TO 20096 20098 CONTINUE 20093 CONTINUE C C IF USER HAS PROVIDED SIZE PARAMETERS, MAKE SURE THEY ARE ORDERED C AND POSITIVE. IF (.NOT.(SIZEUP)) GO TO 20103 IF (.NOT.(ASMALL.LE.ZERO .OR. ABIG.LT.ASMALL)) GO TO 20106 NERR=17 CALL XERMSG ('SLATEC', 'SPOPT', + 'IN SPLP, SIZE PARAMETERS FOR MATRIX MUST BE SMALLEST AND ' // + 'LARGEST MAGNITUDES OF NONZERO ENTRIES.', NERR, IOPT) INFO=-NERR RETURN 20106 CONTINUE 20103 CONTINUE C C THE NUMBER OF ITERATIONS OF REV. SIMPLEX STEPS MUST BE POSITIVE. IF (.NOT.(MXITLP.LE.0)) GO TO 20109 NERR=18 CALL XERMSG ('SLATEC', 'SPOPT', + 'IN SPLP, THE NUMBER OF REVISED SIMPLEX STEPS BETWEEN ' // + 'CHECK-POINTS MUST BE POSITIVE.', NERR, IOPT) INFO=-NERR RETURN 20109 CONTINUE C C CHECK THAT SAVE AND PAGE FILE NUMBERS ARE DEFINED AND NOT EQUAL. IF (.NOT.(ISAVE.LE.0.OR.IPAGEF.LE.0.OR.(ISAVE.EQ.IPAGEF))) GO TO 2 *0112 NERR=19 CALL XERMSG ('SLATEC', 'SPOPT', + 'IN SPLP, FILE NUMBERS FOR SAVED DATA AND MATRIX PAGES ' // + 'MUST BE POSITIVE AND NOT EQUAL.', NERR, IOPT) INFO=-NERR RETURN 20112 CONTINUE CONTINUE GO TO 20003 END