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