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