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