1*DECK DPLPMN 2 SUBROUTINE DPLPMN (DUSRMT, 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 DPLPMN 7C***SUBSIDIARY 8C***PURPOSE Subsidiary to DSPLP 9C***LIBRARY SLATEC 10C***TYPE DOUBLE 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 DSPLP PACKAGE. 18C 19C***SEE ALSO DSPLP 20C***ROUTINES CALLED DASUM, DCOPY, DDOT, DPINCW, DPINIT, DPINTM, DPLPCE, 21C DPLPDM, DPLPFE, DPLPFL, DPLPMU, DPLPUP, DPNNZR, 22C DPOPT, DPRWPG, DVOUT, IVOUT, LA05BD, SCLOSM, XERMSG 23C***COMMON BLOCKS LA05DD 24C***REVISION HISTORY (YYMMDD) 25C 811215 DATE WRITTEN 26C 890531 Changed all specific intrinsics to generic. (WRB) 27C 890605 Removed unreferenced labels. (WRB) 28C 891009 Removed unreferenced variable. (WRB) 29C 891214 Prologue converted to Version 4.0 format. (BAB) 30C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) 31C 900328 Added TYPE section. (WRB) 32C 900510 Convert XERRWV calls to XERMSG calls. (RWC) 33C***END PROLOGUE DPLPMN 34 DOUBLE PRECISION ABIG,AIJ,AMAT(*),ANORM,ASMALL,BASMAT(*), 35 * BL(*),BU(*),COLNRM(*),COSTS(*),COSTSC,CSC(*),DATTRV(*), 36 * DIRNRM,DUALS(*),DULNRM,EPS,TUNE,ERD(*),ERDNRM,ERP(*),FACTOR,GG, 37 * ONE,PRGOPT(*),PRIMAL(*),RESNRM,RG(*),RHS(*),RHSNRM,ROPT(07), 38 * RPRIM(*),RPRNRM,RZ(*),RZJ,SCALR,SCOSTS,SIZE,SMALL,THETA, 39 * TOLLS,UPBND,UU,WR(*),WW(*),XLAMDA,XVAL,ZERO,RDUM(01),TOLABS 40 DOUBLE PRECISION DDOT,DASUM 41C 42 INTEGER IBASIS(*),IBB(*),IBRC(LBM,2),IMAT(*),IND(*), 43 * IPR(*),IWR(*),INTOPT(08),IDUM(01) 44C 45C ARRAY LOCAL VARIABLES 46C NAME(LENGTH) DESCRIPTION 47C 48C COSTS(NVARS) COST COEFFICIENTS 49C PRGOPT( ) OPTION VECTOR 50C DATTRV( ) DATA TRANSFER VECTOR 51C PRIMAL(NVARS+MRELAS) AS OUTPUT IT IS PRIMAL SOLUTION OF LP. 52C INTERNALLY, THE FIRST NVARS POSITIONS HOLD 53C THE COLUMN CHECK SUMS. THE NEXT MRELAS 54C POSITIONS HOLD THE CLASSIFICATION FOR THE 55C BASIC VARIABLES -1 VIOLATES LOWER 56C BOUND, 0 FEASIBLE, +1 VIOLATES UPPER BOUND 57C DUALS(MRELAS+NVARS) DUAL SOLUTION. INTERNALLY HOLDS R.H. SIDE 58C AS FIRST MRELAS ENTRIES. 59C AMAT(LMX) SPARSE FORM OF DATA MATRIX 60C IMAT(LMX) SPARSE FORM OF DATA MATRIX 61C BL(NVARS+MRELAS) LOWER BOUNDS FOR VARIABLES 62C BU(NVARS+MRELAS) UPPER BOUNDS FOR VARIABLES 63C IND(NVARS+MRELAS) INDICATOR FOR VARIABLES 64C CSC(NVARS) COLUMN SCALING 65C IBASIS(NVARS+MRELAS) COLS. 1-MRELAS ARE BASIC, REST ARE NON-BASIC 66C IBB(NVARS+MRELAS) INDICATOR FOR NON-BASIC VARS., POLARITY OF 67C VARS., AND POTENTIALLY INFINITE VARS. 68C IF IBB(J).LT.0, VARIABLE J IS BASIC 69C IF IBB(J).GT.0, VARIABLE J IS NON-BASIC 70C IF IBB(J).EQ.0, VARIABLE J HAS TO BE IGNORED 71C BECAUSE IT WOULD CAUSE UNBOUNDED SOLN. 72C WHEN MOD(IBB(J),2).EQ.0, VARIABLE IS AT ITS 73C UPPER BOUND, OTHERWISE IT IS AT ITS LOWER 74C BOUND 75C COLNRM(NVARS) NORM OF COLUMNS 76C ERD(MRELAS) ERRORS IN DUAL VARIABLES 77C ERP(MRELAS) ERRORS IN PRIMAL VARIABLES 78C BASMAT(LBM) BASIS MATRIX FOR HARWELL SPARSE CODE 79C IBRC(LBM,2) ROW AND COLUMN POINTERS FOR BASMAT(*) 80C IPR(2*MRELAS) WORK ARRAY FOR HARWELL SPARSE CODE 81C IWR(8*MRELAS) WORK ARRAY FOR HARWELL SPARSE CODE 82C WR(MRELAS) WORK ARRAY FOR HARWELL SPARSE CODE 83C RZ(NVARS+MRELAS) REDUCED COSTS 84C RPRIM(MRELAS) INTERNAL PRIMAL SOLUTION 85C RG(NVARS+MRELAS) COLUMN WEIGHTS 86C WW(MRELAS) WORK ARRAY 87C RHS(MRELAS) HOLDS TRANSLATED RIGHT HAND SIDE 88C 89C SCALAR LOCAL VARIABLES 90C NAME TYPE DESCRIPTION 91C 92C LMX INTEGER LENGTH OF AMAT(*) 93C LPG INTEGER LENGTH OF PAGE FOR AMAT(*) 94C EPS DOUBLE MACHINE PRECISION 95C TUNE DOUBLE PARAMETER TO SCALE ERROR ESTIMATES 96C TOLLS DOUBLE RELATIVE TOLERANCE FOR SMALL RESIDUALS 97C TOLABS DOUBLE ABSOLUTE TOLERANCE FOR SMALL RESIDUALS. 98C USED IF RELATIVE ERROR TEST FAILS. 99C IN CONSTRAINT EQUATIONS 100C FACTOR DOUBLE .01--DETERMINES IF BASIS IS SINGULAR 101C OR COMPONENT IS FEASIBLE. MAY NEED TO 102C BE INCREASED TO 1.D0 ON SHORT WORD 103C LENGTH MACHINES. 104C ASMALL DOUBLE LOWER BOUND FOR NON-ZERO MAGN. IN AMAT(*) 105C ABIG DOUBLE UPPER BOUND FOR NON-ZERO MAGN. IN AMAT(*) 106C MXITLP INTEGER MAXIMUM NUMBER OF ITERATIONS FOR LP 107C ITLP INTEGER ITERATION COUNTER FOR TOTAL LP ITERS 108C COSTSC DOUBLE COSTS(*) SCALING 109C SCOSTS DOUBLE TEMP LOC. FOR COSTSC. 110C XLAMDA DOUBLE WEIGHT PARAMETER FOR PEN. METHOD. 111C ANORM DOUBLE NORM OF DATA MATRIX AMAT(*) 112C RPRNRM DOUBLE NORM OF THE SOLUTION 113C DULNRM DOUBLE NORM OF THE DUALS 114C ERDNRM DOUBLE NORM OF ERROR IN DUAL VARIABLES 115C DIRNRM DOUBLE NORM OF THE DIRECTION VECTOR 116C RHSNRM DOUBLE NORM OF TRANSLATED RIGHT HAND SIDE VECTOR 117C RESNRM DOUBLE NORM OF RESIDUAL VECTOR FOR CHECKING 118C FEASIBILITY 119C NZBM INTEGER NUMBER OF NON-ZEROS IN BASMAT(*) 120C LBM INTEGER LENGTH OF BASMAT(*) 121C SMALL DOUBLE EPS*ANORM USED IN HARWELL SPARSE CODE 122C LP INTEGER USED IN HARWELL LA05*() PACK AS OUTPUT 123C FILE NUMBER. SET=I1MACH(4) NOW. 124C UU DOUBLE 0.1--USED IN HARWELL SPARSE CODE 125C FOR RELATIVE PIVOTING TOLERANCE. 126C GG DOUBLE OUTPUT INFO FLAG IN HARWELL SPARSE CODE 127C IPLACE INTEGER INTEGER USED BY SPARSE MATRIX CODES 128C IENTER INTEGER NEXT COLUMN TO ENTER BASIS 129C NREDC INTEGER NO. OF FULL REDECOMPOSITIONS 130C KPRINT INTEGER LEVEL OF OUTPUT, =0-3 131C IDG INTEGER FORMAT AND PRECISION OF OUTPUT 132C ITBRC INTEGER NO. OF ITERS. BETWEEN RECALCULATING 133C THE ERROR IN THE PRIMAL SOLUTION. 134C NPP INTEGER NO. OF NEGATIVE REDUCED COSTS REQUIRED 135C IN PARTIAL PRICING 136C JSTRT INTEGER STARTING PLACE FOR PARTIAL PRICING. 137C 138 LOGICAL COLSCP,SAVEDT,CONTIN,CSTSCP,UNBND, 139 * FEAS,FINITE,FOUND,MINPRB,REDBAS, 140 * SINGLR,SIZEUP,STPEDG,TRANS,USRBAS,ZEROLV,LOPT(08) 141 CHARACTER*8 XERN1, XERN2 142 EQUIVALENCE (CONTIN,LOPT(1)),(USRBAS,LOPT(2)), 143 * (SIZEUP,LOPT(3)),(SAVEDT,LOPT(4)),(COLSCP,LOPT(5)), 144 * (CSTSCP,LOPT(6)),(MINPRB,LOPT(7)),(STPEDG,LOPT(8)), 145 * (IDG,INTOPT(1)),(IPAGEF,INTOPT(2)),(ISAVE,INTOPT(3)), 146 * (MXITLP,INTOPT(4)),(KPRINT,INTOPT(5)),(ITBRC,INTOPT(6)), 147 * (NPP,INTOPT(7)),(LPRG,INTOPT(8)),(EPS,ROPT(1)),(ASMALL,ROPT(2)), 148 * (ABIG,ROPT(3)),(COSTSC,ROPT(4)),(TOLLS,ROPT(5)),(TUNE,ROPT(6)), 149 * (TOLABS,ROPT(7)) 150C 151C COMMON BLOCK USED BY LA05 () PACKAGE.. 152 COMMON /LA05DD/ SMALL,LP,LENL,LENU,NCP,LROW,LCOL 153 EXTERNAL DUSRMT 154C 155C SET LP=0 SO NO ERROR MESSAGES WILL PRINT WITHIN LA05 () PACKAGE. 156C***FIRST EXECUTABLE STATEMENT DPLPMN 157 LP=0 158C 159C THE VALUES ZERO AND ONE. 160 ZERO=0.D0 161 ONE=1.D0 162 FACTOR=0.01D0 163 LPG=LMX-(NVARS+4) 164 IOPT=1 165 INFO=0 166 UNBND=.FALSE. 167 JSTRT=1 168C 169C PROCESS USER OPTIONS IN PRGOPT(*). 170C CHECK THAT ANY USER-GIVEN CHANGES ARE WELL-DEFINED. 171 CALL DPOPT(PRGOPT,MRELAS,NVARS,INFO,CSC,IBASIS,ROPT,INTOPT,LOPT) 172 IF (.NOT.(INFO.LT.0)) GO TO 20002 173 GO TO 30001 17420002 IF (.NOT.(CONTIN)) GO TO 20003 175 GO TO 30002 17620006 GO TO 20004 177C 178C INITIALIZE SPARSE DATA MATRIX, AMAT(*) AND IMAT(*). 17920003 CALL DPINTM(MRELAS,NVARS,AMAT,IMAT,LMX,IPAGEF) 180C 181C UPDATE MATRIX DATA AND CHECK BOUNDS FOR CONSISTENCY. 18220004 CALL DPLPUP(DUSRMT,MRELAS,NVARS,PRGOPT,DATTRV, 183 * BL,BU,IND,INFO,AMAT,IMAT,SIZEUP,ASMALL,ABIG) 184 IF (.NOT.(INFO.LT.0)) GO TO 20007 185 GO TO 30001 186C 187C++ CODE FOR OUTPUT=YES IS ACTIVE 18820007 IF (.NOT.(KPRINT.GE.1)) GO TO 20008 189 GO TO 30003 19020011 CONTINUE 191C++ CODE FOR OUTPUT=NO IS INACTIVE 192C++ END 193C 194C INITIALIZATION. SCALE DATA, NORMALIZE BOUNDS, FORM COLUMN 195C CHECK SUMS, AND FORM INITIAL BASIS MATRIX. 19620008 CALL DPINIT(MRELAS,NVARS,COSTS,BL,BU,IND,PRIMAL,INFO, 197 * AMAT,CSC,COSTSC,COLNRM,XLAMDA,ANORM,RHS,RHSNRM, 198 * IBASIS,IBB,IMAT,LOPT) 199 IF (.NOT.(INFO.LT.0)) GO TO 20012 200 GO TO 30001 201C 20220012 NREDC=0 203 ASSIGN 20013 TO NPR004 204 GO TO 30004 20520013 IF (.NOT.(SINGLR)) GO TO 20014 206 NERR=23 207 CALL XERMSG ('SLATEC', 'DPLPMN', 208 + 'IN DSPLP, A SINGULAR INITIAL BASIS WAS ENCOUNTERED.', NERR, 209 + IOPT) 210 INFO=-NERR 211 GO TO 30001 21220014 ASSIGN 20018 TO NPR005 213 GO TO 30005 21420018 ASSIGN 20019 TO NPR006 215 GO TO 30006 21620019 ASSIGN 20020 TO NPR007 217 GO TO 30007 21820020 IF (.NOT.(USRBAS)) GO TO 20021 219 ASSIGN 20024 TO NPR008 220 GO TO 30008 22120024 IF (.NOT.(.NOT.FEAS)) GO TO 20025 222 NERR=24 223 CALL XERMSG ('SLATEC', 'DPLPMN', 224 + 'IN DSPLP, AN INFEASIBLE INITIAL BASIS WAS ENCOUNTERED.', 225 + NERR, IOPT) 226 INFO=-NERR 227 GO TO 30001 22820025 CONTINUE 22920021 ITLP=0 230C 231C LAMDA HAS BEEN SET TO A CONSTANT, PERFORM PENALTY METHOD. 232 ASSIGN 20029 TO NPR009 233 GO TO 30009 23420029 ASSIGN 20030 TO NPR010 235 GO TO 30010 23620030 ASSIGN 20031 TO NPR006 237 GO TO 30006 23820031 ASSIGN 20032 TO NPR008 239 GO TO 30008 24020032 IF (.NOT.(.NOT.FEAS)) GO TO 20033 241C 242C SET LAMDA TO INFINITY BY SETTING COSTSC TO ZERO (SAVE THE VALUE OF 243C COSTSC) AND PERFORM STANDARD PHASE-1. 244 IF(KPRINT.GE.2)CALL IVOUT(0,IDUM,'('' ENTER STANDARD PHASE-1'')', 245 *IDG) 246 SCOSTS=COSTSC 247 COSTSC=ZERO 248 ASSIGN 20036 TO NPR007 249 GO TO 30007 25020036 ASSIGN 20037 TO NPR009 251 GO TO 30009 25220037 ASSIGN 20038 TO NPR010 253 GO TO 30010 25420038 ASSIGN 20039 TO NPR006 255 GO TO 30006 25620039 ASSIGN 20040 TO NPR008 257 GO TO 30008 25820040 IF (.NOT.(FEAS)) GO TO 20041 259C 260C SET LAMDA TO ZERO, COSTSC=SCOSTS, PERFORM STANDARD PHASE-2. 261 IF(KPRINT.GT.1)CALL IVOUT(0,IDUM,'('' ENTER STANDARD PHASE-2'')', 262 *IDG) 263 XLAMDA=ZERO 264 COSTSC=SCOSTS 265 ASSIGN 20044 TO NPR009 266 GO TO 30009 26720044 CONTINUE 26820041 GO TO 20034 269C CHECK IF ANY BASIC VARIABLES ARE STILL CLASSIFIED AS 270C INFEASIBLE. IF ANY ARE, THEN THIS MAY NOT YET BE AN 271C OPTIMAL POINT. THEREFORE SET LAMDA TO ZERO AND TRY 272C TO PERFORM MORE SIMPLEX STEPS. 27320033 I=1 274 N20046=MRELAS 275 GO TO 20047 27620046 I=I+1 27720047 IF ((N20046-I).LT.0) GO TO 20048 278 IF (PRIMAL(I+NVARS).NE.ZERO) GO TO 20045 279 GO TO 20046 28020048 GO TO 20035 28120045 XLAMDA=ZERO 282 ASSIGN 20050 TO NPR009 283 GO TO 30009 28420050 CONTINUE 28520034 CONTINUE 286C 28720035 ASSIGN 20051 TO NPR011 288 GO TO 30011 28920051 IF (.NOT.(FEAS.AND.(.NOT.UNBND))) GO TO 20052 290 INFO=1 291 GO TO 20053 29220052 IF (.NOT.((.NOT.FEAS).AND.(.NOT.UNBND))) GO TO 10001 293 NERR=1 294 CALL XERMSG ('SLATEC', 'DPLPMN', 295 + 'IN DSPLP, THE PROBLEM APPEARS TO BE INFEASIBLE', NERR, IOPT) 296 INFO=-NERR 297 GO TO 20053 29810001 IF (.NOT.(FEAS .AND. UNBND)) GO TO 10002 299 NERR=2 300 CALL XERMSG ('SLATEC', 'DPLPMN', 301 + 'IN DSPLP, THE PROBLEM APPEARS TO HAVE NO FINITE SOLUTION.', 302 + NERR, IOPT) 303 INFO=-NERR 304 GO TO 20053 30510002 IF (.NOT.((.NOT.FEAS).AND.UNBND)) GO TO 10003 306 NERR=3 307 CALL XERMSG ('SLATEC', 'DPLPMN', 308 + 'IN DSPLP, THE PROBLEM APPEARS TO BE INFEASIBLE AND TO ' // 309 + 'HAVE NO FINITE SOLN.', NERR, IOPT) 310 INFO=-NERR 31110003 CONTINUE 31220053 CONTINUE 313C 314 IF (.NOT.(INFO.EQ.(-1) .OR. INFO.EQ.(-3))) GO TO 20055 315 SIZE=DASUM(NVARS,PRIMAL,1)*ANORM 316 SIZE=SIZE/DASUM(NVARS,CSC,1) 317 SIZE=SIZE+DASUM(MRELAS,PRIMAL(NVARS+1),1) 318 I=1 319 N20058=NVARS+MRELAS 320 GO TO 20059 32120058 I=I+1 32220059 IF ((N20058-I).LT.0) GO TO 20060 323 NX0066=IND(I) 324 IF (NX0066.LT.1.OR.NX0066.GT.4) GO TO 20066 325 GO TO (20062,20063,20064,20065), NX0066 32620062 IF (.NOT.(SIZE+ABS(PRIMAL(I)-BL(I))*FACTOR.EQ.SIZE)) GO TO 20068 327 GO TO 20058 32820068 IF (.NOT.(PRIMAL(I).GT.BL(I))) GO TO 10004 329 GO TO 20058 33010004 IND(I)=-4 331 GO TO 20067 33220063 IF (.NOT.(SIZE+ABS(PRIMAL(I)-BU(I))*FACTOR.EQ.SIZE)) GO TO 20071 333 GO TO 20058 33420071 IF (.NOT.(PRIMAL(I).LT.BU(I))) GO TO 10005 335 GO TO 20058 33610005 IND(I)=-4 337 GO TO 20067 33820064 IF (.NOT.(SIZE+ABS(PRIMAL(I)-BL(I))*FACTOR.EQ.SIZE)) GO TO 20074 339 GO TO 20058 34020074 IF (.NOT.(PRIMAL(I).LT.BL(I))) GO TO 10006 341 IND(I)=-4 342 GO TO 20075 34310006 IF (.NOT.(SIZE+ABS(PRIMAL(I)-BU(I))*FACTOR.EQ.SIZE)) GO TO 10007 344 GO TO 20058 34510007 IF (.NOT.(PRIMAL(I).GT.BU(I))) GO TO 10008 346 IND(I)=-4 347 GO TO 20075 34810008 GO TO 20058 34920075 GO TO 20067 35020065 GO TO 20058 35120066 CONTINUE 35220067 GO TO 20058 35320060 CONTINUE 35420055 CONTINUE 355C 356 IF (.NOT.(INFO.EQ.(-2) .OR. INFO.EQ.(-3))) GO TO 20077 357 J=1 358 N20080=NVARS 359 GO TO 20081 36020080 J=J+1 36120081 IF ((N20080-J).LT.0) GO TO 20082 362 IF (.NOT.(IBB(J).EQ.0)) GO TO 20084 363 NX0091=IND(J) 364 IF (NX0091.LT.1.OR.NX0091.GT.4) GO TO 20091 365 GO TO (20087,20088,20089,20090), NX0091 36620087 BU(J)=BL(J) 367 IND(J)=-3 368 GO TO 20092 36920088 BL(J)=BU(J) 370 IND(J)=-3 371 GO TO 20092 37220089 GO TO 20080 37320090 BL(J)=ZERO 374 BU(J)=ZERO 375 IND(J)=-3 37620091 CONTINUE 37720092 CONTINUE 37820084 GO TO 20080 37920082 CONTINUE 38020077 CONTINUE 381C++ CODE FOR OUTPUT=YES IS ACTIVE 382 IF (.NOT.(KPRINT.GE.1)) GO TO 20093 383 ASSIGN 20096 TO NPR012 384 GO TO 30012 38520096 CONTINUE 38620093 CONTINUE 387C++ CODE FOR OUTPUT=NO IS INACTIVE 388C++ END 389 GO TO 30001 390C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 391C PROCEDURE (COMPUTE RIGHT HAND SIDE) 39230010 RHS(1)=ZERO 393 CALL DCOPY(MRELAS,RHS,0,RHS,1) 394 J=1 395 N20098=NVARS+MRELAS 396 GO TO 20099 39720098 J=J+1 39820099 IF ((N20098-J).LT.0) GO TO 20100 399 NX0106=IND(J) 400 IF (NX0106.LT.1.OR.NX0106.GT.4) GO TO 20106 401 GO TO (20102,20103,20104,20105), NX0106 40220102 SCALR=-BL(J) 403 GO TO 20107 40420103 SCALR=-BU(J) 405 GO TO 20107 40620104 SCALR=-BL(J) 407 GO TO 20107 40820105 SCALR=ZERO 40920106 CONTINUE 41020107 IF (.NOT.(SCALR.NE.ZERO)) GO TO 20108 411 IF (.NOT.(J.LE.NVARS)) GO TO 20111 412 I=0 41320114 CALL DPNNZR(I,AIJ,IPLACE,AMAT,IMAT,J) 414 IF (.NOT.(I.LE.0)) GO TO 20116 415 GO TO 20115 41620116 RHS(I)=RHS(I)+AIJ*SCALR 417 GO TO 20114 41820115 GO TO 20112 41920111 RHS(J-NVARS)=RHS(J-NVARS)-SCALR 42020112 CONTINUE 42120108 GO TO 20098 42220100 J=1 423 N20119=NVARS+MRELAS 424 GO TO 20120 42520119 J=J+1 42620120 IF ((N20119-J).LT.0) GO TO 20121 427 SCALR=ZERO 428 IF(IND(J).EQ.3.AND.MOD(IBB(J),2).EQ.0) SCALR=BU(J)-BL(J) 429 IF (.NOT.(SCALR.NE.ZERO)) GO TO 20123 430 IF (.NOT.(J.LE.NVARS)) GO TO 20126 431 I=0 43220129 CALL DPNNZR(I,AIJ,IPLACE,AMAT,IMAT,J) 433 IF (.NOT.(I.LE.0)) GO TO 20131 434 GO TO 20130 43520131 RHS(I)=RHS(I)-AIJ*SCALR 436 GO TO 20129 43720130 GO TO 20127 43820126 RHS(J-NVARS)=RHS(J-NVARS)+SCALR 43920127 CONTINUE 44020123 GO TO 20119 44120121 CONTINUE 442 GO TO NPR010, (20030,20038) 443C PROCEDURE (PERFORM SIMPLEX STEPS) 44430009 ASSIGN 20134 TO NPR013 445 GO TO 30013 44620134 ASSIGN 20135 TO NPR014 447 GO TO 30014 44820135 IF (.NOT.(KPRINT.GT.2)) GO TO 20136 449 CALL DVOUT(MRELAS,DUALS,'('' BASIC (INTERNAL) DUAL SOLN.'')',IDG) 450 CALL DVOUT(NVARS+MRELAS,RZ,'('' REDUCED COSTS'')',IDG) 45120136 CONTINUE 45220139 ASSIGN 20141 TO NPR015 453 GO TO 30015 45420141 IF (.NOT.(.NOT. FOUND)) GO TO 20142 455 GO TO 30016 45620145 CONTINUE 45720142 IF (.NOT.(FOUND)) GO TO 20146 458 IF (KPRINT.GE.3) CALL DVOUT(MRELAS,WW,'('' SEARCH DIRECTION'')', 459 *IDG) 460 GO TO 30017 46120149 IF (.NOT.(FINITE)) GO TO 20150 462 GO TO 30018 46320153 ASSIGN 20154 TO NPR005 464 GO TO 30005 46520154 GO TO 20151 46620150 UNBND=.TRUE. 467 IBB(IBASIS(IENTER))=0 46820151 GO TO 20147 46920146 GO TO 20140 47020147 ITLP=ITLP+1 471 GO TO 30019 47220155 GO TO 20139 47320140 CONTINUE 474 GO TO NPR009, (20029,20037,20044,20050) 475C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 476C PROCEDURE (RETRIEVE SAVED DATA FROM FILE ISAVE) 47730002 LPR=NVARS+4 478 REWIND ISAVE 479 READ(ISAVE) (AMAT(I),I=1,LPR),(IMAT(I),I=1,LPR) 480 KEY=2 481 IPAGE=1 482 GO TO 20157 48320156 IF (NP.LT.0) GO TO 20158 48420157 LPR1=LPR+1 485 READ(ISAVE) (AMAT(I),I=LPR1,LMX),(IMAT(I),I=LPR1,LMX) 486 CALL DPRWPG(KEY,IPAGE,LPG,AMAT,IMAT) 487 NP=IMAT(LMX-1) 488 IPAGE=IPAGE+1 489 GO TO 20156 49020158 NPARM=NVARS+MRELAS 491 READ(ISAVE) (IBASIS(I),I=1,NPARM) 492 REWIND ISAVE 493 GO TO 20006 494C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 495C PROCEDURE (SAVE DATA ON FILE ISAVE) 496C 497C SOME PAGES MAY NOT BE WRITTEN YET. 49830020 IF (.NOT.(AMAT(LMX).EQ.ONE)) GO TO 20159 499 AMAT(LMX)=ZERO 500 KEY=2 501 IPAGE=ABS(IMAT(LMX-1)) 502 CALL DPRWPG(KEY,IPAGE,LPG,AMAT,IMAT) 503C 504C FORCE PAGE FILE TO BE OPENED ON RESTARTS. 50520159 KEY=AMAT(4) 506 AMAT(4)=ZERO 507 LPR=NVARS+4 508 WRITE(ISAVE) (AMAT(I),I=1,LPR),(IMAT(I),I=1,LPR) 509 AMAT(4)=KEY 510 IPAGE=1 511 KEY=1 512 GO TO 20163 51320162 IF (NP.LT.0) GO TO 20164 51420163 CALL DPRWPG(KEY,IPAGE,LPG,AMAT,IMAT) 515 LPR1=LPR+1 516 WRITE(ISAVE) (AMAT(I),I=LPR1,LMX),(IMAT(I),I=LPR1,LMX) 517 NP=IMAT(LMX-1) 518 IPAGE=IPAGE+1 519 GO TO 20162 52020164 NPARM=NVARS+MRELAS 521 WRITE(ISAVE) (IBASIS(I),I=1,NPARM) 522 ENDFILE ISAVE 523C 524C CLOSE FILE, IPAGEF, WHERE PAGES ARE STORED. THIS IS NEEDED SO THAT 525C THE PAGES MAY BE RESTORED AT A CONTINUATION OF DSPLP(). 526 GO TO 20317 527C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 528C PROCEDURE (DECOMPOSE BASIS MATRIX) 529C++ CODE FOR OUTPUT=YES IS ACTIVE 53030004 IF (.NOT.(KPRINT.GE.2)) GO TO 20165 531 CALL IVOUT(MRELAS,IBASIS, 532 *'('' SUBSCRIPTS OF BASIC VARIABLES DURING REDECOMPOSITION'')', 533 *IDG) 534C++ CODE FOR OUTPUT=NO IS INACTIVE 535C++ END 536C 537C SET RELATIVE PIVOTING FACTOR FOR USE IN LA05 () PACKAGE. 53820165 UU=0.1 539 CALL DPLPDM( 540 *MRELAS,NVARS,LMX,LBM,NREDC,INFO,IOPT, 541 *IBASIS,IMAT,IBRC,IPR,IWR,IND,IBB, 542 *ANORM,EPS,UU,GG, 543 *AMAT,BASMAT,CSC,WR, 544 *SINGLR,REDBAS) 545 IF (.NOT.(INFO.LT.0)) GO TO 20168 546 GO TO 30001 54720168 CONTINUE 548 GO TO NPR004, (20013,20204,20242) 549C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 550C PROCEDURE (CLASSIFY VARIABLES) 551C 552C DEFINE THE CLASSIFICATION OF THE BASIC VARIABLES 553C -1 VIOLATES LOWER BOUND, 0 FEASIBLE, +1 VIOLATES UPPER BOUND. 554C (THIS INFO IS STORED IN PRIMAL(NVARS+1)-PRIMAL(NVARS+MRELAS)) 555C TRANSLATE VARIABLE TO ITS UPPER BOUND, IF .GT. UPPER BOUND 55630007 PRIMAL(NVARS+1)=ZERO 557 CALL DCOPY(MRELAS,PRIMAL(NVARS+1),0,PRIMAL(NVARS+1),1) 558 I=1 559 N20172=MRELAS 560 GO TO 20173 56120172 I=I+1 56220173 IF ((N20172-I).LT.0) GO TO 20174 563 J=IBASIS(I) 564 IF (.NOT.(IND(J).NE.4)) GO TO 20176 565 IF (.NOT.(RPRIM(I).LT.ZERO)) GO TO 20179 566 PRIMAL(I+NVARS)=-ONE 567 GO TO 20180 56820179 IF (.NOT.(IND(J).EQ.3)) GO TO 10009 569 UPBND=BU(J)-BL(J) 570 IF (J.LE.NVARS) UPBND=UPBND/CSC(J) 571 IF (.NOT.(RPRIM(I).GT.UPBND)) GO TO 20182 572 RPRIM(I)=RPRIM(I)-UPBND 573 IF (.NOT.(J.LE.NVARS)) GO TO 20185 574 K=0 57520188 CALL DPNNZR(K,AIJ,IPLACE,AMAT,IMAT,J) 576 IF (.NOT.(K.LE.0)) GO TO 20190 577 GO TO 20189 57820190 RHS(K)=RHS(K)-UPBND*AIJ*CSC(J) 579 GO TO 20188 58020189 GO TO 20186 58120185 RHS(J-NVARS)=RHS(J-NVARS)+UPBND 58220186 PRIMAL(I+NVARS)=ONE 58320182 CONTINUE 584 CONTINUE 58510009 CONTINUE 58620180 CONTINUE 58720176 GO TO 20172 58820174 CONTINUE 589 GO TO NPR007, (20020,20036) 590C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 591C PROCEDURE (COMPUTE ERROR IN DUAL AND PRIMAL SYSTEMS) 59230005 NTRIES=1 593 GO TO 20195 59420194 NTRIES=NTRIES+1 59520195 IF ((2-NTRIES).LT.0) GO TO 20196 596 CALL DPLPCE( 597 *MRELAS,NVARS,LMX,LBM,ITLP,ITBRC, 598 *IBASIS,IMAT,IBRC,IPR,IWR,IND,IBB, 599 *ERDNRM,EPS,TUNE,GG, 600 *AMAT,BASMAT,CSC,WR,WW,PRIMAL,ERD,ERP, 601 *SINGLR,REDBAS) 602 IF (.NOT.(.NOT. SINGLR)) GO TO 20198 603C++ CODE FOR OUTPUT=YES IS ACTIVE 604 IF (.NOT.(KPRINT.GE.3)) GO TO 20201 605 CALL DVOUT(MRELAS,ERP,'('' EST. ERROR IN PRIMAL COMPS.'')',IDG) 606 CALL DVOUT(MRELAS,ERD,'('' EST. ERROR IN DUAL COMPS.'')',IDG) 60720201 CONTINUE 608C++ CODE FOR OUTPUT=NO IS INACTIVE 609C++ END 610 GO TO 20193 61120198 IF (NTRIES.EQ.2) GO TO 20197 612 ASSIGN 20204 TO NPR004 613 GO TO 30004 61420204 CONTINUE 615 GO TO 20194 61620196 CONTINUE 61720197 NERR=26 618 CALL XERMSG ('SLATEC', 'DPLPMN', 619 + 'IN DSPLP, MOVED TO A SINGULAR POINT. THIS SHOULD NOT HAPPEN.', 620 + NERR, IOPT) 621 INFO=-NERR 622 GO TO 30001 62320193 CONTINUE 624 GO TO NPR005, (20018,20154,20243) 625C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 626C PROCEDURE (CHECK FEASIBILITY) 627C 628C SEE IF NEARBY FEASIBLE POINT SATISFIES THE CONSTRAINT 629C EQUATIONS. 630C 631C COPY RHS INTO WW(*), THEN UPDATE WW(*). 63230008 CALL DCOPY(MRELAS,RHS,1,WW,1) 633 J=1 634 N20206=MRELAS 635 GO TO 20207 63620206 J=J+1 63720207 IF ((N20206-J).LT.0) GO TO 20208 638 IBAS=IBASIS(J) 639 XVAL=RPRIM(J) 640C 641C ALL VARIABLES BOUNDED BELOW HAVE ZERO AS THAT BOUND. 642 IF (IND(IBAS).LE.3) XVAL=MAX(ZERO,XVAL) 643C 644C IF THE VARIABLE HAS AN UPPER BOUND, COMPUTE THAT BOUND. 645 IF (.NOT.(IND(IBAS).EQ.3)) GO TO 20210 646 UPBND=BU(IBAS)-BL(IBAS) 647 IF (IBAS.LE.NVARS) UPBND=UPBND/CSC(IBAS) 648 XVAL=MIN(UPBND,XVAL) 64920210 CONTINUE 650C 651C SUBTRACT XVAL TIMES COLUMN VECTOR FROM RIGHT-HAND SIDE IN WW(*) 652 IF (.NOT.(XVAL.NE.ZERO)) GO TO 20213 653 IF (.NOT.(IBAS.LE.NVARS)) GO TO 20216 654 I=0 65520219 CALL DPNNZR(I,AIJ,IPLACE,AMAT,IMAT,IBAS) 656 IF (.NOT.(I.LE.0)) GO TO 20221 657 GO TO 20220 65820221 WW(I)=WW(I)-XVAL*AIJ*CSC(IBAS) 659 GO TO 20219 66020220 GO TO 20217 66120216 IF (.NOT.(IND(IBAS).EQ.2)) GO TO 20224 662 WW(IBAS-NVARS)=WW(IBAS-NVARS)-XVAL 663 GO TO 20225 66420224 WW(IBAS-NVARS)=WW(IBAS-NVARS)+XVAL 66520225 CONTINUE 666 CONTINUE 66720217 CONTINUE 66820213 CONTINUE 669 GO TO 20206 670C 671C COMPUTE NORM OF DIFFERENCE AND CHECK FOR FEASIBILITY. 67220208 RESNRM=DASUM(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 DCOPY(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 DPINCW( 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', 'DPLPMN', 711 * 'IN DSPLP, 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 DCOPY(MRELAS,RHS,1,WW,1) 750 TRANS = .FALSE. 751 CALL LA05BD(BASMAT,IBRC,LBM,MRELAS,IPR,IWR,WR,GG,WW,TRANS) 752 CALL DCOPY(MRELAS,WW,1,RPRIM,1) 753 RPRNRM=DASUM(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 LA05BD(BASMAT,IBRC,LBM,MRELAS,IPR,IWR,WR,GG,DUALS,TRANS) 774 DULNRM=DASUM(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 DPLPFE( 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 DPLPFL( 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 DPLPMU( 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 DCOPY(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 DPNNZR(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 DVOUT(NVARS,COSTS,'('' ARRAY OF COSTS'')',IDG) 908 CALL IVOUT(NVARS+MRELAS,IND, 909 * '('' CONSTRAINT INDICATORS'')',IDG) 910 CALL DVOUT(NVARS+MRELAS,BL, 911 *'('' LOWER BOUNDS FOR VARIABLES (IGNORE UNUSED ENTRIES.)'')',IDG) 912 CALL DVOUT(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)=DDOT(NVARS,COSTS,1,PRIMAL,1) 939 CALL DVOUT(1,RDUM, 940 * '('' OUTPUT VALUE OF THE OBJECTIVE FUNCTION'')',IDG) 941 CALL DVOUT(NVARS+MRELAS,PRIMAL, 942 * '('' THE OUTPUT INDEPENDENT AND DEPENDENT VARIABLES'')',IDG) 943 CALL DVOUT(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 DVOUT(1,RDUM,'('' LENGTH OF THE EXCHANGE STEP'')',IDG) 966 IF (.NOT.(KPRINT.GE.3)) GO TO 20311 967 CALL DVOUT(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 DVOUT(MRELAS,RHS,'('' TRANSLATED RHS'')',IDG) 973 CALL DVOUT(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