1 2C**************************************************** 3C **** RDMPS1 ... READ THE MPS FILE **** 4C**************************************************** 5 SUBROUTINE rdmps1(RCODE,BUFFER,MAXM,MAXN,MAXNZA, 6 X M,N,NZA,IROBJ,BIG,DLOBND,DUPBND, 7 X NAMEC,NAMEB,NAMRAN,NAMBND,NAMMPS,INMPS, 8 X RWNAME,CLNAME,STAVAR,RWSTAT, 9 X HDRWCD,LNKRW,HDCLCD,LNKCL, 10 X RWNMBS,CLPNTS,IROW, 11 X ACOEFF,RHSB,RANGES, 12 X UPBND,LOBND,RELT) 13C 14C *** PARAMETERS 15 INTEGER*4 RCODE,MAXM,MAXN,MAXNZA,M,N,NZA,IROBJ 16 DOUBLE PRECISION BIG,DLOBND,DUPBND 17 CHARACTER*(*) NAMEC,NAMEB,NAMRAN,NAMBND,NAMMPS 18 CHARACTER*4096 BUFFER 19 CHARACTER*8 RWNAME(MAXM),CLNAME(MAXN) 20 INTEGER*4 STAVAR(*),RWSTAT(*),RWNMBS(*) 21 INTEGER*4 HDRWCD(*),LNKRW(*) 22 INTEGER*4 HDCLCD(*),LNKCL(*) 23 INTEGER*4 CLPNTS(*),IROW(*) 24 DOUBLE PRECISION ACOEFF(*),RHSB(*),RANGES(*) 25 DOUBLE PRECISION UPBND(*),LOBND(*),RELT(*) 26C 27C 28C 29C *** PARAMETERS DESCRIPTION 30C RCODE Return code: 31C 0 Everything OK; 32C 21 Number of constraints exceeds MAXM. 33C 22 Number of variables exceeds MAXN. 34C 23 Number of nonzeros exceeds MAXNZA. 35C 83 Error in MPS file (in RHSB or RANGES). 36C 84 Error in MPS file (in ROWS, COLUMNS or BOUNDS). 37C 86 Unable to open the MPS file. 38C MAXM Maximum number of constraints. 39C MAXN Maximum number of variables. 40C MAXNZA Maximum number of nonzeros of the LP constraint matrix. 41C M Current number of constraints. 42C N Current number of variables. 43C NZA Current number of nonzeros of the LP constraint matrix. 44C IROBJ Index of the objective row. 45C BIG "Big" number. 46C DUPBND Default UPPER bound. 47C DLOBND Default LOWER bound. 48C NAMEC Name of the objective row. 49C NAMEB Name of the right hand side section. 50C NAMRAN Name of the ranges section. 51C NAMBND Name of the bounds section. 52C NAMMPS Name of the LP problem. 53C FILMPS Name of the MPS input file. 54C RWNAME Array of row names. 55C CLNAME Array of column names. 56C STAVAR Work array for (local) variable status. 57C RWSTAT Array of row types: 58C 1 row type is = ; 59C 2 row type is >= ; 60C 3 row type is <= ; 61C 4 objective row; 62C 5 other free row. 63C HDRWCD Header to the linked list of rows with the same codes. 64C LNKRW Linked list of rows with the same codes. 65C HDCLCD Header to the linked list of columns with the same codes. 66C LNKCL Linked list of columns with the same codes. 67C RWNMBS Row numbers of nonzeros in columns of matrix A. 68C CLPNTS Pointers to the beginning of columns of matrix A. 69C IROW Integer work array. 70C ACOEFF Array of nonzero elements for each column. 71C RHSB Right hand side of the linear program. 72C RANGES Array of constraint ranges. 73C UPBND Array of upper bounds. 74C LOBND Array of lower bounds. 75C RELT Real work array. 76C 77C 78C 79C *** LOCAL VARIABLES 80 INTEGER*4 LINE,I,INMPS,J,COLLEN,INDEX,IPOS,STATUS,NSTRCT,KCODE 81 INTEGER*4 IMPSOK 82 DOUBLE PRECISION SMALLA,VAL1,VAL2 83 CHARACTER*8 NAME0,NAMRW1,NAMRW2,NAMCLN 84 CHARACTER*2 TYPROW,BNDTYP 85 CHARACTER*4 NM 86 CHARACTER*100 RDLINE 87 CHARACTER SECT 88C 89C 90C 91C *** PURPOSE 92C This routine reads the MPS input file. 93C 94C *** SUBROUTINES CALLED 95C LKINDX,RDRHS,LKCODE 96C 97C *** NOTES 98C 99C 100C *** REFERENCES: 101C Altman A., Gondzio J. (1993). An efficient implementation of 102C a higher order primal-dual interior point method for large 103C sparse linear programs, Archives of Control Sciences 2, 104C No 1-2, pp. 23-40. 105C Altman A., Gondzio J. (1993). HOPDM - A higher order primal- 106C dual method for large scale linear programmming, European 107C Journal of Operational Research 66 (1993) pp 158-160. 108C Gondzio J., Tachat D. (1994). The design and application of 109C IPMLO - a FORTRAN library for linear optimization with 110C interior point methods, RAIRO Recherche Operationnelle 28, 111C No 1, pp. 37-56. 112C Murtagh B. (1981). Advanced Linear Programming, McGrew-Hill, 113C New York, 1981. 114C Murtagh B., Saunders M. (1983). MINOS 5.0 User's guide, 115C Technical Report SOL 83-20, Department of Operations Research, 116C Stanford University, Stanford, 1983. 117C 118C *** HISTORY: 119C Written by: Jacek Gondzio, Systems Research Institute, 120C Polish Academy of Sciences, Newelska 6, 121C 01-447 Warsaw, Poland. 122C Date written: November 15, 1992 123C Last modified: February 8, 1997 124C DIGITEO - Michael Baudin, 06/2011: Ignore blank lines 125C 126C 127C *** BODY OF (RDMPS1) *** 128C 129 SMALLA=1.0D-10 130C 131C Format used to read every line of the MPS file. 132 1000 FORMAT(A80) 133C 134C 135C Initialize. 136 M=0 137 LINE=0 138 IROBJ=-1 139C 140 141 142 DO 20 I=1,MAXM 143 RWNAME(I)=' ' 144 RWSTAT(I)=0 145 20 CONTINUE 146C 147 148C Initialize linked lists of rows/cols with the same codes. 149 DO 40 I=1,MAXM 150 HDRWCD(I)=0 151 LNKRW(I)=0 152 40 CONTINUE 153 DO 50 J=1,MAXN 154 HDCLCD(J)=0 155 LNKCL(J)=0 156 50 CONTINUE 157C 158C 159C 160C Read the problem name. 161 60 LINE=LINE+1 162 READ(INMPS,1000,END=9000) RDLINE 163 IF(RDLINE(1:1).EQ.'*'.OR. LNBLNK(RDLINE).EQ.0) GO TO 60 164 READ(RDLINE,61,ERR=9000) NM,NAMMPS 165 61 FORMAT(A4,10X,A8) 166 IF(NM.NE.'NAME'.AND.NM.NE.'name') GO TO 60 167 168 70 LINE=LINE+1 169 READ(INMPS,1000,END=9000) RDLINE 170 IF(RDLINE(1:1).EQ.'*'.OR. LNBLNK(RDLINE).EQ.0) GO TO 70 171 READ(RDLINE,71,ERR=9000) SECT 172 71 FORMAT(A1) 173 IF(SECT.NE.'R'.AND.SECT.NE.'r') GO TO 9000 174C 175C 176C 177 178C 179C Read the ROWS section. 180 100 LINE=LINE+1 181 READ(INMPS,1000,END=9000) RDLINE 182 IF(RDLINE(1:1).EQ.'*'.OR. LNBLNK(RDLINE).EQ.0) GO TO 100 183 READ(RDLINE,101,ERR=9000) SECT,TYPROW,NAMRW1 184 101 FORMAT(A1,A2,1X,A8) 185 IF(SECT.NE.' ') GO TO 200 186C 187C Here if a constraint has been found. Determine its type. 188C Check if there is enough space for a new row. 189 M=M+1 190css IF(M.GE.MAXM) GO TO 9010 191 IF(M.GT.MAXM) GO TO 9010 192C 193 IF(TYPROW.EQ.' E'.OR.TYPROW.EQ.'E '.OR. 194 X TYPROW.EQ.' e'.OR.TYPROW.EQ.'e ') THEN 195 RWSTAT(M)=1 196 GO TO 120 197 ENDIF 198C 199 IF(TYPROW.EQ.' G'.OR.TYPROW.EQ.'G '.OR. 200 X TYPROW.EQ.' g'.OR.TYPROW.EQ.'g ') THEN 201 RWSTAT(M)=2 202 GO TO 120 203 ENDIF 204C 205 IF(TYPROW.EQ.' L'.OR.TYPROW.EQ.'L '.OR. 206 X TYPROW.EQ.' l'.OR.TYPROW.EQ.'l ') THEN 207 RWSTAT(M)=3 208 GO TO 120 209 ENDIF 210C 211 IF(TYPROW.EQ.' N'.OR.TYPROW.EQ.'N '.OR. 212 X TYPROW.EQ.' n'.OR.TYPROW.EQ.'n ') THEN 213 IF(NAMRW1.EQ.NAMEC(1:8)) THEN 214C 215C Save index of the objective row. 216 IROBJ=M 217 RWSTAT(M)=4 218 ELSE 219 RWSTAT(M)=5 220C 221C The first free row is a default objective. 222 IF(NAMEC(1:8).EQ.' ') THEN 223 IROBJ=M 224 RWSTAT(M)=4 225 NAMEC(1:8)=NAMRW1 226 ENDIF 227 ENDIF 228 GO TO 120 229 ENDIF 230C 231C Invalid row type. 232 GO TO 9050 233C 234C Here to save the row name. 235 120 RWNAME(M)=NAMRW1 236C 237C Continue reading of the ROWS section. 238 GO TO 100 239C 240C 241C 242C 243C 244C 245C Read COLUMNS section. 246 200 CONTINUE 247 248 INDEX=1 249C 250C ENCODE all row names and create linked lists of rows 251C with the same codes. 252 IMPSOK=1 253 DO 210 I=1,M 254 CALL MYCODE(IOLOG,RWNAME(I),KCODE,M) 255 LNKRW(I)=HDRWCD(KCODE) 256 HDRWCD(KCODE)=I 257C 258C Check for multiple row definition (February 10, 1996). 259C Scan all rows with the same code. 260 IPOS=LNKRW(I) 261 205 IF(IPOS.EQ.0) GO TO 210 262 IF(RWNAME(IPOS).EQ.RWNAME(I)) THEN 263 WRITE(BUFFER,206) RWNAME(IPOS) 264 206 FORMAT(1X,'RDMPS1 error: Row ',A8,'repeated.') 265C CALL basout(io,wte,BUFFER) 266 IMPSOK=0 267 GO TO 210 268 ENDIF 269 IPOS=LNKRW(IPOS) 270 GO TO 205 271 210 CONTINUE 272 IF(IMPSOK.EQ.0) GO TO 9400 273C 274 IF(SECT.NE.'C'.AND.SECT.NE.'c') GO TO 9000 275 NAME0=' ' 276 220 LINE=LINE+1 277 READ(INMPS,1000,END=9000) RDLINE 278 IF(RDLINE(1:1).EQ.'*'.OR. LNBLNK(RDLINE).EQ.0) GO TO 220 279 READ(RDLINE,221,ERR=9000) SECT,NAMCLN,NAMRW1,VAL1,NAMRW2,VAL2 280 221 FORMAT(A1,3X,A8,2X,A8,2X,D12.0,3X,A8,2X,D12.0) 281C 282 IF(NAMCLN.EQ.NAME0) GO TO 260 283C 284C Here if the new column has been found. 285C Save the previous column in the LP data structures. 286C 287C Check if this is the first column. 288 IF(NAME0.EQ.' ') THEN 289 NAME0=NAMCLN 290 COLLEN=0 291 NZA=0 292 N=1 293 GO TO 260 294 ENDIF 295C 296 IF(NZA+COLLEN.GT.MAXNZA) GO TO 9020 297C 298 CLPNTS(N)=NZA+1 299 CLNAME(N)=NAME0 300 DO 240 I=1,COLLEN 301 IPOS=NZA+I 302 RWNMBS(IPOS)=IROW(I) 303 ACOEFF(IPOS)=RELT(I) 304 240 CONTINUE 305 NZA=NZA+COLLEN 306C 307C Check if there are still columns to be read. 308 IF(SECT.NE.' ') THEN 309 CLPNTS(N+1)=NZA+1 310 NSTRCT=N 311 GO TO 300 312 ELSE 313C 314C Initialize the new column. 315 N=N+1 316css IF(N.GE.MAXN) GO TO 9030 317 IF(N.GT.MAXN) GO TO 9030 318 NAME0=NAMCLN 319 COLLEN=0 320 GO TO 260 321 ENDIF 322C 323C 324C Find the position of the nonzero element. 325C 260 CALL LKINDX(RWNAME,M,NAMRW1,INDEX) 326 260 CALL LKCODE(RWNAME,M,NAMRW1,INDEX,HDRWCD,LNKRW,IOLOG) 327 IF(INDEX.EQ.0) GO TO 9040 328C 329C 330C Save nonzero element of the N-th column. 331 IF(DABS(VAL1).LE.SMALLA) GO TO 280 332 COLLEN=COLLEN+1 333 IROW(COLLEN)=INDEX 334 RELT(COLLEN)=VAL1 335C 336C Check if there is another nonzero read in the analysed line. 337 280 IF(NAMRW2.NE.' ') THEN 338 NAMRW1=NAMRW2 339 VAL1=VAL2 340 NAMRW2=' ' 341 GO TO 260 342 ELSE 343 GO TO 220 344 ENDIF 345C 346C 347C 348C 349C Initialize RHSB and RANGES arrays. 350 300 DO 320 I=1,MAXM 351 RHSB(I)=0.0 352 RANGES(I)=BIG 353 320 CONTINUE 354C 355C 356C 357C Set the default bounds for all structural variables. 358 DO 520 J=1,MAXN 359 STAVAR(J)=0 360 LOBND(J)=DLOBND 361 UPBND(J)=DUPBND 362 520 CONTINUE 363C 364C 365C 366C 367C 368C 369C Read the RHSB section. 370C 371 IF(SECT.NE.'R'.AND.SECT.NE.'r') GO TO 9000 372 CALL RDRHS(RCODE,BUFFER,MAXM,M,LINE, 373 X HDRWCD,LNKRW,HDCLCD,LNKCL, 374 X NAMEB,RHSB,RWNAME,SECT,INMPS,IOLOG) 375C 376 IF(RCODE.GT.0) GO TO 6000 377C 378C 379C 380C 381C Check if there is a RANGES section to be read. 382 IF(SECT.NE.'R'.AND.SECT.NE.'r') GO TO 400 383C 384C 385C 386C 387C 388C 389C Read the RANGES section. 390C 391 CALL RDRHS(RCODE,BUFFER,MAXM,M,LINE, 392 X HDRWCD,LNKRW,HDCLCD,LNKCL, 393 X NAMRAN,RANGES,RWNAME,SECT,INMPS,IOLOG) 394C 395 IF(RCODE.GT.0) GO TO 6000 396C 397C 398C 399 400 CONTINUE 400 IF(SECT.NE.'B'.AND.SECT.NE.'b') GO TO 600 401C 402C 403C 404C 405C 406C 407C Read the BOUNDS section. 408C 409 INDEX=1 410 550 LINE=LINE+1 411 READ(INMPS,1000,END=9000) RDLINE 412 IF(RDLINE(1:1).EQ.'*'.OR. LNBLNK(RDLINE).EQ.0) GO TO 550 413C 414C ENCODE all column names and create linked lists of columns 415C with the same codes. 416C DO 560 J=1,N 417C LNKCL(J)=HDCLCD(KCODE) 418C HDCLCD(KCODE)=J 419C 560 CONTINUE 420C 421 READ(RDLINE,561,ERR=9000) SECT,BNDTYP,NAME0,NAMCLN,VAL1 422 561 FORMAT(A1,A2,1X,A8,2X,A8,2X,D12.0) 423C 424 IF(SECT.NE.' ') GO TO 600 425C 426C First record met defines default section name. 427 IF(NAMBND(1:8).EQ.' ') THEN 428 NAMBND(1:8)=NAME0 429 ENDIF 430C 431C Ignore the record that define unimportant bound. 432 IF(NAME0.NE.NAMBND(1:8)) GO TO 550 433C 434C Determine index of the variable to which the bound refers. 435 CALL LKINDX(CLNAME,N,NAMCLN,INDEX) 436C CALL LKCODE(CLNAME,N,NAMCLN,INDEX,HDCLCD,LNKCL,IOLOG) 437 IF(INDEX.EQ.0) GO TO 9060 438C 439C 440C Here to detect the type of the bound read. 441 STATUS=STAVAR(INDEX) 442C 443C 444C 445 IF(BNDTYP.EQ.'UP'.OR.BNDTYP.EQ.'up') THEN 446C 447C Here when an UPPER bound is being defined. 448C Accept multiple definition of the UPPER bound. 449C The last definition is valid. 450 IF(STATUS.EQ.6) GO TO 9070 451 IF(STATUS.EQ.-1) GO TO 9080 452C 453 IF(STATUS.EQ.0.OR.STATUS.EQ.1) THEN 454C 455C Not yet bounded variable (or multiple UPPER bound). 456 UPBND(INDEX)=VAL1 457 STAVAR(INDEX)=1 458 GO TO 550 459 ENDIF 460C 461 IF(STATUS.EQ.2.OR.STATUS.EQ.3) THEN 462C 463C Already LOWER bounded variable. 464 UPBND(INDEX)=VAL1 465 STAVAR(INDEX)=3 466 GO TO 550 467 ENDIF 468C 469 ENDIF 470C 471C 472C 473 IF(BNDTYP.EQ.'LO'.OR.BNDTYP.EQ.'lo') THEN 474C 475C Here when a LOWER bound is being defined. 476 IF(STATUS.EQ.2.OR.STATUS.EQ.3.OR.STATUS.EQ.6) GO TO 9070 477 IF(STATUS.EQ.-1) GO TO 9080 478C 479 IF(STATUS.EQ.0) THEN 480C 481C Not yet bounded variable. 482 LOBND(INDEX)=VAL1 483 STAVAR(INDEX)=2 484 GO TO 550 485 ENDIF 486C 487 IF(STATUS.EQ.1) THEN 488C 489C Already UPPER bounded variable. 490 LOBND(INDEX)=VAL1 491 STAVAR(INDEX)=3 492 GO TO 550 493 ENDIF 494C 495 ENDIF 496C 497C 498C 499 IF(BNDTYP.EQ.'FR'.OR.BNDTYP.EQ.'fr') THEN 500C 501C Here when a FREE variable is being defined. 502 IF(STATUS.GT.0) GO TO 9090 503C 504C Not yet bounded variable. 505 LOBND(INDEX)=-BIG 506 UPBND(INDEX)=BIG 507 STAVAR(INDEX)=-1 508 GO TO 550 509C 510 ENDIF 511C 512C 513C 514 IF(BNDTYP.EQ.'FX'.OR.BNDTYP.EQ.'fx') THEN 515C 516C Here when a FIXED variable is being defined. 517 IF(STATUS.EQ.-1) GO TO 9080 518 IF(STATUS.NE.0) GO TO 9100 519C 520C Not yet bounded variable. 521 LOBND(INDEX)=VAL1 522 UPBND(INDEX)=VAL1 523 STAVAR(INDEX)=6 524 GO TO 550 525C 526 ENDIF 527C 528C 529C 530 IF(BNDTYP.EQ.'PL'.OR.BNDTYP.EQ.'pl') THEN 531C 532C Here when a PLUS INFINITY bound is being defined. 533 IF(STATUS.EQ.-1) GO TO 9080 534 IF(STATUS.NE.0) GO TO 9070 535C 536C Not yet bounded variable. 537C LOBND(INDEX)=VAL1 538 UPBND(INDEX)=BIG 539 STAVAR(INDEX)=2 540 GO TO 550 541C 542 ENDIF 543C 544C 545C 546 IF(BNDTYP.EQ.'MI'.OR.BNDTYP.EQ.'mi') THEN 547C 548C Here when a MINUS INFINITY bound is being defined. 549 IF(STATUS.EQ.-1) GO TO 9080 550 IF(STATUS.NE.0) GO TO 9070 551C 552C Not yet bounded variable. 553 LOBND(INDEX)=-BIG 554C UPBND(INDEX)=VAL1 555 STAVAR(INDEX)=1 556 GO TO 550 557C 558 ENDIF 559C 560 GO TO 9110 561C 562C 563C 564 600 CONTINUE 565 IF(SECT.NE.'E'.AND.SECT.NE.'e') GO TO 9000 566C 567C 568C 569C 570C 571C 572C The ENDATA card has been found. 573C 574 IF(IROBJ.EQ.-1) GO TO 9130 575 5000 CONTINUE 576 RCODE=0 577C 578 6000 CONTINUE 579C Close the MPS input file. 580css call clunit(-inmps,filmps(1:ilen),mode) 581c CLOSE(INMPS) 582 RETURN 583C 584C 585C 586C 587C 588C Here when error occurs. 589 9000 WRITE(BUFFER,9001) LINE 590 9001 FORMAT(1X,'RDMPS1: Error while reading line',I10, 591 X ' of the MPS file.') 592css CALL basout(io,wte,BUFFER) 593 RCODE=84 594 GO TO 6000 595C 596 9010 WRITE(BUFFER,9011) 597 9011 FORMAT(1X,'RDMPS1 ERROR: Number of constraints', 598 X ' in the MPS file exceeds MAXM.') 599css CALL basout(io,wte,BUFFER) 600 RCODE=21 601 GO TO 6000 602C 603 9020 WRITE(BUFFER,9021) 604 9021 FORMAT(1X,'RDMPS1 ERROR: Number of nonzeros', 605 X ' of matrix A exceeds MAXNZA.') 606css CALL basout(io,wte,BUFFER) 607 RCODE=23 608 GO TO 6000 609C 610 9030 WRITE(BUFFER,9031) 611 9031 FORMAT(1X,'RDMPS1 ERROR: Number of variables', 612 X ' in the MPS file exceeds MAXN.') 613css CALL basout(io,wte,BUFFER) 614 RCODE=22 615 GO TO 6000 616C 617 9040 WRITE(BUFFER,9041) LINE 618 9041 FORMAT(1X,'RDMPS1 ERROR: Unknown row found', 619 X ' at line',I10,' of the MPS file.') 620css CALL basout(io,wte,BUFFER) 621 RCODE=84 622 GO TO 6000 623C 624 9050 WRITE(BUFFER,9051) TYPROW,LINE 625 9051 FORMAT(1X,'RDMPS1 ERROR: Unknown row type=',A2, 626 X ' at line',I10,' of the MPS file.') 627css CALL basout(io,wte,BUFFER) 628 RCODE=84 629 GO TO 6000 630C 631 9060 WRITE(BUFFER,9061) LINE 632 9061 FORMAT(1X,'RDMPS1 ERROR: Unknown column found', 633 X ' at line',I10,' of the MPS file.') 634css CALL basout(io,wte,BUFFER) 635 RCODE=84 636 GO TO 6000 637C 638 9070 WRITE(BUFFER,9071) LINE,BNDTYP 639 9071 FORMAT(1X,'RDMPS1 ERROR: Line',I10,' in MPS file', 640 X ' defines ',A2,' bound') 641css CALL basout(io,wte,BUFFER) 642 WRITE(BUFFER,9072) NAMCLN 643 9072 FORMAT(14X,'for variable ',A8, 644 X ' that has already been bounded.') 645css CALL basout(io,wte,BUFFER) 646 RCODE=84 647 GO TO 6000 648C 649 9080 WRITE(BUFFER,9081) LINE,BNDTYP 650 9081 FORMAT(1X,'RDMPS1 ERROR: Line',I10,' in MPS file', 651 X ' defines ',A2,' bound') 652 CALL basout(io,wte,BUFFER) 653 WRITE(BUFFER,9082) NAMCLN 654 9082 FORMAT(14X,'for variable ',A8, 655 X ' that has earlier been declared FREE.') 656css CALL basout(io,wte,BUFFER) 657 RCODE=84 658 GO TO 6000 659C 660 9090 WRITE(BUFFER,9091) LINE 661 9091 FORMAT(1X,'RDMPS1 ERROR: Line',I10,' in MPS file', 662 X ' declares as FREE') 663css CALL basout(io,wte,BUFFER) 664 WRITE(BUFFER,9092) NAMCLN 665 9092 FORMAT(14X,' variable ',A8, 666 X ' that has earlier been bounded.') 667css CALL basout(io,wte,BUFFER) 668 RCODE=84 669 GO TO 6000 670C 671 9100 WRITE(BUFFER,9101) LINE,NAMCLN 672 9101 FORMAT(1X,'RDMPS1 ERROR: Line',I10,' in MPS file', 673 X ' declares as FIXED',14X,' variable ',A8, 674 X ' that has earlier been bounded.') 675css CALL basout(io,wte,BUFFER) 676css WRITE(BUFFER,9102) NAMCLN 677css 9102 FORMAT(14X,' variable ',A8, 678css X ' that has earlier been bounded.') 679css CALL basout(io,wte,BUFFER) 680 RCODE=84 681 GO TO 6000 682C 683 9110 WRITE(BUFFER,9111) LINE,BNDTYP 684 9111 FORMAT(1X,'RDMPS1 ERROR: Line',I10,' in MPS file', 685 X ' has invalid bound type ',A2) 686css CALL basout(io,wte,BUFFER) 687 RCODE=84 688 GO TO 6000 689C 690 9130 WRITE(BUFFER,9131) NAMEC(1:8) 691 9131 FORMAT(1X,'RDMPS1 ERROR: Objective row =',A8, 692 X ' has no entries.') 693css CALL basout(io,wte,BUFFER) 694 RCODE=84 695 GO TO 6000 696 697C 698 9400 WRITE(BUFFER,9401) 699 9401 FORMAT(1X,'RDMPS1 ERROR: Multiple row definition.') 700css CALL basout(io,wte,BUFFER) 701 RCODE=84 702 GO TO 6000 703C *** LAST CARD OF (RDMPS1) *** 704 END 705C****************************************************************** 706 SUBROUTINE LKCODE(RWNAME,M,NAME,INDEX,HEADER,LINKS,IOLOG) 707C 708 INTEGER*4 KCODE,M,I,INDEX,IOLOG 709 710 INTEGER*4 HEADER(M),LINKS(M) 711 CHARACTER*8 RWNAME(M),NAME 712C 713C Get code of the NAME. 714 CALL MYCODE(IOLOG,NAME,KCODE,M) 715 INDEX=HEADER(KCODE) 716C 717C Determine the index such that RWNAME(index) = NAME. 718 DO 100 I=1,M 719 IF(INDEX.EQ.0) GO TO 200 720 IF(RWNAME(INDEX).EQ.NAME) GO TO 200 721 INDEX=LINKS(INDEX) 722 100 CONTINUE 723C 724 200 CONTINUE 725 RETURN 726 END 727C******************************************************************* 728 SUBROUTINE LKINDX(RWNAME,M,NAME,INDEX) 729C 730 INTEGER*4 M,I,INDEX,INDEX2 731 CHARACTER*8 RWNAME(M),NAME 732C 733 INDEX2=INDEX 734C WRITE(0,10) INDEX 735C 10 FORMAT(1X,' old index=',I5) 736 INDEX=0 737 DO 100 I=INDEX2,M 738 IF(RWNAME(I).EQ.NAME) THEN 739 INDEX=I 740 GO TO 200 741 ENDIF 742 100 CONTINUE 743 DO 150 I=1,INDEX2 744 IF(RWNAME(I).EQ.NAME) THEN 745 INDEX=I 746 GO TO 200 747 ENDIF 748 150 CONTINUE 749C 750 200 CONTINUE 751 RETURN 752 END 753C******************************************************************** 754C ******* RDRHS ... READ THE RHS SECTION OF THE MPS FILE ******* 755C******************************************************************** 756C 757 SUBROUTINE RDRHS(RCODE,BUFFER,MAXM,M,LINE, 758 X HDRWCD,LNKRW,HDCLCD,LNKCL, 759 X NAMEB,RRHS,RWNAME,SECT,INMPS,IOLOG) 760C 761C 762C 763C *** PARAMETERS 764 INTEGER*4 RCODE,MAXM,M,LINE,INMPS,IOLOG 765 CHARACTER*8 NAMEB,RWNAME(MAXM) 766 INTEGER*4 HDRWCD(M+1),LNKRW(M+1) 767 INTEGER*4 HDCLCD(M+1),LNKCL(M+1) 768 DOUBLE PRECISION RRHS(MAXM) 769 CHARACTER*100 BUFFER 770 CHARACTER SECT 771C 772C 773C 774C *** LOCAL VARIABLES 775 INTEGER*4 INDEX 776 DOUBLE PRECISION VAL1,VAL2 777 CHARACTER*8 NAME0,NAMRW1,NAMRW2 778 CHARACTER*100 RDLINE 779C 780C 781C 782C *** PARAMETERS DESCRIPTION 783C ON INPUT: 784C MAXM Maximum number of constraints. 785C M Current number of constraints. 786C LINE Current number of the line read from the MPS file. 787C NAMEB The name of the right hand side section chosen. 788C RWNAME Array of row names. 789C HDRWCD Header to the linked list of rows with the same codes. 790C LNKRW Linked list of rows with the same codes. 791C HDCLCD Header to the linked list of columns with the same codes. 792C LNKCL Linked list of columns with the same codes. 793C IOLOG Output unit number where log messages are to be written. 794C INMPS Input unit number where the input MPS file is read from. 795C 796C ON OUTPUT: 797C RCODE Return code: 798C 0 Everything OK; 799C 83 Error in MPS file (in RRHS or RANGES section). 800C RRHS The right hand side vector. 801C SECT Indicator of the section that follows RRHS one. 802C 803C 804C 805C *** SUBROUTINES CALLED 806C LKINDX 807C 808C 809C 810C *** PURPOSE 811C This routine reads the RRHS section of the MPS file. 812C (It can also be used to read the RANGES section). 813C 814C 815C 816C *** NOTES 817C 818C 819C 820C *** REFERENCES: 821C Altman A., Gondzio J. (1993). An efficient implementation of 822C a higher order primal-dual interior point method for large 823C sparse linear programs, Archives of Control Sciences 2, 824C No 1-2, pp. 23-40. 825C Altman A., Gondzio J. (1993). HOPDM - A higher order primal- 826C dual method for large scale linear programmming, European 827C Journal of Operational Research 66 (1993) pp 158-160. 828C Gondzio J., Tachat D. (1994). The design and application of 829C IPMLO - a FORTRAN library for linear optimization with 830C interior point methods, RAIRO Recherche Operationnelle 28, 831C No 1, pp. 37-56. 832C 833C 834C 835C *** HISTORY: 836C Written by: Jacek Gondzio, Systems Research Institute, 837C Polish Academy of Sciences, Newelska 6, 838C 01-447 Warsaw, Poland. 839C Last modified: February 8, 1997 840C 841C 842C 843C *** BODY OF (RDRHS) *** 844C 845C Format used to read every line of the MPS file. 846 1000 FORMAT(A80) 847C 848C 849C 850C 851C Main loop begins here. 852 200 LINE=LINE+1 853 READ(INMPS,1000,ERR=9000) RDLINE 854 IF(RDLINE(1:1).EQ.'*'.OR. LNBLNK(RDLINE).EQ.0) GO TO 200 855 INDEX=1 856 READ(RDLINE,201,ERR=9000) SECT,NAME0,NAMRW1,VAL1,NAMRW2,VAL2 857 201 FORMAT(A1,3X,A8,2X,A8,2X,D12.0,3X,A8,2X,D12.0) 858C 859C Check if the line belongs to the same section. 860 IF(SECT.NE.' ') GO TO 300 861C 862C First record met defines default section name. 863 IF(NAMEB.EQ.' ') THEN 864 NAMEB=NAME0 865 ENDIF 866 IF(NAME0.NE.NAMEB) GO TO 9000 867C 868C 869C Find the position of the nonzero element. 870C 250 CALL LKINDX(RWNAME,M,NAMRW1,INDEX) 871 250 CALL LKCODE(RWNAME,M,NAMRW1,INDEX,HDRWCD,LNKRW,IOLOG) 872 IF(INDEX.EQ.0) GO TO 9010 873C 874C Save the RRHS coefficient. 875 RRHS(INDEX)=VAL1 876C WRITE(BUFFER,251) INDEX,RWNAME(INDEX),VAL1 877C 251 FORMAT(1X,'RDRHS: rw=',I6,' rwname=',A8,' elt=',D14.6) 878C CALL MYWRT(IOLOG,BUFFER) 879C 880C Check if there is another nonzero read in the analysed line. 881 IF(NAMRW2.NE.' ') THEN 882 NAMRW1=NAMRW2 883 VAL1=VAL2 884 NAMRW2=' ' 885 GO TO 250 886 ELSE 887 GO TO 200 888 ENDIF 889C 890C 891C 892 300 CONTINUE 893 RCODE=0 894C 895 6000 CONTINUE 896 RETURN 897C 898C 899C 900C Here if an error occurs. 901 9000 WRITE(BUFFER,9001) LINE 902 9001 FORMAT(1X,'RDRHS ERROR: Unexpected characters found', 903 X ' at line',I10,' of the MPS file.') 904css CALL basout(io,wte,BUFFER) 905 RCODE=83 906 GO TO 6000 907C 908 9010 WRITE(BUFFER,9011) LINE 909 9011 FORMAT(1X,'RDRHS ERROR: Unknown row was found', 910 X ' at line',I10,' of the MPS file.') 911css CALL basout(io,wte,BUFFER) 912 RCODE=83 913 GO TO 6000 914C 915C 916C 917C *** LAST CARD OF (RDRHS) *** 918 END 919 920C******************************************************************* 921C ** MYCODE ... ENCODE THE 8-CHARACTER NAME INTO AN INTEGER ** 922C******************************************************************* 923C 924 SUBROUTINE MYCODE(IOLOG,NAME,KCODE,M) 925C 926C 927C *** PARAMETERS 928 CHARACTER*9 NAME 929 INTEGER*4 IOLOG,KCODE,M 930C 931C 932C *** LOCAL VARIABLES 933 INTEGER*4 IPOS 934C 935C 936C *** PARAMETERS DESCRIPTION 937C NAME 8-character name (row or column name). 938C KCODE Integer code associated to the name. 939C M The number of rows (or columns) in matrix A. 940C IOLOG Output unit number where log messages are to be written. 941C 942C *** HISTORY: 943C Written by: Jacek Gondzio, Systems Research Institute, 944C Polish Academy of Sciences, Newelska 6, 945C 01-447 Warsaw, Poland. 946C Date written: October 14, 1994 947C Last modified: May 17, 1995 948C 949C 950C *** BODY OF (MYCODE) *** 951C 952C 953 KCODE=0 954 DO 100 IPOS=1,8 955 KCODE=KCODE+ICHAR(NAME(IPOS:IPOS))*IPOS 956C WRITE(BUFFER,101) IPOS,NAME(IPOS:IPOS) 957C 101 FORMAT(1X,'ipos=',I2,' char=',A1) 958C CALL MYWRT(IOLOG,BUFFER) 959 100 CONTINUE 960 KCODE=MOD(KCODE,M)+1 961C WRITE(BUFFER,102) NAME,KCODE 962C 102 FORMAT(1X,' name=',A8,' has a code=',I6) 963C CALL MYWRT(IOLOG,BUFFER) 964 RETURN 965C 966C 967C *** LAST CARD OF (MYCODE) *** 968 END 969 970