1 SUBROUTINE SPOPT(PRGOPT,MRELAS,NVARS,INFO,CSC,IBASIS,ROPT, 2 * INTOPT,LOPT) 3C***BEGIN PROLOGUE SPOPT 4C***REFER TO SPLP 5C THE EDITING REQUIRED TO CONVERT THIS SUBROUTINE FROM SINGLE TO 6C DOUBLE PRECISION INVOLVES THE FOLLOWING CHARACTER STRING CHANGES. 7C 8C USE AN EDITING COMMAND (CHANGE) /STRING-1/(TO)STRING-2/. 9C /REAL (12 BLANKS)/DOUBLE PRECISION/, 10C /R1MACH/D1MACH/,/E0/D0/ 11C 12C REVISED 821122-1045 13C REVISED YYMMDD-HHMM 14C REVISED 000601 Changed intrinsics to generics 15C 16C THIS SUBROUTINE PROCESSES THE OPTION VECTOR, PRGOPT(*), 17C AND VALIDATES ANY MODIFIED DATA. 18C***ROUTINES CALLED R1MACH,XERROR 19C***END PROLOGUE SPOPT 20 REAL ABIG,ASMALL,COSTSC,CSC(*),EPS,ONE,PRGOPT(*), 21 * ROPT(07),TOLLS,TUNE,ZERO,R1MACH,TOLABS 22 INTEGER IBASIS(*),INTOPT(08) 23 LOGICAL CONTIN,USRBAS,SIZEUP,SAVEDT,COLSCP,CSTSCP,MINPRB, 24 * STPEDG,LOPT(8) 25C 26C***FIRST EXECUTABLE STATEMENT SPOPT 27 IOPT=1 28 ZERO=0.E0 29 ONE=1.E0 30 GO TO 30001 3120002 CONTINUE 32 GO TO 30002 33C 3420003 LOPT(1)=CONTIN 35 LOPT(2)=USRBAS 36 LOPT(3)=SIZEUP 37 LOPT(4)=SAVEDT 38 LOPT(5)=COLSCP 39 LOPT(6)=CSTSCP 40 LOPT(7)=MINPRB 41 LOPT(8)=STPEDG 42C 43 INTOPT(1)=IDG 44 INTOPT(2)=IPAGEF 45 INTOPT(3)=ISAVE 46 INTOPT(4)=MXITLP 47 INTOPT(5)=KPRINT 48 INTOPT(6)=ITBRC 49 INTOPT(7)=NPP 50 INTOPT(8)=LPRG 51C 52 ROPT(1)=EPS 53 ROPT(2)=ASMALL 54 ROPT(3)=ABIG 55 ROPT(4)=COSTSC 56 ROPT(5)=TOLLS 57 ROPT(6)=TUNE 58 ROPT(7)=TOLABS 59 RETURN 60C 61C 62C PROCEDURE (INITIALIZE PARAMETERS AND PROCESS USER OPTIONS) 6330001 CONTIN = .FALSE. 64 USRBAS = .FALSE. 65 SIZEUP = .FALSE. 66 SAVEDT = .FALSE. 67 COLSCP = .FALSE. 68 CSTSCP = .FALSE. 69 MINPRB = .TRUE. 70 STPEDG = .TRUE. 71C 72C GET THE MACHINE REL. FLOATING POINT ACCURACY VALUE FROM THE 73C PORT LIBRARY SUBPROGRAM, R1MACH( ). 74 EPS=R1MACH(4) 75 TOLLS=R1MACH(4) 76 TUNE=ONE 77 TOLABS=ZERO 78C 79C DEFINE NOMINAL FILE NUMBERS FOR MATRIX PAGES AND DATA SAVING. 80 IPAGEF=1 81 ISAVE=2 82 ITBRC=10 83 MXITLP=3*(NVARS+MRELAS) 84 KPRINT=0 85 IDG=-4 86 NPP=NVARS 87 LPRG=0 88C 89 LAST = 1 90 IADBIG=10000 91 ICTMAX=1000 92 ICTOPT= 0 9320004 NEXT=PRGOPT(LAST) 94 IF (.NOT.(NEXT.LE.0 .OR. NEXT.GT.IADBIG)) GO TO 20006 95C 96C THE CHECKS FOR SMALL OR LARGE VALUES OF NEXT ARE TO PREVENT 97C WORKING WITH UNDEFINED DATA. 98 NERR=14 99 CALL XERROR('SPLP( ). THE USER OPTION ARRAY HAS UNDEFINED DATA.', 100 * 50,NERR,IOPT) 101 INFO=-NERR 102 RETURN 10320006 IF (.NOT.(NEXT.EQ.1)) GO TO 10001 104 GO TO 20005 10510001 IF (.NOT.(ICTOPT.GT.ICTMAX)) GO TO 10002 106 NERR=15 107 CALL XERROR('SPLP( ). OPTION ARRAY PROCESSING IS CYCLING.', 108 *44,NERR,IOPT) 109 INFO=-NERR 110 RETURN 11110002 CONTINUE 11220007 KEY = PRGOPT(LAST+1) 113C 114C IF KEY = 50, THIS IS TO BE A MAXIMIZATION PROBLEM 115C INSTEAD OF A MINIMIZATION PROBLEM. 116 IF (.NOT.(KEY.EQ.50)) GO TO 20010 117 MINPRB = PRGOPT(LAST+2).EQ.ZERO 118 LDS=3 119 GO TO 20009 12020010 CONTINUE 121C 122C IF KEY = 51, THE LEVEL OF OUTPUT IS BEING MODIFIED. 123C KPRINT = 0, NO OUTPUT 124C = 1, SUMMARY OUTPUT 125C = 2, LOTS OF OUTPUT 126C = 3, EVEN MORE OUTPUT 12720011 IF (.NOT.(KEY.EQ.51)) GO TO 20013 128 KPRINT=PRGOPT(LAST+2) 129 LDS=3 130 GO TO 20009 13120013 CONTINUE 132C 133C IF KEY = 52, REDEFINE THE FORMAT AND PRECISION USED 134C IN THE OUTPUT. 13520014 IF (.NOT.(KEY.EQ.52)) GO TO 20016 136 IF (PRGOPT(LAST+2).NE.ZERO) IDG=PRGOPT(LAST+3) 137 LDS=4 138 GO TO 20009 13920016 CONTINUE 140C 141C IF KEY = 53, THE ALLOTED SPACE FOR THE SPARSE MATRIX 142C STORAGE AND/OR SPARSE EQUATION SOLVING HAS BEEN CHANGED. 143C (PROCESSED IN SPLP(). THIS IS TO COMPUTE THE LENGTH OF PRGOPT(*).) 14420017 IF (.NOT.(KEY.EQ.53)) GO TO 20019 145 LDS=5 146 GO TO 20009 14720019 CONTINUE 148C 149C IF KEY = 54, REDEFINE THE FILE NUMBER WHERE THE PAGES 150C FOR THE SPARSE MATRIX ARE STORED. 15120020 IF (.NOT.(KEY.EQ.54)) GO TO 20022 152 IF(PRGOPT(LAST+2).NE.ZERO) IPAGEF = PRGOPT(LAST+3) 153 LDS=4 154 GO TO 20009 15520022 CONTINUE 156C 157C IF KEY = 55, A CONTINUATION FOR A PROBLEM MAY BE REQUESTED. 15820023 IF (.NOT.(KEY .EQ. 55)) GO TO 20025 159 CONTIN = PRGOPT(LAST+2).NE.ZERO 160 LDS=3 161 GO TO 20009 16220025 CONTINUE 163C 164C IF KEY = 56, REDEFINE THE FILE NUMBER WHERE THE SAVED DATA 165C WILL BE STORED. 16620026 IF (.NOT.(KEY.EQ.56)) GO TO 20028 167 IF(PRGOPT(LAST+2).NE.ZERO) ISAVE = PRGOPT(LAST+3) 168 LDS=4 169 GO TO 20009 17020028 CONTINUE 171C 172C IF KEY = 57, SAVE DATA (ON EXTERNAL FILE) AT MXITLP ITERATIONS OR 173C THE OPTIMUM, WHICHEVER COMES FIRST. 17420029 IF (.NOT.(KEY.EQ.57)) GO TO 20031 175 SAVEDT=PRGOPT(LAST+2).NE.ZERO 176 LDS=3 177 GO TO 20009 17820031 CONTINUE 179C 180C IF KEY = 58, SEE IF PROBLEM IS TO RUN ONLY A GIVEN 181C NUMBER OF ITERATIONS. 18220032 IF (.NOT.(KEY.EQ.58)) GO TO 20034 183 IF (PRGOPT(LAST+2).NE.ZERO) MXITLP = PRGOPT(LAST+3) 184 LDS=4 185 GO TO 20009 18620034 CONTINUE 187C 188C IF KEY = 59, SEE IF USER PROVIDES THE BASIS INDICES. 18920035 IF (.NOT.(KEY .EQ. 59)) GO TO 20037 190 USRBAS = PRGOPT(LAST+2) .NE. ZERO 191 IF (.NOT.(USRBAS)) GO TO 20040 192 I=1 193 N20043=MRELAS 194 GO TO 20044 19520043 I=I+1 19620044 IF ((N20043-I).LT.0) GO TO 20045 197 IBASIS(I) = PRGOPT(LAST+2+I) 198 GO TO 20043 19920045 CONTINUE 20020040 CONTINUE 20120041 LDS=MRELAS+3 202 GO TO 20009 20320037 CONTINUE 204C 205C IF KEY = 60, SEE IF USER HAS PROVIDED SCALING OF COLUMNS. 20620038 IF (.NOT.(KEY .EQ. 60)) GO TO 20047 207 COLSCP = PRGOPT(LAST+2).NE.ZERO 208 IF (.NOT.(COLSCP)) GO TO 20050 209 J=1 210 N20053=NVARS 211 GO TO 20054 21220053 J=J+1 21320054 IF ((N20053-J).LT.0) GO TO 20055 214 CSC(J)=ABS(PRGOPT(LAST+2+J)) 215 GO TO 20053 21620055 CONTINUE 21720050 CONTINUE 21820051 LDS=NVARS+3 219 GO TO 20009 22020047 CONTINUE 221C 222C IF KEY = 61, SEE IF USER HAS PROVIDED SCALING OF COSTS. 22320048 IF (.NOT.(KEY .EQ. 61)) GO TO 20057 224 CSTSCP = PRGOPT(LAST+2).NE.ZERO 225 IF (CSTSCP) COSTSC = PRGOPT(LAST+3) 226 LDS=4 227 GO TO 20009 22820057 CONTINUE 229C 230C IF KEY = 62, SEE IF SIZE PARAMETERS ARE PROVIDED WITH THE DATA. 231C THESE WILL BE CHECKED AGAINST THE MATRIX ELEMENT SIZES LATER. 23220058 IF (.NOT.(KEY .EQ. 62)) GO TO 20060 233 SIZEUP = PRGOPT(LAST+2).NE.ZERO 234 IF (.NOT.(SIZEUP)) GO TO 20063 235 ASMALL = PRGOPT(LAST+3) 236 ABIG = PRGOPT(LAST+4) 23720063 CONTINUE 23820064 LDS=5 239 GO TO 20009 24020060 CONTINUE 241C 242C IF KEY = 63, SEE IF TOLERANCE FOR LINEAR SYSTEM RESIDUAL ERROR IS 243C PROVIDED. 24420061 IF (.NOT.(KEY .EQ. 63)) GO TO 20066 245 IF (PRGOPT(LAST+2).NE.ZERO) TOLLS = MAX(EPS,PRGOPT(LAST+3)) 246 LDS=4 247 GO TO 20009 24820066 CONTINUE 249C 250C IF KEY = 64, SEE IF MINIMUM REDUCED COST OR STEEPEST EDGE 251C DESCENT IS TO BE USED FOR SELECTING VARIABLES TO ENTER BASIS. 25220067 IF (.NOT.(KEY.EQ.64)) GO TO 20069 253 STPEDG = PRGOPT(LAST+2).EQ.ZERO 254 LDS=3 255 GO TO 20009 25620069 CONTINUE 257C 258C IF KEY = 65, SET THE NUMBER OF ITERATIONS BETWEEN RECALCULATING 259C THE ERROR IN THE PRIMAL SOLUTION. 26020070 IF (.NOT.(KEY.EQ.65)) GO TO 20072 261 IF (PRGOPT(LAST+2).NE.ZERO) ITBRC=MAX(ONE,PRGOPT(LAST+3)) 262 LDS=4 263 GO TO 20009 26420072 CONTINUE 265C 266C IF KEY = 66, SET THE NUMBER OF NEGATIVE REDUCED COSTS TO BE FOUND 267C IN THE PARTIAL PRICING STRATEGY. 26820073 IF (.NOT.(KEY.EQ.66)) GO TO 20075 269 IF (.NOT.(PRGOPT(LAST+2).NE.ZERO)) GO TO 20078 270 NPP=MAX(PRGOPT(LAST+3),ONE) 271 NPP=MIN0(NPP,NVARS) 27220078 CONTINUE 27320079 LDS=4 274 GO TO 20009 27520075 CONTINUE 276C IF KEY = 67, CHANGE THE TUNING PARAMETER TO APPLY TO THE ERROR 277C ESTIMATES FOR THE PRIMAL AND DUAL SYSTEMS. 27820076 IF (.NOT.(KEY.EQ.67)) GO TO 20081 279 IF (.NOT.(PRGOPT(LAST+2).NE.ZERO)) GO TO 20084 280 TUNE=ABS(PRGOPT(LAST+3)) 28120084 CONTINUE 28220085 LDS=4 283 GO TO 20009 28420081 CONTINUE 28520082 IF (.NOT.(KEY.EQ.68)) GO TO 20087 286 LDS=6 287 GO TO 20009 28820087 CONTINUE 289C 290C RESET THE ABSOLUTE TOLERANCE TO BE USED ON THE FEASIBILITY 291C DECISION PROVIDED THE RELATIVE ERROR TEST FAILED. 29220088 IF (.NOT.(KEY.EQ.69)) GO TO 20090 293 IF(PRGOPT(LAST+2).NE.ZERO)TOLABS=PRGOPT(LAST+3) 294 LDS=4 295 GO TO 20009 29620090 CONTINUE 29720091 CONTINUE 298C 29920009 ICTOPT = ICTOPT+1 300 LAST = NEXT 301 LPRG=LPRG+LDS 302 GO TO 20004 30320005 CONTINUE 30431001 GO TO 20002 305C 306C PROCEDURE (VALIDATE OPTIONALLY MODIFIED DATA) 307C 308C IF USER HAS DEFINED THE BASIS, CHECK FOR VALIDITY OF INDICES. 30930002 IF (.NOT.(USRBAS)) GO TO 20093 310 I=1 311 N20096=MRELAS 312 GO TO 20097 31320096 I=I+1 31420097 IF ((N20096-I).LT.0) GO TO 20098 315 ITEST=IBASIS(I) 316 IF (.NOT.(ITEST.LE.0 .OR.ITEST.GT.(NVARS+MRELAS))) GO TO 20100 317 NERR=16 318 CALL XERROR( 'SPLP( ). AN INDEX OF USER-SUPPLIED BASIS IS OUT OF 319 *RANGE.',57,NERR,IOPT) 320 INFO=-NERR 321 RETURN 32220100 CONTINUE 32320101 GO TO 20096 32420098 CONTINUE 32520093 CONTINUE 326C 327C IF USER HAS PROVIDED SIZE PARAMETERS, MAKE SURE THEY ARE ORDERED 328C AND POSITIVE. 32920094 IF (.NOT.(SIZEUP)) GO TO 20103 330 IF (.NOT.(ASMALL.LE.ZERO .OR. ABIG.LT.ASMALL)) GO TO 20106 331 NERR=17 332 CALL XERROR( 'SPLP( ). SIZE PARAMETERS FOR MATRIX MUST BE SMALLE 333 *ST AND LARGEST MAGNITUDES OF NONZERO ENTRIES.',100,NERR,IOPT) 334 INFO=-NERR 335 RETURN 33620106 CONTINUE 33720103 CONTINUE 338C 339C THE NUMBER OF ITERATIONS OF REV. SIMPLEX STEPS MUST BE POSITIVE. 34020104 IF (.NOT.(MXITLP.LE.0)) GO TO 20109 341 NERR=18 342 CALL XERROR( 'SPLP( ). THE NUMBER OF REVISED SIMPLEX STEPS BETWEE 343 *N CHECK-POINTS MUST BE POSITIVE.',83,NERR,IOPT) 344 INFO=-NERR 345 RETURN 34620109 CONTINUE 347C 348C CHECK THAT SAVE AND PAGE FILE NUMBERS ARE DEFINED AND NOT EQUAL. 34920110 IF (.NOT.(ISAVE.LE.0.OR.IPAGEF.LE.0.OR.(ISAVE.EQ.IPAGEF))) GO TO 2 350 *0112 351 NERR=19 352 CALL XERROR( 'SPLP( ). FILE NUMBERS FOR SAVED DATA AND MATRIX PAG 353 *ES MUST BE POSITIVE AND NOT EQUAL.',85 ,NERR,IOPT) 354 INFO=-NERR 355 RETURN 35620112 CONTINUE 35720113 CONTINUE 35831002 GO TO 20003 359 END 360