1*DECK SPOPT 2 SUBROUTINE SPOPT (PRGOPT, MRELAS, NVARS, INFO, CSC, IBASIS, ROPT, 3 + INTOPT, LOPT) 4C***BEGIN PROLOGUE SPOPT 5C***SUBSIDIARY 6C***PURPOSE Subsidiary to SPLP 7C***LIBRARY SLATEC 8C***TYPE SINGLE PRECISION (SPOPT-S, DPOPT-D) 9C***AUTHOR (UNKNOWN) 10C***DESCRIPTION 11C 12C THE EDITING REQUIRED TO CONVERT THIS SUBROUTINE FROM SINGLE TO 13C DOUBLE PRECISION INVOLVES THE FOLLOWING CHARACTER STRING CHANGES. 14C 15C USE AN EDITING COMMAND (CHANGE) /STRING-1/(TO)STRING-2/. 16C /REAL (12 BLANKS)/DOUBLE PRECISION/, 17C /R1MACH/D1MACH/,/E0/D0/ 18C 19C REVISED 821122-1045 20C REVISED YYMMDD-HHMM 21C 22C THIS SUBROUTINE PROCESSES THE OPTION VECTOR, PRGOPT(*), 23C AND VALIDATES ANY MODIFIED DATA. 24C 25C***SEE ALSO SPLP 26C***ROUTINES CALLED R1MACH, XERMSG 27C***REVISION HISTORY (YYMMDD) 28C 811215 DATE WRITTEN 29C 890531 Changed all specific intrinsics to generic. (WRB) 30C 890605 Removed unreferenced labels. (WRB) 31C 891214 Prologue converted to Version 4.0 format. (BAB) 32C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) 33C 900328 Added TYPE section. (WRB) 34C***END PROLOGUE SPOPT 35 REAL ABIG,ASMALL,COSTSC,CSC(*),EPS,ONE,PRGOPT(*), 36 * ROPT(07),TOLLS,TUNE,ZERO,R1MACH,TOLABS 37 INTEGER IBASIS(*),INTOPT(08) 38 LOGICAL CONTIN,USRBAS,SIZEUP,SAVEDT,COLSCP,CSTSCP,MINPRB, 39 * STPEDG,LOPT(8) 40C 41C***FIRST EXECUTABLE STATEMENT SPOPT 42 IOPT=1 43 ZERO=0.E0 44 ONE=1.E0 45 GO TO 30001 4620002 CONTINUE 47 GO TO 30002 48C 4920003 LOPT(1)=CONTIN 50 LOPT(2)=USRBAS 51 LOPT(3)=SIZEUP 52 LOPT(4)=SAVEDT 53 LOPT(5)=COLSCP 54 LOPT(6)=CSTSCP 55 LOPT(7)=MINPRB 56 LOPT(8)=STPEDG 57C 58 INTOPT(1)=IDG 59 INTOPT(2)=IPAGEF 60 INTOPT(3)=ISAVE 61 INTOPT(4)=MXITLP 62 INTOPT(5)=KPRINT 63 INTOPT(6)=ITBRC 64 INTOPT(7)=NPP 65 INTOPT(8)=LPRG 66C 67 ROPT(1)=EPS 68 ROPT(2)=ASMALL 69 ROPT(3)=ABIG 70 ROPT(4)=COSTSC 71 ROPT(5)=TOLLS 72 ROPT(6)=TUNE 73 ROPT(7)=TOLABS 74 RETURN 75C 76C 77C PROCEDURE (INITIALIZE PARAMETERS AND PROCESS USER OPTIONS) 7830001 CONTIN = .FALSE. 79 USRBAS = .FALSE. 80 SIZEUP = .FALSE. 81 SAVEDT = .FALSE. 82 COLSCP = .FALSE. 83 CSTSCP = .FALSE. 84 MINPRB = .TRUE. 85 STPEDG = .TRUE. 86C 87C GET THE MACHINE REL. FLOATING POINT ACCURACY VALUE FROM THE 88C LIBRARY SUBPROGRAM, R1MACH( ). 89 EPS=R1MACH(4) 90 TOLLS=R1MACH(4) 91 TUNE=ONE 92 TOLABS=ZERO 93C 94C DEFINE NOMINAL FILE NUMBERS FOR MATRIX PAGES AND DATA SAVING. 95 IPAGEF=1 96 ISAVE=2 97 ITBRC=10 98 MXITLP=3*(NVARS+MRELAS) 99 KPRINT=0 100 IDG=-4 101 NPP=NVARS 102 LPRG=0 103C 104 LAST = 1 105 IADBIG=10000 106 ICTMAX=1000 107 ICTOPT= 0 10820004 NEXT=PRGOPT(LAST) 109 IF (.NOT.(NEXT.LE.0 .OR. NEXT.GT.IADBIG)) GO TO 20006 110C 111C THE CHECKS FOR SMALL OR LARGE VALUES OF NEXT ARE TO PREVENT 112C WORKING WITH UNDEFINED DATA. 113 NERR=14 114 CALL XERMSG ('SLATEC', 'SPOPT', 115 + 'IN SPLP, THE USER OPTION ARRAY HAS UNDEFINED DATA.', NERR, 116 + IOPT) 117 INFO=-NERR 118 RETURN 11920006 IF (.NOT.(NEXT.EQ.1)) GO TO 10001 120 GO TO 20005 12110001 IF (.NOT.(ICTOPT.GT.ICTMAX)) GO TO 10002 122 NERR=15 123 CALL XERMSG ('SLATEC', 'SPOPT', 124 + 'IN SPLP, OPTION ARRAY PROCESSING IS CYCLING.', NERR, IOPT) 125 INFO=-NERR 126 RETURN 12710002 CONTINUE 128 KEY = PRGOPT(LAST+1) 129C 130C IF KEY = 50, THIS IS TO BE A MAXIMIZATION PROBLEM 131C INSTEAD OF A MINIMIZATION PROBLEM. 132 IF (.NOT.(KEY.EQ.50)) GO TO 20010 133 MINPRB = PRGOPT(LAST+2).EQ.ZERO 134 LDS=3 135 GO TO 20009 13620010 CONTINUE 137C 138C IF KEY = 51, THE LEVEL OF OUTPUT IS BEING MODIFIED. 139C KPRINT = 0, NO OUTPUT 140C = 1, SUMMARY OUTPUT 141C = 2, LOTS OF OUTPUT 142C = 3, EVEN MORE OUTPUT 143 IF (.NOT.(KEY.EQ.51)) GO TO 20013 144 KPRINT=PRGOPT(LAST+2) 145 LDS=3 146 GO TO 20009 14720013 CONTINUE 148C 149C IF KEY = 52, REDEFINE THE FORMAT AND PRECISION USED 150C IN THE OUTPUT. 151 IF (.NOT.(KEY.EQ.52)) GO TO 20016 152 IF (PRGOPT(LAST+2).NE.ZERO) IDG=PRGOPT(LAST+3) 153 LDS=4 154 GO TO 20009 15520016 CONTINUE 156C 157C IF KEY = 53, THE ALLOTTED SPACE FOR THE SPARSE MATRIX 158C STORAGE AND/OR SPARSE EQUATION SOLVING HAS BEEN CHANGED. 159C (PROCESSED IN SPLP(). THIS IS TO COMPUTE THE LENGTH OF PRGOPT(*).) 160 IF (.NOT.(KEY.EQ.53)) GO TO 20019 161 LDS=5 162 GO TO 20009 16320019 CONTINUE 164C 165C IF KEY = 54, REDEFINE THE FILE NUMBER WHERE THE PAGES 166C FOR THE SPARSE MATRIX ARE STORED. 167 IF (.NOT.(KEY.EQ.54)) GO TO 20022 168 IF(PRGOPT(LAST+2).NE.ZERO) IPAGEF = PRGOPT(LAST+3) 169 LDS=4 170 GO TO 20009 17120022 CONTINUE 172C 173C IF KEY = 55, A CONTINUATION FOR A PROBLEM MAY BE REQUESTED. 174 IF (.NOT.(KEY .EQ. 55)) GO TO 20025 175 CONTIN = PRGOPT(LAST+2).NE.ZERO 176 LDS=3 177 GO TO 20009 17820025 CONTINUE 179C 180C IF KEY = 56, REDEFINE THE FILE NUMBER WHERE THE SAVED DATA 181C WILL BE STORED. 182 IF (.NOT.(KEY.EQ.56)) GO TO 20028 183 IF(PRGOPT(LAST+2).NE.ZERO) ISAVE = PRGOPT(LAST+3) 184 LDS=4 185 GO TO 20009 18620028 CONTINUE 187C 188C IF KEY = 57, SAVE DATA (ON EXTERNAL FILE) AT MXITLP ITERATIONS OR 189C THE OPTIMUM, WHICHEVER COMES FIRST. 190 IF (.NOT.(KEY.EQ.57)) GO TO 20031 191 SAVEDT=PRGOPT(LAST+2).NE.ZERO 192 LDS=3 193 GO TO 20009 19420031 CONTINUE 195C 196C IF KEY = 58, SEE IF PROBLEM IS TO RUN ONLY A GIVEN 197C NUMBER OF ITERATIONS. 198 IF (.NOT.(KEY.EQ.58)) GO TO 20034 199 IF (PRGOPT(LAST+2).NE.ZERO) MXITLP = PRGOPT(LAST+3) 200 LDS=4 201 GO TO 20009 20220034 CONTINUE 203C 204C IF KEY = 59, SEE IF USER PROVIDES THE BASIS INDICES. 205 IF (.NOT.(KEY .EQ. 59)) GO TO 20037 206 USRBAS = PRGOPT(LAST+2) .NE. ZERO 207 IF (.NOT.(USRBAS)) GO TO 20040 208 I=1 209 N20043=MRELAS 210 GO TO 20044 21120043 I=I+1 21220044 IF ((N20043-I).LT.0) GO TO 20045 213 IBASIS(I) = PRGOPT(LAST+2+I) 214 GO TO 20043 21520045 CONTINUE 21620040 CONTINUE 217 LDS=MRELAS+3 218 GO TO 20009 21920037 CONTINUE 220C 221C IF KEY = 60, SEE IF USER HAS PROVIDED SCALING OF COLUMNS. 222 IF (.NOT.(KEY .EQ. 60)) GO TO 20047 223 COLSCP = PRGOPT(LAST+2).NE.ZERO 224 IF (.NOT.(COLSCP)) GO TO 20050 225 J=1 226 N20053=NVARS 227 GO TO 20054 22820053 J=J+1 22920054 IF ((N20053-J).LT.0) GO TO 20055 230 CSC(J)=ABS(PRGOPT(LAST+2+J)) 231 GO TO 20053 23220055 CONTINUE 23320050 CONTINUE 234 LDS=NVARS+3 235 GO TO 20009 23620047 CONTINUE 237C 238C IF KEY = 61, SEE IF USER HAS PROVIDED SCALING OF COSTS. 239 IF (.NOT.(KEY .EQ. 61)) GO TO 20057 240 CSTSCP = PRGOPT(LAST+2).NE.ZERO 241 IF (CSTSCP) COSTSC = PRGOPT(LAST+3) 242 LDS=4 243 GO TO 20009 24420057 CONTINUE 245C 246C IF KEY = 62, SEE IF SIZE PARAMETERS ARE PROVIDED WITH THE DATA. 247C THESE WILL BE CHECKED AGAINST THE MATRIX ELEMENT SIZES LATER. 248 IF (.NOT.(KEY .EQ. 62)) GO TO 20060 249 SIZEUP = PRGOPT(LAST+2).NE.ZERO 250 IF (.NOT.(SIZEUP)) GO TO 20063 251 ASMALL = PRGOPT(LAST+3) 252 ABIG = PRGOPT(LAST+4) 25320063 CONTINUE 254 LDS=5 255 GO TO 20009 25620060 CONTINUE 257C 258C IF KEY = 63, SEE IF TOLERANCE FOR LINEAR SYSTEM RESIDUAL ERROR IS 259C PROVIDED. 260 IF (.NOT.(KEY .EQ. 63)) GO TO 20066 261 IF (PRGOPT(LAST+2).NE.ZERO) TOLLS = MAX(EPS,PRGOPT(LAST+3)) 262 LDS=4 263 GO TO 20009 26420066 CONTINUE 265C 266C IF KEY = 64, SEE IF MINIMUM REDUCED COST OR STEEPEST EDGE 267C DESCENT IS TO BE USED FOR SELECTING VARIABLES TO ENTER BASIS. 268 IF (.NOT.(KEY.EQ.64)) GO TO 20069 269 STPEDG = PRGOPT(LAST+2).EQ.ZERO 270 LDS=3 271 GO TO 20009 27220069 CONTINUE 273C 274C IF KEY = 65, SET THE NUMBER OF ITERATIONS BETWEEN RECALCULATING 275C THE ERROR IN THE PRIMAL SOLUTION. 276 IF (.NOT.(KEY.EQ.65)) GO TO 20072 277 IF (PRGOPT(LAST+2).NE.ZERO) ITBRC=MAX(ONE,PRGOPT(LAST+3)) 278 LDS=4 279 GO TO 20009 28020072 CONTINUE 281C 282C IF KEY = 66, SET THE NUMBER OF NEGATIVE REDUCED COSTS TO BE FOUND 283C IN THE PARTIAL PRICING STRATEGY. 284 IF (.NOT.(KEY.EQ.66)) GO TO 20075 285 IF (.NOT.(PRGOPT(LAST+2).NE.ZERO)) GO TO 20078 286 NPP=MAX(PRGOPT(LAST+3),ONE) 287 NPP=MIN(NPP,NVARS) 28820078 CONTINUE 289 LDS=4 290 GO TO 20009 29120075 CONTINUE 292C IF KEY = 67, CHANGE THE TUNING PARAMETER TO APPLY TO THE ERROR 293C ESTIMATES FOR THE PRIMAL AND DUAL SYSTEMS. 294 IF (.NOT.(KEY.EQ.67)) GO TO 20081 295 IF (.NOT.(PRGOPT(LAST+2).NE.ZERO)) GO TO 20084 296 TUNE=ABS(PRGOPT(LAST+3)) 29720084 CONTINUE 298 LDS=4 299 GO TO 20009 30020081 CONTINUE 301 IF (.NOT.(KEY.EQ.68)) GO TO 20087 302 LDS=6 303 GO TO 20009 30420087 CONTINUE 305C 306C RESET THE ABSOLUTE TOLERANCE TO BE USED ON THE FEASIBILITY 307C DECISION PROVIDED THE RELATIVE ERROR TEST FAILED. 308 IF (.NOT.(KEY.EQ.69)) GO TO 20090 309 IF(PRGOPT(LAST+2).NE.ZERO)TOLABS=PRGOPT(LAST+3) 310 LDS=4 311 GO TO 20009 31220090 CONTINUE 313 CONTINUE 314C 31520009 ICTOPT = ICTOPT+1 316 LAST = NEXT 317 LPRG=LPRG+LDS 318 GO TO 20004 31920005 CONTINUE 320 GO TO 20002 321C 322C PROCEDURE (VALIDATE OPTIONALLY MODIFIED DATA) 323C 324C IF USER HAS DEFINED THE BASIS, CHECK FOR VALIDITY OF INDICES. 32530002 IF (.NOT.(USRBAS)) GO TO 20093 326 I=1 327 N20096=MRELAS 328 GO TO 20097 32920096 I=I+1 33020097 IF ((N20096-I).LT.0) GO TO 20098 331 ITEST=IBASIS(I) 332 IF (.NOT.(ITEST.LE.0 .OR.ITEST.GT.(NVARS+MRELAS))) GO TO 20100 333 NERR=16 334 CALL XERMSG ('SLATEC', 'SPOPT', 335 + 'IN SPLP, AN INDEX OF USER-SUPPLIED BASIS IS OUT OF RANGE.', 336 + NERR, IOPT) 337 INFO=-NERR 338 RETURN 33920100 CONTINUE 340 GO TO 20096 34120098 CONTINUE 34220093 CONTINUE 343C 344C IF USER HAS PROVIDED SIZE PARAMETERS, MAKE SURE THEY ARE ORDERED 345C AND POSITIVE. 346 IF (.NOT.(SIZEUP)) GO TO 20103 347 IF (.NOT.(ASMALL.LE.ZERO .OR. ABIG.LT.ASMALL)) GO TO 20106 348 NERR=17 349 CALL XERMSG ('SLATEC', 'SPOPT', 350 + 'IN SPLP, SIZE PARAMETERS FOR MATRIX MUST BE SMALLEST AND ' // 351 + 'LARGEST MAGNITUDES OF NONZERO ENTRIES.', NERR, IOPT) 352 INFO=-NERR 353 RETURN 35420106 CONTINUE 35520103 CONTINUE 356C 357C THE NUMBER OF ITERATIONS OF REV. SIMPLEX STEPS MUST BE POSITIVE. 358 IF (.NOT.(MXITLP.LE.0)) GO TO 20109 359 NERR=18 360 CALL XERMSG ('SLATEC', 'SPOPT', 361 + 'IN SPLP, THE NUMBER OF REVISED SIMPLEX STEPS BETWEEN ' // 362 + 'CHECK-POINTS MUST BE POSITIVE.', NERR, IOPT) 363 INFO=-NERR 364 RETURN 36520109 CONTINUE 366C 367C CHECK THAT SAVE AND PAGE FILE NUMBERS ARE DEFINED AND NOT EQUAL. 368 IF (.NOT.(ISAVE.LE.0.OR.IPAGEF.LE.0.OR.(ISAVE.EQ.IPAGEF))) GO TO 2 369 *0112 370 NERR=19 371 CALL XERMSG ('SLATEC', 'SPOPT', 372 + 'IN SPLP, FILE NUMBERS FOR SAVED DATA AND MATRIX PAGES ' // 373 + 'MUST BE POSITIVE AND NOT EQUAL.', NERR, IOPT) 374 INFO=-NERR 375 RETURN 37620112 CONTINUE 377 CONTINUE 378 GO TO 20003 379 END 380