1*DECK SPLPMN
2      SUBROUTINE SPLPMN (USRMAT, MRELAS, NVARS, COSTS, PRGOPT, DATTRV,
3     +   BL, BU, IND, INFO, PRIMAL, DUALS, AMAT, CSC, COLNRM, ERD, ERP,
4     +   BASMAT, WR, RZ, RG, RPRIM, RHS, WW, LMX, LBM, IBASIS, IBB,
5     +   IMAT, IBRC, IPR, IWR)
6C***BEGIN PROLOGUE  SPLPMN
7C***SUBSIDIARY
8C***PURPOSE  Subsidiary to SPLP
9C***LIBRARY   SLATEC
10C***TYPE      SINGLE PRECISION (SPLPMN-S, DPLPMN-D)
11C***AUTHOR  (UNKNOWN)
12C***DESCRIPTION
13C
14C     MARVEL OPTION(S).. OUTPUT=YES/NO TO ELIMINATE PRINTED OUTPUT.
15C     THIS DOES NOT APPLY TO THE CALLS TO THE ERROR PROCESSOR.
16C
17C     MAIN SUBROUTINE FOR SPLP PACKAGE.
18C
19C***SEE ALSO  SPLP
20C***ROUTINES CALLED  IVOUT, LA05BS, PINITM, PNNZRS, PRWPGE, SASUM,
21C                    SCLOSM, SCOPY, SDOT, SPINCW, SPINIT, SPLPCE,
22C                    SPLPDM, SPLPFE, SPLPFL, SPLPMU, SPLPUP, SPOPT,
23C                    SVOUT, XERMSG
24C***COMMON BLOCKS    LA05DS
25C***REVISION HISTORY  (YYMMDD)
26C   811215  DATE WRITTEN
27C   890531  Changed all specific intrinsics to generic.  (WRB)
28C   890605  Corrected references to XERRWV.  (WRB)
29C   890605  Removed unreferenced labels.  (WRB)
30C   891009  Removed unreferenced variable.  (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   900510  Convert XERRWV calls to XERMSG calls.  (RWC)
35C***END PROLOGUE  SPLPMN
36      REAL             ABIG,AIJ,AMAT(*),ANORM,ASMALL,BASMAT(*),
37     * BL(*),BU(*),COLNRM(*),COSTS(*),COSTSC,CSC(*),DATTRV(*),
38     * DIRNRM,DUALS(*),DULNRM,EPS,TUNE,ERD(*),ERDNRM,ERP(*),FACTOR,GG,
39     * ONE,PRGOPT(*),PRIMAL(*),RESNRM,RG(*),RHS(*),RHSNRM,ROPT(07),
40     * RPRIM(*),RPRNRM,RZ(*),RZJ,SCALR,SCOSTS,SIZE,SMALL,THETA,
41     * TOLLS,UPBND,UU,WR(*),WW(*),XLAMDA,XVAL,ZERO,RDUM(01),TOLABS
42C
43      INTEGER IBASIS(*),IBB(*),IBRC(LBM,2),IMAT(*),IND(*),
44     * IPR(*),IWR(*),INTOPT(08),IDUM(01)
45C
46C     ARRAY LOCAL VARIABLES
47C     NAME(LENGTH)          DESCRIPTION
48C
49C     COSTS(NVARS)          COST COEFFICIENTS
50C     PRGOPT( )             OPTION VECTOR
51C     DATTRV( )             DATA TRANSFER VECTOR
52C     PRIMAL(NVARS+MRELAS)  AS OUTPUT IT IS PRIMAL SOLUTION OF LP.
53C                           INTERNALLY, THE FIRST NVARS POSITIONS HOLD
54C                           THE COLUMN CHECK SUMS.  THE NEXT MRELAS
55C                           POSITIONS HOLD THE CLASSIFICATION FOR THE
56C                           BASIC VARIABLES  -1 VIOLATES LOWER
57C                           BOUND, 0 FEASIBLE, +1 VIOLATES UPPER BOUND
58C     DUALS(MRELAS+NVARS)   DUAL SOLUTION. INTERNALLY HOLDS R.H. SIDE
59C                           AS FIRST MRELAS ENTRIES.
60C     AMAT(LMX)             SPARSE FORM OF DATA MATRIX
61C     IMAT(LMX)             SPARSE FORM OF DATA MATRIX
62C     BL(NVARS+MRELAS)      LOWER BOUNDS FOR VARIABLES
63C     BU(NVARS+MRELAS)      UPPER BOUNDS FOR VARIABLES
64C     IND(NVARS+MRELAS)     INDICATOR FOR VARIABLES
65C     CSC(NVARS)            COLUMN SCALING
66C     IBASIS(NVARS+MRELAS)  COLS. 1-MRELAS ARE BASIC, REST ARE NON-BASIC
67C     IBB(NVARS+MRELAS)     INDICATOR FOR NON-BASIC VARS., POLARITY OF
68C                           VARS., AND POTENTIALLY INFINITE VARS.
69C                           IF IBB(J).LT.0, VARIABLE J IS BASIC
70C                           IF IBB(J).GT.0, VARIABLE J IS NON-BASIC
71C                           IF IBB(J).EQ.0, VARIABLE J HAS TO BE IGNORED
72C                           BECAUSE IT WOULD CAUSE UNBOUNDED SOLN.
73C                           WHEN MOD(IBB(J),2).EQ.0, VARIABLE IS AT ITS
74C                           UPPER BOUND, OTHERWISE IT IS AT ITS LOWER
75C                           BOUND
76C     COLNRM(NVARS)         NORM OF COLUMNS
77C     ERD(MRELAS)           ERRORS IN DUAL VARIABLES
78C     ERP(MRELAS)           ERRORS IN PRIMAL VARIABLES
79C     BASMAT(LBM)           BASIS MATRIX FOR HARWELL SPARSE CODE
80C     IBRC(LBM,2)           ROW AND COLUMN POINTERS FOR BASMAT(*)
81C     IPR(2*MRELAS)         WORK ARRAY FOR HARWELL SPARSE CODE
82C     IWR(8*MRELAS)         WORK ARRAY FOR HARWELL SPARSE CODE
83C     WR(MRELAS)            WORK ARRAY FOR HARWELL SPARSE CODE
84C     RZ(NVARS+MRELAS)      REDUCED COSTS
85C     RPRIM(MRELAS)         INTERNAL PRIMAL SOLUTION
86C     RG(NVARS+MRELAS)      COLUMN WEIGHTS
87C     WW(MRELAS)            WORK ARRAY
88C     RHS(MRELAS)           HOLDS TRANSLATED RIGHT HAND SIDE
89C
90C     SCALAR LOCAL VARIABLES
91C     NAME       TYPE         DESCRIPTION
92C
93C     LMX        INTEGER      LENGTH OF AMAT(*)
94C     LPG        INTEGER      LENGTH OF PAGE FOR AMAT(*)
95C     EPS        REAL         MACHINE PRECISION
96C     TUNE       REAL         PARAMETER TO SCALE ERROR ESTIMATES
97C     TOLLS      REAL         RELATIVE TOLERANCE FOR SMALL RESIDUALS
98C     TOLABS     REAL         ABSOLUTE TOLERANCE FOR SMALL RESIDUALS.
99C                             USED IF RELATIVE ERROR TEST FAILS.
100C                             IN CONSTRAINT EQUATIONS
101C     FACTOR     REAL         .01--DETERMINES IF BASIS IS SINGULAR
102C                             OR COMPONENT IS FEASIBLE.  MAY NEED TO
103C                             BE INCREASED TO 1.E0 ON SHORT WORD
104C                             LENGTH MACHINES.
105C     ASMALL     REAL         LOWER BOUND FOR NON-ZERO MAGN. IN AMAT(*)
106C     ABIG       REAL         UPPER BOUND FOR NON-ZERO MAGN. IN AMAT(*)
107C     MXITLP     INTEGER      MAXIMUM NUMBER OF ITERATIONS FOR LP
108C     ITLP       INTEGER      ITERATION COUNTER FOR TOTAL LP ITERS
109C     COSTSC     REAL         COSTS(*) SCALING
110C     SCOSTS     REAL         TEMP LOC. FOR COSTSC.
111C     XLAMDA     REAL         WEIGHT PARAMETER FOR PEN. METHOD.
112C     ANORM      REAL         NORM OF DATA MATRIX AMAT(*)
113C     RPRNRM     REAL         NORM OF THE SOLUTION
114C     DULNRM     REAL         NORM OF THE DUALS
115C     ERDNRM     REAL         NORM OF ERROR IN DUAL VARIABLES
116C     DIRNRM     REAL         NORM OF THE DIRECTION VECTOR
117C     RHSNRM     REAL         NORM OF TRANSLATED RIGHT HAND SIDE VECTOR
118C     RESNRM     REAL         NORM OF RESIDUAL VECTOR FOR CHECKING
119C                             FEASIBILITY
120C     NZBM       INTEGER      NUMBER OF NON-ZEROS IN BASMAT(*)
121C     LBM        INTEGER      LENGTH OF BASMAT(*)
122C     SMALL      REAL         EPS*ANORM  USED IN HARWELL SPARSE CODE
123C     LP         INTEGER      USED IN HARWELL LA05*() PACK AS OUTPUT
124C                             FILE NUMBER. SET=I1MACH(4) NOW.
125C     UU         REAL         0.1--USED IN HARWELL SPARSE CODE
126C                             FOR RELATIVE PIVOTING TOLERANCE.
127C     GG         REAL         OUTPUT INFO FLAG IN HARWELL SPARSE CODE
128C     IPLACE     INTEGER      INTEGER USED BY SPARSE MATRIX CODES
129C     IENTER     INTEGER      NEXT COLUMN TO ENTER BASIS
130C     NREDC      INTEGER      NO. OF FULL REDECOMPOSITIONS
131C     KPRINT     INTEGER      LEVEL OF OUTPUT, =0-3
132C     IDG        INTEGER      FORMAT AND PRECISION OF OUTPUT
133C     ITBRC      INTEGER      NO. OF ITERS. BETWEEN RECALCULATING
134C                             THE ERROR IN THE PRIMAL SOLUTION.
135C     NPP        INTEGER      NO. OF NEGATIVE REDUCED COSTS REQUIRED
136C                             IN PARTIAL PRICING
137C     JSTRT      INTEGER      STARTING PLACE FOR PARTIAL PRICING.
138C
139      LOGICAL COLSCP,SAVEDT,CONTIN,CSTSCP,UNBND,
140     *        FEAS,FINITE,FOUND,MINPRB,REDBAS,
141     *        SINGLR,SIZEUP,STPEDG,TRANS,USRBAS,ZEROLV,LOPT(08)
142      CHARACTER*8 XERN1, XERN2
143      EQUIVALENCE (CONTIN,LOPT(1)),(USRBAS,LOPT(2)),
144     *  (SIZEUP,LOPT(3)),(SAVEDT,LOPT(4)),(COLSCP,LOPT(5)),
145     *  (CSTSCP,LOPT(6)),(MINPRB,LOPT(7)),(STPEDG,LOPT(8)),
146     *  (IDG,INTOPT(1)),(IPAGEF,INTOPT(2)),(ISAVE,INTOPT(3)),
147     *  (MXITLP,INTOPT(4)),(KPRINT,INTOPT(5)),(ITBRC,INTOPT(6)),
148     *  (NPP,INTOPT(7)),(LPRG,INTOPT(8)),(EPS,ROPT(1)),(ASMALL,ROPT(2)),
149     *  (ABIG,ROPT(3)),(COSTSC,ROPT(4)),(TOLLS,ROPT(5)),(TUNE,ROPT(6)),
150     *   (TOLABS,ROPT(7))
151C
152C     COMMON BLOCK USED BY LA05 () PACKAGE..
153      COMMON /LA05DS/ SMALL,LP,LENL,LENU,NCP,LROW,LCOL
154      EXTERNAL USRMAT
155C
156C     SET LP=0 SO NO ERROR MESSAGES WILL PRINT WITHIN LA05 () PACKAGE.
157C***FIRST EXECUTABLE STATEMENT  SPLPMN
158      LP=0
159C
160C     THE VALUES ZERO AND ONE.
161      ZERO=0.E0
162      ONE=1.E0
163      FACTOR=0.01E0
164      LPG=LMX-(NVARS+4)
165      IOPT=1
166      INFO=0
167      UNBND=.FALSE.
168      JSTRT=1
169C
170C     PROCESS USER OPTIONS IN PRGOPT(*).
171C     CHECK THAT ANY USER-GIVEN CHANGES ARE WELL-DEFINED.
172      CALL SPOPT(PRGOPT,MRELAS,NVARS,INFO,CSC,IBASIS,ROPT,INTOPT,LOPT)
173      IF (.NOT.(INFO.LT.0)) GO TO 20002
174      GO TO 30001
17520002 IF (.NOT.(CONTIN)) GO TO 20003
176      GO TO 30002
17720006 GO TO 20004
178C
179C     INITIALIZE SPARSE DATA MATRIX, AMAT(*) AND IMAT(*).
18020003 CALL PINITM(MRELAS,NVARS,AMAT,IMAT,LMX,IPAGEF)
181C
182C     UPDATE MATRIX DATA AND CHECK BOUNDS FOR CONSISTENCY.
18320004 CALL SPLPUP(USRMAT,MRELAS,NVARS,PRGOPT,DATTRV,
184     *     BL,BU,IND,INFO,AMAT,IMAT,SIZEUP,ASMALL,ABIG)
185      IF (.NOT.(INFO.LT.0)) GO TO 20007
186      GO TO 30001
187C
188C++  CODE FOR OUTPUT=YES IS ACTIVE
18920007 IF (.NOT.(KPRINT.GE.1)) GO TO 20008
190      GO TO 30003
19120011 CONTINUE
192C++  CODE FOR OUTPUT=NO IS INACTIVE
193C++  END
194C
195C     INITIALIZATION. SCALE DATA, NORMALIZE BOUNDS, FORM COLUMN
196C     CHECK SUMS, AND FORM INITIAL BASIS MATRIX.
19720008 CALL SPINIT(MRELAS,NVARS,COSTS,BL,BU,IND,PRIMAL,INFO,
198     * AMAT,CSC,COSTSC,COLNRM,XLAMDA,ANORM,RHS,RHSNRM,
199     * IBASIS,IBB,IMAT,LOPT)
200      IF (.NOT.(INFO.LT.0)) GO TO 20012
201      GO TO 30001
202C
20320012 NREDC=0
204      ASSIGN 20013 TO NPR004
205      GO TO 30004
20620013 IF (.NOT.(SINGLR)) GO TO 20014
207      NERR=23
208      CALL XERMSG ('SLATEC', 'SPLPMN',
209     +   'IN SPLP,  A SINGULAR INITIAL BASIS WAS ENCOUNTERED.', NERR,
210     +   IOPT)
211      INFO=-NERR
212      GO TO 30001
21320014 ASSIGN 20018 TO NPR005
214      GO TO 30005
21520018 ASSIGN 20019 TO NPR006
216      GO TO 30006
21720019 ASSIGN 20020 TO NPR007
218      GO TO 30007
21920020 IF (.NOT.(USRBAS)) GO TO 20021
220      ASSIGN 20024 TO NPR008
221      GO TO 30008
22220024 IF (.NOT.(.NOT.FEAS)) GO TO 20025
223      NERR=24
224      CALL XERMSG ('SLATEC', 'SPLPMN',
225     +   'IN SPLP, AN INFEASIBLE INITIAL BASIS WAS ENCOUNTERED.', NERR,
226     +   IOPT)
227      INFO=-NERR
228      GO TO 30001
22920025 CONTINUE
23020021 ITLP=0
231C
232C     LAMDA HAS BEEN SET TO A CONSTANT, PERFORM PENALTY METHOD.
233      ASSIGN 20029 TO NPR009
234      GO TO 30009
23520029 ASSIGN 20030 TO NPR010
236      GO TO 30010
23720030 ASSIGN 20031 TO NPR006
238      GO TO 30006
23920031 ASSIGN 20032 TO NPR008
240      GO TO 30008
24120032 IF (.NOT.(.NOT.FEAS)) GO TO 20033
242C
243C     SET LAMDA TO INFINITY BY SETTING COSTSC TO ZERO (SAVE THE VALUE OF
244C     COSTSC) AND PERFORM STANDARD PHASE-1.
245      IF(KPRINT.GE.2)CALL IVOUT(0,IDUM,'('' ENTER STANDARD PHASE-1'')',
246     *IDG)
247      SCOSTS=COSTSC
248      COSTSC=ZERO
249      ASSIGN 20036 TO NPR007
250      GO TO 30007
25120036 ASSIGN 20037 TO NPR009
252      GO TO 30009
25320037 ASSIGN 20038 TO NPR010
254      GO TO 30010
25520038 ASSIGN 20039 TO NPR006
256      GO TO 30006
25720039 ASSIGN 20040 TO NPR008
258      GO TO 30008
25920040 IF (.NOT.(FEAS)) GO TO 20041
260C
261C     SET LAMDA TO ZERO, COSTSC=SCOSTS, PERFORM STANDARD PHASE-2.
262      IF(KPRINT.GT.1)CALL IVOUT(0,IDUM,'('' ENTER STANDARD PHASE-2'')',
263     *IDG)
264      XLAMDA=ZERO
265      COSTSC=SCOSTS
266      ASSIGN 20044 TO NPR009
267      GO TO 30009
26820044 CONTINUE
26920041 GO TO 20034
270C     CHECK IF ANY BASIC VARIABLES ARE STILL CLASSIFIED AS
271C     INFEASIBLE.  IF ANY ARE, THEN THIS MAY NOT YET BE AN
272C     OPTIMAL POINT.  THEREFORE SET LAMDA TO ZERO AND TRY
273C     TO PERFORM MORE SIMPLEX STEPS.
27420033 I=1
275      N20046=MRELAS
276      GO TO 20047
27720046 I=I+1
27820047 IF ((N20046-I).LT.0) GO TO 20048
279      IF (PRIMAL(I+NVARS).NE.ZERO) GO TO 20045
280      GO TO 20046
28120048 GO TO 20035
28220045 XLAMDA=ZERO
283      ASSIGN 20050 TO NPR009
284      GO TO 30009
28520050 CONTINUE
28620034 CONTINUE
287C
28820035 ASSIGN 20051 TO NPR011
289      GO TO 30011
29020051 IF (.NOT.(FEAS.AND.(.NOT.UNBND))) GO TO 20052
291      INFO=1
292      GO TO 20053
29320052 IF (.NOT.((.NOT.FEAS).AND.(.NOT.UNBND))) GO TO 10001
294      NERR=1
295      CALL XERMSG ('SLATEC', 'SPLPMN',
296     +   'IN SPLP, THE PROBLEM APPEARS TO BE INFEASIBLE', NERR, IOPT)
297      INFO=-NERR
298      GO TO 20053
29910001 IF (.NOT.(FEAS .AND. UNBND)) GO TO 10002
300      NERR=2
301      CALL XERMSG ('SLATEC', 'SPLPMN',
302     +   'IN SPLP, THE PROBLEM APPEARS TO HAVE NO FINITE SOLUTION.',
303     +   NERR, IOPT)
304      INFO=-NERR
305      GO TO 20053
30610002 IF (.NOT.((.NOT.FEAS).AND.UNBND)) GO TO 10003
307      NERR=3
308      CALL XERMSG ('SLATEC', 'SPLPMN',
309     +   'IN SPLP, THE PROBLEM APPEARS TO BE INFEASIBLE AND TO HAVE ' //
310     +   'NO FINITE SOLUTION.', NERR, IOPT)
311      INFO=-NERR
31210003 CONTINUE
31320053 CONTINUE
314C
315      IF (.NOT.(INFO.EQ.(-1) .OR. INFO.EQ.(-3))) GO TO 20055
316      SIZE=SASUM(NVARS,PRIMAL,1)*ANORM
317      SIZE=SIZE/SASUM(NVARS,CSC,1)
318      SIZE=SIZE+SASUM(MRELAS,PRIMAL(NVARS+1),1)
319      I=1
320      N20058=NVARS+MRELAS
321      GO TO 20059
32220058 I=I+1
32320059 IF ((N20058-I).LT.0) GO TO 20060
324      NX0066=IND(I)
325      IF (NX0066.LT.1.OR.NX0066.GT.4) GO TO 20066
326      GO TO (20062,20063,20064,20065), NX0066
32720062 IF (.NOT.(SIZE+ABS(PRIMAL(I)-BL(I))*FACTOR.EQ.SIZE)) GO TO 20068
328      GO TO 20058
32920068 IF (.NOT.(PRIMAL(I).GT.BL(I))) GO TO 10004
330      GO TO 20058
33110004 IND(I)=-4
332      GO TO 20067
33320063 IF (.NOT.(SIZE+ABS(PRIMAL(I)-BU(I))*FACTOR.EQ.SIZE)) GO TO 20071
334      GO TO 20058
33520071 IF (.NOT.(PRIMAL(I).LT.BU(I))) GO TO 10005
336      GO TO 20058
33710005 IND(I)=-4
338      GO TO 20067
33920064 IF (.NOT.(SIZE+ABS(PRIMAL(I)-BL(I))*FACTOR.EQ.SIZE)) GO TO 20074
340      GO TO 20058
34120074 IF (.NOT.(PRIMAL(I).LT.BL(I))) GO TO 10006
342      IND(I)=-4
343      GO TO 20075
34410006 IF (.NOT.(SIZE+ABS(PRIMAL(I)-BU(I))*FACTOR.EQ.SIZE)) GO TO 10007
345      GO TO 20058
34610007 IF (.NOT.(PRIMAL(I).GT.BU(I))) GO TO 10008
347      IND(I)=-4
348      GO TO 20075
34910008 GO TO 20058
35020075 GO TO 20067
35120065 GO TO 20058
35220066 CONTINUE
35320067 GO TO 20058
35420060 CONTINUE
35520055 CONTINUE
356C
357      IF (.NOT.(INFO.EQ.(-2) .OR. INFO.EQ.(-3))) GO TO 20077
358      J=1
359      N20080=NVARS
360      GO TO 20081
36120080 J=J+1
36220081 IF ((N20080-J).LT.0) GO TO 20082
363      IF (.NOT.(IBB(J).EQ.0)) GO TO 20084
364      NX0091=IND(J)
365      IF (NX0091.LT.1.OR.NX0091.GT.4) GO TO 20091
366      GO TO (20087,20088,20089,20090), NX0091
36720087 BU(J)=BL(J)
368      IND(J)=-3
369      GO TO 20092
37020088 BL(J)=BU(J)
371      IND(J)=-3
372      GO TO 20092
37320089 GO TO 20080
37420090 BL(J)=ZERO
375      BU(J)=ZERO
376      IND(J)=-3
37720091 CONTINUE
37820092 CONTINUE
37920084 GO TO 20080
38020082 CONTINUE
38120077 CONTINUE
382C++  CODE FOR OUTPUT=YES IS ACTIVE
383      IF (.NOT.(KPRINT.GE.1)) GO TO 20093
384      ASSIGN 20096 TO NPR012
385      GO TO 30012
38620096 CONTINUE
38720093 CONTINUE
388C++  CODE FOR OUTPUT=NO IS INACTIVE
389C++  END
390      GO TO 30001
391C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
392C     PROCEDURE (COMPUTE RIGHT HAND SIDE)
39330010 RHS(1)=ZERO
394      CALL SCOPY(MRELAS,RHS,0,RHS,1)
395      J=1
396      N20098=NVARS+MRELAS
397      GO TO 20099
39820098 J=J+1
39920099 IF ((N20098-J).LT.0) GO TO 20100
400      NX0106=IND(J)
401      IF (NX0106.LT.1.OR.NX0106.GT.4) GO TO 20106
402      GO TO (20102,20103,20104,20105), NX0106
40320102 SCALR=-BL(J)
404      GO TO 20107
40520103 SCALR=-BU(J)
406      GO TO 20107
40720104 SCALR=-BL(J)
408      GO TO 20107
40920105 SCALR=ZERO
41020106 CONTINUE
41120107 IF (.NOT.(SCALR.NE.ZERO)) GO TO 20108
412      IF (.NOT.(J.LE.NVARS)) GO TO 20111
413      I=0
41420114 CALL PNNZRS(I,AIJ,IPLACE,AMAT,IMAT,J)
415      IF (.NOT.(I.LE.0)) GO TO 20116
416      GO TO 20115
41720116 RHS(I)=RHS(I)+AIJ*SCALR
418      GO TO 20114
41920115 GO TO 20112
42020111 RHS(J-NVARS)=RHS(J-NVARS)-SCALR
42120112 CONTINUE
42220108 GO TO 20098
42320100 J=1
424      N20119=NVARS+MRELAS
425      GO TO 20120
42620119 J=J+1
42720120 IF ((N20119-J).LT.0) GO TO 20121
428      SCALR=ZERO
429      IF(IND(J).EQ.3.AND.MOD(IBB(J),2).EQ.0) SCALR=BU(J)-BL(J)
430      IF (.NOT.(SCALR.NE.ZERO)) GO TO 20123
431      IF (.NOT.(J.LE.NVARS)) GO TO 20126
432      I=0
43320129 CALL PNNZRS(I,AIJ,IPLACE,AMAT,IMAT,J)
434      IF (.NOT.(I.LE.0)) GO TO 20131
435      GO TO 20130
43620131 RHS(I)=RHS(I)-AIJ*SCALR
437      GO TO 20129
43820130 GO TO 20127
43920126 RHS(J-NVARS)=RHS(J-NVARS)+SCALR
44020127 CONTINUE
44120123 GO TO 20119
44220121 CONTINUE
443      GO TO NPR010, (20030,20038)
444C     PROCEDURE (PERFORM SIMPLEX STEPS)
44530009 ASSIGN 20134 TO NPR013
446      GO TO 30013
44720134 ASSIGN 20135 TO NPR014
448      GO TO 30014
44920135 IF (.NOT.(KPRINT.GT.2)) GO TO 20136
450      CALL SVOUT(MRELAS,DUALS,'('' BASIC (INTERNAL) DUAL SOLN.'')',IDG)
451      CALL SVOUT(NVARS+MRELAS,RZ,'('' REDUCED COSTS'')',IDG)
45220136 CONTINUE
45320139 ASSIGN 20141 TO NPR015
454      GO TO 30015
45520141 IF (.NOT.(.NOT. FOUND)) GO TO 20142
456      GO TO 30016
45720145 CONTINUE
45820142 IF (.NOT.(FOUND)) GO TO 20146
459      IF (KPRINT.GE.3) CALL SVOUT(MRELAS,WW,'('' SEARCH DIRECTION'')',
460     *IDG)
461      GO TO 30017
46220149 IF (.NOT.(FINITE)) GO TO 20150
463      GO TO 30018
46420153 ASSIGN 20154 TO NPR005
465      GO TO 30005
46620154 GO TO 20151
46720150 UNBND=.TRUE.
468      IBB(IBASIS(IENTER))=0
46920151 GO TO 20147
47020146 GO TO 20140
47120147 ITLP=ITLP+1
472      GO TO 30019
47320155 GO TO 20139
47420140 CONTINUE
475      GO TO NPR009, (20029,20037,20044,20050)
476C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
477C     PROCEDURE (RETRIEVE SAVED DATA FROM FILE ISAVE)
47830002 LPR=NVARS+4
479      REWIND ISAVE
480      READ(ISAVE) (AMAT(I),I=1,LPR),(IMAT(I),I=1,LPR)
481      KEY=2
482      IPAGE=1
483      GO TO 20157
48420156 IF (NP.LT.0) GO TO 20158
48520157 LPR1=LPR+1
486      READ(ISAVE) (AMAT(I),I=LPR1,LMX),(IMAT(I),I=LPR1,LMX)
487      CALL PRWPGE(KEY,IPAGE,LPG,AMAT,IMAT)
488      NP=IMAT(LMX-1)
489      IPAGE=IPAGE+1
490      GO TO 20156
49120158 NPARM=NVARS+MRELAS
492      READ(ISAVE) (IBASIS(I),I=1,NPARM)
493      REWIND ISAVE
494      GO TO 20006
495C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
496C     PROCEDURE (SAVE DATA ON FILE ISAVE)
497C
498C     SOME PAGES MAY NOT BE WRITTEN YET.
49930020 IF (.NOT.(AMAT(LMX).EQ.ONE)) GO TO 20159
500      AMAT(LMX)=ZERO
501      KEY=2
502      IPAGE=ABS(IMAT(LMX-1))
503      CALL PRWPGE(KEY,IPAGE,LPG,AMAT,IMAT)
504C
505C     FORCE PAGE FILE TO BE OPENED ON RESTARTS.
50620159 KEY=AMAT(4)
507      AMAT(4)=ZERO
508      LPR=NVARS+4
509      WRITE(ISAVE) (AMAT(I),I=1,LPR),(IMAT(I),I=1,LPR)
510      AMAT(4)=KEY
511      IPAGE=1
512      KEY=1
513      GO TO 20163
51420162 IF (NP.LT.0) GO TO 20164
51520163 CALL PRWPGE(KEY,IPAGE,LPG,AMAT,IMAT)
516      LPR1=LPR+1
517      WRITE(ISAVE) (AMAT(I),I=LPR1,LMX),(IMAT(I),I=LPR1,LMX)
518      NP=IMAT(LMX-1)
519      IPAGE=IPAGE+1
520      GO TO 20162
52120164 NPARM=NVARS+MRELAS
522      WRITE(ISAVE) (IBASIS(I),I=1,NPARM)
523      ENDFILE ISAVE
524C
525C     CLOSE FILE, IPAGEF, WHERE PAGES ARE STORED. THIS IS NEEDED SO THAT
526C     THE PAGES MAY BE RESTORED AT A CONTINUATION OF SPLP().
527      GO TO 20317
528C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
529C     PROCEDURE (DECOMPOSE BASIS MATRIX)
530C++  CODE FOR OUTPUT=YES IS ACTIVE
53130004 IF (.NOT.(KPRINT.GE.2)) GO TO 20165
532      CALL IVOUT(MRELAS,IBASIS,
533     *'('' SUBSCRIPTS OF BASIC VARIABLES DURING REDECOMPOSITION'')',
534     *IDG)
535C++  CODE FOR OUTPUT=NO IS INACTIVE
536C++  END
537C
538C     SET RELATIVE PIVOTING FACTOR FOR USE IN LA05 () PACKAGE.
53920165 UU=0.1
540      CALL SPLPDM(
541     *MRELAS,NVARS,LMX,LBM,NREDC,INFO,IOPT,
542     *IBASIS,IMAT,IBRC,IPR,IWR,IND,IBB,
543     *ANORM,EPS,UU,GG,
544     *AMAT,BASMAT,CSC,WR,
545     *SINGLR,REDBAS)
546      IF (.NOT.(INFO.LT.0)) GO TO 20168
547      GO TO 30001
54820168 CONTINUE
549      GO TO NPR004, (20013,20204,20242)
550C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
551C     PROCEDURE (CLASSIFY VARIABLES)
552C
553C     DEFINE THE CLASSIFICATION OF THE BASIC VARIABLES
554C     -1 VIOLATES LOWER BOUND, 0 FEASIBLE, +1 VIOLATES UPPER BOUND.
555C     (THIS INFO IS STORED IN PRIMAL(NVARS+1)-PRIMAL(NVARS+MRELAS))
556C     TRANSLATE VARIABLE TO ITS UPPER BOUND, IF .GT. UPPER BOUND
55730007 PRIMAL(NVARS+1)=ZERO
558      CALL SCOPY(MRELAS,PRIMAL(NVARS+1),0,PRIMAL(NVARS+1),1)
559      I=1
560      N20172=MRELAS
561      GO TO 20173
56220172 I=I+1
56320173 IF ((N20172-I).LT.0) GO TO 20174
564      J=IBASIS(I)
565      IF (.NOT.(IND(J).NE.4)) GO TO 20176
566      IF (.NOT.(RPRIM(I).LT.ZERO)) GO TO 20179
567      PRIMAL(I+NVARS)=-ONE
568      GO TO 20180
56920179 IF (.NOT.(IND(J).EQ.3)) GO TO 10009
570      UPBND=BU(J)-BL(J)
571      IF (J.LE.NVARS) UPBND=UPBND/CSC(J)
572      IF (.NOT.(RPRIM(I).GT.UPBND)) GO TO 20182
573      RPRIM(I)=RPRIM(I)-UPBND
574      IF (.NOT.(J.LE.NVARS)) GO TO 20185
575      K=0
57620188 CALL PNNZRS(K,AIJ,IPLACE,AMAT,IMAT,J)
577      IF (.NOT.(K.LE.0)) GO TO 20190
578      GO TO 20189
57920190 RHS(K)=RHS(K)-UPBND*AIJ*CSC(J)
580      GO TO 20188
58120189 GO TO 20186
58220185 RHS(J-NVARS)=RHS(J-NVARS)+UPBND
58320186 PRIMAL(I+NVARS)=ONE
58420182 CONTINUE
585      CONTINUE
58610009 CONTINUE
58720180 CONTINUE
58820176 GO TO 20172
58920174 CONTINUE
590      GO TO NPR007, (20020,20036)
591C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
592C     PROCEDURE (COMPUTE ERROR IN DUAL AND PRIMAL SYSTEMS)
59330005 NTRIES=1
594      GO TO 20195
59520194 NTRIES=NTRIES+1
59620195 IF ((2-NTRIES).LT.0) GO TO 20196
597      CALL SPLPCE(
598     *MRELAS,NVARS,LMX,LBM,ITLP,ITBRC,
599     *IBASIS,IMAT,IBRC,IPR,IWR,IND,IBB,
600     *ERDNRM,EPS,TUNE,GG,
601     *AMAT,BASMAT,CSC,WR,WW,PRIMAL,ERD,ERP,
602     *SINGLR,REDBAS)
603      IF (.NOT.(.NOT. SINGLR)) GO TO 20198
604C++  CODE FOR OUTPUT=YES IS ACTIVE
605      IF (.NOT.(KPRINT.GE.3)) GO TO 20201
606      CALL SVOUT(MRELAS,ERP,'('' EST. ERROR IN PRIMAL COMPS.'')',IDG)
607      CALL SVOUT(MRELAS,ERD,'('' EST. ERROR IN DUAL COMPS.'')',IDG)
60820201 CONTINUE
609C++  CODE FOR OUTPUT=NO IS INACTIVE
610C++  END
611      GO TO 20193
61220198 IF (NTRIES.EQ.2) GO TO 20197
613      ASSIGN 20204 TO NPR004
614      GO TO 30004
61520204 CONTINUE
616      GO TO 20194
61720196 CONTINUE
61820197 NERR=26
619      CALL XERMSG ('SLATEC', 'SPLPMN',
620     +   'IN SPLP, MOVED TO A SINGULAR POINT.  THIS SHOULD NOT HAPPEN.',
621     +   NERR, IOPT)
622      INFO=-NERR
623      GO TO 30001
62420193 CONTINUE
625      GO TO NPR005, (20018,20154,20243)
626C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
627C     PROCEDURE (CHECK FEASIBILITY)
628C
629C     SEE IF NEARBY FEASIBLE POINT SATISFIES THE CONSTRAINT
630C     EQUATIONS.
631C
632C     COPY RHS INTO WW(*), THEN UPDATE WW(*).
63330008 CALL SCOPY(MRELAS,RHS,1,WW,1)
634      J=1
635      N20206=MRELAS
636      GO TO 20207
63720206 J=J+1
63820207 IF ((N20206-J).LT.0) GO TO 20208
639      IBAS=IBASIS(J)
640      XVAL=RPRIM(J)
641C
642C     ALL VARIABLES BOUNDED BELOW HAVE ZERO AS THAT BOUND.
643      IF (IND(IBAS).LE.3) XVAL=MAX(ZERO,XVAL)
644C
645C     IF THE VARIABLE HAS AN UPPER BOUND, COMPUTE THAT BOUND.
646      IF (.NOT.(IND(IBAS).EQ.3)) GO TO 20210
647      UPBND=BU(IBAS)-BL(IBAS)
648      IF (IBAS.LE.NVARS) UPBND=UPBND/CSC(IBAS)
649      XVAL=MIN(UPBND,XVAL)
65020210 CONTINUE
651C
652C     SUBTRACT XVAL TIMES COLUMN VECTOR FROM RIGHT-HAND SIDE IN WW(*)
653      IF (.NOT.(XVAL.NE.ZERO)) GO TO 20213
654      IF (.NOT.(IBAS.LE.NVARS)) GO TO 20216
655      I=0
65620219 CALL PNNZRS(I,AIJ,IPLACE,AMAT,IMAT,IBAS)
657      IF (.NOT.(I.LE.0)) GO TO 20221
658      GO TO 20220
65920221 WW(I)=WW(I)-XVAL*AIJ*CSC(IBAS)
660      GO TO 20219
66120220 GO TO 20217
66220216 IF (.NOT.(IND(IBAS).EQ.2)) GO TO 20224
663      WW(IBAS-NVARS)=WW(IBAS-NVARS)-XVAL
664      GO TO 20225
66520224 WW(IBAS-NVARS)=WW(IBAS-NVARS)+XVAL
66620225 CONTINUE
66720217 CONTINUE
66820213 CONTINUE
669      GO TO 20206
670C
671C   COMPUTE NORM OF DIFFERENCE AND CHECK FOR FEASIBILITY.
67220208 RESNRM=SASUM(MRELAS,WW,1)
673      FEAS=RESNRM.LE.TOLLS*(RPRNRM*ANORM+RHSNRM)
674C
675C     TRY AN ABSOLUTE ERROR TEST IF THE RELATIVE TEST FAILS.
676      IF(.NOT. FEAS)FEAS=RESNRM.LE.TOLABS
677      IF (.NOT.(FEAS)) GO TO 20227
678      PRIMAL(NVARS+1)=ZERO
679      CALL SCOPY(MRELAS,PRIMAL(NVARS+1),0,PRIMAL(NVARS+1),1)
68020227 CONTINUE
681      GO TO NPR008, (20024,20032,20040)
682C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
683C     PROCEDURE (INITIALIZE REDUCED COSTS AND STEEPEST EDGE WEIGHTS)
68430014 CALL SPINCW(
685     *MRELAS,NVARS,LMX,LBM,NPP,JSTRT,
686     *IBASIS,IMAT,IBRC,IPR,IWR,IND,IBB,
687     *COSTSC,GG,ERDNRM,DULNRM,
688     *AMAT,BASMAT,CSC,WR,WW,RZ,RG,COSTS,COLNRM,DUALS,
689     *STPEDG)
690C
691      GO TO NPR014, (20135,20246)
692C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
693C     PROCEDURE (CHECK AND RETURN WITH EXCESS ITERATIONS)
69430019 IF (.NOT.(ITLP.GT.MXITLP)) GO TO 20230
695      NERR=25
696      ASSIGN 20233 TO NPR011
697      GO TO 30011
698C++  CODE FOR OUTPUT=YES IS ACTIVE
69920233 IF (.NOT.(KPRINT.GE.1)) GO TO 20234
700      ASSIGN 20237 TO NPR012
701      GO TO 30012
70220237 CONTINUE
70320234 CONTINUE
704C++  CODE FOR OUTPUT=NO IS INACTIVE
705C++  END
706      IDUM(1)=0
707      IF(SAVEDT) IDUM(1)=ISAVE
708      WRITE (XERN1, '(I8)') MXITLP
709      WRITE (XERN2, '(I8)') IDUM(1)
710      CALL XERMSG ('SLATEC', 'SPLPMN',
711     *   'IN SPLP, MAX ITERATIONS = ' // XERN1 //
712     *   ' TAKEN.  UP-TO-DATE RESULTS SAVED ON FILE NO. ' // XERN2 //
713     *   '.  IF FILE NO. = 0, NO SAVE.', NERR, IOPT)
714      INFO=-NERR
715      GO TO 30001
71620230 CONTINUE
717      GO TO 20155
718C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
719C     PROCEDURE (REDECOMPOSE BASIS MATRIX AND TRY AGAIN)
72030016 IF (.NOT.(.NOT.REDBAS)) GO TO 20239
721      ASSIGN 20242 TO NPR004
722      GO TO 30004
72320242 ASSIGN 20243 TO NPR005
724      GO TO 30005
72520243 ASSIGN 20244 TO NPR006
726      GO TO 30006
72720244 ASSIGN 20245 TO NPR013
728      GO TO 30013
72920245 ASSIGN 20246 TO NPR014
730      GO TO 30014
73120246 CONTINUE
732C
733C     ERASE NON-CYCLING MARKERS NEAR COMPLETION.
73420239 I=MRELAS+1
735      N20247=MRELAS+NVARS
736      GO TO 20248
73720247 I=I+1
73820248 IF ((N20247-I).LT.0) GO TO 20249
739      IBASIS(I)=ABS(IBASIS(I))
740      GO TO 20247
74120249 ASSIGN 20251 TO NPR015
742      GO TO 30015
74320251 CONTINUE
744      GO TO 20145
745C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
746C     PROCEDURE (COMPUTE NEW PRIMAL)
747C
748C     COPY RHS INTO WW(*), SOLVE SYSTEM.
74930006 CALL SCOPY(MRELAS,RHS,1,WW,1)
750      TRANS = .FALSE.
751      CALL LA05BS(BASMAT,IBRC,LBM,MRELAS,IPR,IWR,WR,GG,WW,TRANS)
752      CALL SCOPY(MRELAS,WW,1,RPRIM,1)
753      RPRNRM=SASUM(MRELAS,RPRIM,1)
754      GO TO NPR006, (20019,20031,20039,20244,20275)
755C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
756C     PROCEDURE (COMPUTE NEW DUALS)
757C
758C     SOLVE FOR DUAL VARIABLES. FIRST COPY COSTS INTO DUALS(*).
75930013 I=1
760      N20252=MRELAS
761      GO TO 20253
76220252 I=I+1
76320253 IF ((N20252-I).LT.0) GO TO 20254
764      J=IBASIS(I)
765      IF (.NOT.(J.LE.NVARS)) GO TO 20256
766      DUALS(I)=COSTSC*COSTS(J)*CSC(J) + XLAMDA*PRIMAL(I+NVARS)
767      GO TO 20257
76820256 DUALS(I)=XLAMDA*PRIMAL(I+NVARS)
76920257 CONTINUE
770      GO TO 20252
771C
77220254 TRANS=.TRUE.
773      CALL LA05BS(BASMAT,IBRC,LBM,MRELAS,IPR,IWR,WR,GG,DUALS,TRANS)
774      DULNRM=SASUM(MRELAS,DUALS,1)
775      GO TO NPR013, (20134,20245,20267)
776C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
777C     PROCEDURE (FIND VARIABLE TO ENTER BASIS AND GET SEARCH DIRECTION)
77830015 CALL SPLPFE(
779     *MRELAS,NVARS,LMX,LBM,IENTER,
780     *IBASIS,IMAT,IBRC,IPR,IWR,IND,IBB,
781     *ERDNRM,EPS,GG,DULNRM,DIRNRM,
782     *AMAT,BASMAT,CSC,WR,WW,BL,BU,RZ,RG,COLNRM,DUALS,
783     *FOUND)
784      GO TO NPR015, (20141,20251)
785C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
786C     PROCEDURE (CHOOSE VARIABLE TO LEAVE BASIS)
78730017 CALL SPLPFL(
788     *MRELAS,NVARS,IENTER,ILEAVE,
789     *IBASIS,IND,IBB,
790     *THETA,DIRNRM,RPRNRM,
791     *CSC,WW,BL,BU,ERP,RPRIM,PRIMAL,
792     *FINITE,ZEROLV)
793      GO TO 20149
794C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
795C     PROCEDURE (MAKE MOVE AND UPDATE)
79630018 CALL SPLPMU(
797     *MRELAS,NVARS,LMX,LBM,NREDC,INFO,IENTER,ILEAVE,IOPT,NPP,JSTRT,
798     *IBASIS,IMAT,IBRC,IPR,IWR,IND,IBB,
799     *ANORM,EPS,UU,GG,RPRNRM,ERDNRM,DULNRM,THETA,COSTSC,XLAMDA,RHSNRM,
800     *AMAT,BASMAT,CSC,WR,RPRIM,WW,BU,BL,RHS,ERD,ERP,RZ,RG,COLNRM,COSTS,
801     *PRIMAL,DUALS,SINGLR,REDBAS,ZEROLV,STPEDG)
802      IF (.NOT.(INFO.EQ.(-26))) GO TO 20259
803      GO TO 30001
804C++  CODE FOR OUTPUT=YES IS ACTIVE
80520259 IF (.NOT.(KPRINT.GE.2)) GO TO 20263
806      GO TO 30021
80720266 CONTINUE
808C++  CODE FOR OUTPUT=NO IS INACTIVE
809C++  END
81020263 CONTINUE
811      GO TO 20153
812C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
813C     PROCEDURE(RESCALE AND REARRANGE VARIABLES)
814C
815C     RESCALE THE DUAL VARIABLES.
81630011 ASSIGN 20267 TO NPR013
817      GO TO 30013
81820267 IF (.NOT.(COSTSC.NE.ZERO)) GO TO 20268
819      I=1
820      N20271=MRELAS
821      GO TO 20272
82220271 I=I+1
82320272 IF ((N20271-I).LT.0) GO TO 20273
824      DUALS(I)=DUALS(I)/COSTSC
825      GO TO 20271
82620273 CONTINUE
82720268 ASSIGN 20275 TO NPR006
828      GO TO 30006
829C
830C     REAPPLY COLUMN SCALING TO PRIMAL.
83120275 I=1
832      N20276=MRELAS
833      GO TO 20277
83420276 I=I+1
83520277 IF ((N20276-I).LT.0) GO TO 20278
836      J=IBASIS(I)
837      IF (.NOT.(J.LE.NVARS)) GO TO 20280
838      SCALR=CSC(J)
839      IF(IND(J).EQ.2)SCALR=-SCALR
840      RPRIM(I)=RPRIM(I)*SCALR
84120280 GO TO 20276
842C
843C     REPLACE TRANSLATED BASIC VARIABLES INTO ARRAY PRIMAL(*)
84420278 PRIMAL(1)=ZERO
845      CALL SCOPY(NVARS+MRELAS,PRIMAL,0,PRIMAL,1)
846      J=1
847      N20283=NVARS+MRELAS
848      GO TO 20284
84920283 J=J+1
85020284 IF ((N20283-J).LT.0) GO TO 20285
851      IBAS=ABS(IBASIS(J))
852      XVAL=ZERO
853      IF (J.LE.MRELAS) XVAL=RPRIM(J)
854      IF (IND(IBAS).EQ.1) XVAL=XVAL+BL(IBAS)
855      IF (IND(IBAS).EQ.2) XVAL=BU(IBAS)-XVAL
856      IF (.NOT.(IND(IBAS).EQ.3)) GO TO 20287
857      IF (MOD(IBB(IBAS),2).EQ.0) XVAL=BU(IBAS)-BL(IBAS)-XVAL
858      XVAL = XVAL+BL(IBAS)
85920287 PRIMAL(IBAS)=XVAL
860      GO TO 20283
861C
862C     COMPUTE DUALS FOR INDEPENDENT VARIABLES WITH BOUNDS.
863C     OTHER ENTRIES ARE ZERO.
86420285 J=1
865      N20290=NVARS
866      GO TO 20291
86720290 J=J+1
86820291 IF ((N20290-J).LT.0) GO TO 20292
869      RZJ=ZERO
870      IF (.NOT.(IBB(J).GT.ZERO .AND. IND(J).NE.4)) GO TO 20294
871      RZJ=COSTS(J)
872      I=0
87320297 CALL PNNZRS(I,AIJ,IPLACE,AMAT,IMAT,J)
874      IF (.NOT.(I.LE.0)) GO TO 20299
875      GO TO 20298
87620299 CONTINUE
877      RZJ=RZJ-AIJ*DUALS(I)
878      GO TO 20297
87920298 CONTINUE
88020294 DUALS(MRELAS+J)=RZJ
881      GO TO 20290
88220292 CONTINUE
883      GO TO NPR011, (20051,20233)
884C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
885C++  CODE FOR OUTPUT=YES IS ACTIVE
886C     PROCEDURE (PRINT PROLOGUE)
88730003 IDUM(1)=MRELAS
888      CALL IVOUT(1,IDUM,'(''1NUM. OF DEPENDENT VARS., MRELAS'')',IDG)
889      IDUM(1)=NVARS
890      CALL IVOUT(1,IDUM,'('' NUM. OF INDEPENDENT VARS., NVARS'')',IDG)
891      CALL IVOUT(1,IDUM,'('' DIMENSION OF COSTS(*)='')',IDG)
892      IDUM(1)=NVARS+MRELAS
893      CALL IVOUT(1,IDUM, '('' DIMENSIONS OF BL(*),BU(*),IND(*)''
894     */'' PRIMAL(*),DUALS(*) ='')',IDG)
895      CALL IVOUT(1,IDUM,'('' DIMENSION OF IBASIS(*)='')',IDG)
896      IDUM(1)=LPRG+1
897      CALL IVOUT(1,IDUM,'('' DIMENSION OF PRGOPT(*)='')',IDG)
898      CALL IVOUT(0,IDUM,
899     * '('' 1-NVARS=INDEPENDENT VARIABLE INDICES.''/
900     * '' (NVARS+1)-(NVARS+MRELAS)=DEPENDENT VARIABLE INDICES.''/
901     * '' CONSTRAINT INDICATORS ARE 1-4 AND MEAN'')',IDG)
902      CALL IVOUT(0,IDUM,
903     * '('' 1=VARIABLE HAS ONLY LOWER BOUND.''/
904     * '' 2=VARIABLE HAS ONLY UPPER BOUND.''/
905     * '' 3=VARIABLE HAS BOTH BOUNDS.''/
906     * '' 4=VARIABLE HAS NO BOUNDS, IT IS FREE.'')',IDG)
907      CALL SVOUT(NVARS,COSTS,'('' ARRAY OF COSTS'')',IDG)
908      CALL IVOUT(NVARS+MRELAS,IND,
909     * '('' CONSTRAINT INDICATORS'')',IDG)
910      CALL SVOUT(NVARS+MRELAS,BL,
911     *'('' LOWER BOUNDS FOR VARIABLES  (IGNORE UNUSED ENTRIES.)'')',IDG)
912      CALL SVOUT(NVARS+MRELAS,BU,
913     *'('' UPPER BOUNDS FOR VARIABLES  (IGNORE UNUSED ENTRIES.)'')',IDG)
914      IF (.NOT.(KPRINT.GE.2)) GO TO 20302
915      CALL IVOUT(0,IDUM,
916     * '(''0NON-BASIC INDICES THAT ARE NEGATIVE SHOW VARIABLES''
917     * '' EXCHANGED AT A ZERO''/'' STEP LENGTH'')',IDG)
918      CALL IVOUT(0,IDUM,
919     * '('' WHEN COL. NO. LEAVING=COL. NO. ENTERING, THE ENTERING ''
920     * ''VARIABLE MOVED''/'' TO ITS BOUND.  IT REMAINS NON-BASIC.''/
921     * '' WHEN COL. NO. OF BASIS EXCHANGED IS NEGATIVE, THE LEAVING''/
922     * '' VARIABLE IS AT ITS UPPER BOUND.'')',IDG)
92320302 CONTINUE
924      GO TO 20011
925C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
926C     PROCEDURE (PRINT SUMMARY)
92730012 IDUM(1)=INFO
928      CALL IVOUT(1,IDUM,'('' THE OUTPUT VALUE OF INFO IS'')',IDG)
929      IF (.NOT.(MINPRB)) GO TO 20305
930      CALL IVOUT(0,IDUM,'('' THIS IS A MINIMIZATION PROBLEM.'')',IDG)
931      GO TO 20306
93220305 CALL IVOUT(0,IDUM,'('' THIS IS A MAXIMIZATION PROBLEM.'')',IDG)
93320306 IF (.NOT.(STPEDG)) GO TO 20308
934      CALL IVOUT(0,IDUM,'('' STEEPEST EDGE PRICING WAS USED.'')',IDG)
935      GO TO 20309
93620308 CALL IVOUT(0,IDUM,'('' MINIMUM REDUCED COST PRICING WAS USED.'')',
937     * IDG)
93820309 RDUM(1)=SDOT(NVARS,COSTS,1,PRIMAL,1)
939      CALL SVOUT(1,RDUM,
940     * '('' OUTPUT VALUE OF THE OBJECTIVE FUNCTION'')',IDG)
941      CALL SVOUT(NVARS+MRELAS,PRIMAL,
942     * '('' THE OUTPUT INDEPENDENT AND DEPENDENT VARIABLES'')',IDG)
943      CALL SVOUT(MRELAS+NVARS,DUALS,
944     * '('' THE OUTPUT DUAL VARIABLES'')',IDG)
945      CALL IVOUT(NVARS+MRELAS,IBASIS,
946     * '('' VARIABLE INDICES IN POSITIONS 1-MRELAS ARE BASIC.'')',IDG)
947      IDUM(1)=ITLP
948      CALL IVOUT(1,IDUM,'('' NO. OF ITERATIONS'')',IDG)
949      IDUM(1)=NREDC
950      CALL IVOUT(1,IDUM,'('' NO. OF FULL REDECOMPS'')',IDG)
951      GO TO NPR012, (20096,20237)
952C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
953C     PROCEDURE (PRINT ITERATION SUMMARY)
95430021 IDUM(1)=ITLP+1
955      CALL IVOUT(1,IDUM,'(''0ITERATION NUMBER'')',IDG)
956      IDUM(1)=IBASIS(ABS(ILEAVE))
957      CALL IVOUT(1,IDUM,
958     * '('' INDEX OF VARIABLE ENTERING THE BASIS'')',IDG)
959      IDUM(1)=ILEAVE
960      CALL IVOUT(1,IDUM,'('' COLUMN OF THE BASIS EXCHANGED'')',IDG)
961      IDUM(1)=IBASIS(IENTER)
962      CALL IVOUT(1,IDUM,
963     * '('' INDEX OF VARIABLE LEAVING THE BASIS'')',IDG)
964      RDUM(1)=THETA
965      CALL SVOUT(1,RDUM,'('' LENGTH OF THE EXCHANGE STEP'')',IDG)
966      IF (.NOT.(KPRINT.GE.3)) GO TO 20311
967      CALL SVOUT(MRELAS,RPRIM,'('' BASIC (INTERNAL) PRIMAL SOLN.'')',
968     * IDG)
969      CALL IVOUT(NVARS+MRELAS,IBASIS,
970     * '('' VARIABLE INDICES IN POSITIONS 1-MRELAS ARE BASIC.'')',IDG)
971      CALL IVOUT(NVARS+MRELAS,IBB,'('' IBB ARRAY'')',IDG)
972      CALL SVOUT(MRELAS,RHS,'('' TRANSLATED RHS'')',IDG)
973      CALL SVOUT(MRELAS,DUALS,'('' BASIC (INTERNAL) DUAL SOLN.'')',IDG)
97420311 CONTINUE
975      GO TO 20266
976C++  CODE FOR OUTPUT=NO IS INACTIVE
977C++  END
978C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
979C     PROCEDURE (RETURN TO USER)
98030001 IF (.NOT.(SAVEDT)) GO TO 20314
981      GO TO 30020
98220317 CONTINUE
98320314 IF(IMAT(LMX-1).NE.(-1)) CALL SCLOSM(IPAGEF)
984C
985C     THIS TEST IS THERE ONLY TO AVOID DIAGNOSTICS ON SOME FORTRAN
986C     COMPILERS.
987      RETURN
988      END
989