1# to unbundle, sh this file (in an empty directory) 2echo read.me 1>&2 3sed >read.me <<'//GO.SYSIN DD read.me' 's/^-//' 4- 5-This bundle includes 10 files: 6- 1. read.me 7- 2. input.f 8- 3. std2mps.f 9- 4. common5.for 10- 5. time7.frs 11- 6. core.mpc 12- 7. stoch1.frs 13- 8. stoch2.frs 14- 9. stoch3.frs 15- 10. paper.lis 16- 17-If the beginning of this bundle makes no sense to you (i.e., if you 18-are not using a UNIX(R) system), then use your favorite editor to 19-remove the - at the start of each line and to split this bundle into 20-the requisite files, each of which starts with a line of the form 21-"sed >filename ..." and ends with a line of the form 22-"//GO.SYSIN DD filename". 23- 24-Files 2, 3, and 4 are Fortran source files: input5.f is an input 25-routine for stochastic linear programming problems, stdtomps.f is a 26-main program that writes an MPS file for the deterministic equivalent 27-problem, and common5.for is an include file containing all the common 28-blocks for the .f files. You'll have to include common5.for by hand 29-(insert it in place of each "include" statement) if your compiler 30-won't do this for you. 31- 32-Compiling and loading stdtomps.f and input5.f together will give you a 33-program that expects input files on Fortran units 1, 2, and 3. For the 34-forestry problems STOCFOR1,2,3, time7.frs should be attached to unit 1, 35-the EMPS output from expanding core.mpc should be attached to unit 2, 36-and one of the files stoch1.frs, stoch2.frs, or stoch3.frs should be 37-attached to unit 3 to produce, respectively, problem STOCFOR1, 38-STOCFOR2, or STOCFOR3. These LP problems are output on Fortran unit 7. 39-(The present version of std2mps.f prints numerical values to more 40-decimal places than did the version that generated the STOCFOR1 and 41-STOCFOR2 in netlib's lp/data .) 42- 43-paper.lis is a summary of "A Standard Input Format for Multistage 44-Stochastic Linear Programs" by J.R. Birge, M.A.H. Dempster, H.I. 45-Gassmann, E.A. Gunn, A.J. King, and S.W. Wallace [COAL Newsletter 46-No. 17 (Dec. 1987), pp. 1-19]. 47- 48-Complain to dmg if this read.me is unclear. Gus Gassmann provided the 49-other files in this bundle. He says, 50- 51- I cannot give any guarantees that the programs will run 52- correctly, or that they will run at all. If you experience 53- any problems, I would appreciate hearing about them, on the 54- off chance that I might be able to assist: 55- 56- Gus Gassmann 57- School of Business Administration 58- Dalhousie University 59- Halifax, N.S. B3H 1Z5 60- Canada 61- 62- ph. (902)-424-7080 63- 64- email: GASSMANN @ Dalac.bitnet 65//GO.SYSIN DD read.me 66echo input.f 1>&2 67sed >input.f <<'//GO.SYSIN DD input.f' 's/^-//' 68-C************************************************************************ 69-C* ** 70-C* This routine is distributed with the understanding that it is ** 71-C* not to be re-distributed to third parties without the consent ** 72-C* of the author. The author cannot assume any responsibilities ** 73-C* for the correctness of the routine. ** 74-C* ** 75-C* In case of problems, please contact ** 76-C* ** 77-C* Professor H.I. Gassmann ** 78-C* School of Business Administration ** 79-C* Dalhousie University ** 80-C* Halifax, Nova Scotia ** 81-C* CANADA, B3H 1Z5 ** 82-C* (902)-424-7080 ** 83-C* ** 84-C************************************************************************ 85-C 86- SUBROUTINE INPUT ( PROBNM, IOBJ1 ) 87-C 88-C This subroutine is the top level input routine. It first reads a 89-C time file in the format laid out in Birge et al. (COAL newsletter, No.17, 90-C December 1987) and described in a bit more detail below. It then calls 91-C further subroutines to read in the core file and the stoch file in one 92-C of the four formats described in the paper. 93-C 94-C ----------------------------------------------------- 95-C 96-C A brief description of the input format follows: 97-C 98-C All the information is contained in three input files, which are in 99-C the order they are accessed: 100-C 101-C - the TIME FILE which breaks the rows and columns up into periods 102-C - the CORE FILE which contains information for a 'base scenario' 103-C - the STOCH FILE which describes the stochastics of the problem 104-C 105-C TIME FILE: 106-C 107-C The first column and row of each period appear in the first two name 108-C fields in standard MPSX format. The period is given a name in the 109-C third name field. 110-C 111-C 112-C CORE FILE: 113-C 114-C Standard MPSX format: The ROWS section lists all the rows for the 115-C entire problem period by period, starting with period 1 and ending 116-C with period T. The objective row is considered to be part of period 1. 117-C 118-C The COLUMNS section is dealt with in the same way, columns are listed 119-C period by period. The RHS, BOUNDS and RANGES sections follow as in the 120-C MPSX standard. 121-C 122-C 123-C STOCH FILE: 124-C 125-C Three different ways to specify random elements have been implemented 126-C to date. They are considered mutually exclusive, although a certain 127-C amount of mixing may be possible. THIS REQUIRES MORE WORK. 128-C 129-C Independent random elements are specified with the keyword INDEP, one 130-C element per data record. 131-C 132-C Blocks of random data which vary jointly but exhibit period-to-period 133-C independence can be specified with the BLOCKS option. 134-C 135-C The SCEN option allows dependence across time periods, but assumes 136-C that all nodes in the decision tree belonging to the same time period 137-C have identical problem dimensions and sparsity pattern in the 138-C constraint matrix. 139-C 140-C 141-C In all cases, the program attempts to minimize storage by reducing 142-C redundancies as much as possible. (MY VERSION OF SUPERSPARSITY.) 143-C 144-C Version 5 is intended to read a full lower triangular constraint 145-C structure, but will detect staircase structure. 146-C 147-C ----------------------------------------------------------------- 148-C 149-C The internal representation is as follows. 150-C 151-C DISCRETE distributions: 152-C 153-C For each node N in the decision tree, N = 1,...,NODES, 154-C 155-C find in array with offset address 156-C A matrix coefficients A KELMA (KDATA(N)+LMTX) (+) 157-C A matrix locations IA KELMA (KDATA(N)+LMTX) 158-C A matrix column pointers LA KCOLA (KDATA(N)+LMTX) 159-C cost coefficients COST KCOST (N) 160-C variable names NAMES KNAMES(N) 161-C upper bounds XUB KBOUND(N) 162-C lower bound XLB KBOUND(N) 163-C right hand sides XI KRHS (N) 164-C decision variables X KROW (N) 165-C dual variables YPI KCOL (N) 166-C 167-C (+) LMTX = 1 for blocks on the main diagonal 168-C = 2 for blocks immediately to the LEFT of the main diagonal 169-C > 2 for blocks further away. 170-C Staircase problems are indicated by MARKOV = .TRUE. 171-C 172-C Problem dimensions are in arrays NROW, NCOL (number of columns 173-C including slacks) and NELMA. 174-C 175-C 176-C Note that the identity matrix for the slack variables is at present 177-C *NOT* stored as part of the A matrix and that the cost coefficients 178-C are separated, even if costs are deterministic. 179-C 180-C The tree itself is represented by three pointer arrays IANCTR, IDESC, 181-C IBROTH, which for each node give, respectively, the ancestor node, 182-C the immediate successor node, and the next node in the same period. 183-C If IBROTH > 0, then both nodes have the same ancestor, but it has 184-C proven advantageous to link nodes in the same time period which have 185-C different ancestors. This is indicated by a negative value for IBROTH, 186-C and the next node in this case is given by ABS(IBROTH). 187-C 188-C The network standard described in the paper has not been implemented yet. 189-C 190-C ------------------------------------------------------------------------ 191-C 192-C This version dated 29 December 1988 193-C 194-C --------------------------------------------------------------------- 195-C 196-C ***DESCRIPTION OF PARAMETERS*** 197-C 198-C PROBNM = 8-CHARACTER STRING VARIABLE CONTAINING THE PROBLEM NAME 199-C IOBJ1 = ORIGINAL OBJECTIVE ROW (MAY BE ZERO) 200-C THE OBJECTIVE ROW IS INTERCEPTED AND SWAPPED TO 201-C POSITION 1 FOR EASIER IDENTIFICATION IN SUBPROBLEMS 202-C IN PERIODS 2, 3, ..., T. 203-C 204-C --------------------------------------------------------------------- 205-C 206-C& Include file COMMON5.FOR which is accessed in all routines: 207-C 208- IMPLICIT REAL*8(A-H,O,P,R-Z), INTEGER(I-N), CHARACTER*1 (Q) 209- CHARACTER*8 NAMES, DXI, DBOUND, DRANGE 210- LOGICAL MARKOV 211-C 212- COMMON A(30000),E(10000),B(20000),X(20000),XLB(3000),XUB(3000), 213- 1 XI(10000),YPI(20000),YPIBAR(600),Y(350),YTEMP(600), 214- 2 YTEMP1(600),IA(30000),IE(10000),JH(20000),KINBAS(40000), 215- 3 LA(10000),LE(1001),MARKOV 216-C 217- COMMON /ATLAS/ MAPCOL(600),MAPROW(350),MAPCUT(2000) 218- COMMON /CHARS/ QA,QAST,QB,QBL,QC,QD,QE,QF,QG,QH,QI,QK,QL,QM,QN, 219- * QO,QP,QR,QS,QT,QU,QV,QX,QSTAT 220- COMMON /CONST/ ZTOLZE, ZTOLPV, ZTCOST, NAMAX, NBMAX, NCMAX, 221- * NEMAX, NLMAX, NPMAX, NRMAX, NTMAX, NVMAX, 222- * NROWMX, NCOLMX, NEGINF 223-C 224- COMMON /CUTDAT/ICTYPE(2000),ICUT1(2000),KFIRST(2000),LINKUT(2000), 225- * KCUT0, MAXCOL,MAXROW,MAXRHS,NOFCUT 226- COMMON /INDATA/ LASTC, LASTD, LASTR, LASTBD,LASTNM,LASTCA 227- COMMON /LPSTAT/ LPCUTS,LPPROB,LPBINV,LPNORM,LPOPTC 228-C 229- COMMON /PARAM/ IBASIS,ICONST,IDUAL,INDEP,INVFRQ,IOBJ,ISCHUR, 230- * ISTOCH,ITRFRQ,INFLAG,JVRSN,MULTI,NECHO,NREADB 231- COMMON /PIVOT/ APV,CMAX,CMIN,DE,DP,DRES,IPTYPE,NINF,NOPT,NPIVOT, 232- * IROWP,IROWQ,ITCNT,JCOLP,JCOLQ,JCOUT,NETA, 233- * NELEM,LASTA,NLELEM,NLETA,NUELEM,NUETA 234- COMMON /SCHUR/ DRHS(100),DZBAR(100),XMACH(10),JIN(100),JOUT(100), 235- * NTLBAS(350),NTLROW(600),ICHAIN(301), 236- * INCH,IQFST,IRFST,LENC,INVT 237-C 238- COMMON /SCINFO/ XOLD(2000), PROB(2000), KCOL(2000), KCOLA(5000), 239- 1 KCOST(2000), KELMA(5000), KROW(2000), KRHS(2000), 240- 2 KNAMES(2000),KBOUND(2000),NCOL(2000), NCUT(2000), 241- 3 IANCTR(2000),IBROTH(2000),IDESC(2000),INHBT(2000), 242- 4 NELMA(5000), LOOKAT(2000),NROW(2000), NTH(2000), 243- 5 NUDATA(2000),NUDUAL(2000),NDESC(2000),KDATA(2000) 244- COMMON /SEQ/ IDIR,IPER,INODE,JPASS,LPER,NPASS,NPER,NODES, 245- * IASTO(10,10),IRNGE0(10),IRNGE1(10),IRNGE2(10) 246- COMMON /TRIKL/ COST(3000),XLTEMP(350),XUTEMP(350),XPREV 247- COMMON /UNITS / IOTIM,IOCOR,IOSTO,IOINB,IOPAR,IOLOG,IOBAS,IOSUM, 248- * IOSOL 249- COMMON /VARNAM/ NAMES(3000), DXI, DBOUND, DRANGE 250-C# 251-C ----------- end of include file COMMON5.FOR ---------- 252-C 253- LOGICAL SIMPLE, ERRCOR, ERRSTO, ERRTIM 254- CHARACTER*8 DNAME(3), DTIME(10), DBLANK, DSIMPL, 255- * PROBNM, DTIMEC(10), DTIMER(10), DROW, DCOL, DOTS, 256- * DISCR 257- DIMENSION IROTYP(3000), KREF(10) 258- EQUIVALENCE (IROTYP,E) 259-C 260- DATA DBLANK/' '/, DSIMPL/'SIMPLE '/, DOTS /' ... '/, 261- * DISCR /'DISCRETE'/ 262-C 263-C -------------------------------------------------------------------------- 264-C 265-C Set up some name fields first 266-C (This should probably be read from a SPECS file.) 267-C 268- PROBNM = DBLANK 269- DXI = DOTS 270- DBOUND = DOTS 271- DRANGE = DOTS 272- ERRCOR = .FALSE. 273- ERRSTO = .FALSE. 274- ERRTIM = .FALSE. 275- NPER = 0 276- SIMPLE = .FALSE. 277- MARKOV = .TRUE. 278-C 279-C Next process the time file to get the partitioning into periods 280-C 281- NREC = 0 282- IENDAT = 0 283- IF (NECHO .GE. 2) WRITE (IOLOG, 1100) 284-C 285- 100 CONTINUE 286- READ (IOTIM, 1000, END=101, ERR=102) 287- * Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 288- NREC = NREC + 1 289- IF (Q1 .EQ. QAST ) GOTO 100 290- IF (IENDAT .EQ. 0) IENDAT = 1 291- IF (Q1 .EQ. QT .AND. Q2 .EQ. QI) GOTO 105 292- IF (Q1 .EQ. QP .AND. Q2 .EQ. QE) GOTO 110 293- IF (Q1 .EQ. QE) GOTO 130 294- IF (Q1 .EQ. QBL) GOTO 120 295- WRITE (IOLOG, 1200) 296- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 297- WRITE (IOLOG, 1400) 298- GOTO 9999 299-C 300-C Missing ENDATA card 301-C 302- 101 CONTINUE 303- IF (IENDAT .EQ. 0) GOTO 102 304- IF (IENDAT .EQ. 1) GOTO 9050 305- WRITE (IOLOG, 1200) 306- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 307- WRITE (IOLOG, 1700) 308- GOTO 140 309-C 310-C ERROR WHILE READING THE TIME FILE. TREAT AS MISSING AND PROCEED 311-C 312- 102 CONTINUE 313- IF (NREC .GT. 0) WRITE (IOLOG, 1200) 314- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 315- WRITE (IOLOG, 3970) 316- DTIMEC(1) = DOTS 317- DTIMER(1) = DOTS 318- DTIME(1) = 'PERIOD1' 319- ERRTIM = .TRUE. 320- PROBNM = DOTS 321- NPER = 1 322- GOTO 140 323-C 324-C WE HAVE FOUND A TIME FILE AND A NAME FOR OUR PROBLEM 325-C 326- 105 CONTINUE 327- PROBNM = DNAME(2) 328- IF (NECHO .GE. 2) WRITE (IOLOG, 1200) 329- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2) 330- GOTO 100 331- 110 CONTINUE 332- IENDAT = 2 333- IF (DNAME(2) .EQ. DSIMPL) SIMPLE = .TRUE. 334- IF (NECHO .GE. 5) WRITE (IOLOG, 1200) 335- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2) 336- GOTO 100 337- 120 CONTINUE 338- NPER = NPER + 1 339- IF (NPER .GT. NPMAX) GOTO 9030 340- IF (NECHO .GE. 5) 341- * WRITE (IOLOG, 2500) NREC,DNAME(3),DNAME(2),DNAME(1) 342- DTIMEC(NPER) = DNAME(1) 343- DTIMER(NPER) = DNAME(2) 344- DTIME(NPER) = DNAME(3) 345- GOTO 100 346-C 347-C End of TIME file 348-C 349- 130 CONTINUE 350- IF (NECHO .GE. 2) WRITE (IOLOG, 1200) 351- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2) 352- 140 CONTINUE 353- IF (SIMPLE) GOTO 9100 354- NREC = 0 355- NPSEEN = 0 356- IF (NECHO .GE. 2) WRITE (IOLOG, 1800) 357-C 358-C ***** READ THE CORE FILE ***** 359-C 360- 150 CONTINUE 361- READ (IOCOR, 1000, END=151, ERR=151) 362- * Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 363- NREC = NREC + 1 364- IF (Q1 .EQ. QN .AND. Q2. EQ. QA) GOTO 155 365- IF (Q1 .EQ. QAST) GOTO 150 366- WRITE (IOLOG, 1200) 367- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 368- WRITE (IOLOG, 2300) 369- GOTO 9999 370-C 371-C Error during read or missing CORE file. Keep going. 372-C 373- 151 CONTINUE 374- IF (NREC .GT. 0) WRITE (IOLOG, 1200) 375- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 376- WRITE (IOLOG, 3980) 377- ERRCOR = .TRUE. 378- IF (PROBNM .EQ. DBLANK) PROBNM = DOTS 379- GOTO 450 380-C 381-C WE HAVE FOUND THE PROBLEM NAME. DOES IT MATCH? 382-C 383- 155 CONTINUE 384- IF (PROBNM .EQ. DOTS) PROBNM = DNAME(2) 385- IF (DNAME(2) .NE. PROBNM) GOTO 9150 386- IF (NECHO .GE. 2) WRITE (IOLOG, 1200) NREC,Q1,Q2,Q3,Q4, 387- * DNAME(1),DNAME(2) 388- CALL INCORE ( DTIMEC, DTIMER, IROTYP, SIMPLE, PROBNM, 389- * IOBJ1, NPSEEN, IERR, NREC) 390- 391-C ***** PROCESS THE STOCH-FILE ***** 392-C 393- 450 CONTINUE 394- DROW = DBLANK 395- DCOL = DBLANK 396- QTYP = QBL 397- NREALS = 1 398- JNODES = 1 399- IPREV = 1 400- NODES = NPER 401- IIPER = 0 402- IPER0 = 0 403- PROB(1) = 1.0 404- NREC = 0 405- IF (NECHO .GE. 2) WRITE (IOLOG, 1900) 406- 451 CONTINUE 407- READ (IOSTO, 1000, ERR=455, END=455) 408- * Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 409- NREC = NREC + 1 410- IF (Q1 .EQ. QAST) GOTO 451 411- IF (Q1 .EQ. QS .AND. Q2 .EQ. QT) GOTO 452 412- IF (Q1 .EQ. QI .AND. Q2 .EQ. QN) GOTO 460 413- IF (Q1 .EQ. QB .AND. Q2 .EQ. QL) GOTO 470 414- IF (Q1 .EQ. QS .AND. Q2 .EQ. QC) GOTO 480 415- WRITE (IOLOG, 1200) 416- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 417- WRITE (IOLOG, 1600) 418- GOTO 9999 419-C 420- 452 CONTINUE 421- IF (PROBNM .EQ. DOTS) PROBNM = DNAME(2) 422- IF (DNAME(2) .NE. PROBNM) GOTO 9150 423- IF (NECHO .GE. 2) WRITE (IOLOG, 1200) NREC,Q1,Q2,Q3,Q4, 424- * DNAME(1),DNAME(2) 425- GOTO 451 426-C 427-C Error during read or missing STOCH file - Keep going 428-C (This means the problem is assumed to be deterministic) 429-C 430- 455 CONTINUE 431- IF (NREC .GT. 0) WRITE (IOLOG, 1200) 432- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 433- WRITE (IOLOG, 3990) 434- IF (ERRCOR .OR. PROBNM .EQ. DOTS) GOTO 9995 435- IF (NPER .EQ. 0) NPER = 1 436- NODES = NPER 437- GOTO 955 438-C 439-C THE RANDOM ELEMENTS ARE INDEPENDENT 440-C 441- 460 CONTINUE 442- IF (ERRCOR .OR. ERRTIM) GOTO 9995 443- IF (NPSEEN .NE. NPER ) WRITE (IOLOG, 2000) 444- NPER = NPSEEN 445- IF (NECHO .GE. 5 ) WRITE (IOLOG, 1200) 446- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2) 447- IF (DNAME(2) .NE. DISCR ) GOTO 500 448- L = 1 449- CALL INELEM(IROTYP,DTIME,IIPER,IPER0,JNODES,IERR,NREC) 450- GOTO 900 451-C 452-C HERE WE HAVE BLOCK STRUCTURE AND PERIOD-TO-PERIOD INDEPENDENCE 453-C 454- 470 CONTINUE 455- IF (ERRCOR .OR. ERRTIM) GOTO 9995 456- IF (NPSEEN .NE. NPER ) WRITE (IOLOG, 2000) 457- NPER = NPSEEN 458- IF (NECHO .GE. 5 ) WRITE (IOLOG, 1200) 459- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2) 460- IF (DNAME(2) .NE. DISCR ) GOTO 500 461- L = 2 462- CALL INBLOK(IROTYP,DTIME,IIPER,IPER0,JNODES,IERR,NREC) 463- GOTO 900 464-C 465-C TIME DEPENDENCE: SCENARIOS 466-C 467- 480 CONTINUE 468- IF (ERRCOR .OR. ERRTIM) GOTO 9995 469- IF (NPSEEN .NE. NPER ) WRITE (IOLOG, 2000) 470- NPER = NPSEEN 471- IF (NECHO .GE. 5 ) WRITE (IOLOG, 1200) 472- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2) 473- IF (DNAME(2) .NE. DISCR ) GOTO 500 474- L = 3 475- CALL INSCEN(IROTYP,IIPER,IPER0,DTIME,IERR,NREC) 476- GOTO 900 477-C 478-C ONLY DISCRETE DISTRIBUTIONS ARE ALLOWED 479-C 480- 500 CONTINUE 481- WRITE (IOLOG, 2400) 482- GOTO 9999 483-C 484-C END OF INPUT 485-C 486- 900 CONTINUE 487- WRITE (IOLOG, 2100) 488- DO 901 I=1,NPER 489- IRNGE0(I) = I 490- 901 CONTINUE 491-C 492-C NOW LINK TOGETHER ALL NODES OF THE SAME PERIOD 493-C 494- 925 CONTINUE 495- KREF(NPER+1) = NODES + 1 496- IF (IPER0 .EQ. 0) GOTO 951 497- DO 950 IP=IPER0,NPER 498- ISC1 = IRNGE0(IP) 499- 930 CONTINUE 500- IF (IBROTH(ISC1) .EQ. 0) GOTO 940 501- ISC1 = IBROTH(ISC1) 502- GOTO 930 503- 940 CONTINUE 504- IAN = IANCTR(ISC1) 505- IF (IAN .EQ. 0) GOTO 950 506- 942 CONTINUE 507- IBRO = IABS(IBROTH(IAN)) 508- IF (IBRO .EQ. 0) GOTO 950 509- ISC2 = IDESC(IBRO) 510- IF (ISC2 .EQ. 0) GOTO 945 511- IBROTH(ISC1) = -ISC2 512- ISC1 = ISC2 513- GOTO 930 514- 945 CONTINUE 515- IAN = IBRO 516- GOTO 942 517- 950 CONTINUE 518- 951 CONTINUE 519- IF (L .NE. 3) GOTO 955 520-C 521-C FOR SCENARIOS WE HAVE TO FIND CONDITIONAL PROBABILITIES 522-C 523- DO 954 IP=2,NPER 524- ISC1 = IRNGE0(NPER+2-IP) 525- 952 CONTINUE 526- PROB(ISC1) = PROB(ISC1)/PROB(IANCTR(ISC1)) 527- ISC1 = IABS(IBROTH(ISC1)) 528- IF (ISC1 .GT. 0) GOTO 952 529- 954 CONTINUE 530-C 531- 955 CONTINUE 532- DO 960 IP=1,NPER 533- NROWS = NROW(IP) 534- NSCOL = NCOL(IP) - NROWS 535- RELEM = NELMA(KDATA(IP)+1) 536- RDENS = RELEM / (NROWS * NSCOL) 537- IF (NECHO .GE. 2) 538- * WRITE (IOLOG, 1300) IP, NROWS, NSCOL, RDENS 539- 960 CONTINUE 540-C 541- NP1 = IANCTR(NODES) 542- NEXT = NODES + 1 543- NROWS = NROW(NODES) 544- NCOLS = NCOL(NODES) 545- MAXCOL = KCOL(NODES) + NCOLS + 1 546- MAXROW = KROW(NODES) + NROWS 547- NCMAX = MIN( NCMAX, NCOLMX-MAXCOL, NROWMX-MAXROW ) 548- IF (MAXCOL .GE. NCOLMX .OR. MAXROW .GE. NROWMX) GOTO 9200 549- IF (NECHO .GE. 1) WRITE (IOLOG, 1500) NCMAX 550- KCOL(NEXT) = MAXCOL 551- KROW(NEXT) = MAXROW 552- KRHS(NEXT) = LASTR 553- KCOST(NEXT) = LASTC 554- KBOUND(NEXT) = LASTBD 555- KNAMES(NEXT) = KNAMES(NODES) + NCOLS + 1 556- LASTBD = LASTBD + 1 557- XLB(LASTBD) = 0.D0 558- XUB(LASTBD) = 1.D8 559-C 560-C COUNT DESCENDANTS FOR EACH PROBLEM 561-C 562- DO 999 I=1,NODES 563- N0 = 0 564- I0 = IDESC(I) 565- 995 CONTINUE 566- IF (I0 .LE. 0) GOTO 998 567- I0 = IBROTH(I0) 568- N0 = N0 + 1 569- GOTO 995 570- 998 CONTINUE 571- NDESC(I) = N0 572- 999 CONTINUE 573- RETURN 574-C 575-C COME HERE IF ANYTHING WENT WRONG 576-C 577- 9030 CONTINUE 578- WRITE (IOLOG, 1200) 579- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 580- WRITE (IOLOG, 3030) NPMAX 581- GOTO 9999 582-C 583- 9050 CONTINUE 584- WRITE (IOLOG, 1200) 585- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 586- WRITE (IOLOG, 3050) 587- GOTO 9999 588-C 589- 9100 CONTINUE 590- WRITE (IOLOG, 1200) 591- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 592- WRITE (IOLOG, 3100) 593- GOTO 9999 594-C 595- 9150 CONTINUE 596- WRITE (IOLOG, 1200) 597- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 598- WRITE (IOLOG, 3150) 599- GOTO 9999 600-C 601- 9200 CONTINUE 602- WRITE (IOLOG, 1200) 603- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 604- WRITE (IOLOG, 3200) 605- GOTO 9999 606-C 607- 9995 CONTINUE 608- WRITE (IOLOG, 3995) 609- 9999 CONTINUE 610- CALL STOPIT 611-C 612- 1000 FORMAT(4A1,A8,2X,A8,2X,F12.4,3X,A8,2X,F12.4) 613- 1100 FORMAT(/,' Process TIME file:') 614- 1200 FORMAT(I8,4X,4A1,A8,2X,A8,2X,F12.4,3X,A8,2X,F12.4) 615- 1300 FORMAT(' Period',I3,' has',I4,' rows and',I4,' columns.', 616- * ' Density of constraint matrix:',F6.3) 617- 1400 FORMAT(' XXX - FATAL - Illegal record in TIME file') 618- 1500 FORMAT(' There is space for at most',I5,' cuts') 619- 1600 FORMAT(' XXX - FATAL - Illegal record in STOCH file') 620- 1700 FORMAT(' XXX - WARNING - Missing ENDATA card') 621- 1800 FORMAT(/,' Process CORE file:') 622- 1900 FORMAT(/,' Process STOCH file:') 623- 2000 FORMAT(' XXX - WARNING - Number of periods in CORE file does not', 624- * ' match information in TIME file') 625- 2100 FORMAT(' ') 626- 2300 FORMAT(' XXX - FATAL - Illegal record in CORE file') 627- 2400 FORMAT(' XXX - FATAL - Only DISCRETE distributions can be', 628- * ' handled so far.') 629- 2500 FORMAT(I8,4X,' Period ',A8,' - first row ',A8,', first column ', 630- * A8) 631- 2600 FORMAT(' *** Number of periods has been adjusted to',I3,' ***') 632- 2700 FORMAT(I8,4X,4A1,A8,2X,A8) 633- 3030 FORMAT(' XXX - FATAL - Too many periods specified: Use at most', 634- * I4) 635- 3050 FORMAT(' XXX - FATAL - Detected EOF while reading TIME_FILE') 636- 3100 FORMAT(' XXX - FATAL - Simple recourse has not been', 637- * ' implemented') 638- 3150 FORMAT(' XXX - FATAL - Name does not match info in TIME file') 639- 3200 FORMAT(' XXX - FATAL - Global problem dimensions exceed', 640- * ' capacity') 641- 3970 FORMAT(' XXX - WARNING - Error during READ or non-existent TIME', 642- * ' file') 643- 3980 FORMAT(' XXX - WARNING - Error during READ or non-existent CORE', 644- * ' file') 645- 3990 FORMAT(' XXX - WARNING - Error during READ or non-existent STOCH', 646- * ' file') 647- 3995 FORMAT(' XXX - FATAL - Not enough information to solve the', 648- * ' problem') 649- END 650-C 651-C :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: 652-C 653- SUBROUTINE INCORE ( DTIMEC, DTIMER, IROTYP, SIMPLE, PROBNM, 654- * IOBJ1, NPSEEN, IERR, NREC) 655-C 656-C This subroutine reads the core file in the modified MPS format 657-C described in the standards paper. 658-C 659-C --------------------------------------- 660-C This version dated November 3, 1987. 661-C --------------------------------------- 662-C 663- include 'common5.for' 664-C 665- LOGICAL SIMPLE 666- CHARACTER*8 DNAME(3), DROWNM(3000), DBLANK, DSIMPL, 667- * PROBNM, DTIMEC(10), DTIMER(10), DROW, DCOL, DOTS, 668- * DISCR, OBJNAM 669- DIMENSION IROTYP(3000),AUX(3000,10),IAUX(3000,10),LAUX(1000,10), 670- * LMNS(10) 671- EQUIVALENCE (DROWNM,X) 672-C 673- DATA DBLANK/' '/, DSIMPL/'SIMPLE '/, DOTS /' ... '/, 674- * DISCR /'DISCRETE'/ 675-C 676-C INITIALIZE POINTERS 677-C 678- IOBJ = 0 679- IOBJ1 = 0 680- NPSEEN = 1 681- INODE = 1 682- KDATA(1) = 0 683- KCOLA(1) = 0 684- KELMA(1) = 0 685- KBOUND(1) = 0 686- KROW(1) = 0 687- KCOL(1) = 0 688- KRHS(1) = 0 689- KCOST(1) = 0 690- KNAMES(1) = 0 691- IANCTR(1) = 0 692- IBROTH(1) = 0 693- PROB(1) = 1.D0 694- IROW = KROW(1) 695- IRHS = KRHS(1) 696- NROWS = 0 697- MAXROW = 0 698- OBJNAM = DBLANK 699- IENDAT = 0 700-C 701-C Now read the core-file. Start with the ROWS section 702-C 703- 150 CONTINUE 704- READ (IOCOR, 1000, ERR=9980, END=9000) 705- * Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 706- NREC = NREC + 1 707- IF (Q1 .EQ. QBL) GOTO 160 708- IF (Q1 .EQ. QN .AND. Q2 .EQ. QA) GOTO 155 709- IF (Q1 .EQ. QR .AND. Q2 .EQ. QO) GOTO 151 710- IF (Q1 .EQ. QC .AND. Q2 .EQ. QO) GOTO 200 711- IF (Q1 .EQ. QR .AND. Q2 .EQ. QH) GOTO 9300 712- IF (Q1 .EQ. QB) GOTO 9300 713- IF (Q1 .EQ. QR .AND. Q2 .EQ. QA) GOTO 9300 714- IF (Q1 .EQ. QE) GOTO 9300 715- IF (Q1 .EQ. QAST) GOTO 150 716- WRITE (IOLOG, 1300) 717- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 718- WRITE (IOLOG, 2300) 719- GOTO 9999 720-C 721- 151 CONTINUE 722- IENDAT = 1 723- IF (NECHO .GE. 2) WRITE (IOLOG, 1300) 724- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 725- GOTO 150 726-C 727- 155 CONTINUE 728- IF (DNAME(2) .NE. PROBNM) GOTO 9150 729- GOTO 150 730- 160 CONTINUE 731- IF (NECHO .GE. 5) WRITE (IOLOG, 1300) 732- * NREC,Q1,Q2,Q3,Q4,DNAME(1) 733- IF (DNAME(1) .NE. DTIMER(NPSEEN+1)) GOTO 180 734-C 735-C Here we have the first row of a new time period 736-C 737- IF (IOBJ .GT. 0) GOTO 165 738- NROWS = NROWS + 1 739- MAXROW = MAXROW + 1 740- IOBJ = NROWS 741- NROW(INODE) = NROWS 742- NCOL(INODE) = NROWS 743- DROWNM(NROWS) = DROWNM(1) 744- DROWNM(1) = DOTS 745- IROTYP(NROWS) = IROTYP(1) 746- IROTYP(1) = 2 747- 165 CONTINUE 748- NPSEEN = NPSEEN + 1 749- IPREV = INODE 750- INODE = INODE + 1 751- IDESC(IPREV) = INODE 752- IRNGE0(IPREV) = IPREV 753- IRNGE1(IPREV) = IPREV 754- IRNGE2(IPREV) = IPREV 755- IBROTH(INODE) = 0 756- IANCTR(INODE) = IPREV 757- PROB(INODE) = 1.0 758- KROW(INODE) = KROW(IPREV) + NROW(IPREV) 759- KRHS(INODE) = KRHS(IPREV) + NROW(IPREV) 760- IROW = KROW(INODE) 761- DROWNM(IROW+1) = DROWNM(1) 762- IROTYP(IROW+1) = 2 763- NROWS = 1 764-C 765-C Test row type 766-C 767- 180 CONTINUE 768- MAXROW = MAXROW + 1 769- NROWS = NROWS + 1 770- NROW(INODE) = NROWS 771- NCOL(INODE) = NROWS 772- DROWNM(IROW+NROWS) = DNAME(1) 773- IF ( NROWS .GT. NRMAX) GOTO 9100 774- IF ((Q2 .EQ. QG).OR.(Q3 .EQ. QG)) GOTO 185 775- IF ((Q2 .EQ. QL).OR.(Q3 .EQ. QL)) GOTO 186 776- IF ((Q2 .EQ. QN).OR.(Q3 .EQ. QN)) GOTO 187 777- IROTYP(IROW+NROWS) = 0 778- GOTO 150 779- 185 CONTINUE 780- IROTYP(IROW+NROWS) = -1 781- GOTO 150 782- 186 CONTINUE 783- IROTYP(IROW+NROWS) = 1 784- GOTO 150 785- 187 CONTINUE 786- IF (NPSEEN .GT. 1 .OR. IOBJ .GT. 0) GOTO 188 787- IF (DNAME(1) .NE. OBJNAM .AND. OBJNAM .NE. DBLANK) 788- * GOTO 188 789- IOBJ = NROWS 790- IOBJ1 = NROWS 791- IROTYP(NROWS) = IROTYP(1) 792- IROTYP(1) = 2 793- DROWNM(NROWS) = DROWNM(1) 794- DROWNM(1) = DNAME(1) 795- GOTO 150 796- 188 CONTINUE 797- IROTYP(IROW+NROWS) = 2 798- GOTO 150 799-C 800-C Now start the column section 801-C 802- 200 CONTINUE 803- IF (NECHO .GE. 2) WRITE (IOLOG, 1300) 804- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 805- IF (NPSEEN .GT. NPER) GOTO 9200 806- IF (IENDAT .EQ. 0) GOTO 9700 807- IENDAT = 2 808- IDESC(INODE) = 0 809- IBROTH(INODE) = 0 810- IANCTR(INODE) = INODE - 1 811- IRNGE0(NPSEEN) = INODE 812- IRNGE1(NPSEEN) = INODE 813- IRNGE2(NPSEEN) = INODE 814- IPER = 1 815- IOBJ = 1 816- IROW = 0 817- ICOL = 0 818- IRHS = 0 819- INODE = 1 820- ICOLA = 0 821- ICOST = 0 822- IDATA = 0 823- IELMA = 0 824- INAMES = 0 825- IBOUND = 0 826- NROWS = NROW(1) 827- IROW1 = NROWS 828- KMTX = 1 829- DO 201 JR=1,NROWS 830- NAMES(JR) = DROWNM(JR) 831- XLB(JR) = 0.D0 832- XUB(JR) = 1.D8 833- IF (IROTYP(JR) .LE. 0) XUB(JR) = 0.D0 834- IF (IROTYP(JR) .EQ. 2) XLB(JR) =-1.D8 835- IF (IROTYP(JR) .EQ.-1) XLB(JR) =-1.D8 836- 201 CONTINUE 837- NELEM = 0 838- DO 2015 JJ=1,NPMAX 839- LMNS(JJ) = 0 840- 2015 CONTINUE 841-C 842- 202 CONTINUE 843- READ (IOCOR, 1000, ERR=9980, END=9000) 844- * Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 845- NREC = NREC + 1 846- IF (Q1 .EQ. QR .AND. Q2 .EQ. QH) GOTO 260 847- IF (Q1 .EQ. QB .AND. Q2 .EQ. QO) GOTO 270 848- IF (Q1 .EQ. QR .AND. Q2 .EQ. QA) GOTO 280 849- IF (Q1 .EQ. QE ) GOTO 290 850- IF (Q1 .EQ. QBL ) GOTO 205 851- IF (Q1 .EQ. QAST) GOTO 202 852- WRITE (IOLOG, 1300) NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2), 853- * ATEMP1,DNAME(3),ATEMP2 854- WRITE (IOLOG, 2300) 855- GOTO 9999 856-C 857- 205 CONTINUE 858- IF (NECHO .GE. 5) WRITE (IOLOG, 1300) NREC,Q1,Q2,Q3,Q4, 859- * DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 860- JNM = 2 861- IF (DABS(ATEMP1) .GT. ZTOLZE) GOTO 206 862- IF (DABS(ATEMP2) .LE. ZTOLZE) GOTO 202 863- JNM = 3 864- ATEMP1 = ATEMP2 865- 206 CONTINUE 866- IF (DNAME(1) .EQ. DCOL) GO TO 220 867- IF (DNAME(1) .NE. DTIMEC(IPER+1)) GOTO 215 868-C 869-C A NEW PERIOD IS COMING UP. 870-C 871- IF (IPER .GE. NPSEEN) GOTO 9200 872- NCOL(IPER) = NCOLS 873- NELMA(IDATA+1) = NELEM 874- LASTA = LASTA + NELEM 875- LASTCA = LASTCA + NCOLS + 1 -NROW(IPER) 876- IF (IPER .EQ. NPSEEN) GOTO 211 877-C 878-C CHECK IF PROBLEM STILL HAS STAIRCASE STRUCTURE. 879-C 880- NMTX = NPSEEN - IPER 881- DO 210 JMTX=1,NMTX 882- LMNJ = LMNS(JMTX) 883- IF (LMNJ .EQ. 0 .AND. JMTX .GE. 2 .AND. MARKOV) 884- * GOTO 210 885- IF (LMNJ .EQ. 0 .OR. JMTX .LT. 2 .OR. .NOT. MARKOV) 886- * GOTO 2105 887- MARKOV = .FALSE. 888- DO 2101 JAUX = 4,IPER 889- J = IPER + 4 - JAUX 890- KDAT2 = J * (J-1)/2 + 3 891- KDAT1 = J * 2 892- KDATA(J) = KDAT2 893- DO 2100 K=1,2 894- KCOLA(KDAT2-K) = KCOLA(KDAT1-K) 895- KELMA(KDAT2-K) = KELMA(KDAT1-K) 896- NELMA(KDAT2-K) = NELMA(KDAT1-K) 897- KCOLA(KDAT1-K) = 0 898- KELMA(KDAT1-K) = 0 899- NELMA(KDAT1-K) = 0 900- 2100 CONTINUE 901- 2101 CONTINUE 902- DO 2104 JN=1,IPER 903- NCOLA = NCOL(JN) + 1 - NROW(JN) 904- DO 2103 JP=3,NPSEEN+1-JN 905- IF (JN .EQ. IPER .AND. JP .GT. NMTX) 906- * GOTO 2103 907- JAUX = JN + JP - 1 908- JDAT = JAUX*(JAUX-1)/2 + JP 909- KCOLA(JDAT) = LASTCA 910- KELMA(JDAT) = LASTA 911- NELMA(JDAT) = 0 912- DO 2102 JC=1,NCOLA 913- LA(LASTCA+JC) = 1 914- 2102 CONTINUE 915- LASTCA = LASTCA + NCOLA 916- 2103 CONTINUE 917- 2104 CONTINUE 918-C 919-C COPY SUB-DIAGONAL MATRICES OF CURRENT NODE 920-C 921- 2105 CONTINUE 922- JAUX = IPER + JMTX 923- JLOC = JAUX*(JAUX-1)/2 + JMTX + 1 924- IF (MARKOV) JLOC = JAUX*2 + JMTX - 2 925- KCOLA(JLOC) = LASTCA 926- KELMA(JLOC) = LASTA 927- NELMA(JLOC) = LMNJ 928- DO 209 JC=1,NCOLS-NROW(IPER) 929- LL = LAUX(JC,JMTX) 930- KK = LAUX(JC+1,JMTX) - 1 931- LA(LASTCA+JC) = LL 932- DO 208 JR=LL,KK 933- IA(LASTA+JR) = IAUX(JR,JMTX) 934- A(LASTA+JR) = AUX(JR,JMTX) 935- 208 CONTINUE 936- 209 CONTINUE 937- LASTA = LASTA + LMNS(JMTX) 938- LASTCA = LASTCA + NCOLS + 1 - NROW(IPER) 939- LA(LASTCA) = KK + 1 940- 210 CONTINUE 941-C 942-C NOW SET THE POINTER VALUES 943-C 944- 211 CONTINUE 945- NMTX = IPER 946- KMTX = NPSEEN - IPER 947- IF (MARKOV) KMTX = 1 948- IF (MARKOV .AND. IPER .GT. 2) NMTX = 2 949- IPREV = IPER 950- IPER = IPER + 1 951- INODE = INODE + 1 952- IDATA = KDATA(IPREV) + NMTX 953- KCOL(IPER) = KCOL(IPREV) + NCOLS + 1 954- KCOLA(IDATA+1) = LASTCA 955- KCOST(IPER) = KCOST(IPREV) + NCOLS - NROW(IPREV) 956- KELMA(IDATA+1) = LASTA 957- KBOUND(IPER) = KBOUND(IPREV) + NCOLS + 1 958- KNAMES(IPER) = KNAMES(IPREV) + NCOLS + 1 959- KDATA(IPER) = IDATA 960- NELEM = 0 961- DO 2115 JJ=1,NPMAX 962- LMNS(JJ) = 0 963- 2115 CONTINUE 964- ICOL = KCOL(IPER) 965- IROW = KROW(IPER) 966- IRHS = KRHS(IPER) 967- ICOLA = LASTCA 968- ICOST = KCOST(IPER) 969- IELMA = LASTA 970- INAMES = KNAMES(IPER) 971- IBOUND = KBOUND(IPER) 972- NROWS = NROW(IPER) 973- DO 213 JR=1,NROWS 974- NAMES(INAMES+JR) = DROWNM(IROW+JR) 975- XLB(IBOUND+JR) = 0.D0 976- XUB(IBOUND+JR) = 1.D8 977- IF (IROTYP(IROW+JR) .LE. 0) XUB(IBOUND+JR) = 0.D0 978- IF (IROTYP(IROW+JR) .EQ. 2) XLB(IBOUND+JR) =-1.D8 979- IF (IROTYP(IROW+JR) .EQ.-1) XLB(IBOUND+JR) =-1.D8 980- 213 CONTINUE 981-C 982-C START A NEW COLUMN 983-C 984- 215 CONTINUE 985- NCOLS = NCOL(INODE) + 1 986- NCOL(INODE) = NCOLS 987- DCOL = DNAME(1) 988- NAMES(INAMES+NCOLS) = DCOL 989- ICC = ICOLA + NCOLS - NROWS 990- LA(ICC) = NELEM + 1 991- LA(ICC+1) = NELEM + 1 992- IF (NCOLS .GE. NVMAX ) GOTO 9110 993- IF (IPER .EQ. NPSEEN) GOTO 220 994- DO 218 JMTX=1,KMTX 995- LAUX(NCOLS-NROWS, JMTX) = LMNS(JMTX) + 1 996- LAUX(NCOLS-NROWS+1,JMTX) = LMNS(JMTX) + 1 997- 218 CONTINUE 998-C 999-C TEST FOR ROW MATCH 1000-C 1001- 220 CONTINUE 1002- DROW = DNAME(JNM) 1003- DO 230 I=1,NROWS 1004- IF (DROW .EQ. NAMES(INAMES+I)) GOTO 240 1005- 230 CONTINUE 1006- IF (IPER .GE. NPER) GOTO 236 1007- DO 235 JMTX=1,NPER-IPER 1008- JROWS = NROW(IPER+JMTX) 1009- IROW1 = KROW(IPER+JMTX) 1010- DO 235 I=2,JROWS 1011- IF (DROW .EQ. DROWNM(IROW1+I)) GOTO 250 1012- 235 CONTINUE 1013- 236 CONTINUE 1014-C 1015-C PERHAPS WE ARE DEALING WITH AN ALTERNATIVE OBJECTIVE ROW? 1016-C 1017- LROWS = NROW(1) 1018- DO 237 I=1,LROWS 1019- IF (DROW .EQ. NAMES(I) .AND. IROTYP(I) .EQ. 2) GOTO 255 1020- 237 CONTINUE 1021-C 1022- WRITE (IOLOG, 1300) NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2), 1023- * ATEMP1,DNAME(3),ATEMP2 1024- WRITE (IOLOG, 1100) 1025- GOTO 9999 1026-C 1027-C MATCHED A COEFFICIENT IN THE A-MATRIX 1028-C 1029- 240 CONTINUE 1030- IF (I .EQ. IOBJ) GOTO 245 1031- NELEM = NELEM + 1 1032- IA(IELMA+NELEM) = I 1033- A(IELMA+NELEM) = ATEMP1 1034- LA(ICOLA+NCOLS-NROWS+1) = NELEM + 1 1035- GOTO 255 1036-C 1037-C COST COEFFICIENTS (EVEN IF FIXED) ARE NOT STORED IN THE A-MATRIX 1038-C 1039- 245 CONTINUE 1040- COST(ICOST+NCOLS-NROWS) = ATEMP1 1041- GOTO 255 1042-C 1043-C WE HAVE FOUND AN ELEMENT OF THE JMTX-th SUBDIAGONAL MATRIX 1044-C 1045- 250 CONTINUE 1046- IF (JMTX .LE. KMTX) GOTO 253 1047- KMTX = NPSEEN - IPER 1048- DO 252 JJ=2,KMTX 1049- DO 251 JC=1,NCOLS+1-NROWS 1050- LAUX(JC,JJ) = 1 1051- 251 CONTINUE 1052- 252 CONTINUE 1053- 253 CONTINUE 1054- LMNS(JMTX) = LMNS(JMTX) + 1 1055- LAUX(NCOLS+1-NROWS,JMTX) = LMNS(JMTX) + 1 1056- IAUX(LMNS(JMTX), JMTX) = I 1057- AUX(LMNS(JMTX), JMTX) = ATEMP1 1058-C 1059- 255 CONTINUE 1060- IF (JNM .EQ. 3) GOTO 202 1061- IF (DABS(ATEMP2) .LE. ZTOLZE) GOTO 202 1062- JNM = 3 1063- ATEMP1 = ATEMP2 1064- GOTO 220 1065-C 1066-C THE COLUMNS SECTION IS DONE. WHAT IS NEXT? 1067-C 1068- 260 CONTINUE 1069- L = 1 1070- GOTO 300 1071- 270 CONTINUE 1072- L = 2 1073- GOTO 300 1074- 280 CONTINUE 1075- L = 3 1076- GOTO 300 1077- 290 CONTINUE 1078- L = 4 1079-C 1080-C SET RHS AND BOUNDS TO DEFAULT VALUES AND SET INITIAL BASIS 1081-C 1082- 300 CONTINUE 1083- IF (IPER .NE. NPSEEN) GOTO 9200 1084- LASTA = LASTA + NELEM 1085- LASTC = KCOST(IPER) + NCOLS - NROW(IPER) 1086- LASTCA = LASTCA + 1 + NCOLS - NROW(IPER) 1087- LASTR = KRHS(IPER) + NROW(IPER) 1088- LASTBD = KBOUND(IPER) + NCOLS + 1 1089- LASTD = 2 * IPER - 1 1090- IF (.NOT. MARKOV) LASTD = IPER * (IPER+1)/2 1091- IF (IPER .EQ. 1) LASTD = 1 1092- NCOL(IPER) = NCOLS 1093- NELMA(IDATA+1) = NELEM 1094- DEFRHS = 0.D0 1095- DEFLOB = 0.D0 1096- DEFUPB = 99999999. 1097- DO 301 J=1,MAXROW 1098- XI(J) = DEFRHS 1099- 301 CONTINUE 1100- DO 304 IP=1,NPSEEN 1101- MINC = KBOUND(IP) + NROW(IP) + 1 1102- MAXC = KBOUND(IP) + NCOL(IP) 1103- DO 302 J=MINC,MAXC 1104- XLB(J) = DEFLOB 1105- XUB(J) = DEFUPB 1106- 302 CONTINUE 1107- NROWS = NROW(IP) 1108- NCOLS = NCOL(IP) 1109- IROW = KROW(IP) 1110- ICOL = KCOL(IP) 1111- DO 303 I=1,NROWS 1112- JH(IROW+I) = ICOL + I 1113- KINBAS(ICOL+I) = IROW + I 1114- 303 CONTINUE 1115- DO 304 I=NROWS+1,NCOLS+1 1116- KINBAS(ICOL+I) = 0 1117- 304 CONTINUE 1118- IF (L .EQ. 4) GOTO 450 1119- IF (NECHO .GE. 2) WRITE (IOLOG, 1300) NREC,Q1,Q2,Q3,Q4, 1120- * DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 1121-C 1122-C RHS, BOUNDS AND RANGES 1123-C 1124- 305 CONTINUE 1125- IP0 = 1 1126- I0 = 1 1127- 306 CONTINUE 1128- READ (IOCOR, 1000, ERR=9980, END=9000) 1129- * Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 1130- NREC = NREC + 1 1131- IF (Q1 .EQ. QAST) GOTO 306 1132- IF (Q1 .EQ. QE ) GOTO 450 1133- IF (Q1 .EQ. QBL ) GOTO 309 1134- L = 2 1135- IF (Q1 .EQ. QB .AND. Q2 .EQ. QO) GOTO 307 1136- L = 3 1137- IF (Q1 .EQ. QR .AND. Q2 .EQ. QA) GOTO 307 1138- WRITE (IOLOG,1300) 1139- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 1140- WRITE (IOLOG, 2300) 1141- GOTO 9999 1142-C 1143- 307 CONTINUE 1144- IF (NECHO .GE. 2) WRITE (IOLOG, 1300) NREC,Q1,Q2,Q3,Q4, 1145- * DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 1146- GOTO 305 1147-C 1148- 309 CONTINUE 1149- IF (NECHO .GE. 5) WRITE (IOLOG, 1300) NREC,Q1,Q2,Q3,Q4, 1150- * DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 1151- GOTO (310,350,400,450), L 1152-C 1153- 310 CONTINUE 1154- J = 2 1155- IF (DABS(ATEMP1) .GT. ZTOLZE) GOTO 312 1156- IF (DABS(ATEMP2) .LE. ZTOLZE) GOTO 306 1157- J = 3 1158- ATEMP1 = ATEMP2 1159-C 1160-C TEST FOR ROW MATCH 1161-C 1162- 312 CONTINUE 1163- IF (DXI .EQ. DOTS ) DXI = DNAME(1) 1164- IF (DXI .NE. DNAME(1) ) GOTO 306 1165- DROW = DNAME(J) 1166- IP = IP0 1167- DO 318 I=I0,NROW(IP) 1168- IF (DROW .EQ. NAMES(KNAMES(IP)+I)) GOTO 330 1169- 318 CONTINUE 1170- DO 319 I=1,I0 1171- IF (DROW .EQ. NAMES(KNAMES(IP)+I)) GOTO 330 1172- 319 CONTINUE 1173- DO 320 IP=IP0+1,NPER 1174- DO 320 I=1,NROW(IP) 1175- IF (DROW .EQ. NAMES(KNAMES(IP)+I)) GOTO 330 1176- 320 CONTINUE 1177- DO 321 IP=1,NPER 1178- DO 321 I=1,NROW(IP) 1179- IF (DROW .EQ. NAMES(KNAMES(IP)+I)) GOTO 330 1180- 321 CONTINUE 1181- WRITE (IOLOG, 1300) 1182- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 1183- WRITE (IOLOG, 1200) 1184- GOTO 9999 1185-C 1186-C MATCHED 1187-C 1188- 330 CONTINUE 1189- IP0 = IP 1190- I0 = I 1191- XI(KRHS(IP)+I) = ATEMP1 1192- IF (J .EQ. 3) GOTO 306 1193- IF (DABS(ATEMP2) .LE. ZTOLZE) GOTO 306 1194- J = 3 1195- ATEMP1 = ATEMP2 1196- GOTO 312 1197-C 1198-C BOUNDS SECTION. MATCH THE COLUMN NAME. 1199-C 1200- 350 CONTINUE 1201- IF (DBOUND .EQ. DOTS ) DBOUND = DNAME(1) 1202- IF (DBOUND .NE. DNAME(1) ) GOTO 306 1203- DROW = DNAME(2) 1204- IP = IP0 1205- DO 354 I=I0,NCOL(IP) 1206- IF (DROW .EQ. NAMES(KNAMES(IP)+I)) GOTO 360 1207- 354 CONTINUE 1208- DO 355 I=1,I0 1209- IF (DROW .EQ. NAMES(KNAMES(IP)+I)) GOTO 360 1210- 355 CONTINUE 1211- DO 356 IP=IP0+1,NPER 1212- DO 356 I=1,NCOL(IP) 1213- IF (DROW .EQ. NAMES(KNAMES(IP)+I)) GOTO 360 1214- 356 CONTINUE 1215- DO 357 IP=1,NPER 1216- DO 357 I=1,NCOL(IP) 1217- IF (DROW .EQ. NAMES(KNAMES(IP)+I)) GOTO 360 1218- 357 CONTINUE 1219- WRITE (IOLOG, 1300) 1220- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 1221- WRITE (IOLOG, 1200) 1222- GOTO 9999 1223-C 1224-C MATCHED. NOW DETERMINE THE BOUND TYPE 1225-C 1226- 360 CONTINUE 1227- IP0 = IP 1228- I0 = I 1229- IC = KBOUND(IP) + I 1230- IF (Q2 .EQ. QL .AND. Q3 .EQ. QO) GOTO 361 1231- IF (Q2 .EQ. QU .AND. Q3 .EQ. QP) GOTO 366 1232- IF (Q2 .EQ. QF .AND. Q3 .EQ. QX) GOTO 365 1233- IF (Q2 .EQ. QF .AND. Q3 .EQ. QR) GOTO 370 1234- IF (Q2 .EQ. QM .AND. Q3 .EQ. QI) GOTO 368 1235- IF (Q2 .EQ. QP .AND. Q3 .EQ. QL) GOTO 372 1236- WRITE (IOLOG, 1300) 1237- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 1238- WRITE (IOLOG, 1700) 1239- GOTO 9999 1240-C 1241- 361 CONTINUE 1242- XLB(IC) = ATEMP1 1243- GOTO 306 1244- 365 CONTINUE 1245- XLB(IC) = ATEMP1 1246- 366 CONTINUE 1247- XUB(IC) = ATEMP1 1248- GOTO 306 1249- 368 CONTINUE 1250- XLB(IC) = -1.D8 1251- GOTO 306 1252- 370 CONTINUE 1253- XLB(IC) = -1.D8 1254- 372 CONTINUE 1255- XUB(IC) = 1.D8 1256- GOTO 306 1257-C 1258-C RANGES SECTION. MATCH THE ROW NAME. 1259-C 1260- 400 CONTINUE 1261- IF (DRANGE .EQ. DOTS ) DRANGE = DNAME(1) 1262- IF (DRANGE .NE. DNAME(1) ) GOTO 306 1263- J = 2 1264- IF (DABS(ATEMP1) .GT. ZTOLZE) GOTO 412 1265- IF (DABS(ATEMP2) .LE. ZTOLZE) GOTO 306 1266- J = 3 1267- ATEMP1 = ATEMP2 1268-C 1269-C TEST FOR ROW MATCH 1270-C 1271- 412 CONTINUE 1272- DROW = DNAME(J) 1273- IP = IP0 1274- DO 418 I=I0,NROW(IP) 1275- IF (DROW .EQ. NAMES(KNAMES(IP)+I)) GOTO 430 1276- 418 CONTINUE 1277- DO 419 I=1,I0 1278- IF (DROW .EQ. NAMES(KNAMES(IP)+I)) GOTO 430 1279- 419 CONTINUE 1280- DO 420 IP=IP0+1,NPER 1281- DO 420 I=1,NROW(IP) 1282- IF (DROW .EQ. NAMES(KNAMES(IP)+I)) GOTO 430 1283- 420 CONTINUE 1284- DO 421 IP=1,NPER 1285- DO 421 I=1,NROW(IP) 1286- IF (DROW .EQ. NAMES(KNAMES(IP)+I)) GOTO 430 1287- 421 CONTINUE 1288- WRITE (IOLOG, 1300) 1289- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 1290- WRITE (IOLOG, 1200) 1291- GOTO 9999 1292-C 1293-C MATCHED 1294-C 1295- 430 CONTINUE 1296- IP0 = IP 1297- I0 = I 1298- IR = KRHS(IP) + I 1299- IT = IROTYP(IR) 1300- IF (IT .EQ. 1) GOTO 435 1301- IF (IT .EQ. -1) GOTO 440 1302- IF (IT .NE. 0) GOTO 9600 1303- IF (ATEMP1 .GT. 0.) XUB(KBOUND(IP)+I) = ATEMP1 1304- IF (ATEMP1 .LT. 0.) XLB(KBOUND(IP)+I) =-ATEMP1 1305- GOTO 442 1306- 435 CONTINUE 1307- XUB(KBOUND(IP)+I) = DABS(ATEMP1) 1308- GOTO 442 1309- 440 CONTINUE 1310- XLB(KBOUND(IP)+I) = -DABS(ATEMP1) 1311- 442 CONTINUE 1312- IF (J .EQ. 3) GOTO 306 1313- IF (DABS(ATEMP2) .LE. ZTOLZE) GOTO 306 1314- J = 3 1315- ATEMP1 = ATEMP2 1316- GOTO 412 1317-C 1318-C END OF CORE FILE 1319-C 1320- 450 CONTINUE 1321- IF (NECHO .GE. 2) WRITE (IOLOG, 1300) 1322- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 1323- RETURN 1324-C 1325-C COME HERE IF ANYTHING WENT WRONG 1326-C 1327- 9000 CONTINUE 1328- WRITE (IOLOG, 1300) 1329- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 1330- IF (IENDAT .EQ. 0) GOTO 9020 1331- IF (IENDAT .EQ. 1 .OR. NPER .NE. NPSEEN) GOTO 9010 1332- WRITE (IOLOG, 3000) 1333- RETURN 1334-C 1335- 9010 CONTINUE 1336- WRITE (IOLOG, 3010) 1337- GOTO 9999 1338-C 1339- 9020 CONTINUE 1340- IERR = 1 1341- WRITE (IOLOG, 3020) 1342- RETURN 1343-C 1344- 9100 CONTINUE 1345- WRITE (IOLOG, 1300) 1346- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 1347- WRITE (IOLOG, 3100) 1348- GOTO 9999 1349-C 1350- 9110 CONTINUE 1351- WRITE (IOLOG, 1300) 1352- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 1353- WRITE (IOLOG, 3110) 1354- GOTO 9999 1355-C 1356- 9150 CONTINUE 1357- WRITE (IOLOG, 1300) 1358- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 1359- WRITE (IOLOG, 3150) 1360- GOTO 9999 1361-C 1362- 9200 CONTINUE 1363- WRITE (IOLOG, 1300) 1364- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 1365- WRITE (IOLOG, 3200) 1366- GOTO 9999 1367-C 1368- 9300 CONTINUE 1369- WRITE (IOLOG, 1300) 1370- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 1371- WRITE (IOLOG, 3300) 1372- GOTO 9999 1373-C 1374- 9600 CONTINUE 1375- WRITE (IOLOG, 1300) 1376- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 1377- WRITE (IOLOG, 3600) 1378- GOTO 9999 1379-C 1380- 9700 CONTINUE 1381- WRITE (IOLOG, 1300) 1382- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 1383- WRITE (IOLOG, 3700) 1384- GOTO 9999 1385-C 1386- 9980 CONTINUE 1387- WRITE (IOLOG, 3980) 1388- GOTO 9999 1389-C 1390- 9999 CONTINUE 1391- CALL STOPIT 1392-C 1393- 1000 FORMAT(4A1,A8,2X,A8,2X,F12.4,3X,A8,2X,F12.4) 1394- 1100 FORMAT(' XXX - FATAL - Unmatched row and column names') 1395- 1200 FORMAT(' XXX - FATAL - Unmatched variable name in column', 1396- * ' section') 1397- 1300 FORMAT(I8,4X,4A1,A8,2X,A8,2X,F12.4,3X,A8,2X,F12.4) 1398- 1700 FORMAT(' XXX - FATAL - Error in BOUNDS section.') 1399- 2300 FORMAT(' XXX - FATAL - Illegal header card in CORE file') 1400- 3000 FORMAT(' XXX - WARNING - Missing ENDATA card in CORE file') 1401- 3010 FORMAT(' XXX - FATAL - Detected EOF in CORE file') 1402- 3020 FORMAT(' XXX - WARNING - No information in CORE file') 1403- 3100 FORMAT(' XXX - FATAL - Exceeded row capacity for single node') 1404- 3110 FORMAT(' XXX - FATAL - Exceeded column capacity for one node') 1405- 3150 FORMAT(' XXX - FATAL - Duplicate NAME card in core file') 1406- 3200 FORMAT(' XXX - FATAL - Number of periods misspecified in ROWS', 1407- * ' or COLUMNS section') 1408- 3300 FORMAT(' XXX - FATAL - No COLUMNS section specified') 1409- 3450 FORMAT(' XXX - FATAL - Simple recourse not implemented yet') 1410- 3600 FORMAT(' XXX - FATAL - Illegal row type in RANGES section') 1411- 3700 FORMAT(' XXX - FATAL - ROWS section is non-existent') 1412- 3980 FORMAT(' XXX - FATAL - Error while reading CORE_FILE') 1413- END 1414-C 1415-C :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: 1416-C 1417- SUBROUTINE INELEM (IROTYP, DTIME, IIPER, IPER0, JNODES, IERR, 1418- * NREC) 1419-C 1420-C This subroutine reads the stoch file for independent realizations 1421-C of the random variables. It distinguishes between staircase and 1422-C block-triangular problems by means of the logical variable MARKOV. 1423-C This can be set in INCORE, since the sparsity structure is assumed 1424-C to be the same for all scenarios. 1425-C 1426-C ------------------------------- 1427-C Dated April 14, 1988 1428-C ------------------------------- 1429-C 1430- include 'common5.for' 1431-C 1432- CHARACTER*8 DNAME(3), DTIME(10), DBLANK, DSIMPL, DROW, DCOL, 1433- * DOTS, DISCR, DBLOCK 1434- DIMENSION IROTYP(3000), LOC1(2000), LOC2(2000) 1435- EQUIVALENCE (LOC1,X), (LOC2,IE) 1436-C 1437- DATA DBLANK/' '/, DSIMPL/'SIMPLE '/, DOTS /' ... '/, 1438- * DISCR /'DISCRETE'/ 1439-C 1440- DROW = DBLANK 1441- DCOL = DBLANK 1442- QTYP = QBL 1443- NREALS = 1 1444- JNODES = 1 1445- IPREV = 1 1446- NODES = NPER 1447- IIPER = 0 1448- IPER0 = 0 1449- PROB(1) = 1.0 1450-C 1451-C START WITH SOME BOOK-KEEPING AND FIX THE PERIOD 1452-C 1453- 100 CONTINUE 1454- READ (IOSTO, 1000, ERR=9990, END=910) 1455- * Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 1456- NREC = NREC + 1 1457- IF (Q1 .EQ. QAST) GOTO 100 1458- IF (Q1 .EQ. QE ) GOTO 900 1459- IF (Q1 .EQ. QBL ) GOTO 110 1460- WRITE (IOLOG, 1100) 1461- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 1462- WRITE (IOLOG, 1600) 1463- GOTO 9999 1464-C 1465-C First determine the period of this element 1466-C 1467- 110 CONTINUE 1468- IF (NECHO .GE. 5) WRITE (IOLOG, 1100) 1469- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 1470- DO 130 IP=1,NPER 1471- IF (DNAME(3) .EQ. DTIME(IP)) GOTO 140 1472- 130 CONTINUE 1473-C 1474-C Infer the period from the row or column name 1475-C 1476- DBLOCK = DNAME(2) 1477- IF (DBLOCK .EQ. NAMES(1)) DBLOCK = DNAME(1) 1478- DO 138 IP=1,NPER 1479- DO 138 J=1,NCOL(IP) 1480- IF (DBLOCK .EQ. NAMES(KNAMES(IP)+J)) GOTO 140 1481- 138 CONTINUE 1482- GOTO 9875 1483-C 1484-C First realization or repeat? 1485-C 1486- 140 CONTINUE 1487- IF (DNAME(1) .EQ. DCOL .AND. DNAME(2) .EQ. DROW .AND. 1488- * IP .EQ. IIPER) GOTO 160 1489- IF (IP .LT. IIPER) GOTO 9850 1490- DCOL = DNAME(1) 1491- DROW = DNAME(2) 1492- PROB1 = ATEMP2 1493- JNODES = JNODES * NREALS 1494- NREALS = 1 1495- IIPER = IP 1496- NCURR = IRNGE0(IP) 1497- IF (NECHO .GE. 2) WRITE (IOLOG, 1700) 1498- * NREC,NREALS,DROW,DCOL 1499- 150 CONTINUE 1500- PROB(NCURR) = PROB(NCURR) * ATEMP2 1501- NCURR = IABS(IBROTH(NCURR)) 1502- IF (NCURR .GT. 0) GOTO 150 1503- GOTO 300 1504-C 1505-C ANOTHER REALIZATION OF AN ELEMENT DETECTED BEFORE 1506-C 1507- 160 CONTINUE 1508- NREALS = NREALS + 1 1509- NREF = IRNGE0(IP) 1510- NMTX = IP 1511- IF (MARKOV .AND. IP .GT. 2) NMTX = 2 1512- IF (NECHO .GE. 2) WRITE (IOLOG, 1800) NREC,NREALS 1513-C 1514-C Duplicate all the nodes existing in the current period 1515-C 1516- DO 220 I=1,JNODES 1517- REFPRB = PROB(NREF) 1518- IF (NREALS .LE. 2) GOTO 180 1519- DO 170 J=1,NREALS-2 1520- NREF = IABS(IBROTH(NREF)) 1521- 170 CONTINUE 1522- 180 CONTINUE 1523- NCURR = NODES + I 1524- IANCTR(NCURR) = IANCTR(NREF) 1525- IBROTH(NCURR) = IBROTH(NREF) 1526- IBROTH(NREF) = NCURR 1527- PROB(NCURR) = REFPRB * ATEMP2 / PROB1 1528- KROW(NCURR) = KROW(NCURR-1) + NROW(NCURR-1) 1529- KCOL(NCURR) = KCOL(NCURR-1) + NCOL(NCURR-1) + 1 1530- KNAMES(NCURR) = KNAMES(NREF) 1531- KBOUND(NCURR) = KBOUND(NREF) 1532- KCOST(NCURR) = KCOST(NREF) 1533- KDATA(NCURR) = LASTD 1534- KRHS(NCURR) = KRHS(NREF) 1535- NROW(NCURR) = NROW(IP) 1536- NCOL(NCURR) = NCOL(IP) 1537- NTH(NCURR) = NTH(IP) 1538- NCUT(NCURR) = NCUT(IP) 1539- NREF = IABS(IBROTH(NCURR)) 1540- NROWS = NROW(NCURR) 1541- NCOLS = NCOL(NCURR) 1542- ICOL = KCOL(NCURR) 1543- IROW = KROW(NCURR) 1544- LASTD = LASTD + NMTX 1545- KDATC = KDATA(NCURR) 1546- KDATI = KDATA(IP) 1547- DO 190 IMTX=1,NMTX 1548- KCOLA(KDATC+IMTX) = KCOLA(KDATI+IMTX) 1549- KELMA(KDATC+IMTX) = KELMA(KDATI+IMTX) 1550- NELMA(KDATC+IMTX) = NELMA(KDATI+IMTX) 1551- 190 CONTINUE 1552- DO 200 J=1,NROWS 1553- JH(IROW+J) = ICOL + J 1554- KINBAS(ICOL+J) = IROW + J 1555- 200 CONTINUE 1556- DO 210 J=NROWS+1,NCOLS+1 1557- KINBAS(ICOL+J) = 0 1558- 210 CONTINUE 1559- 220 CONTINUE 1560- NODES = NODES + JNODES 1561- IRNGE2(IP) = NODES 1562-C 1563-C Now duplicate the rest of the tree as well 1564-C 1565- DO 290 JP=IP+1,NPER 1566- NREF = IRNGE0(JP) 1567- NMTX = JP 1568- IF (MARKOV .AND. JP .GT. 2) NMTX = 2 1569- DO 280 I=1,JNODES 1570- IF (NREALS .LE. 2) GOTO 240 1571- DO 230 J=1,NREALS-2 1572- NREF = IABS(IBROTH(NREF)) 1573- 230 CONTINUE 1574- 240 CONTINUE 1575- NCURR = NODES + I 1576- NPREV = NCURR - JNODES 1577- IANCTR(NCURR) = NPREV 1578- IDESC(NPREV) = NCURR 1579- IBROTH(NCURR) = IBROTH(NREF) 1580- IBROTH(NREF) = -NCURR 1581- PROB(NCURR) = 1.0 1582- KROW(NCURR) = KROW(NCURR-1) + NROW(NCURR-1) 1583- KCOL(NCURR) = KCOL(NCURR-1) + NCOL(NCURR-1) + 1 1584- KNAMES(NCURR) = KNAMES(NREF) 1585- KBOUND(NCURR) = KBOUND(NREF) 1586- KCOST(NCURR) = KCOST(NREF) 1587- KDATA(NCURR) = LASTD 1588- KRHS(NCURR) = KRHS(NREF) 1589- NROW(NCURR) = NROW(JP) 1590- NCOL(NCURR) = NCOL(JP) 1591- NTH(NCURR) = NTH(JP) 1592- NCUT(NCURR) = NCUT(JP) 1593- NREF = IABS(IBROTH(NCURR)) 1594- NROWS = NROW(NCURR) 1595- NCOLS = NCOL(NCURR) 1596- ICOL = KCOL(NCURR) 1597- IROW = KROW(NCURR) 1598- LASTD = LASTD + NMTX 1599- KDATC = KDATA(NCURR) 1600- KDATI = KDATA(JP) 1601- DO 250 IMTX=1,NMTX 1602- KCOLA(KDATC+IMTX) = KCOLA(KDATI+IMTX) 1603- KELMA(KDATC+IMTX) = KELMA(KDATI+IMTX) 1604- NELMA(KDATC+IMTX) = NELMA(KDATI+IMTX) 1605- 250 CONTINUE 1606- DO 260 J=1,NROWS 1607- JH(IROW+J) = ICOL + J 1608- KINBAS(ICOL+J) = IROW + J 1609- 260 CONTINUE 1610- DO 270 J=NROWS+1,NCOLS+1 1611- KINBAS(ICOL+J) = 0 1612- 270 CONTINUE 1613- 280 CONTINUE 1614- NODES = NODES + JNODES 1615- IRNGE2(JP) = NODES 1616- 290 CONTINUE 1617-C 1618-C DETERMINE THE TYPE OF THE RANDOM ELEMENT AND ITS ROW 1619-C 1620- 300 CONTINUE 1621- DO 310 LP=IP,NPER 1622- DO 310 LROW=1,NCOL(LP) 1623- IF (DROW .EQ. NAMES(KNAMES(LP)+LROW)) GOTO 330 1624- 310 CONTINUE 1625-C 1626- DO 320 I=1,NROW(1) 1627- IF (DROW .EQ. NAMES(I) .AND. IROTYP(I) .EQ. 2) 1628- * GOTO 890 1629- 320 CONTINUE 1630- GOTO 9875 1631-C 1632- 330 CONTINUE 1633- IF (DROW .EQ. NAMES(1)) GOTO 400 1634- IF (DCOL .EQ. DBOUND ) GOTO 600 1635- IF (DCOL .EQ. DRANGE ) GOTO 610 1636- IF (DCOL .EQ. DXI ) GOTO 500 1637- DO 350 JMTX=1,LP 1638- IF (MARKOV .AND. JMTX .GE. 3) GOTO 360 1639- JP = LP + 1 - JMTX 1640- JNAME = KNAMES(JP) + NROW(JP) 1641- DO 340 LCOL=1,NCOL(JP)-NROW(JP) 1642- IF (DCOL .EQ. NAMES(JNAME+LCOL)) GOTO 700 1643- 340 CONTINUE 1644- 350 CONTINUE 1645-C 1646- 360 CONTINUE 1647- LROWS = NROW(1) 1648- DO 370 I=1,LROWS 1649- IF (DROW .EQ. NAMES(I) .AND. IROTYP(I) .EQ. 2) 1650- * GOTO 890 1651- 370 CONTINUE 1652- GOTO 9875 1653-C 1654-C HERE WE HAVE A RANDOM COST COEFFICIENT. COPY INFO IF NECESSARY 1655-C 1656- 400 CONTINUE 1657- DO 410 LP=IP,NPER 1658- JNAME = KNAMES(LP) + NROW(LP) 1659- DO 410 LPOSC=1,NCOL(LP)-NROW(LP) 1660- IF (DCOL .EQ. NAMES(JNAME+LPOSC)) GOTO 420 1661- 410 CONTINUE 1662- WRITE (IOLOG, 1100) NREC,Q1,Q2,Q3,Q4,DNAME(1), 1663- * DNAME(2),ATEMP1,DNAME(3),ATEMP2 1664- WRITE (IOLOG, 2100) 1665- GOTO 9999 1666-C 1667- 420 CONTINUE 1668- IF (NREALS .GT. 1) GOTO 440 1669- NREF = IRNGE0(LP) 1670- DO 430 I=1,JNODES 1671- COST(KCOST(NREF)+LPOSC) = ATEMP1 1672- NREF = IABS(IBROTH(NREF)) 1673- 430 CONTINUE 1674- GOTO 890 1675-C 1676- 440 CONTINUE 1677- NODE0 = NODES - JNODES*(NPER+1-LP) 1678- IF (KCOST(NODE0+1) .NE. KCOST(IRNGE0(LP))) GOTO 480 1679-C 1680-C Copy the cost coefficients 1681-C 1682- NREF = IRNGE0(LP) 1683- NCPD = 0 1684- DO 470 I=1,JNODES 1685- DO 450 JC=1,NCPD 1686- IF (KCOST(NREF) .NE. LOC1(JC)) GOTO 450 1687- KCOST(NODE0+I) = LOC2(JC) 1688- GOTO 465 1689- 450 CONTINUE 1690- NCPD = NCPD + 1 1691- LOC1(NCPD) = KCOST(NREF) 1692- LOC2(NCPD) = LASTC 1693- KCOST(NODE0+I) = LASTC 1694- KCREF = KCOST(NREF) 1695- DO 460 JCOEF=1,NCOL(LP)-NROW(LP) 1696- COST(LASTC+JCOEF) = COST(KCREF+JCOEF) 1697- 460 CONTINUE 1698- COST(LASTC+LPOSC) = ATEMP1 1699- LASTC = LASTC + NCOL(LP) - NROW(LP) 1700- 465 CONTINUE 1701- NREF = IABS(IBROTH(NREF)) 1702- IF (NREF .GT. NODE0) GOTO 465 1703- 470 CONTINUE 1704- GOTO 890 1705-C 1706- 480 CONTINUE 1707- NREF = IRNGE0(LP) 1708- DO 490 I=1,JNODES 1709- COST(KCOST(NODE0+I)+LPOSC) = ATEMP1 1710- 490 CONTINUE 1711- GOTO 890 1712-C 1713-C HERE WE HAVE A RANDOM RHS 1714-C 1715- 500 CONTINUE 1716- IF (NREALS .GT. 1) GOTO 540 1717- NREF = IRNGE0(LP) 1718- DO 530 I=1,JNODES 1719- XI(KRHS(NREF)+LROW) = ATEMP1 1720- NREF = IABS(IBROTH(NREF)) 1721- 530 CONTINUE 1722- GOTO 890 1723-C 1724- 540 CONTINUE 1725- NODE0 = NODES - JNODES*(NPER+1-LP) 1726- IF (KRHS(NODE0+1) .NE. KRHS(IRNGE0(LP))) GOTO 580 1727-C 1728-C Copy the coefficients of the rhs. 1729-C 1730- NREF = IRNGE0(LP) 1731- NCPD = 0 1732- DO 570 I=1,JNODES 1733- DO 550 JC=1,NCPD 1734- IF (KRHS(NREF) .NE. LOC1(JC)) GOTO 550 1735- KRHS(NODE0+I) = LOC2(JC) 1736- GOTO 565 1737- 550 CONTINUE 1738- NCPD = NCPD + 1 1739- LOC1(NCPD) = KRHS(NREF) 1740- LOC2(NCPD) = LASTR 1741- KRHS(NODE0+I) = LASTR 1742- KCREF = KRHS(NREF) 1743- DO 560 JCOEF=1,NROW(LP) 1744- XI(LASTR+JCOEF) = XI(KCREF+JCOEF) 1745- 560 CONTINUE 1746- XI(LASTR+LROW) = ATEMP1 1747- LASTR = LASTR + NROW(LP) 1748- 565 CONTINUE 1749- NREF = IABS(IBROTH(NREF)) 1750- IF (NREF .GT. NODE0) GOTO 565 1751- 570 CONTINUE 1752- GOTO 890 1753-C 1754- 580 CONTINUE 1755- NREF = IRNGE0(LP) 1756- DO 590 I=1,JNODES 1757- XI(KRHS(NODE0+I)+LROW) = ATEMP1 1758- 590 CONTINUE 1759- GOTO 890 1760-C 1761-C RANDOM BOUND ON A DECISION VARIABLE 1762-C 1763- 600 CONTINUE 1764- JL = 0 1765- JU = 0 1766- IF (LROW .LE. NROW(IP)) GOTO 9060 1767- IF (Q3 .EQ. QP .OR. Q3 .EQ. QX) JU = 1 1768- IF (Q3 .EQ. QP .OR. Q3 .EQ. QX) TMPU = ATEMP1 1769- IF (Q3 .EQ. QO .OR. Q3 .EQ. QX) JL = 1 1770- IF (Q3 .EQ. QO .OR. Q3 .EQ. QX) TMPL = ATEMP1 1771- IF (Q3 .EQ. QR .OR. Q3 .EQ. QL) JU = 1 1772- IF (Q3 .EQ. QR .OR. Q3 .EQ. QL) TMPU = 1.D8 1773- IF (Q3 .EQ. QL .OR. Q3 .EQ. QI) JL = 1 1774- IF (Q3 .EQ. QL .OR. Q3 .EQ. QI) TMPL = -1.D8 1775- GOTO 620 1776-C 1777-C STOCHASTIC RANGE FOR ONE OF THE ROWS 1778-C 1779- 610 CONTINUE 1780- JL = 0 1781- JU = 0 1782- IT = IROTYP(KRHS(IP) + LROW) 1783- IF (IT .EQ. -1) GOTO 617 1784- IF (IT .EQ. 1) GOTO 616 1785- IF (IT .NE. 0) GOTO 9070 1786- IF (ATEMP1 .GT. 0.0) GOTO 615 1787- JL = 1 1788- TMPL = ATEMP1 1789- GOTO 620 1790- 615 CONTINUE 1791- JU = 1 1792- TMPU = ATEMP1 1793- GOTO 620 1794- 616 CONTINUE 1795- JU = 1 1796- TMPU = DABS(ATEMP1) 1797- GOTO 620 1798- 617 CONTINUE 1799- JL = 1 1800- TMPL = -DABS(ATEMP1) 1801-C 1802-C Store the coefficients in arrays XLB and XUB. 1803-C 1804- 620 CONTINUE 1805- IF (NREALS .GT. 1) GOTO 640 1806- NREF = IRNGE0(LP) 1807- DO 630 I=1,JNODES 1808- IF (JL .EQ. 1) XLB(KBOUND(NREF)+LROW) = TMPL 1809- IF (JU .EQ. 1) XUB(KBOUND(NREF)+LROW) = TMPU 1810- NREF = IABS(IBROTH(NREF)) 1811- 630 CONTINUE 1812- GOTO 890 1813-C 1814- 640 CONTINUE 1815- NODE0 = NODES - JNODES*(NPER+1-LP) 1816- IF (KBOUND(NODE0+1) .NE. KBOUND(IRNGE0(LP))) 1817- * GOTO 680 1818-C 1819-C Copy the bounds. 1820-C 1821- NREF = IRNGE0(LP) 1822- NCPD = 0 1823- DO 670 I=1,JNODES 1824- DO 650 JC=1,NCPD 1825- IF (KBOUND(NREF) .NE. LOC1(JC)) GOTO 650 1826- KBOUND(NODE0+I) = LOC2(JC) 1827- GOTO 665 1828- 650 CONTINUE 1829- NCPD = NCPD + 1 1830- LOC1(NCPD) = KBOUND(NREF) 1831- LOC2(NCPD) = LASTBD 1832- KBOUND(NODE0+I) = LASTBD 1833- KCREF = KBOUND(NREF) 1834- DO 660 JCOEF=1,NCOL(LP)+1 1835- XLB(LASTBD+JCOEF) = XLB(KCREF+JCOEF) 1836- XLB(LASTBD+JCOEF) = XLB(KCREF+JCOEF) 1837- 660 CONTINUE 1838- IF (JL .EQ. 1) XLB(LASTBD+LROW) = TMPL 1839- IF (JU .EQ. 1) XUB(LASTBD+LROW) = TMPU 1840- LASTBD = LASTBD + NCOL(LP) + 1 1841- 665 CONTINUE 1842- NREF = IABS(IBROTH(NREF)) 1843- IF (NREF .GT. NODE0) GOTO 665 1844- 670 CONTINUE 1845- GOTO 890 1846-C 1847- 680 CONTINUE 1848- NREF = IRNGE0(LP) 1849- DO 690 I=1,JNODES 1850- IF (JL .EQ. 1) XLB(KBOUND(NODE0+I)+LROW) = TMPL 1851- IF (JU .EQ. 1) XUB(KBOUND(NODE0+I)+LROW) = TMPU 1852- 690 CONTINUE 1853- GOTO 890 1854-C 1855-C HERE WE HAVE A RANDOM COEFFICIENT IN THE CONSTRAINT MATRIX 1856-C 1857- 700 CONTINUE 1858- IASTO(LP,JMTX) = 1 1859- JELMA = KELMA(KDATA(LP)+JMTX) 1860- LL = LA(KCOLA(KDATA(LP)+JMTX)+LCOL) 1861- KK = LA(KCOLA(KDATA(LP)+JMTX)+LCOL+1) - 1 1862- DO 710 LPOSA=LL,KK 1863- IF (IA(JELMA+LPOSA) .EQ. LROW) GOTO 720 1864- 710 CONTINUE 1865- WRITE (IOLOG, 1100) NREC,Q1,Q2,Q3,Q4,DNAME(1), 1866- * DNAME(2),ATEMP1,DNAME(3),ATEMP2 1867- WRITE (IOLOG, 2200) 1868- GOTO 9999 1869-C 1870- 720 CONTINUE 1871- IF (NREALS .GT. 1) GOTO 740 1872- NREF = IRNGE0(LP) 1873- DO 730 I=1,JNODES 1874- A(KELMA(KDATA(NREF)+JMTX)+LPOSA) = ATEMP1 1875- NREF = IABS(IBROTH(NREF)) 1876- 730 CONTINUE 1877- GOTO 890 1878-C 1879- 740 CONTINUE 1880- NODE0 = NODES - JNODES*(NPER+1-LP) 1881- IAREF = KDATA(IRNGE0(LP)) + JMTX 1882- IACUR = KDATA(NODE0+1) + JMTX 1883- IF (KELMA(IACUR) .NE. KELMA(IAREF)) GOTO 780 1884-C 1885-C Copy the A coefficients 1886-C 1887- NREF = IRNGE0(LP) 1888- NCPD = 0 1889- DO 770 I=1,JNODES 1890- DO 750 JC=1,NCPD 1891- IAREF = KDATA(NREF) + JMTX 1892- IF (KELMA(IAREF) .NE. LOC1(JC)) GOTO 750 1893- KELMA(KDATA(NODE0+I)+JMTX) = LOC2(JC) 1894- GOTO 765 1895- 750 CONTINUE 1896- NCPD = NCPD + 1 1897- LOC1(NCPD) = KELMA(KDATA(NREF)+JMTX) 1898- LOC2(NCPD) = LASTA 1899- KELMA(KDATA(NODE0+I)+JMTX) = LASTA 1900- KCREF = KELMA(KDATA(NREF)+JMTX) 1901- NELMS = NELMA(KDATA(NREF)+JMTX) 1902- DO 760 JCOEF=1,NELMS 1903- A(LASTA+JCOEF) = A(KCREF+JCOEF) 1904- IA(LASTA+JCOEF) = IA(KCREF+JCOEF) 1905- 760 CONTINUE 1906- A(LASTA+LPOSA) = ATEMP1 1907- LASTA = LASTA + NELMS 1908- 765 CONTINUE 1909- NREF = IABS(IBROTH(NREF)) 1910- IF (NREF .GT. NODE0) GOTO 765 1911- 770 CONTINUE 1912- GOTO 890 1913-C 1914- 780 CONTINUE 1915- NREF = IRNGE0(LP) 1916- DO 790 I=1,JNODES 1917- A(KELMA(KDATA(NODE0+I)+JMTX)+LPOSA) = ATEMP1 1918- 790 CONTINUE 1919-C 1920-C ONLY ONE ELEMENT PER RECORD. GET THE NEXT CASE. 1921-C 1922- 890 CONTINUE 1923- GOTO 100 1924-C 1925-C Have found an ENDATA card 1926-C 1927- 900 CONTINUE 1928- JNODES = JNODES * NREALS 1929- IF (NECHO .GE. 2) WRITE (IOLOG, 1100) 1930- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 1931- RETURN 1932-C 1933- 910 CONTINUE 1934- JNODES = JNODES * NREALS 1935- WRITE (IOLOG, 1100) 1936- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 1937- WRITE (IOLOG, 1200) 1938- RETURN 1939-C 1940-C COME HERE IF ANYTHING WENT WRONG 1941-C 1942- 9060 CONTINUE 1943- WRITE (IOLOG, 1100) 1944- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 1945- WRITE (IOLOG, 3060) 1946- GOTO 9999 1947-C 1948- 9070 CONTINUE 1949- WRITE (IOLOG, 1100) 1950- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 1951- WRITE (IOLOG, 3070) 1952- GOTO 9999 1953-C 1954- 9850 CONTINUE 1955- WRITE (IOLOG, 1100) 1956- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 1957- WRITE (IOLOG, 3850) 1958- GOTO 9999 1959-C 1960- 9875 CONTINUE 1961- WRITE (IOLOG, 1100) 1962- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 1963- WRITE (IOLOG, 3875) 1964- GOTO 9999 1965-C 1966- 9990 CONTINUE 1967- WRITE (IOLOG, 1100) 1968- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 1969- WRITE (IOLOG, 3990) 1970- 9999 CONTINUE 1971- CALL STOPIT 1972-C 1973- 1000 FORMAT(4A1,A8,2X,A8,2X,F12.4,3X,A8,2X,F12.4) 1974- 1100 FORMAT(I8,4X,4A1,A8,2X,A8,2X,F12.4,3X,A8,2X,F12.4) 1975- 1200 FORMAT(' XXX - WARNING - Missing ENDATA card') 1976- 1600 FORMAT(' XXX - FATAL - Illegal header card in STOCH file') 1977- 1700 FORMAT(I8,4X,' Found realization number',I4,' in location ',A8, 1978- * ' - ',A8) 1979- 1800 FORMAT(I8,4X,' Found realization number',I4) 1980- 1900 FORMAT(' XXX - FATAL - Illegal type of random element') 1981- 2100 FORMAT(' XXX - FATAL - Unmatched variable name') 1982- 2200 FORMAT(' XXX - FATAL - Location of random element undefined') 1983- 3060 FORMAT(' XXX - FATAL - Attempt to set explicit bound on logical' 1984- * ,' variable') 1985- 3070 FORMAT(' XXX - FATAL - Illegal row type in stochastic RANGES', 1986- * ' section') 1987- 3850 FORMAT(' XXX - FATAL - Chronological order violated for random', 1988- * ' elements') 1989- 3875 FORMAT(' XXX - FATAL - Illegal type of random element') 1990- 3990 FORMAT(' XXX - FATAL - Error while reading STOCH_FILE') 1991- END 1992-C 1993-C :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: 1994-C 1995- SUBROUTINE INBLOK (IROTYP, DTIME, IIPER, IPER0, JNODES, IERR, 1996- * NREC) 1997-C 1998-C This subroutine reads BLOCK structure, both for staircase and 1999-C full block-triangular problems. 2000-C 2001-C ----------------------------------- 2002-C | Version of January 28, 1988 | 2003-C ----------------------------------- 2004-C 2005- include 'common5.for' 2006-C 2007- CHARACTER*8 DNAME(3), DTIME(10), DBLANK, DSIMPL, DROW, DCOL, 2008- * DOTS, DISCR, DBLOCK 2009- DIMENSION IROTYP(3000), LOC1(2000), LOC2(2000) 2010- EQUIVALENCE (LOC1,X), (LOC2,IE) 2011-C 2012- DATA DBLANK/' '/, DSIMPL/'SIMPLE '/, DOTS /' ... '/, 2013- * DISCR /'DISCRETE'/ 2014-C 2015- DROW = DBLANK 2016- DCOL = DBLANK 2017- QTYP = QBL 2018- NREALS = 1 2019- JNODES = 1 2020- IPREV = 1 2021- NODES = NPER 2022- IIPER = 0 2023- IPER0 = 0 2024- PROB(1) = 1.0 2025-C 2026-C START WITH SOME BOOK-KEEPING AND FIX THE PERIOD 2027-C 2028- 100 CONTINUE 2029- READ (IOSTO, 1000, ERR=9990, END=910) 2030- * Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 2031- NREC = NREC + 1 2032- IF (Q1 .EQ. QAST) GOTO 100 2033- IF (Q1 .EQ. QE ) GOTO 900 2034- IF (Q1 .EQ. QBL ) GOTO 110 2035- WRITE (IOLOG, 1100) 2036- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 2037- WRITE (IOLOG, 1600) 2038- GOTO 9999 2039-C 2040- 110 CONTINUE 2041- IF (Q2 .EQ. QB .AND. Q3 .EQ. QL) GOTO 120 2042- IF (NECHO .GE. 5) WRITE (IOLOG, 1100) NREC,Q1,Q2,Q3,Q4, 2043- * DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 2044- DCOL = DNAME(1) 2045- DROW = DNAME(2) 2046- GOTO 300 2047-C 2048- 120 CONTINUE 2049- IF (DNAME(1) .EQ. DBLOCK) GOTO 160 2050-C 2051-C Another BL card has been detected. Find period of this block 2052-C 2053- DBLOCK = DNAME(1) 2054- DO 130 IP=1,NPER 2055- IF (DNAME(2) .EQ. DTIME(IP)) GOTO 140 2056- 130 CONTINUE 2057- WRITE (IOLOG, 1100) NREC,Q1,Q2,Q3,Q4,DNAME(1), 2058- * DNAME(2),ATEMP1,DNAME(3),ATEMP2 2059- WRITE (IOLOG, 2000) 2060- GOTO 9999 2061-C 2062-C First realization of a new block 2063-C 2064- 140 CONTINUE 2065- IF (IP .LT. IIPER) GOTO 9850 2066- PROB1 = ATEMP1 2067- JNODES = JNODES * NREALS 2068- NREALS = 1 2069- IIPER = IP 2070- NCURR = IRNGE0(IP) 2071- IF (NECHO .LT. 2) GOTO 150 2072- IF (NECHO .LT. 5) WRITE (IOLOG, 1700) 2073- * NREC, NREALS, DBLOCK 2074- IF (NECHO .GE. 5) WRITE (IOLOG, 1300) 2075- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),DNAME(3),NREALS 2076- 150 CONTINUE 2077- PROB(NCURR) = PROB(NCURR) * ATEMP1 2078- NCURR = IABS(IBROTH(NCURR)) 2079- IF (NCURR .GT. 0) GOTO 150 2080- GOTO 100 2081-C 2082-C ANOTHER REALIZATION OF A BLOCK DETECTED BEFORE 2083-C 2084- 160 CONTINUE 2085- NREALS = NREALS + 1 2086- NREF = IRNGE0(IP) 2087- NMTX = IP 2088- IF (MARKOV .AND. IP .GT. 2) NMTX = 2 2089- IF (NECHO .LT. 2) GOTO 165 2090- IF (NECHO .LT. 5) WRITE (IOLOG, 1800) NREC,NREALS 2091- IF (NECHO .GE. 5) WRITE (IOLOG, 1300) 2092- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),DNAME(3),NREALS 2093-C 2094-C Duplicate all the nodes existing in the current period 2095-C 2096- 165 CONTINUE 2097- DO 220 I=1,JNODES 2098- REFPRB = PROB(NREF) 2099- IF (NREALS .LE. 2) GOTO 180 2100- DO 170 J=1,NREALS-2 2101- NREF = IABS(IBROTH(NREF)) 2102- 170 CONTINUE 2103- 180 CONTINUE 2104- NCURR = NODES + I 2105- IANCTR(NCURR) = IANCTR(NREF) 2106- IBROTH(NCURR) = IBROTH(NREF) 2107- IBROTH(NREF) = NCURR 2108- PROB(NCURR) = REFPRB * ATEMP1 / PROB1 2109- KROW(NCURR) = KROW(NCURR-1) + NROW(NCURR-1) 2110- KCOL(NCURR) = KCOL(NCURR-1) + NCOL(NCURR-1) + 1 2111- KNAMES(NCURR) = KNAMES(NREF) 2112- KBOUND(NCURR) = KBOUND(NREF) 2113- KCOST(NCURR) = KCOST(NREF) 2114- KDATA(NCURR) = LASTD 2115- KRHS(NCURR) = KRHS(NREF) 2116- NROW(NCURR) = NROW(IP) 2117- NCOL(NCURR) = NCOL(IP) 2118- NTH(NCURR) = NTH(IP) 2119- NCUT(NCURR) = NCUT(IP) 2120- NREF = IABS(IBROTH(NCURR)) 2121- NROWS = NROW(NCURR) 2122- NCOLS = NCOL(NCURR) 2123- ICOL = KCOL(NCURR) 2124- IROW = KROW(NCURR) 2125- LASTD = LASTD + NMTX 2126- KDATC = KDATA(NCURR) 2127- KDATI = KDATA(IP) 2128- DO 190 IMTX=1,NMTX 2129- KCOLA(KDATC+IMTX) = KCOLA(KDATI+IMTX) 2130- KELMA(KDATC+IMTX) = KELMA(KDATI+IMTX) 2131- NELMA(KDATC+IMTX) = NELMA(KDATI+IMTX) 2132- 190 CONTINUE 2133- DO 200 J=1,NROWS 2134- JH(IROW+J) = ICOL + J 2135- KINBAS(ICOL+J) = IROW + J 2136- 200 CONTINUE 2137- DO 210 J=NROWS+1,NCOLS+1 2138- KINBAS(ICOL+J) = 0 2139- 210 CONTINUE 2140- 220 CONTINUE 2141- NODES = NODES + JNODES 2142- IRNGE2(IP) = NODES 2143-C 2144-C Now duplicate the rest of the tree as well 2145-C 2146- DO 290 JP=IP+1,NPER 2147- NREF = IRNGE0(JP) 2148- NMTX = JP 2149- IF (MARKOV .AND. JP .GT. 2) NMTX = 2 2150- DO 280 I=1,JNODES 2151- IF (NREALS .LE. 2) GOTO 240 2152- DO 230 J=1,NREALS-2 2153- NREF = IABS(IBROTH(NREF)) 2154- 230 CONTINUE 2155- 240 CONTINUE 2156- NCURR = NODES + I 2157- NPREV = NCURR - JNODES 2158- IANCTR(NCURR) = NPREV 2159- IDESC(NPREV) = NCURR 2160- IBROTH(NCURR) = IBROTH(NREF) 2161- IBROTH(NREF) = -NCURR 2162- PROB(NCURR) = 1.0 2163- KROW(NCURR) = KROW(NCURR-1) + NROW(NCURR-1) 2164- KCOL(NCURR) = KCOL(NCURR-1) + NCOL(NCURR-1) + 1 2165- KNAMES(NCURR) = KNAMES(NREF) 2166- KBOUND(NCURR) = KBOUND(NREF) 2167- KCOST(NCURR) = KCOST(NREF) 2168- KDATA(NCURR) = LASTD 2169- KRHS(NCURR) = KRHS(NREF) 2170- NROW(NCURR) = NROW(JP) 2171- NCOL(NCURR) = NCOL(JP) 2172- NTH(NCURR) = NTH(JP) 2173- NCUT(NCURR) = NCUT(JP) 2174- NREF = IABS(IBROTH(NCURR)) 2175- NROWS = NROW(NCURR) 2176- NCOLS = NCOL(NCURR) 2177- ICOL = KCOL(NCURR) 2178- IROW = KROW(NCURR) 2179- LASTD = LASTD + NMTX 2180- KDATC = KDATA(NCURR) 2181- KDATI = KDATA(JP) 2182- DO 250 IMTX=1,NMTX 2183- KCOLA(KDATC+IMTX) = KCOLA(KDATI+IMTX) 2184- KELMA(KDATC+IMTX) = KELMA(KDATI+IMTX) 2185- NELMA(KDATC+IMTX) = NELMA(KDATI+IMTX) 2186- 250 CONTINUE 2187- DO 260 J=1,NROWS 2188- JH(IROW+J) = ICOL + J 2189- KINBAS(ICOL+J) = IROW + J 2190- 260 CONTINUE 2191- DO 270 J=NROWS+1,NCOLS+1 2192- KINBAS(ICOL+J) = 0 2193- 270 CONTINUE 2194- 280 CONTINUE 2195- NODES = NODES + JNODES 2196- IRNGE2(JP) = NODES 2197- 290 CONTINUE 2198- GOTO 100 2199-C 2200-C DETERMINE THE TYPE OF THE RANDOM ELEMENT AND ITS ROW 2201-C 2202- 300 CONTINUE 2203- DO 310 LP=IP,NPER 2204- DO 310 LROW=1,NCOL(LP) 2205- IF (DROW .EQ. NAMES(KNAMES(LP)+LROW)) GOTO 330 2206- 310 CONTINUE 2207-C 2208- DO 320 I=1,NROW(1) 2209- IF (DROW .EQ. NAMES(I) .AND. IROTYP(I) .EQ. 2) 2210- * GOTO 890 2211- 320 CONTINUE 2212- WRITE (IOLOG, 1100) NREC,Q1,Q2,Q3,Q4,DNAME(1), 2213- * DNAME(2),ATEMP1,DNAME(3),ATEMP2 2214- WRITE (IOLOG, 1900) 2215- GOTO 9999 2216-C 2217- 330 CONTINUE 2218- IF (DROW .EQ. NAMES(1)) GOTO 400 2219- IF (DCOL .EQ. DBOUND ) GOTO 600 2220- IF (DCOL .EQ. DRANGE ) GOTO 610 2221- IF (DCOL .EQ. DXI ) GOTO 500 2222- DO 350 JMTX=1,LP 2223- IF (MARKOV .AND. JMTX .GE. 3) GOTO 360 2224- JP = LP + 1 - JMTX 2225- JNAME = KNAMES(JP) + NROW(JP) 2226- DO 340 LCOL=1,NCOL(JP)-NROW(JP) 2227- IF (DCOL .EQ. NAMES(JNAME+LCOL)) GOTO 700 2228- 340 CONTINUE 2229- 350 CONTINUE 2230-C 2231- 360 CONTINUE 2232- LROWS = NROW(1) 2233- DO 370 I=1,LROWS 2234- IF (DROW .EQ. NAMES(I) .AND. IROTYP(I) .EQ. 2) 2235- * GOTO 890 2236- 370 CONTINUE 2237- GOTO 9875 2238-C 2239-C HERE WE HAVE A RANDOM COST COEFFICIENT. COPY INFO IF NECESSARY 2240-C 2241- 400 CONTINUE 2242- DO 410 LP=IP,NPER 2243- JNAME = KNAMES(LP) + NROW(LP) 2244- DO 410 LPOSC=1,NCOL(LP)-NROW(LP) 2245- IF (DCOL .EQ. NAMES(JNAME+LPOSC)) GOTO 420 2246- 410 CONTINUE 2247- WRITE (IOLOG, 1100) NREC,Q1,Q2,Q3,Q4,DNAME(1), 2248- * DNAME(2),ATEMP1,DNAME(3),ATEMP2 2249- WRITE (IOLOG, 2100) 2250- GOTO 9999 2251-C 2252- 420 CONTINUE 2253- IF (NREALS .GT. 1) GOTO 440 2254- NREF = IRNGE0(LP) 2255- DO 430 I=1,JNODES 2256- COST(KCOST(NREF)+LPOSC) = ATEMP1 2257- NREF = IABS(IBROTH(NREF)) 2258- 430 CONTINUE 2259- GOTO 890 2260-C 2261- 440 CONTINUE 2262- NODE0 = NODES - JNODES*(NPER+1-LP) 2263- IF (KCOST(NODE0+1) .NE. KCOST(IRNGE0(LP))) GOTO 480 2264-C 2265-C Copy the cost coefficients 2266-C 2267- NREF = IRNGE0(LP) 2268- NCPD = 0 2269- DO 470 I=1,JNODES 2270- DO 450 JC=1,NCPD 2271- IF (KCOST(NREF) .NE. LOC1(JC)) GOTO 450 2272- KCOST(NODE0+I) = LOC2(JC) 2273- GOTO 465 2274- 450 CONTINUE 2275- NCPD = NCPD + 1 2276- LOC1(NCPD) = KCOST(NREF) 2277- LOC2(NCPD) = LASTC 2278- KCOST(NODE0+I) = LASTC 2279- KCREF = KCOST(NREF) 2280- DO 460 JCOEF=1,NCOL(LP)-NROW(LP) 2281- COST(LASTC+JCOEF) = COST(KCREF+JCOEF) 2282- 460 CONTINUE 2283- COST(LASTC+LPOSC) = ATEMP1 2284- LASTC = LASTC + NCOL(LP) - NROW(LP) 2285- 465 CONTINUE 2286- NREF = IABS(IBROTH(NREF)) 2287- IF (NREF .GT. NODE0) GOTO 465 2288- 470 CONTINUE 2289- GOTO 890 2290-C 2291- 480 CONTINUE 2292- NREF = IRNGE0(LP) 2293- DO 490 I=1,JNODES 2294- COST(KCOST(NODE0+I)+LPOSC) = ATEMP1 2295- 490 CONTINUE 2296- GOTO 890 2297-C 2298-C HERE WE HAVE A RANDOM RHS 2299-C 2300- 500 CONTINUE 2301- IF (NREALS .GT. 1) GOTO 540 2302- NREF = IRNGE0(LP) 2303- DO 530 I=1,JNODES 2304- XI(KRHS(NREF)+LROW) = ATEMP1 2305- NREF = IABS(IBROTH(NREF)) 2306- 530 CONTINUE 2307- GOTO 890 2308-C 2309- 540 CONTINUE 2310- NODE0 = NODES - JNODES*(NPER+1-LP) 2311- IF (KRHS(NODE0+1) .NE. KRHS(IRNGE0(LP))) GOTO 580 2312-C 2313-C Copy the coefficients of the rhs. 2314-C 2315- NREF = IRNGE0(LP) 2316- NCPD = 0 2317- DO 570 I=1,JNODES 2318- DO 550 JC=1,NCPD 2319- IF (KRHS(NREF) .NE. LOC1(JC)) GOTO 550 2320- KRHS(NODE0+I) = LOC2(JC) 2321- GOTO 565 2322- 550 CONTINUE 2323- NCPD = NCPD + 1 2324- LOC1(NCPD) = KRHS(NREF) 2325- LOC2(NCPD) = LASTR 2326- KRHS(NODE0+I) = LASTR 2327- KCREF = KRHS(NREF) 2328- DO 560 JCOEF=1,NROW(LP) 2329- XI(LASTR+JCOEF) = XI(KCREF+JCOEF) 2330- 560 CONTINUE 2331- XI(LASTR+LROW) = ATEMP1 2332- LASTR = LASTR + NROW(LP) 2333- 565 CONTINUE 2334- NREF = IABS(IBROTH(NREF)) 2335- IF (NREF .GT. NODE0) GOTO 565 2336- 570 CONTINUE 2337- GOTO 890 2338-C 2339- 580 CONTINUE 2340- NREF = IRNGE0(LP) 2341- DO 590 I=1,JNODES 2342- XI(KRHS(NODE0+I)+LROW) = ATEMP1 2343- 590 CONTINUE 2344- GOTO 890 2345-C 2346-C RANDOM BOUND ON A DECISION VARIABLE 2347-C 2348- 600 CONTINUE 2349- JL = 0 2350- JU = 0 2351- IF (LROW .LE. NROW(IP)) GOTO 9060 2352- IF (Q3 .EQ. QP .OR. Q3 .EQ. QX) JU = 1 2353- IF (Q3 .EQ. QP .OR. Q3 .EQ. QX) TMPU = ATEMP1 2354- IF (Q3 .EQ. QO .OR. Q3 .EQ. QX) JL = 1 2355- IF (Q3 .EQ. QO .OR. Q3 .EQ. QX) TMPL = ATEMP1 2356- IF (Q3 .EQ. QR .OR. Q3 .EQ. QL) JU = 1 2357- IF (Q3 .EQ. QR .OR. Q3 .EQ. QL) TMPU = 1.D8 2358- IF (Q3 .EQ. QL .OR. Q3 .EQ. QI) JL = 1 2359- IF (Q3 .EQ. QL .OR. Q3 .EQ. QI) TMPL = -1.D8 2360- GOTO 620 2361-C 2362-C STOCHASTIC RANGE FOR ONE OF THE ROWS 2363-C 2364- 610 CONTINUE 2365- JL = 0 2366- JU = 0 2367- IT = IROTYP(KRHS(IP) + LROW) 2368- IF (IT .EQ. -1) GOTO 617 2369- IF (IT .EQ. 1) GOTO 616 2370- IF (IT .NE. 0) GOTO 9070 2371- IF (ATEMP1 .GT. 0.0) GOTO 615 2372- JL = 1 2373- TMPL = ATEMP1 2374- GOTO 620 2375- 615 CONTINUE 2376- JU = 1 2377- TMPU = ATEMP1 2378- GOTO 620 2379- 616 CONTINUE 2380- JU = 1 2381- TMPU = DABS(ATEMP1) 2382- GOTO 620 2383- 617 CONTINUE 2384- JL = 1 2385- TMPL = -DABS(ATEMP1) 2386-C 2387-C Store the coefficients in arrays XLB and XUB. 2388-C 2389- 620 CONTINUE 2390- IF (NREALS .GT. 1) GOTO 640 2391- NREF = IRNGE0(LP) 2392- DO 630 I=1,JNODES 2393- IF (JL .EQ. 1) XLB(KBOUND(NREF)+LROW) = TMPL 2394- IF (JU .EQ. 1) XUB(KBOUND(NREF)+LROW) = TMPU 2395- NREF = IABS(IBROTH(NREF)) 2396- 630 CONTINUE 2397- GOTO 890 2398-C 2399- 640 CONTINUE 2400- NODE0 = NODES - JNODES*(NPER+1-LP) 2401- IF (KBOUND(NODE0+1) .NE. KBOUND(IRNGE0(LP))) 2402- * GOTO 680 2403-C 2404-C Copy the bounds. 2405-C 2406- NREF = IRNGE0(LP) 2407- NCPD = 0 2408- DO 670 I=1,JNODES 2409- DO 650 JC=1,NCPD 2410- IF (KBOUND(NREF) .NE. LOC1(JC)) GOTO 650 2411- KBOUND(NODE0+I) = LOC2(JC) 2412- GOTO 665 2413- 650 CONTINUE 2414- NCPD = NCPD + 1 2415- LOC1(NCPD) = KBOUND(NREF) 2416- LOC2(NCPD) = LASTBD 2417- KBOUND(NODE0+I) = LASTBD 2418- KCREF = KBOUND(NREF) 2419- DO 660 JCOEF=1,NCOL(LP)+1 2420- XLB(LASTBD+JCOEF) = XLB(KCREF+JCOEF) 2421- XLB(LASTBD+JCOEF) = XLB(KCREF+JCOEF) 2422- 660 CONTINUE 2423- IF (JL .EQ. 1) XLB(LASTBD+LROW) = TMPL 2424- IF (JU .EQ. 1) XUB(LASTBD+LROW) = TMPU 2425- LASTBD = LASTBD + NCOL(LP) + 1 2426- 665 CONTINUE 2427- NREF = IABS(IBROTH(NREF)) 2428- IF (NREF .GT. NODE0) GOTO 665 2429- 670 CONTINUE 2430- GOTO 890 2431-C 2432- 680 CONTINUE 2433- NREF = IRNGE0(LP) 2434- DO 690 I=1,JNODES 2435- IF (JL .EQ. 1) XLB(KBOUND(NODE0+I)+LROW) = TMPL 2436- IF (JU .EQ. 1) XUB(KBOUND(NODE0+I)+LROW) = TMPU 2437- 690 CONTINUE 2438- GOTO 890 2439-C 2440-C HERE WE HAVE A RANDOM COEFFICIENT IN THE CONSTRAINT MATRIX 2441-C 2442- 700 CONTINUE 2443- IASTO(LP,JMTX) = 1 2444- JELMA = KELMA(KDATA(LP)+JMTX) 2445- LL = LA(KCOLA(KDATA(LP)+JMTX)+LCOL) 2446- KK = LA(KCOLA(KDATA(LP)+JMTX)+LCOL+1) - 1 2447- DO 710 LPOSA=LL,KK 2448- IF (IA(JELMA+LPOSA) .EQ. LROW) GOTO 720 2449- 710 CONTINUE 2450- WRITE (IOLOG, 1000) NREC,Q1,Q2,Q3,Q4,DNAME(1), 2451- * DNAME(2),ATEMP1,DNAME(3),ATEMP2 2452- WRITE (IOLOG, 2200) 2453- GOTO 9999 2454-C 2455- 720 CONTINUE 2456- IF (NREALS .GT. 1) GOTO 740 2457- NREF = IRNGE0(LP) 2458- DO 730 I=1,JNODES 2459- A(KELMA(KDATA(NREF)+JMTX)+LPOSA) = ATEMP1 2460- NREF = IABS(IBROTH(NREF)) 2461- 730 CONTINUE 2462- GOTO 890 2463-C 2464- 740 CONTINUE 2465- NODE0 = NODES - JNODES*(NPER+1-LP) 2466- IAREF = KDATA(IRNGE0(LP)) + JMTX 2467- IACUR = KDATA(NODE0+1) + JMTX 2468- IF (KELMA(IACUR) .NE. KELMA(IAREF)) GOTO 780 2469-C 2470-C Copy the A coefficients 2471-C 2472- NREF = IRNGE0(LP) 2473- NCPD = 0 2474- DO 770 I=1,JNODES 2475- DO 750 JC=1,NCPD 2476- IAREF = KDATA(NREF) + JMTX 2477- IF (KELMA(IAREF) .NE. LOC1(JC)) GOTO 750 2478- KELMA(KDATA(NODE0+I)+JMTX) = LOC2(JC) 2479- GOTO 765 2480- 750 CONTINUE 2481- NCPD = NCPD + 1 2482- LOC1(NCPD) = KELMA(KDATA(NREF)+JMTX) 2483- LOC2(NCPD) = LASTA 2484- KELMA(KDATA(NODE0+I)+JMTX) = LASTA 2485- KCREF = KELMA(KDATA(NREF)+JMTX) 2486- NELMS = NELMA(KDATA(NREF)+JMTX) 2487- DO 760 JCOEF=1,NELMS 2488- A(LASTA+JCOEF) = A(KCREF+JCOEF) 2489- IA(LASTA+JCOEF) = IA(KCREF+JCOEF) 2490- 760 CONTINUE 2491- A(LASTA+LPOSA) = ATEMP1 2492- LASTA = LASTA + NELMS 2493- 765 CONTINUE 2494- NREF = IABS(IBROTH(NREF)) 2495- IF (NREF .GT. NODE0) GOTO 765 2496- 770 CONTINUE 2497- GOTO 890 2498-C 2499- 780 CONTINUE 2500- NREF = IRNGE0(LP) 2501- DO 790 I=1,JNODES 2502- A(KELMA(KDATA(NODE0+I)+JMTX)+LPOSA) = ATEMP1 2503- 790 CONTINUE 2504-C 2505-C THE DATA ROW COULD CONTAIN INFO IN THE THIRD NAME FIELD 2506-C 2507- 890 CONTINUE 2508- IF (DNAME(3) .EQ. DBLANK) GOTO 100 2509- DROW = DNAME(3) 2510- DNAME(3) = DBLANK 2511- ATEMP1 = ATEMP2 2512- GOTO 300 2513-C 2514-C Have found an ENDATA card 2515-C 2516- 900 CONTINUE 2517- JNODES = JNODES * NREALS 2518- IF (NECHO .GE. 2) WRITE (IOLOG, 1100) 2519- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 2520- RETURN 2521-C 2522- 910 CONTINUE 2523- JNODES = JNODES * NREALS 2524- WRITE (IOLOG, 1100) 2525- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 2526- WRITE (IOLOG, 1200) 2527- RETURN 2528-C 2529-C COME HERE IF ANYTHING WENT WRONG 2530-C 2531- 9060 CONTINUE 2532- WRITE (IOLOG, 1100) 2533- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 2534- WRITE (IOLOG, 3060) 2535- GOTO 9999 2536-C 2537- 9070 CONTINUE 2538- WRITE (IOLOG, 1100) 2539- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 2540- WRITE (IOLOG, 3070) 2541- GOTO 9999 2542-C 2543- 9850 CONTINUE 2544- WRITE (IOLOG, 1100) 2545- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 2546- WRITE (IOLOG, 3850) 2547- GOTO 9999 2548-C 2549- 9875 CONTINUE 2550- WRITE (IOLOG, 1100) 2551- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 2552- WRITE (IOLOG, 3875) 2553- GOTO 9999 2554-C 2555- 9990 CONTINUE 2556- WRITE (IOLOG, 1100) 2557- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 2558- WRITE (IOLOG, 3990) 2559- 9999 CONTINUE 2560- CALL STOPIT 2561-C 2562- 1000 FORMAT(4A1,A8,2X,A8,2X,F12.4,3X,A8,2X,F12.4) 2563- 1100 FORMAT(I8,4X,4A1,A8,2X,A8,2X,F12.4,3X,A8,2X,F12.4) 2564- 1200 FORMAT(' XXX - WARNING - Missing ENDATA card') 2565- 1300 FORMAT(I8,4X,4A1,A8,2X,A8,17X,A8,14X,' : Realization',I3) 2566- 1600 FORMAT(' XXX - FATAL - Illegal header card in STOCH file') 2567- 1700 FORMAT(I8,4X,' Found realization number',I4,' of block ',A8) 2568- 1800 FORMAT(I8,4X,' Found realization number',I4) 2569- 1900 FORMAT(' XXX - FATAL - Illegal type of random element') 2570- 2000 FORMAT(' XXX - FATAL - Illegal name for a time period') 2571- 2100 FORMAT(' XXX - FATAL - Unmatched variable name') 2572- 2200 FORMAT(' XXX - FATAL - Location of random element undefined') 2573- 3060 FORMAT(' XXX - FATAL - Attempt to set explicit bound on logical' 2574- * ,' variable') 2575- 3070 FORMAT(' XXX - FATAL - Illegal row type in stochastic RANGES', 2576- * ' section') 2577- 3850 FORMAT(' XXX - FATAL - Chronological order violated for random', 2578- * ' elements') 2579- 3875 FORMAT(' XXX - FATAL - Illegal type of random element') 2580- 3990 FORMAT(' XXX - FATAL - Error while reading STOCH_FILE') 2581- END 2582-C 2583-C :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: 2584-C 2585- SUBROUTINE INSCEN (IROTYP, IIPER, IPER0, DTIME, IERR, NREC) 2586-C 2587-C Subroutine to input stoch file in SCENARIO format 2588-C 2589-C ------------------------ 2590-C 2591-C Version of 31 January 1988 2592-C 2593-C ------------------------ 2594-C 2595- include 'common5.for' 2596-C 2597- CHARACTER*8 DNAME(3), DTIME(10), DBLANK, DSIMPL, DISCR, 2598- * DROW, DCOL, DOTS, DSCNAM(2000) 2599- DIMENSION IROTYP(3000), LNODE(2000), KREF(10) 2600- EQUIVALENCE (DSCNAM,X), (LNODE,IE) 2601- DATA DBLANK/' '/, DSIMPL/'SIMPLE '/, DOTS /' ... '/, 2602- * DISCR /'DISCRETE'/ 2603-C 2604- L = 0 2605- DROW = DBLANK 2606- DCOL = DBLANK 2607- QTYP = QBL 2608- NREALS = 1 2609- JNODES = 1 2610- IPREV = 1 2611- NODES = NPER 2612- IIPER = 1 2613- IPER0 = NPER 2614- PROB(1) = 1.0 2615- NSCEN = 0 2616-C 2617- 700 CONTINUE 2618- READ (IOSTO, 1000, ERR=9990, END=910) 2619- * Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 2620- NREC = NREC + 1 2621- IF (Q1 .EQ. QAST) GOTO 700 2622- IF (Q1 .EQ. QE ) GOTO 900 2623- IF (Q1 .EQ. QBL ) GOTO 701 2624- WRITE (IOLOG, 1100) 2625- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 2626- WRITE (IOLOG, 1600) 2627- GOTO 9999 2628-C 2629- 701 CONTINUE 2630- IF (Q2 .EQ. QS .AND. Q3 .EQ. QC) GOTO 702 2631- IF (NECHO .GE. 5) WRITE (IOLOG, 1100) 2632- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 2633- DCOL = DNAME(1) 2634- DROW = DNAME(2) 2635- QTYP = Q3 2636- GOTO 720 2637-C 2638-C SET UP PROBABILITIES 2639-C 2640- 702 CONTINUE 2641- IF (NECHO .GE. 2) WRITE (IOLOG, 1800) NREC,DNAME(1) 2642- IF (NSCEN .GT. 0) GOTO 704 2643- DO 703 I=1,NPER 2644- PROB(I) = ATEMP1 2645- 703 CONTINUE 2646- NSCEN = NSCEN + 1 2647- DSCNAM(NSCEN) = DNAME(1) 2648- LNODE(NSCEN) = NPER 2649- GOTO 700 2650-C 2651-C THIS IS NOT SCENARIO 1, FIND THE SCENARIO IT BRANCHES FROM 2652-C 2653- 704 CONTINUE 2654- DO 705 I=1,NSCEN 2655- IF (DNAME(2) .EQ. DSCNAM(I)) GOTO 706 2656- 705 CONTINUE 2657- WRITE (IOLOG, 1100) NREC, Q1,Q2,Q3,Q4,DNAME(1), 2658- * DNAME(2),ATEMP1,DNAME(3),ATEMP2 2659- WRITE (IOLOG, 2000) 2660- GOTO 9999 2661-C 2662-C GOT IT. 2663-C 2664- 706 CONTINUE 2665- NSCEN = NSCEN + 1 2666- DSCNAM(NSCEN) = DNAME(1) 2667- LNODE(NSCEN) = NODES + 1 2668- LASTN = LNODE(I) 2669- IP = NPER 2670- 707 CONTINUE 2671- NMTX = IP 2672- IF (MARKOV .AND. IP .GT. 2) NMTX = 2 2673- KREF(IP) = LASTN 2674- NODES = NODES + 1 2675- IBROTH(NODES) = 0 2676- IF (IP .EQ. NPER) IDESC(NODES) = 0 2677- IF (IP .LT. NPER) IDESC(NODES) = NODES - 1 2678- IF (IP .LT. NPER) IANCTR(NODES-1) = NODES 2679- IRNGE2(IP) = NODES 2680- KROW(NODES) = KROW(NODES-1) + NROW(NODES-1) 2681- KCOL(NODES) = KCOL(NODES-1) + NCOL(NODES-1) + 1 2682- KCOST(NODES) = KCOST(LASTN) 2683- KDATA(NODES) = LASTD 2684- KBOUND(NODES) = KBOUND(LASTN) 2685- KNAMES(NODES) = KNAMES(LASTN) 2686- KRHS(NODES) = KRHS(LASTN) 2687- NROW(NODES) = NROW(LASTN) 2688- NCOL(NODES) = NCOL(LASTN) 2689- NCUT(NODES) = NCUT(LASTN) 2690- NTH(NODES) = NTH(LASTN) 2691- PROB(NODES) = ATEMP1 2692-C 2693- NROWS = NROW(NODES) 2694- NCOLS = NCOL(NODES) 2695- IROW = KROW(NODES) 2696- ICOL = KCOL(NODES) 2697- LASTD = LASTD + NMTX 2698- KDATC = KDATA(NODES) 2699- KDATI = KDATA(IP) 2700- DO 7079 IMTX=1,NMTX 2701- KCOLA(KDATC+IMTX) = KCOLA(KDATI+IMTX) 2702- KELMA(KDATC+IMTX) = KELMA(KDATI+IMTX) 2703- NELMA(KDATC+IMTX) = NELMA(KDATI+IMTX) 2704- 7079 CONTINUE 2705- DO 708 I=1,NROWS 2706- KINBAS(ICOL+I) = IROW + I 2707- JH(IROW+I) = ICOL + I 2708- 708 CONTINUE 2709- DO 709 I=NROWS+1,NCOLS+1 2710- KINBAS(ICOL+I) = 0 2711- 709 CONTINUE 2712- IF (DTIME(IP) .EQ. DNAME(3)) GOTO 710 2713- IF (IP .EQ. 1) GOTO 9040 2714- IP = IP - 1 2715- LASTN = IANCTR(LASTN) 2716- GOTO 707 2717-C 2718- 710 CONTINUE 2719- IANCTR(NODES) = IANCTR(LASTN) 2720- IIPER = IP 2721- IBRO1 = LASTN 2722- 711 CONTINUE 2723- IF (IBROTH(IBRO1) .EQ. 0) GOTO 712 2724- IBRO1 = IBROTH(IBRO1) 2725- GOTO 711 2726-C 2727-C FIX THE PROBABILITIES 2728-C 2729- 712 CONTINUE 2730- IBROTH(IBRO1) = NODES 2731- 713 CONTINUE 2732- LASTN = IANCTR(LASTN) 2733- IF (LASTN .EQ. 0) GOTO 700 2734- PROB(LASTN) = PROB(LASTN) + ATEMP1 2735- GOTO 713 2736-C 2737-C FIRST DETERMINE THE PERIOD 2738-C 2739- 720 CONTINUE 2740- DO 721 IP=IIPER,NPER 2741- DO 721 LROW=1,NCOL(IP) 2742- IF (DROW .EQ. NAMES(KNAMES(IP)+LROW)) GOTO 723 2743- 721 CONTINUE 2744-C 2745- DO 722 II=1,NROW(1) 2746- IF (DROW .EQ. NAMES(I) .AND. IROTYP(I) .EQ. 2) 2747- * GOTO 788 2748- 722 CONTINUE 2749- WRITE (IOLOG, 1100) NREC,Q1,Q2,Q3,Q4,DNAME(1), 2750- * DNAME(2),ATEMP1,DNAME(3),ATEMP2 2751- WRITE (IOLOG, 1900) 2752- GOTO 9999 2753-C 2754- 723 CONTINUE 2755- NCURR = NODES + IIPER - IP 2756- IF (NSCEN .EQ. 1) NCURR = IP 2757- IF (IPER0 .GT. IP) IPER0 = IP 2758- IF (DROW .EQ. NAMES(1)) GOTO 730 2759- IF (DCOL .EQ. DBOUND ) GOTO 750 2760- IF (DCOL .EQ. DRANGE ) GOTO 752 2761- IF (DCOL .EQ. DXI ) GOTO 740 2762- DO 727 JMTX=1,IP 2763- IF (MARKOV .AND. JMTX .GE. 3) GOTO 728 2764- JP = IP + 1 - JMTX 2765- JNAMES = KNAMES(JP) 2766- DO 726 I=NROW(JP)+1,NCOL(JP) 2767- IF (DCOL .EQ. NAMES(JNAMES+I)) GOTO 770 2768- 726 CONTINUE 2769- 727 CONTINUE 2770-C 2771- 728 CONTINUE 2772- LROWS = NROW(1) 2773- DO 729 I=1,LROWS 2774- IF (DROW .EQ. NAMES(I) .AND. IROTYP(I) .EQ. 2) 2775- * GOTO 788 2776- 729 CONTINUE 2777- WRITE (IOLOG, 1100) NREC,Q1,Q2,Q3,Q4,DNAME(1), 2778- * DNAME(2),ATEMP1,DNAME(3),ATEMP2 2779- WRITE (IOLOG, 1900) 2780- GOTO 9999 2781-C 2782-C HERE WE HAVE A RANDOM COST COEFFICIENT. COPY INFO IF NECESSARY 2783-C 2784- 730 CONTINUE 2785- DO 731 I=NROW(IP)+1,NCOL(IP) 2786- IF (DCOL .EQ. NAMES(KNAMES(IP)+I)) 2787- * GOTO 732 2788- 731 CONTINUE 2789- WRITE (IOLOG, 1100) NREC,Q1,Q2,Q3,Q4,DNAME(1), 2790- * DNAME(2),ATEMP1,DNAME(3),ATEMP2 2791- WRITE (IOLOG,2100) 2792- GOTO 9999 2793-C 2794- 732 CONTINUE 2795- LPOSC = I - NROW(IP) 2796- IF (NSCEN .EQ. 1) GOTO 736 2797- NREF = KREF(IP) 2798- NCURR = NODES + IIPER - IP 2799- IF (KCOST(NCURR) .NE. KCOST(NREF)) GOTO 736 2800- DO 734 J=1,NCOL(IP)-NROW(IP) 2801- COST(LASTC+J) = COST(KCOST(NREF)+J) 2802- 734 CONTINUE 2803- COST(LASTC+LPOSC) = ATEMP1 2804- KCOST(NCURR) = LASTC 2805- LASTC = LASTC + NCOL(IP) - NROW(IP) 2806- GOTO 788 2807-C 2808- 736 CONTINUE 2809- COST(KCOST(NCURR)+LPOSC) = ATEMP1 2810- GOTO 788 2811-C 2812-C HERE WE HAVE A RANDOM RHS 2813-C 2814- 740 CONTINUE 2815- IF (NSCEN .EQ. 1) GOTO 745 2816- NREF = KREF(IP) 2817- NCURR = NODES + IIPER - IP 2818- IF (KRHS(NCURR) .NE. KRHS(NREF)) GOTO 745 2819- DO 742 J=1,NROW(IP) 2820- XI(LASTR+J) = XI(KRHS(NREF)+J) 2821- 742 CONTINUE 2822- XI(LASTR+LROW) = ATEMP1 2823- KRHS(NCURR) = LASTR 2824- LASTR = LASTR + NROW(IP) 2825- GOTO 748 2826-C 2827- 745 CONTINUE 2828- XI(KRHS(NCURR)+LROW) = ATEMP1 2829- 748 CONTINUE 2830- GOTO 788 2831-C 2832-C RANDOM BOUND ON A DECISION VARIABLE 2833-C 2834- 750 CONTINUE 2835- JL = 0 2836- JU = 0 2837- IF (LROW .LE. NROW(IP)) GOTO 9060 2838- IF (QTYP .EQ. QP .OR. QTYP .EQ. QX) JU = 1 2839- IF (QTYP .EQ. QP .OR. QTYP .EQ. QX) TMPU = ATEMP1 2840- IF (QTYP .EQ. QO .OR. QTYP .EQ. QX) JL = 1 2841- IF (QTYP .EQ. QO .OR. QTYP .EQ. QX) TMPL = ATEMP1 2842- IF (QTYP .EQ. QR .OR. QTYP .EQ. QL) JU = 1 2843- IF (QTYP .EQ. QR .OR. QTYP .EQ. QL) TMPU = 1.D8 2844- IF (QTYP .EQ. QL .OR. QTYP .EQ. QI) JL = 1 2845- IF (QTYP .EQ. QL .OR. QTYP .EQ. QI) TMPL = -1.D8 2846- GOTO 756 2847-C 2848-C STOCHASTIC RANGE FOR ONE OF THE ROWS 2849-C 2850- 752 CONTINUE 2851- JL = 0 2852- JU = 0 2853- IT = IROTYP(KRHS(IP) + LROW) 2854- IF (IT .EQ. -1) GOTO 755 2855- IF (IT .EQ. 1) GOTO 754 2856- IF (IT .NE. 0) GOTO 9070 2857- IF (ATEMP1 .GT. 0.0) GOTO 753 2858- JL = 1 2859- TMPL = ATEMP1 2860- GOTO 756 2861- 753 CONTINUE 2862- JU = 1 2863- TMPU = ATEMP1 2864- GOTO 756 2865- 754 CONTINUE 2866- JU = 1 2867- TMPU = DABS(ATEMP1) 2868- GOTO 756 2869- 755 CONTINUE 2870- JL = 1 2871- TMPL = -DABS(ATEMP1) 2872- 756 CONTINUE 2873- IF (NSCEN .EQ. 1) GOTO 765 2874- NREF = KREF(IP) 2875- NCURR = NODES + IIPER - IP 2876- IF (KBOUND(NCURR) .NE. KBOUND(NREF)) GOTO 765 2877- DO 762 J=1,NCOL(IP) 2878- XLB(LASTBD+J) = XLB(KBOUND(NREF)+J) 2879- XUB(LASTBD+J) = XUB(KBOUND(NREF)+J) 2880- 762 CONTINUE 2881- IF (JL .EQ. 1) XLB(LASTBD+LROW) = TMPL 2882- IF (JU .EQ. 1) XUB(LASTBD+LROW) = TMPU 2883- GOTO 768 2884-C 2885- 765 CONTINUE 2886- IF (JL .EQ. 1) XLB(KBOUND(NCURR)+LROW) = TMPL 2887- IF (JU .EQ. 1) XUB(KBOUND(NCURR)+LROW) = TMPU 2888- 768 CONTINUE 2889- IF (LROW .GT. NROW(IP)) GOTO 700 2890- GOTO 788 2891-C 2892-C HERE WE HAVE A RANDOM COEFFICIENT IN THE CONSTRAINT MATRIX 2893-C 2894- 770 CONTINUE 2895- IASTO(IP,JMTX) = 1 2896- LCOL = I - NROW(JP) 2897- JELMA = KELMA(KDATA(IP)+JMTX) 2898- LL = LA(KCOLA(KDATA(IP)+JMTX)+LCOL) 2899- KK = LA(KCOLA(KDATA(IP)+JMTX)+LCOL+1) - 1 2900- DO 771 I=LL,KK 2901- IF (IA(JELMA+I) .EQ. LROW) GOTO 772 2902- 771 CONTINUE 2903- WRITE (IOLOG, 1100) NREC,Q1,Q2,Q3,Q4,DNAME(1), 2904- * DNAME(2),ATEMP1,DNAME(3),ATEMP2 2905- WRITE (IOLOG, 2200) 2906- GOTO 9999 2907-C 2908- 772 CONTINUE 2909- LPOSA = I 2910- IF (NSCEN .EQ. 1) GOTO 776 2911- NREF = KREF(IP) 2912- NCURR = NODES + IIPER - IP 2913- LMREF = KELMA(KDATA(NREF)+JMTX) 2914- IF (KELMA(KDATA(NCURR)+JMTX) .NE. LMREF) GOTO 776 2915- NELMS = NELMA(KDATA(IP)+JMTX) 2916- DO 774 J=1,NELMS 2917- A(LASTA+J) = A(LMREF+J) 2918- IA(LASTA+J) = IA(LMREF+J) 2919- 774 CONTINUE 2920- A(LASTA+LPOSA) = ATEMP1 2921- KELMA(KDATA(NCURR)+JMTX) = LASTA 2922- LASTA = LASTA + NELMS 2923- GOTO 788 2924-C 2925- 776 CONTINUE 2926- A(KELMA(KDATA(NCURR)+JMTX)+LPOSA) = ATEMP1 2927- GOTO 788 2928-C 2929-C THE THIRD NAME FIELD MIGHT CONTAIN MORE INFORMATION 2930-C 2931- 788 CONTINUE 2932- IF (DNAME(3) .EQ. DBLANK) GOTO 700 2933- DROW = DNAME(3) 2934- DNAME(3) = DBLANK 2935- ATEMP1 = ATEMP2 2936- GOTO 720 2937-C 2938-C END OF STOCH FILE 2939-C 2940- 900 CONTINUE 2941- IF (NECHO .GE. 2) WRITE (IOLOG, 1100) 2942- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 2943- RETURN 2944-C 2945- 910 CONTINUE 2946- WRITE (IOLOG, 1100) 2947- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 2948- WRITE (IOLOG, 1200) 2949- RETURN 2950-C 2951-C COME HERE IF ANYTHING WENT WRONG 2952-C 2953- 9040 CONTINUE 2954- WRITE (IOLOG, 1100) 2955- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 2956- WRITE (IOLOG, 3040) 2957- GOTO 9999 2958-C 2959- 9060 CONTINUE 2960- WRITE (IOLOG, 1100) 2961- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 2962- WRITE (IOLOG, 3060) 2963- GOTO 9999 2964-C 2965- 9070 CONTINUE 2966- WRITE (IOLOG, 1100) 2967- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 2968- WRITE (IOLOG, 3070) 2969- GOTO 9999 2970-C 2971- 9990 CONTINUE 2972- WRITE (IOLOG, 1100) 2973- * NREC,Q1,Q2,Q3,Q4,DNAME(1),DNAME(2),ATEMP1,DNAME(3),ATEMP2 2974- WRITE (IOLOG, 3990) 2975- 9999 CONTINUE 2976- CALL STOPIT 2977-C 2978- 1000 FORMAT(4A1,A8,2X,A8,2X,F12.4,3X,A8,2X,F12.4) 2979- 1100 FORMAT(I8,4X,4A1,A8,2X,A8,2X,F12.4,3X,A8,2X,F12.4) 2980- 1200 FORMAT(' XXX - WARNING - Missing ENDATA card') 2981- 1600 FORMAT(' XXX - FATAL - Illegal header card in STOCH file') 2982- 1800 FORMAT(I8,4X,' Found scenario ',A8) 2983- 1900 FORMAT(' XXX - FATAL - Illegal type of random element') 2984- 2000 FORMAT(' XXX - FATAL - Misspecified branch in decision tree') 2985- 2100 FORMAT(' XXX - FATAL - Unmatched variable name') 2986- 2200 FORMAT(' XXX - FATAL - Location of random element undefined') 2987- 3040 FORMAT(' XXX - FATAL - Period could not be found') 2988- 3060 FORMAT(' XXX - FATAL - Attempt to set explicit bound on logical' 2989- * ,' variable') 2990- 3070 FORMAT(' XXX - FATAL - Illegal row type in stochastic RANGES', 2991- * ' section') 2992- 3990 FORMAT(' XXX - FATAL - Error while reading STOCH_FILE') 2993- END 2994//GO.SYSIN DD input.f 2995echo std2mps.f 1>&2 2996sed >std2mps.f <<'//GO.SYSIN DD std2mps.f' 's/^-//' 2997-C 2998-C This program is used to create an MPS file for MINOS from the 2999-C MPS-like input files for program MSLiP. To distinguish various 3000-C time periods, the row and column names are truncated to the first 6 3001-C characters and a two-character code for the period is appended. 3002-C This allows for up to 1295 nodes in the decision tree, which should 3003-C be sufficient in almost all cases. 3004-C 3005-C (NO CHECK IS PERFORMED TO SEE IF THE FIRST SIX CHARACTERS RESULT 3006-C IN UNIQUE VARIABLE NAMES) 3007-C 3008-C More information about the input format can be found in the top 3009-C level input routine INPUT. The format used is also described in 3010-C a paper by Birge et al. (IIASA working paper 87-118). 3011-C The input routine allows for non-Markovian full block lower-triangular 3012-C constraint matrices, but uses a more compact format for staircase 3013-C problems. 3014-C 3015-C ---------------------- 3016-C 3017-C THE FOLLOWING ROUTINES FROM PROGRAM MSLiP5 ARE CALLED 3018-C BLOCK DATA, INIT, INPUT, IOPREP, STOPIT, UNPACK 3019-C 3020-C (these routines should be given to the linker) 3021-C 3022-C ---------------------- 3023-C 3024-C THIS VERSION DATED APRIL 17, 1988 3025-C 3026-C ---------------------- 3027-C 3028- include 'common5.for' 3029-C 3030- CHARACTER*8 PROBNM 3031-C 3032-C INITIALIZE 3033-C 3034- CALL INIT 3035- CALL IOPREP(1) 3036-C 3037-C INPUT PROBLEM DATA 3038-C 3039- NECHO = 2 3040- CALL INPUT(PROBNM,IOBJ1) 3041-C 3042-C NOW FIND THE PATH PROBABILITIES FROM THE CONDITIONAL PROBABILITIES 3043-C 3044- DO 100 I=2,NPER 3045- I0 = IRNGE0(I) 3046- 95 CONTINUE 3047- PROB(I0) = PROB(I0) * PROB(IANCTR(I0)) 3048- I0 = IABS(IBROTH(I0)) 3049- IF (I0 .GT. 0) GOTO 95 3050- 100 CONTINUE 3051-C 3052- WRITE (IOBAS, 4000) PROBNM 3053- WRITE (IOBAS, 4010) 3054- WRITE (IOBAS, 4020) NAMES(IOBJ) 3055- WRITE (IOLOG, 5000) 3056- DO 110 I=1,NPER 3057- I0 = IRNGE0(I) 3058- 105 CONTINUE 3059- CALL ROWPUT(I0,0) 3060- I0 = IABS(IBROTH(I0)) 3061- IF (I0 .GT. 0) GOTO 105 3062- 110 CONTINUE 3063-C 3064- WRITE (IOBAS, 4040) 3065- WRITE (IOLOG, 5010) 3066- NDC = 0 3067- DO 120 I=1,NPER 3068- I0 = IRNGE0(I) 3069- NMTX = NPER + 1 - I 3070- IF (MARKOV .AND. NMTX .GT. 2) NMTX = 2 3071- 115 CONTINUE 3072- NDC = NDC + 1 3073- IF (NDC .EQ. (NDC/100) * 100) WRITE (IOLOG, 5020) NDC 3074- CALL COLPUT(I0,NMTX) 3075- I0 = IABS(IBROTH(I0)) 3076- IF (I0 .GT. 0) GOTO 115 3077- 120 CONTINUE 3078-C 3079- WRITE (IOBAS, 4070) 3080- WRITE (IOLOG, 5030) 3081- DO 130 I=1,NPER 3082- I0 = I 3083- 125 CONTINUE 3084- CALL RHSPUT(I0,1) 3085- I0 = IABS(IBROTH(I0)) 3086- IF (I0 .GT. 0) GOTO 125 3087- 130 CONTINUE 3088-C 3089- WRITE (IOBAS, 4090) 3090- WRITE (IOLOG, 5040) 3091-C 3092- 9999 CONTINUE 3093- CALL STOPIT 3094-C 3095- 4000 FORMAT('NAME',10X,A8) 3096- 4010 FORMAT('ROWS') 3097- 4020 FORMAT(' N ',A8) 3098- 4040 FORMAT('COLUMNS') 3099- 4070 FORMAT('RHS') 3100- 4090 FORMAT('ENDATA') 3101-C 3102- 5000 FORMAT(' Writing ROWS section') 3103- 5010 FORMAT(' Begin COLUMNS section') 3104- 5020 FORMAT(' Writing at node',I6) 3105- 5030 FORMAT(' Writing RHS section') 3106- 5040 FORMAT(' MPS file has been written') 3107-C 3108- 6000 FORMAT(' Error in input deck.') 3109- END 3110-C 3111-C :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: 3112-C 3113- BLOCK DATA 3114-C 3115-C INITIALIZES GLOBAL PROGRAM CONSTANTS 3116-C SUBROUTINE ADAPTED FROM LINEAR PROGRAMMING CODE LPM-1, WRITTEN 3117-C BY J.A. TOMLIN (OPERATIONS RESEARCH, STANFORD UNIVERSITY), 3118-C MODIFIED FROM STOCHASTIC PROGRAMMING CODE NDSP, WRITTEN BY 3119-C JOHN BIRGE (INDUSTRIAL ENGINEERING, UNIVERSITY OF MICHIGAN) 3120-C 3121- IMPLICIT REAL*8(A-H,O,P,R-Z), INTEGER(I-N), CHARACTER*1 (Q) 3122-C 3123- COMMON /CHARS/ QA,QAST,QB,QBL,QC,QD,QE,QF,QG,QH,QI,QK,QL,QM,QN, 3124- * QO,QP,QR,QS,QT,QU,QV,QX,QSTAT 3125- COMMON /CONST/ ZTOLZE, ZTOLPV, ZTCOST, NAMAX, NBMAX, NCMAX, 3126- * NEMAX, NLMAX, NPMAX, NRMAX, NTMAX, NVMAX, 3127- * NROWMX, NCOLMX, NEGINF 3128-C 3129-C NAMAX - maximal size of A matrix 3130-C NBMAX - maximal number of blocks in constraint matrix 3131-C NCMAX - maximal number of cuts 3132-C NEMAX - maximal size of inverse 3133-C NLMAX - maximal number of columns in A-matrices 3134-C NPMAX - maximal number of time periods 3135-C NRMAX - maximal number of rows per node 3136-C NTMAX - maximal number of eta-vectors in inverse 3137-C NVMAX - maximal number of variables including cuts and thetas 3138-C NROWMX - maximal number of rows altogether, including active cuts 3139-C NCOLMX - maximal number of columns, including cuts and theta columns 3140-C 3141- DATA ZTOLZE/1.0E-7/,ZTOLPV/1.0E-5/,ZTCOST/1.0E-4/ 3142- DATA NAMAX/30000/, NBMAX/5000/, NCMAX/2000/, NEMAX/10000/, 3143- * NLMAX/10000/, NPMAX/10/, NRMAX/350/, NTMAX/1000/, 3144- * NVMAX/600/, NROWMX/20000/, NCOLMX/40000/, NEGINF/-100000/ 3145- DATA QBL /' '/, QA /'A'/, QB /'B'/, QC /'C'/, QD /'D'/, 3146- * QE /'E'/, QF /'F'/, QG /'G'/, QH /'H'/, QI /'I'/, 3147- * QK /'K'/, QL /'L'/, QM /'M'/, QN /'N'/, QO /'O'/, 3148- * QP /'P'/, QR /'R'/, QS /'S'/, QT /'T'/, QU /'U'/, 3149- * QV /'V'/, QX /'X'/, QAST/'*'/ 3150-C 3151- END 3152-C 3153-C ::::::::::::::::::::::::::::::::::::::::::::::::::::: 3154-C 3155- SUBROUTINE ROWPUT(I0,JT) 3156-C 3157-C THIS SUBROUTINE WRITES THE ROWS SECTION FOR NODE I0. 3158-C JT=0 IF NO OBJECTIVE ROW IS WRITTEN, JT=1 OTHERWISE. 3159-C 3160- include 'common5.for' 3161-C 3162- CHARACTER*1 TYPE,CODE(36),PER1,PER2 3163- CHARACTER*8 DRNAM 3164- DATA CODE/ '0','1','2','3','4','5','6','7','8','9','A','B', 3165- * 'C','D','E','F','G','H','I','J','K','L','M','N', 3166- * 'O','P','Q','R','S','T','U','V','W','X','Y','Z'/ 3167-C 3168- I1 = I0/36 3169- IF (I1 .GE. 36) CALL STOPIT 3170- I2 = I0 - I1*36 3171- PER1 = CODE(I1+1) 3172- PER2 = CODE(I2+1) 3173-C 3174- IROW = KROW(I0) 3175- NROWS = NROW(I0) 3176- IBOUND = KBOUND(I0) 3177- INAMES = KNAMES(I0) 3178-C 3179- DO 150 IR=1,NROWS 3180- IF (IR .EQ. IOBJ .AND. JT .EQ. 0) GOTO 150 3181- XUPPER = XUB(IBOUND+IR) 3182- XLOWER = XLB(IBOUND+IR) 3183- IF (XUPPER .GT. 1.) GOTO 110 3184- IF (XLOWER .LT. -1.) GOTO 120 3185- IF (XUPPER - XLOWER .LT. ZTOLZE) GOTO 130 3186- TYPE = QN 3187- GOTO 140 3188- 110 CONTINUE 3189- TYPE = QL 3190- GOTO 140 3191- 120 CONTINUE 3192- TYPE = QG 3193- GOTO 140 3194- 130 CONTINUE 3195- TYPE = QE 3196- 140 CONTINUE 3197- DRNAM = NAMES(INAMES+IR) 3198- WRITE (IOBAS, 4000) TYPE, DRNAM, PER1, PER2 3199- 150 CONTINUE 3200- RETURN 3201-C 3202- 4000 FORMAT(' ',A1,2X,A6,2A1) 3203- END 3204-C 3205-C :::::::::::::::::::::::::::::::::::::::::::::::::::::: 3206-C 3207- SUBROUTINE COLPUT(I0,NMTX) 3208-C 3209-C THIS SUBROUTINE WRITES THE COEFFICIENTS FOR ONE BLOCK OF 3210-C THE A MATRIX. 3211-C 3212-C I0 - GIVES THE NODE FOR THE COLUMN NAMES 3213-C NMTX - GIVES THE NUMBER OF BLOCKS TO BE EXPANDED 3214-C 3215- include 'common5.for' 3216-C 3217- CHARACTER*1 CODE(36),PER1,PER2,PER3,PER4 3218- CHARACTER*8 DCNAM, DRNAM 3219- CHARACTER*30 F4060 3220- DATA CODE/ '0','1','2','3','4','5','6','7','8','9','A','B', 3221- * 'C','D','E','F','G','H','I','J','K','L','M','N', 3222- * 'O','P','Q','R','S','T','U','V','W','X','Y','Z'/ 3223-C 3224- I1 = I0/36 3225- IF (I1 .GE. 36) CALL STOPIT 3226- I2 = I0 - I1*36 3227- PER1 = CODE(I1+1) 3228- PER2 = CODE(I2+1) 3229-C 3230- IROW = KROW(I0) 3231- NROWS = NROW(I0) 3232- NCOLS = NCOL(I0) 3233- IBOUND = KBOUND(I0) 3234- INAMES = KNAMES(I0) 3235-C 3236- DO 180 JC=NROWS+1,NCOLS 3237- DCNAM = NAMES(INAMES+JC) 3238- INODE = I0 3239- LMTX = 1 3240- 110 CONTINUE 3241- L1 = INODE/36 3242- IF (L1 .GE. 36) CALL STOPIT 3243- L2 = INODE - L1*36 3244- PER3 = CODE(L1+1) 3245- PER4 = CODE(L2+1) 3246- JROWS = NROW(INODE) 3247- JNAMES = KNAMES(INODE) 3248- CALL UNPACK(JC,LMTX) 3249- DO 140 JR=1,JROWS 3250- IF (DABS(Y(JR)) .LT. ZTOLZE) GOTO 140 3251- IF (JR .EQ. IOBJ) GOTO 130 3252- DRNAM = NAMES(JNAMES+JR) 3253- WRITE (IOBAS, 4050) 3254- * DCNAM, PER1, PER2, DRNAM, PER3, PER4, Y(JR) 3255- GOTO 140 3256- 130 CONTINUE 3257- YT = Y(JR) * PROB(I0) 3258- DRNAM = NAMES(JR) 3259- AYT = DABS(YT) 3260- IF (AYT .LT. 1.D-8 .OR. AYT .GE. 1.D+10) THEN 3261- F4060 = '(4X,A6,2A1,2X,A8,2X,G12.6)' 3262- ELSE IF (AYT .LT. 1.D-4) THEN 3263- F4060 = '(4X,A6,2A1,2X,A8,2X,G12.7E1)' 3264- ELSE IF (AYT .LT. 1.D-1) THEN 3265- F4060 = '(4X,A6,2A1,2X,A8,2X,F12.10)' 3266- ELSE 3267- F4060 = '(4X,A6,2A1,2X,A8,2X,G16.10)' 3268- END IF 3269- WRITE (IOBAS, F4060) DCNAM, PER1, PER2, DRNAM, YT 3270- 140 CONTINUE 3271- IF (IDESC(INODE) .GT. 0 .AND. LMTX .LT. NMTX) GOTO 160 3272- IF (INODE .EQ. I0) GOTO 180 3273- 150 CONTINUE 3274- IF (IBROTH(INODE) .GT. 0) GOTO 170 3275- IF (IANCTR(INODE) .EQ. I0) GOTO 180 3276- INODE = IANCTR(INODE) 3277- LMTX = LMTX - 1 3278- GOTO 150 3279- 160 CONTINUE 3280- INODE = IDESC(INODE) 3281- LMTX = LMTX + 1 3282- GOTO 110 3283- 170 CONTINUE 3284- INODE = IBROTH(INODE) 3285- GOTO 110 3286- 180 CONTINUE 3287-C 3288- RETURN 3289-C 3290- 4050 FORMAT(4X,A6,2A1,2X,A6,2A1,2X,F12.7) 3291-C4060 FORMAT(4X,A6,2A1,2X,A8,2X,G16.10) 3292- 4070 FORMAT(4X,A6,2A1,2X,A8,2X,'00000.000000') 3293- END 3294-C 3295-C ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: 3296-C 3297- SUBROUTINE RHSPUT(I0,JT) 3298-C 3299- include 'common5.for' 3300-C 3301- CHARACTER*1 CODE(36),PER1,PER2 3302- CHARACTER*8 DRNAM 3303- CHARACTER*32 F4080 3304- DATA CODE/ '0','1','2','3','4','5','6','7','8','9','A','B', 3305- * 'C','D','E','F','G','H','I','J','K','L','M','N', 3306- * 'O','P','Q','R','S','T','U','V','W','X','Y','Z'/ 3307-C 3308- I1 = I0/36 3309- IF (I1 .GE. 36) CALL STOPIT 3310- I2 = I0 - I1*36 3311- PER1 = CODE(I1+1) 3312- PER2 = CODE(I2+1) 3313- IRHS = KRHS(I0) 3314- NR = NROW(I0) 3315- INAM = KNAMES(I0) 3316- DO 208 IR = 1,NR 3317- DRNAM = NAMES(INAM+IR) 3318- IROW = IR + IRHS 3319- AXI = DABS(XI(IROW)) 3320- IF (AXI .LT. ZTOLZE) GOTO 208 3321- IF (AXI .LT. 1.D-8 .OR. AXI .GE. 1.D+10) THEN 3322- F4080 = '(4X,3HRHS,7X,A6,2A1,2X,G12.6)' 3323- ELSE IF (AXI .LT. 1.D-4) THEN 3324- F4080 = '(4X,3HRHS,7X,A6,2A1,2X,G12.7E1)' 3325- ELSE IF (AXI .LT. 1.D-1) THEN 3326- F4080 = '(4X,3HRHS,7X,A6,2A1,2X,F12.10)' 3327- ELSE 3328- F4080 = '(4X,3HRHS,7X,A6,2A1,2X,G16.10)' 3329- END IF 3330- WRITE (IOBAS, F4080) DRNAM, PER1, PER2, XI(IROW) 3331- 208 CONTINUE 3332- RETURN 3333-C 3334-C4080 FORMAT(4X,'RHS',7X,A6,2A1,2X,G16.10) 3335- END 3336- SUBROUTINE INIT 3337-C 3338-C THIS SUBROUTINE SETS MOST VARIABLES IN THE COMMON BLOCKS TO 0. 3339-C 3340- include 'common5.for' 3341-C 3342- DO 100 I=1,NCOLMX 3343- KINBAS(I) = 0 3344- 100 CONTINUE 3345- DO 101 I=1,NAMAX 3346- A(I) = 0.0 3347- IA(I) = 0 3348- 101 CONTINUE 3349- DO 102 I=1,NROWMX 3350- JH(I) = 0 3351- B(I) = 0.0 3352- X(I) = 0.0 3353- YPI(I) = 0.0 3354- 102 CONTINUE 3355- DO 103 I=1,NEMAX 3356- E(I) = 0.0 3357- IE(I) = 0 3358- XI(I) = 0.0 3359- 103 CONTINUE 3360- DO 104 I=1,NBMAX 3361- KCOLA(I) = 0 3362- KELMA(I) = 0 3363- NELMA(I) = 0 3364- 104 CONTINUE 3365- DO 110 I=1,3000 3366- LA(I) = 0 3367- XLB(I) = 0.D0 3368- XUB(I) = 0.D0 3369- 110 CONTINUE 3370- DO 120 I=1,2000 3371- NCOL(I) = 0 3372- NROW(I) = 0 3373- NUDATA(I) = 0 3374- NUDUAL(I) = 0 3375- NTH(I) = 0 3376- NCUT(I) = 0 3377- LINKUT(I) = 0 3378- LOOKAT(I) = 0 3379- ICUT1(I) = 0 3380- INHBT(I) = 0 3381- KCOL(I) = 0 3382- KCOST(I) = 0 3383- KROW(I) = 0 3384- KRHS(I) = 0 3385- KBOUND(I) = 0 3386- KNAMES(I) = 0 3387- IANCTR(I) = 0 3388- IBROTH(I) = 0 3389- IDESC(I) = 0 3390- NDESC(I) = 0 3391- KDATA(I) = 0 3392- PROB(I) = 0.0 3393- 120 CONTINUE 3394- DO 130 I=1,1001 3395- LE(I) = 0 3396- 130 CONTINUE 3397- DO 150 L=1,10 3398- IRNGE0(L) = 0 3399- IRNGE1(L) = 0 3400- IRNGE2(L) = 0 3401- 150 CONTINUE 3402- DO 160 I=1,10 3403- DO 160 J=1,10 3404- IASTO(I,J) = 0 3405- 160 CONTINUE 3406- DE = 0.0 3407- DP = 0.0 3408- IBASIS = 0 3409- IDIR = 0 3410- IDUAL = 0 3411- IOBJ = 0 3412- IROWP = 0 3413- ITCNT = 0 3414- INVFRQ = 0 3415- ISTOCH = 0 3416- ITRFRQ = 0 3417- JCOLP = 0 3418- MAXCOL = 0 3419- MAXROW = 0 3420- NETA = 0 3421- NLELEM = 0 3422- NLETA = 0 3423- NUELEM = 0 3424- NUETA = 0 3425- NELEM = 0 3426- NPASS = 0 3427- IPER = 0 3428- JPASS = 0 3429- JVRSN = 0 3430- NREADB = 0 3431- NPER = 0 3432- INFLAG = 0 3433- INDEP = 0 3434- RETURN 3435- END 3436- SUBROUTINE IOPREP(MODE) 3437-C 3438-C THIS SUBROUTINE CONTAINS THE I/O UNIT ASSIGNMENTS AND OPEN/CLOSE 3439-C STATEMENTS SHOULD SUCH BE NECESSARY. 3440-C 3441-C *** PARAMETER DESCRIPTION *** 3442-C 3443-C MODE = 1 for setup/open I/O channels 3444-C MODE = 2 shutdown/close I/O channels 3445-C 3446- COMMON /UNITS/ IOTIM,IOCOR,IOSTO,IOINB,IOPAR,IOLOG,IOBAS,IOSUM, 3447- * IOSOL 3448-C 3449- IF (MODE .EQ. 2) GOTO 100 3450-C 3451-C ---------------------------------------------------------------- 3452-C 3453-C THE FOLLOWING I/O CHANNELS ARE USED: 3454-C 3455-C IOTIM - Time file 3456-C IOCOR - Core file 3457-C IOSTO - Stoch file 3458-C IOINB - Input starting basis 3459-C IOPAR - Parameters 3460-C IOLOG - Detailed iteration log 3461-C IOBAS - Output final basis 3462-C IOSUM - Summary results 3463-C 3464-C ---------------------------------------------------------------- 3465-C 3466- IOTIM = 1 3467- IOCOR = 2 3468- IOSTO = 3 3469- IOINB = 4 3470- IOPAR = 5 3471- IOLOG = 6 3472- IOBAS = 7 3473- IOSUM = 8 3474-C 3475-C OPEN(IOTIM, ... <- input channel 3476-C OPEN(IOCOR, ... <- input channel 3477-C OPEN(IOSTO, ... <- input channel 3478-C OPEN(IOINB, ... <- input channel 3479-C OPEN(IOPAR, ... <- input channel 3480-C OPEN(IOLOG, ... <- output channel 3481-C OPEN(IOBAS, ... <- output channel 3482-C OPEN(IOSUM, ... <- output channel 3483-C 3484- RETURN 3485-C 3486-C MODE = 2 (this section would be processed just before shutdown) 3487-C 3488- 100 CONTINUE 3489-C CLOSE(IOTIM, ... 3490-C CLOSE(IOCOR, ... 3491-C CLOSE(IOSTO, ... 3492-C CLOSE(IOINB, ... 3493-C CLOSE(IOPAR, ... 3494-C CLOSE(IOLOG, ... 3495-C CLOSE(IOBAS, ... 3496-C CLOSE(IOSUM, ... 3497-C 3498- RETURN 3499- END 3500- SUBROUTINE STOPIT 3501-C 3502-C THIS SUBROUTINE CONTAINS THE ONLY STOP OF THE PROGRAM. 3503-C BEFORE SHUTTING DOWN, ALL I/O CHANNELS ARE CLOSED. 3504-C 3505- CALL IOPREP(2) 3506- STOP 3507- END 3508- SUBROUTINE UNPACK ( IV, IMTX ) 3509-C 3510-C This routine expands a column of one of the blocks that make up 3511-C the constraint matrix. It can be used for off-diagonal blocks as 3512-C well as blocks on the main diagonal. 3513-C 3514-C -------------------- 3515-C 3516-C ****** PARAMETERS ****** 3517-C 3518-C IV Number of the column to be expanded in relative address mode 3519-C IMTX Offset of the block in question 3520-C - IMTX = 1 for a block on the main diagonal (A_t,t) 3521-C - IMTX = 2 for a block immediately to its left (A_t,t-1) 3522-C - IMTX = 3 for A_t,t-2, etc. 3523-C 3524-C -------------------- 3525-C 3526-C written January 31, 1988 3527-C 3528-C -------------------- 3529-C 3530- include 'common5.for' 3531-C 3532-C START BY INITIALIZING AND SETTING THE COLUMN TO ZERO 3533-C 3534- NROWS = NROW(INODE) 3535- NCUTS = NCUT(INODE) 3536- NRTOT = NROWS + NCUTS 3537- NOFTH = 1 3538- ICOST = KCOST(INODE) 3539- IDATA = KDATA(INODE) + IMTX 3540- ICOLA = KCOLA(IDATA) 3541- IELMA = KELMA(IDATA) 3542- DO 100 I=1,NRTOT 3543- Y(I) = 0.0 3544- 100 CONTINUE 3545- IF (IMTX .GT. 1) GOTO 190 3546- NSLACK = NROW(INODE) 3547- NCOLS = NCOL(INODE) 3548- IF (MULTI .EQ. 1) NOFTH = NDESC(INODE) 3549-C 3550-C BLOCK IS ON THE MAIN DIAGONAL. DETERMINE THE TYPE OF COLUMN 3551-C 3552- IF (IV .GT. NCOLS+NOFTH) GOTO 158 3553- IF (IV .GT. NCOLS ) GOTO 140 3554- IF (IV .LE. NSLACK) GOTO 130 3555-C 3556-C HERE IT IS A GENUINE COLUMN 3557-C 3558- IVA = IV - NSLACK + ICOLA 3559- IVN = IV - NSLACK 3560- LL = LA(IVA) + IELMA 3561- KK = LA(IVA+1) + IELMA - 1 3562- DO 110 I=LL,KK 3563- IR = IA(I) 3564- Y(IR) = A(I) 3565- 110 CONTINUE 3566- Y(IOBJ) = COST(ICOST+IVN) 3567-C 3568-C ...AND NOW FOR THE CUTS 3569-C 3570- IF (NCUTS .EQ. 0) GOTO 260 3571- LK = ICUT1(INODE) 3572- DO 120 I=1,NCUTS 3573- IR = KFIRST(LK) + IVN 3574- IL = I + NSLACK 3575- Y(IL) = A(IR) 3576- LK = LINKUT(LK) 3577- 120 CONTINUE 3578- GOTO 260 3579-C 3580-C HERE IT IS AN ORIGINAL SLACK 3581-C 3582- 130 CONTINUE 3583- Y(IV) = 1.0 3584- GOTO 260 3585-C 3586-C HERE IT IS THE COLUMN ASSOCIATED WITH ONE OF THE THETAS 3587-C 3588- 140 CONTINUE 3589- KOFTH = IV - NCOLS 3590- IF (MULTI .EQ. 1) GOTO 142 3591- IF (NTH(INODE) .EQ. 0) GOTO 260 3592- GOTO 153 3593- 142 CONTINUE 3594- ID = IDESC(INODE) 3595- IF (KOFTH .EQ. 1) GOTO 150 3596- DO 145 I=1,KOFTH-1 3597- ID = IBROTH(ID) 3598- 145 CONTINUE 3599- 150 CONTINUE 3600- IF (NTH(ID) .EQ. 0) GOTO 260 3601- 153 CONTINUE 3602- Y(IOBJ) = -1.0 3603- LK = ICUT1(INODE) 3604- DO 155 I=1,NCUTS 3605- IF (ICTYPE(LK) .NE. KOFTH) GOTO 154 3606- IR = I + NSLACK 3607- Y(IR) = 1.0 3608- 154 CONTINUE 3609- LK = LINKUT(LK) 3610- 155 CONTINUE 3611- GOTO 260 3612-C 3613-C HERE IT IS A SLACK FOR A CUT 3614-C 3615- 158 CONTINUE 3616- IR = IV - NCOLS - NOFTH + NSLACK 3617- Y(IR) = 1.0 3618- GOTO 260 3619-C 3620-C THE COLUMN IS IN ONE OF THE SUBDIAGONAL MATRICES 3621-C 3622- 190 CONTINUE 3623- IOFF = 0 3624- JNODE = INODE 3625- DO 200 I=2,IMTX 3626- IOFF = IOFF + NCOL(JNODE) - NROW(JNODE) 3627- JNODE = IANCTR(JNODE) 3628- IF (JNODE .EQ. 0) GOTO 260 3629- 200 CONTINUE 3630- NSLACK = NROW(JNODE) 3631- NCOLS = NCOL(JNODE) 3632- IF (IV .GT. NCOLS .OR. IV .LE. NSLACK) GOTO 260 3633-C 3634-C ONLY GENUINE COLUMNS MATTER, ALL OTHERS ARE ZERO 3635-C 3636- IVA = IV - NSLACK + ICOLA 3637- IVN = IV - NSLACK + IOFF 3638- LL = LA(IVA) + IELMA 3639- KK = LA(IVA+1) + IELMA - 1 3640- DO 210 I=LL,KK 3641- IR = IA(I) 3642- Y(IR) = A(I) 3643- 210 CONTINUE 3644-C 3645-C ... AND NOW FOR THE CUTS. NEEDED FOR NON-MARKOVIAN PROBLEMS ONLY 3646-C 3647- IF (MARKOV .OR. NCUTS .EQ. 0) GOTO 260 3648- LK = ICUT1(INODE) 3649- DO 220 I=1,NCUTS 3650- IR = KFIRST(LK) + IVN 3651- IL = I + NSLACK 3652- Y(IL) = A(IR) 3653- LK = LINKUT(LK) 3654- 220 CONTINUE 3655-C 3656- 260 CONTINUE 3657- RETURN 3658- END 3659//GO.SYSIN DD std2mps.f 3660echo common5.for 1>&2 3661sed >common5.for <<'//GO.SYSIN DD common5.for' 's/^-//' 3662-C& 3663- IMPLICIT REAL*8(A-H,O,P,R-Z), INTEGER(I-N), CHARACTER*1 (Q) 3664- CHARACTER*8 NAMES, DXI, DBOUND, DRANGE 3665- LOGICAL MARKOV 3666-C 3667- COMMON A(30000),E(10000),B(20000),X(20000),XLB(3000),XUB(3000), 3668- 1 XI(10000),YPI(20000),YPIBAR(600),Y(350),YTEMP(600), 3669- 2 YTEMP1(600),IA(30000),IE(10000),JH(20000),KINBAS(40000), 3670- 3 LA(10000),LE(1001),MARKOV 3671-C 3672- COMMON /ATLAS/ MAPCOL(600),MAPROW(350),MAPCUT(2000) 3673- COMMON /CHARS/ QA,QAST,QB,QBL,QC,QD,QE,QF,QG,QH,QI,QK,QL,QM,QN, 3674- * QO,QP,QR,QS,QT,QU,QV,QX,QSTAT 3675- COMMON /CONST/ ZTOLZE, ZTOLPV, ZTCOST, NAMAX, NBMAX, NCMAX, 3676- * NEMAX, NLMAX, NPMAX, NRMAX, NTMAX, NVMAX, 3677- * NROWMX, NCOLMX, NEGINF 3678-C 3679- COMMON /CUTDAT/ICTYPE(2000),ICUT1(2000),KFIRST(2000),LINKUT(2000), 3680- * KCUT0, MAXCOL,MAXROW,MAXRHS,NOFCUT 3681- COMMON /INDATA/ LASTC, LASTD, LASTR, LASTBD,LASTNM,LASTCA 3682- COMMON /LPSTAT/ LPCUTS,LPPROB,LPBINV,LPNORM,LPOPTC 3683-C 3684- COMMON /PARAM/ IBASIS,ICONST,IDUAL,INDEP,INVFRQ,IOBJ,ISCHUR, 3685- * ISTOCH,ITRFRQ,INFLAG,JVRSN,MULTI,NECHO,NREADB 3686- COMMON /PIVOT/ APV,CMAX,CMIN,DE,DP,DRES,IPTYPE,NINF,NOPT,NPIVOT, 3687- * IROWP,IROWQ,ITCNT,JCOLP,JCOLQ,JCOUT,NETA, 3688- * NELEM,LASTA,NLELEM,NLETA,NUELEM,NUETA 3689- COMMON /SCHUR/ DRHS(100),DZBAR(100),XMACH(10),JIN(100),JOUT(100), 3690- * NTLBAS(350),NTLROW(600),ICHAIN(301), 3691- * INCH,IQFST,IRFST,LENC,INVT 3692-C 3693- COMMON /SCINFO/ XOLD(2000), PROB(2000), KCOL(2000), KCOLA(5000), 3694- 1 KCOST(2000), KELMA(5000), KROW(2000), KRHS(2000), 3695- 2 KNAMES(2000),KBOUND(2000),NCOL(2000), NCUT(2000), 3696- 3 IANCTR(2000),IBROTH(2000),IDESC(2000),INHBT(2000), 3697- 4 NELMA(5000), LOOKAT(2000),NROW(2000), NTH(2000), 3698- 5 NUDATA(2000),NUDUAL(2000),NDESC(2000),KDATA(2000) 3699- COMMON /SEQ/ IDIR,IPER,INODE,JPASS,LPER,NPASS,NPER,NODES, 3700- * IASTO(10,10),IRNGE0(10),IRNGE1(10),IRNGE2(10) 3701- COMMON /TRIKL/ COST(3000),XLTEMP(350),XUTEMP(350),XPREV 3702- COMMON /UNITS / IOTIM,IOCOR,IOSTO,IOINB,IOPAR,IOLOG,IOBAS,IOSUM, 3703- * IOSOL 3704- COMMON /VARNAM/ NAMES(3000), DXI, DBOUND, DRANGE 3705-C# 3706//GO.SYSIN DD common5.for 3707echo time7.frs 1>&2 3708sed >time7.frs <<'//GO.SYSIN DD time7.frs' 's/^-//' 3709-TIME STOCHFOR 3710-PERIODS 3711- CLASS3.1 HARV PERIOD1 3712- CLASS3.2 BOUND3.2 PERIOD2 3713- CLASS3.3 BOUND3.3 PERIOD3 3714- CLASS3.4 BOUND3.4 PERIOD4 3715- CLASS3.5 BOUND3.5 PERIOD5 3716- CLASS3.6 BOUND3.6 PERIOD6 3717- CLASS3.7 BOUND3.7 PERIOD7 3718-ENDATA 3719//GO.SYSIN DD time7.frs 3720echo core.mpc 1>&2 3721sed >core.mpc <<'//GO.SYSIN DD core.mpc' 's/^-//' 3722- 3723-NAME STOCHFOR 3724- 118 111 6 474 1 8 0 0 3725- 0 0 21 3726-jO,'yiOg#RO,'y['oa~['g`r[a^`QS-lQSBtQS+MQS;zQS?yQSE]QS?/QS66QS"VQSFXQS"w 3727-QS<v 3728-NHARV 3729-LBOUND3.1 3730-LBOUND4.1 3731-LBOUND5.1 3732-LBOUND6.1 3733-LBOUND7.1 3734-LBOUND8.1 3735-EREGEN1.1 3736-EREGEN2.1 3737-EREGEN3.1 3738-EREGEN4.1 3739-EREGEN5.1 3740-EREGEN6.1 3741-EREGEN7.1 3742-EREGEN8.1 3743-EYIELD1 3744-LBOUND3.2 3745-LBOUND4.2 3746-LBOUND5.2 3747-LBOUND6.2 3748-LBOUND7.2 3749-LBOUND8.2 3750-EREGEN1.2 3751-EREGEN2.2 3752-EREGEN3.2 3753-EREGEN4.2 3754-EREGEN5.2 3755-EREGEN6.2 3756-EREGEN7.2 3757-EREGEN8.2 3758-LTFLOW1.2 3759-GTFLOW2.2 3760-EYIELD2 3761-LBOUND3.3 3762-LBOUND4.3 3763-LBOUND5.3 3764-LBOUND6.3 3765-LBOUND7.3 3766-LBOUND8.3 3767-EREGEN1.3 3768-EREGEN2.3 3769-EREGEN3.3 3770-EREGEN4.3 3771-EREGEN5.3 3772-EREGEN6.3 3773-EREGEN7.3 3774-EREGEN8.3 3775-LTFLOW1.3 3776-GTFLOW2.3 3777-EYIELD3 3778-LBOUND3.4 3779-LBOUND4.4 3780-LBOUND5.4 3781-LBOUND6.4 3782-LBOUND7.4 3783-LBOUND8.4 3784-EREGEN1.4 3785-EREGEN2.4 3786-EREGEN3.4 3787-EREGEN4.4 3788-EREGEN5.4 3789-EREGEN6.4 3790-EREGEN7.4 3791-EREGEN8.4 3792-LTFLOW1.4 3793-GTFLOW2.4 3794-EYIELD4 3795-LBOUND3.5 3796-LBOUND4.5 3797- 6i$Z_SW[`cgk`dhlaN[`TX]adhlaeimb4=O]aUY^beimbfjnc5>P^bVZ_cfjncgkod6?Q_c 3798-LBOUND5.5 3799-LBOUND6.5 3800-LBOUND7.5 3801-LBOUND8.5 3802-EREGEN1.5 3803-EREGEN2.5 3804-EREGEN3.5 3805-EREGEN4.5 3806-EREGEN5.5 3807-EREGEN6.5 3808-EREGEN7.5 3809-EREGEN8.5 3810-LTFLOW1.5 3811-GTFLOW2.5 3812-EYIELD5 3813-LBOUND3.6 3814-LBOUND4.6 3815-LBOUND5.6 3816-LBOUND6.6 3817-LBOUND7.6 3818-LBOUND8.6 3819-EREGEN1.6 3820-EREGEN2.6 3821-EREGEN3.6 3822-EREGEN4.6 3823-EREGEN5.6 3824-EREGEN6.6 3825-EREGEN7.6 3826-EREGEN8.6 3827-LTFLOW1.6 3828-GTFLOW2.6 3829-EYIELD6 3830-LBOUND3.7 3831-LBOUND4.7 3832-LBOUND5.7 3833-LBOUND6.7 3834-LBOUND7.7 3835-LBOUND8.7 3836-EREGEN1.7 3837-EREGEN2.7 3838-EREGEN3.7 3839-EREGEN4.7 3840-EREGEN5.7 3841-EREGEN6.7 3842-EREGEN7.7 3843-EREGEN8.7 3844-LTFLOW1.7 3845-GTFLOW2.7 3846-EYIELD7 3847-8CLASS3.1 3848-;cIA!h9!k<!pK!qM8CLASS4.1 3849-!h9!l<!pE!qC<cIB8CLASS5.1 3850-=cI@!h9!m<!pJ!qF8CLASS6.1 3851-!h9!n<!pN!qD>cI>8CLASS7.1 3852-?cI?!h9!o<!pI!qH8CLASS8.1 3853-!h9!o<!pG!qL@cI=8STATE1.1 3854-Ac!h;!i98STATE2.1 3855-!h;!j9Bc8STATE3.1 3856-Cc;z!h;!k98STATE4.1 3857-!h;!l9Dc<z8STATE5.1 3858-Ec=z!h;!m98STATE6.1 3859-!h;!n9Fc>z8STATE7.1 3860-Gc?z!h;!o98STATE8.1 3861-!h;!o9Hc@z8BALAN1 3862-9zIz8CLASS3.2 3863-Jc!rA!y9!|<"RK"SM8CLASS4.2 3864-!y9!}<"RE"SCKc!rB8CLASS5.2 3865-Lc!r@!y9!~<"RJ"SF8CLASS6.2 3866-!y9"P<"RN"SDMc!r>8CLASS7.2 3867-Nc!r?!y9"Q<"RI"SH8CLASS8.2 3868-!y9"Q<"RG"SLOc!r=8STATE1.2 3869- W[`dgkodhlpe7@R`dX]aehlpeimqf8ASaeY^bfimqfjnrg9BTLob]JrPg(N;/;omj;BEgd{ 3870-!hc!y;!z98STATE2.2 3871-!y;!{9!ic8STATE3.2 3872-!jcJz!y;!|98STATE4.2 3873-!y;!}9!kcKz8STATE5.2 3874-!lcLz!y;!~98STATE6.2 3875-!y;"P9!mcMz8STATE7.2 3876-!ncNz!y;"Q98STATE8.2 3877-!y;"Q9!ocOz8BALAN2 3878-9kM,[>G!rz!pz!qz8PNLTY2 3879-!pz9PU&8CLASS3.3 3880-!sc"TA"[9"_<"dK"eM8CLASS4.3 3881-"[9"`<"dE"eC!tc"TB8CLASS5.3 3882-!uc"T@"[9"a<"dJ"eF8CLASS6.3 3883-"[9"b<"dN"eD!vc"T>8CLASS7.3 3884-!wc"T?"[9"c<"dI"eH8CLASS8.3 3885-"[9"c<"dG"eL!xc"T=8STATE1.3 3886-!yc"[;"]98STATE2.3 3887-"[;"^9!zc8STATE3.3 3888-!{c!sz"[;"_98STATE4.3 3889-"[;"`9!|c!tz8STATE5.3 3890-!}c!uz"[;"a98STATE6.3 3891-"[;"b9!~c!vz8STATE7.3 3892-"Pc!wz"[;"c98STATE8.3 3893-"[;"c9"Qc!xz8BALAN3 3894-9kM+Qkp"Tz"Rz"Sz8PNLTY3 3895-"Rz9QRS28CLASS3.4 3896-"Uc"fA"m9"p<"uK"vM8CLASS4.4 3897-"m9"q<"uE"vC"Vc"fB8CLASS5.4 3898-"Wc"f@"m9"r<"uJ"vF8CLASS6.4 3899-"m9"s<"uN"vD"Xc"f>8CLASS7.4 3900-"Yc"f?"m9"t<"uI"vH8CLASS8.4 3901-"m9"t<"uG"vL"Zc"f=8STATE1.4 3902-"[c"m;"n98STATE2.4 3903-"m;"o9"]c8STATE3.4 3904-"^c"Uz"m;"p98STATE4.4 3905-"m;"q9"_c"Vz8STATE5.4 3906-"`c"Wz"m;"r98STATE6.4 3907-"m;"s9"ac"Xz8STATE7.4 3908-"bc"Yz"m;"t98STATE8.4 3909-"m;"t9"cc"Zz8BALAN4 3910-9kM*Qvy"fz"dz"ez8PNLTY4 3911-"dz9QRNR8CLASS3.5 3912-"gc"wA"~9#R<#WK#XM8CLASS4.5 3913-"~9#S<#WE#XC"hc"wB8CLASS5.5 3914-"ic"w@"~9#T<#WJ#XF8CLASS6.5 3915-"~9#U<#WN#XD"jc"w>8CLASS7.5 3916-"kc"w?"~9#V<#WI#XH8CLASS8.5 3917-"~9#V<#WG#XL"lc"w=8STATE1.5 3918-"mc"~;#P98STATE2.5 3919-"~;#Q9"nc8STATE3.5 3920-"oc"gz"~;#R98STATE4.5 3921-"~;#S9"pc"hz8STATE5.5 3922-"qc"iz"~;#T98STATE6.5 3923-"~;#U9"rc"jz8STATE7.5 3924-"sc"kz"~;#V98STATE8.5 3925-"~;#V9"tc"lz8BALAN5 3926-9kM)ZhS"wz"uz"vz8PNLTY5 3927-"uz9QRJ=8CLASS3.6 3928-"xc#YA#a9#d<#iK#jM8CLASS4.6 3929-#a9#e<#iE#jC"yc#YB8CLASS5.6 3930-"zc#Y@#a9#f<#iJ#jF8CLASS6.6 3931-#a9#g<#iN#jD"{c#Y>8CLASS7.6 3932-"|c#Y?#a9#h<#iI#jH8CLASS8.6 3933-#a9#h<#iG#jL"}c#Y=8STATE1.6 3934-"~c#a;#b98STATE2.6 3935-#a;#c9#Pc8STATE3.6 3936-#Qc"xz#a;#d98STATE4.6 3937-#a;#e9#Rc"yz8STATE5.6 3938-#Sc"zz#a;#f98STATE6.6 3939-#a;#g9#Tc"{z8STATE7.6 3940-#Uc"|z#a;#h98STATE8.6 3941- Z?/W~}peG77NQntn^mdNr3];4AW`q05!+_'[5AS%&Cf]!-D-,Q2CP7_-(U'>1^d^n/yz)o7 3942-#a;#h9#Vc"}z8BALAN6 3943-9kM(lOJ#Yz#Wz#Xz8PNLTY6 3944-#Wz9QRFM8CLASS3.7 3945-#Zc#kA9SO;KeI8CLASS4.7 3946-#[c#kB9SO>]FY8CLASS5.7 3947-#]c#k@9SOBEC78CLASS6.7 3948-#^c#k>9SOF)7B8CLASS7.7 3949-#_c#k?9SOGUH_8CLASS8.7 3950-#`c#k=9SOH'J@8STATE1.7 3951-#ac9kO5LfZ8STATE2.7 3952-#bc9kP#;AD8STATE3.7 3953-#cc#Zz9kO;KeI8STATE4.7 3954-#dc#[z9kO>]FY8STATE5.7 3955-#ec#]z9kOBEC78STATE6.7 3956-#fc#^z9kOF)7B8STATE7.7 3957-#gc#_z9kOGUH_8STATE8.7 3958-#hc#`z9kOH'J@8BALAN7 3959-9kM(&Db#kz#iz#jz8PNLTY7 3960-#iz9QRC! 3961-8RHS 3962-AQQ#[BQQ"CCQQ09DQQ6kERQ"/1FRQ"y*GQQ@YHRQ(?r 3963- Zzweu72u<D/qnE5tp}rTQ 3964//GO.SYSIN DD core.mpc 3965echo stoch1.frs 1>&2 3966sed >stoch1.frs <<'//GO.SYSIN DD stoch1.frs' 's/^-//' 3967-STOCH STOCHFOR 3968-BLOCKS DISCRETE 3969-ENDATA 3970//GO.SYSIN DD stoch1.frs 3971echo stoch2.frs 1>&2 3972sed >stoch2.frs <<'//GO.SYSIN DD stoch2.frs' 's/^-//' 3973-STOCH STOCHFOR 3974-BLOCKS DISCRETE 3975- BL BLOCK1 PERIOD2 .6912 3976- CLASS3.1 REGEN1.2 -1.0000 REGEN4.2 1.0000 3977- CLASS4.1 REGEN1.2 -1.0000 REGEN5.2 1.0000 3978- CLASS5.1 REGEN1.2 -1.0000 REGEN6.2 1.0000 3979- CLASS6.1 REGEN1.2 -1.0000 REGEN7.2 1.0000 3980- CLASS7.1 REGEN1.2 -1.0000 REGEN8.2 1.0000 3981- CLASS8.1 REGEN1.2 -1.0000 REGEN8.2 1.0000 3982- STATE1.1 REGEN1.2 -.00000 REGEN2.2 -1.0000 3983- STATE2.1 REGEN1.2 -.00000 REGEN3.2 -1.0000 3984- STATE3.1 REGEN1.2 -.00000 REGEN4.2 -1.0000 3985- STATE4.1 REGEN1.2 -.00000 REGEN5.2 -1.0000 3986- STATE5.1 REGEN1.2 -.00000 REGEN6.2 -1.0000 3987- STATE6.1 REGEN1.2 -.00000 REGEN7.2 -1.0000 3988- STATE7.1 REGEN1.2 -.00000 REGEN8.2 -1.0000 3989- STATE8.1 REGEN1.2 -.00000 REGEN8.2 -1.0000 3990- BL BLOCK1 PERIOD2 .3088 3991- CLASS3.1 REGEN1.2 -.79732 REGEN4.2 .79732 3992- CLASS4.1 REGEN1.2 -.79732 REGEN5.2 .79732 3993- CLASS5.1 REGEN1.2 -.79732 REGEN6.2 .79732 3994- CLASS6.1 REGEN1.2 -.79732 REGEN7.2 .79732 3995- CLASS7.1 REGEN1.2 -.79732 REGEN8.2 .79732 3996- CLASS8.1 REGEN1.2 -.79732 REGEN8.2 .79732 3997- STATE1.1 REGEN1.2 -.20268 REGEN2.2 -.79732 3998- STATE2.1 REGEN1.2 -.20268 REGEN3.2 -.79732 3999- STATE3.1 REGEN1.2 -.20268 REGEN4.2 -.79732 4000- STATE4.1 REGEN1.2 -.20268 REGEN5.2 -.79732 4001- STATE5.1 REGEN1.2 -.20268 REGEN6.2 -.79732 4002- STATE6.1 REGEN1.2 -.20268 REGEN7.2 -.79732 4003- STATE7.1 REGEN1.2 -.20268 REGEN8.2 -.79732 4004- STATE8.1 REGEN1.2 -.20268 REGEN8.2 -.79732 4005- BL BLOCK2 PERIOD3 .6912 4006- CLASS3.2 REGEN1.3 -1.0000 REGEN4.3 1.0000 4007- CLASS4.2 REGEN1.3 -1.0000 REGEN5.3 1.0000 4008- CLASS5.2 REGEN1.3 -1.0000 REGEN6.3 1.0000 4009- CLASS6.2 REGEN1.3 -1.0000 REGEN7.3 1.0000 4010- CLASS7.2 REGEN1.3 -1.0000 REGEN8.3 1.0000 4011- CLASS8.2 REGEN1.3 -1.0000 REGEN8.3 1.0000 4012- STATE1.2 REGEN1.3 -.00000 REGEN2.3 -1.0000 4013- STATE2.2 REGEN1.3 -.00000 REGEN3.3 -1.0000 4014- STATE3.2 REGEN1.3 -.00000 REGEN4.3 -1.0000 4015- STATE4.2 REGEN1.3 -.00000 REGEN5.3 -1.0000 4016- STATE5.2 REGEN1.3 -.00000 REGEN6.3 -1.0000 4017- STATE6.2 REGEN1.3 -.00000 REGEN7.3 -1.0000 4018- STATE7.2 REGEN1.3 -.00000 REGEN8.3 -1.0000 4019- STATE8.2 REGEN1.3 -.00000 REGEN8.3 -1.0000 4020- BL BLOCK2 PERIOD3 .3088 4021- CLASS3.2 REGEN1.3 -.79732 REGEN4.3 .79732 4022- CLASS4.2 REGEN1.3 -.79732 REGEN5.3 .79732 4023- CLASS5.2 REGEN1.3 -.79732 REGEN6.3 .79732 4024- CLASS6.2 REGEN1.3 -.79732 REGEN7.3 .79732 4025- CLASS7.2 REGEN1.3 -.79732 REGEN8.3 .79732 4026- CLASS8.2 REGEN1.3 -.79732 REGEN8.3 .79732 4027- STATE1.2 REGEN1.3 -.20268 REGEN2.3 -.79732 4028- STATE2.2 REGEN1.3 -.20268 REGEN3.3 -.79732 4029- STATE3.2 REGEN1.3 -.20268 REGEN4.3 -.79732 4030- STATE4.2 REGEN1.3 -.20268 REGEN5.3 -.79732 4031- STATE5.2 REGEN1.3 -.20268 REGEN6.3 -.79732 4032- STATE6.2 REGEN1.3 -.20268 REGEN7.3 -.79732 4033- STATE7.2 REGEN1.3 -.20268 REGEN8.3 -.79732 4034- STATE8.2 REGEN1.3 -.20268 REGEN8.3 -.79732 4035- BL BLOCK3 PERIOD4 .6912 4036- CLASS3.3 REGEN1.4 -1.0000 REGEN4.4 1.0000 4037- CLASS4.3 REGEN1.4 -1.0000 REGEN5.4 1.0000 4038- CLASS5.3 REGEN1.4 -1.0000 REGEN6.4 1.0000 4039- CLASS6.3 REGEN1.4 -1.0000 REGEN7.4 1.0000 4040- CLASS7.3 REGEN1.4 -1.0000 REGEN8.4 1.0000 4041- CLASS8.3 REGEN1.4 -1.0000 REGEN8.4 1.0000 4042- STATE1.3 REGEN1.4 -.00000 REGEN2.4 -1.0000 4043- STATE2.3 REGEN1.4 -.00000 REGEN3.4 -1.0000 4044- STATE3.3 REGEN1.4 -.00000 REGEN4.4 -1.0000 4045- STATE4.3 REGEN1.4 -.00000 REGEN5.4 -1.0000 4046- STATE5.3 REGEN1.4 -.00000 REGEN6.4 -1.0000 4047- STATE6.3 REGEN1.4 -.00000 REGEN7.4 -1.0000 4048- STATE7.3 REGEN1.4 -.00000 REGEN8.4 -1.0000 4049- STATE8.3 REGEN1.4 -.00000 REGEN8.4 -1.0000 4050- BL BLOCK3 PERIOD4 .3088 4051- CLASS3.3 REGEN1.4 -.79732 REGEN4.4 .79732 4052- CLASS4.3 REGEN1.4 -.79732 REGEN5.4 .79732 4053- CLASS5.3 REGEN1.4 -.79732 REGEN6.4 .79732 4054- CLASS6.3 REGEN1.4 -.79732 REGEN7.4 .79732 4055- CLASS7.3 REGEN1.4 -.79732 REGEN8.4 .79732 4056- CLASS8.3 REGEN1.4 -.79732 REGEN8.4 .79732 4057- STATE1.3 REGEN1.4 -.20268 REGEN2.4 -.79732 4058- STATE2.3 REGEN1.4 -.20268 REGEN3.4 -.79732 4059- STATE3.3 REGEN1.4 -.20268 REGEN4.4 -.79732 4060- STATE4.3 REGEN1.4 -.20268 REGEN5.4 -.79732 4061- STATE5.3 REGEN1.4 -.20268 REGEN6.4 -.79732 4062- STATE6.3 REGEN1.4 -.20268 REGEN7.4 -.79732 4063- STATE7.3 REGEN1.4 -.20268 REGEN8.4 -.79732 4064- STATE8.3 REGEN1.4 -.20268 REGEN8.4 -.79732 4065- BL BLOCK4 PERIOD5 .6912 4066- CLASS3.4 REGEN1.5 -1.0000 REGEN4.5 1.0000 4067- CLASS4.4 REGEN1.5 -1.0000 REGEN5.5 1.0000 4068- CLASS5.4 REGEN1.5 -1.0000 REGEN6.5 1.0000 4069- CLASS6.4 REGEN1.5 -1.0000 REGEN7.5 1.0000 4070- CLASS7.4 REGEN1.5 -1.0000 REGEN8.5 1.0000 4071- CLASS8.4 REGEN1.5 -1.0000 REGEN8.5 1.0000 4072- STATE1.4 REGEN1.5 -.00000 REGEN2.5 -1.0000 4073- STATE2.4 REGEN1.5 -.00000 REGEN3.5 -1.0000 4074- STATE3.4 REGEN1.5 -.00000 REGEN4.5 -1.0000 4075- STATE4.4 REGEN1.5 -.00000 REGEN5.5 -1.0000 4076- STATE5.4 REGEN1.5 -.00000 REGEN6.5 -1.0000 4077- STATE6.4 REGEN1.5 -.00000 REGEN7.5 -1.0000 4078- STATE7.4 REGEN1.5 -.00000 REGEN8.5 -1.0000 4079- STATE8.4 REGEN1.5 -.00000 REGEN8.5 -1.0000 4080- BL BLOCK4 PERIOD5 .3088 4081- CLASS3.4 REGEN1.5 -.79732 REGEN4.5 .79732 4082- CLASS4.4 REGEN1.5 -.79732 REGEN5.5 .79732 4083- CLASS5.4 REGEN1.5 -.79732 REGEN6.5 .79732 4084- CLASS6.4 REGEN1.5 -.79732 REGEN7.5 .79732 4085- CLASS7.4 REGEN1.5 -.79732 REGEN8.5 .79732 4086- CLASS8.4 REGEN1.5 -.79732 REGEN8.5 .79732 4087- STATE1.4 REGEN1.5 -.20268 REGEN2.5 -.79732 4088- STATE2.4 REGEN1.5 -.20268 REGEN3.5 -.79732 4089- STATE3.4 REGEN1.5 -.20268 REGEN4.5 -.79732 4090- STATE4.4 REGEN1.5 -.20268 REGEN5.5 -.79732 4091- STATE5.4 REGEN1.5 -.20268 REGEN6.5 -.79732 4092- STATE6.4 REGEN1.5 -.20268 REGEN7.5 -.79732 4093- STATE7.4 REGEN1.5 -.20268 REGEN8.5 -.79732 4094- STATE8.4 REGEN1.5 -.20268 REGEN8.5 -.79732 4095- BL BLOCK5 PERIOD6 .6912 4096- CLASS3.5 REGEN1.6 -1.0000 REGEN4.6 1.0000 4097- CLASS4.5 REGEN1.6 -1.0000 REGEN5.6 1.0000 4098- CLASS5.5 REGEN1.6 -1.0000 REGEN6.6 1.0000 4099- CLASS6.5 REGEN1.6 -1.0000 REGEN7.6 1.0000 4100- CLASS7.5 REGEN1.6 -1.0000 REGEN8.6 1.0000 4101- CLASS8.5 REGEN1.6 -1.0000 REGEN8.6 1.0000 4102- STATE1.5 REGEN1.6 -.00000 REGEN2.6 -1.0000 4103- STATE2.5 REGEN1.6 -.00000 REGEN3.6 -1.0000 4104- STATE3.5 REGEN1.6 -.00000 REGEN4.6 -1.0000 4105- STATE4.5 REGEN1.6 -.00000 REGEN5.6 -1.0000 4106- STATE5.5 REGEN1.6 -.00000 REGEN6.6 -1.0000 4107- STATE6.5 REGEN1.6 -.00000 REGEN7.6 -1.0000 4108- STATE7.5 REGEN1.6 -.00000 REGEN8.6 -1.0000 4109- STATE8.5 REGEN1.6 -.00000 REGEN8.6 -1.0000 4110- BL BLOCK5 PERIOD6 .3088 4111- CLASS3.5 REGEN1.6 -.79732 REGEN4.6 .79732 4112- CLASS4.5 REGEN1.6 -.79732 REGEN5.6 .79732 4113- CLASS5.5 REGEN1.6 -.79732 REGEN6.6 .79732 4114- CLASS6.5 REGEN1.6 -.79732 REGEN7.6 .79732 4115- CLASS7.5 REGEN1.6 -.79732 REGEN8.6 .79732 4116- CLASS8.5 REGEN1.6 -.79732 REGEN8.6 .79732 4117- STATE1.5 REGEN1.6 -.20268 REGEN2.6 -.79732 4118- STATE2.5 REGEN1.6 -.20268 REGEN3.6 -.79732 4119- STATE3.5 REGEN1.6 -.20268 REGEN4.6 -.79732 4120- STATE4.5 REGEN1.6 -.20268 REGEN5.6 -.79732 4121- STATE5.5 REGEN1.6 -.20268 REGEN6.6 -.79732 4122- STATE6.5 REGEN1.6 -.20268 REGEN7.6 -.79732 4123- STATE7.5 REGEN1.6 -.20268 REGEN8.6 -.79732 4124- STATE8.5 REGEN1.6 -.20268 REGEN8.6 -.79732 4125- BL BLOCK6 PERIOD7 .6912 4126- CLASS3.6 REGEN1.7 -1.0000 REGEN4.7 1.0000 4127- CLASS4.6 REGEN1.7 -1.0000 REGEN5.7 1.0000 4128- CLASS5.6 REGEN1.7 -1.0000 REGEN6.7 1.0000 4129- CLASS6.6 REGEN1.7 -1.0000 REGEN7.7 1.0000 4130- CLASS7.6 REGEN1.7 -1.0000 REGEN8.7 1.0000 4131- CLASS8.6 REGEN1.7 -1.0000 REGEN8.7 1.0000 4132- STATE1.6 REGEN1.7 -.00000 REGEN2.7 -1.0000 4133- STATE2.6 REGEN1.7 -.00000 REGEN3.7 -1.0000 4134- STATE3.6 REGEN1.7 -.00000 REGEN4.7 -1.0000 4135- STATE4.6 REGEN1.7 -.00000 REGEN5.7 -1.0000 4136- STATE5.6 REGEN1.7 -.00000 REGEN6.7 -1.0000 4137- STATE6.6 REGEN1.7 -.00000 REGEN7.7 -1.0000 4138- STATE7.6 REGEN1.7 -.00000 REGEN8.7 -1.0000 4139- STATE8.6 REGEN1.7 -.00000 REGEN8.7 -1.0000 4140- BL BLOCK6 PERIOD7 .3088 4141- CLASS3.6 REGEN1.7 -.79732 REGEN4.7 .79732 4142- CLASS4.6 REGEN1.7 -.79732 REGEN5.7 .79732 4143- CLASS5.6 REGEN1.7 -.79732 REGEN6.7 .79732 4144- CLASS6.6 REGEN1.7 -.79732 REGEN7.7 .79732 4145- CLASS7.6 REGEN1.7 -.79732 REGEN8.7 .79732 4146- CLASS8.6 REGEN1.7 -.79732 REGEN8.7 .79732 4147- STATE1.6 REGEN1.7 -.20268 REGEN2.7 -.79732 4148- STATE2.6 REGEN1.7 -.20268 REGEN3.7 -.79732 4149- STATE3.6 REGEN1.7 -.20268 REGEN4.7 -.79732 4150- STATE4.6 REGEN1.7 -.20268 REGEN5.7 -.79732 4151- STATE5.6 REGEN1.7 -.20268 REGEN6.7 -.79732 4152- STATE6.6 REGEN1.7 -.20268 REGEN7.7 -.79732 4153- STATE7.6 REGEN1.7 -.20268 REGEN8.7 -.79732 4154- STATE8.6 REGEN1.7 -.20268 REGEN8.7 -.79732 4155-ENDATA 4156//GO.SYSIN DD stoch2.frs 4157echo stoch3.frs 1>&2 4158sed >stoch3.frs <<'//GO.SYSIN DD stoch3.frs' 's/^-//' 4159-STOCH STOCHFOR 4160-BLOCKS DISCRETE 4161- BL BLOCK1 PERIOD2 .1736 4162- CLASS3.1 REGEN1.2 -1.0000 REGEN4.2 1.0000 4163- CLASS4.1 REGEN1.2 -1.0000 REGEN5.2 1.0000 4164- CLASS5.1 REGEN1.2 -1.0000 REGEN6.2 1.0000 4165- CLASS6.1 REGEN1.2 -1.0000 REGEN7.2 1.0000 4166- CLASS7.1 REGEN1.2 -1.0000 REGEN8.2 1.0000 4167- CLASS8.1 REGEN1.2 -1.0000 REGEN8.2 1.0000 4168- STATE1.1 REGEN1.2 -.00000 REGEN2.2 -1.0000 4169- STATE2.1 REGEN1.2 -.00000 REGEN3.2 -1.0000 4170- STATE3.1 REGEN1.2 -.00000 REGEN4.2 -1.0000 4171- STATE4.1 REGEN1.2 -.00000 REGEN5.2 -1.0000 4172- STATE5.1 REGEN1.2 -.00000 REGEN6.2 -1.0000 4173- STATE6.1 REGEN1.2 -.00000 REGEN7.2 -1.0000 4174- STATE7.1 REGEN1.2 -.00000 REGEN8.2 -1.0000 4175- STATE8.1 REGEN1.2 -.00000 REGEN8.2 -1.0000 4176- BL BLOCK1 PERIOD2 .0299 4177- CLASS3.1 REGEN1.2 -.79732 REGEN4.2 .79732 4178- CLASS4.1 REGEN1.2 -.79732 REGEN5.2 .79732 4179- CLASS5.1 REGEN1.2 -.79732 REGEN6.2 .79732 4180- CLASS6.1 REGEN1.2 -.79732 REGEN7.2 .79732 4181- CLASS7.1 REGEN1.2 -.79732 REGEN8.2 .79732 4182- CLASS8.1 REGEN1.2 -.79732 REGEN8.2 .79732 4183- STATE1.1 REGEN1.2 -.20268 REGEN2.2 -.79732 4184- STATE2.1 REGEN1.2 -.20268 REGEN3.2 -.79732 4185- STATE3.1 REGEN1.2 -.20268 REGEN4.2 -.79732 4186- STATE4.1 REGEN1.2 -.20268 REGEN5.2 -.79732 4187- STATE5.1 REGEN1.2 -.20268 REGEN6.2 -.79732 4188- STATE6.1 REGEN1.2 -.20268 REGEN7.2 -.79732 4189- STATE7.1 REGEN1.2 -.20268 REGEN8.2 -.79732 4190- STATE8.1 REGEN1.2 -.20268 REGEN8.2 -.79732 4191- BL BLOCK1 PERIOD2 .5128 4192- CLASS3.1 REGEN1.2 -.93742 REGEN4.2 .93742 4193- CLASS4.1 REGEN1.2 -.93742 REGEN5.2 .93742 4194- CLASS5.1 REGEN1.2 -.93742 REGEN6.2 .93742 4195- CLASS6.1 REGEN1.2 -.93742 REGEN7.2 .93742 4196- CLASS7.1 REGEN1.2 -.93742 REGEN8.2 .93742 4197- CLASS8.1 REGEN1.2 -.93742 REGEN8.2 .93742 4198- STATE1.1 REGEN1.2 -.06258 REGEN2.2 -.93742 4199- STATE2.1 REGEN1.2 -.06258 REGEN3.2 -.93742 4200- STATE3.1 REGEN1.2 -.06258 REGEN4.2 -.93742 4201- STATE4.1 REGEN1.2 -.06258 REGEN5.2 -.93742 4202- STATE5.1 REGEN1.2 -.06258 REGEN6.2 -.93742 4203- STATE6.1 REGEN1.2 -.06258 REGEN7.2 -.93742 4204- STATE7.1 REGEN1.2 -.06258 REGEN8.2 -.93742 4205- STATE8.1 REGEN1.2 -.06258 REGEN8.2 -.93742 4206- BL BLOCK1 PERIOD2 .2837 4207- CLASS3.1 REGEN1.2 -.91388 REGEN4.2 .91388 4208- CLASS4.1 REGEN1.2 -.91388 REGEN5.2 .91388 4209- CLASS5.1 REGEN1.2 -.91388 REGEN6.2 .91388 4210- CLASS6.1 REGEN1.2 -.91388 REGEN7.2 .91388 4211- CLASS7.1 REGEN1.2 -.91388 REGEN8.2 .91388 4212- CLASS8.1 REGEN1.2 -.91388 REGEN8.2 .91388 4213- STATE1.1 REGEN1.2 -.08612 REGEN2.2 -.91388 4214- STATE2.1 REGEN1.2 -.08612 REGEN3.2 -.91388 4215- STATE3.1 REGEN1.2 -.08612 REGEN4.2 -.91388 4216- STATE4.1 REGEN1.2 -.08612 REGEN5.2 -.91388 4217- STATE5.1 REGEN1.2 -.08612 REGEN6.2 -.91388 4218- STATE6.1 REGEN1.2 -.08612 REGEN7.2 -.91388 4219- STATE7.1 REGEN1.2 -.08612 REGEN8.2 -.91388 4220- STATE8.1 REGEN1.2 -.08612 REGEN8.2 -.91388 4221- BL BLOCK2 PERIOD3 .1736 4222- CLASS3.2 REGEN1.3 -1.0000 REGEN4.3 1.0000 4223- CLASS4.2 REGEN1.3 -1.0000 REGEN5.3 1.0000 4224- CLASS5.2 REGEN1.3 -1.0000 REGEN6.3 1.0000 4225- CLASS6.2 REGEN1.3 -1.0000 REGEN7.3 1.0000 4226- CLASS7.2 REGEN1.3 -1.0000 REGEN8.3 1.0000 4227- CLASS8.2 REGEN1.3 -1.0000 REGEN8.3 1.0000 4228- STATE1.2 REGEN1.3 -.00000 REGEN2.3 -1.0000 4229- STATE2.2 REGEN1.3 -.00000 REGEN3.3 -1.0000 4230- STATE3.2 REGEN1.3 -.00000 REGEN4.3 -1.0000 4231- STATE4.2 REGEN1.3 -.00000 REGEN5.3 -1.0000 4232- STATE5.2 REGEN1.3 -.00000 REGEN6.3 -1.0000 4233- STATE6.2 REGEN1.3 -.00000 REGEN7.3 -1.0000 4234- STATE7.2 REGEN1.3 -.00000 REGEN8.3 -1.0000 4235- STATE8.2 REGEN1.3 -.00000 REGEN8.3 -1.0000 4236- BL BLOCK2 PERIOD3 .0299 4237- CLASS3.2 REGEN1.3 -.79732 REGEN4.3 .79732 4238- CLASS4.2 REGEN1.3 -.79732 REGEN5.3 .79732 4239- CLASS5.2 REGEN1.3 -.79732 REGEN6.3 .79732 4240- CLASS6.2 REGEN1.3 -.79732 REGEN7.3 .79732 4241- CLASS7.2 REGEN1.3 -.79732 REGEN8.3 .79732 4242- CLASS8.2 REGEN1.3 -.79732 REGEN8.3 .79732 4243- STATE1.2 REGEN1.3 -.20268 REGEN2.3 -.79732 4244- STATE2.2 REGEN1.3 -.20268 REGEN3.3 -.79732 4245- STATE3.2 REGEN1.3 -.20268 REGEN4.3 -.79732 4246- STATE4.2 REGEN1.3 -.20268 REGEN5.3 -.79732 4247- STATE5.2 REGEN1.3 -.20268 REGEN6.3 -.79732 4248- STATE6.2 REGEN1.3 -.20268 REGEN7.3 -.79732 4249- STATE7.2 REGEN1.3 -.20268 REGEN8.3 -.79732 4250- STATE8.2 REGEN1.3 -.20268 REGEN8.3 -.79732 4251- BL BLOCK2 PERIOD3 .5128 4252- CLASS3.2 REGEN1.3 -.93742 REGEN4.3 .93742 4253- CLASS4.2 REGEN1.3 -.93742 REGEN5.3 .93742 4254- CLASS5.2 REGEN1.3 -.93742 REGEN6.3 .93742 4255- CLASS6.2 REGEN1.3 -.93742 REGEN7.3 .93742 4256- CLASS7.2 REGEN1.3 -.93742 REGEN8.3 .93742 4257- CLASS8.2 REGEN1.3 -.93742 REGEN8.3 .93742 4258- STATE1.2 REGEN1.3 -.06258 REGEN2.3 -.93742 4259- STATE2.2 REGEN1.3 -.06258 REGEN3.3 -.93742 4260- STATE3.2 REGEN1.3 -.06258 REGEN4.3 -.93742 4261- STATE4.2 REGEN1.3 -.06258 REGEN5.3 -.93742 4262- STATE5.2 REGEN1.3 -.06258 REGEN6.3 -.93742 4263- STATE6.2 REGEN1.3 -.06258 REGEN7.3 -.93742 4264- STATE7.2 REGEN1.3 -.06258 REGEN8.3 -.93742 4265- STATE8.2 REGEN1.3 -.06258 REGEN8.3 -.93742 4266- BL BLOCK2 PERIOD3 .2837 4267- CLASS3.2 REGEN1.3 -.91388 REGEN4.3 .91388 4268- CLASS4.2 REGEN1.3 -.91388 REGEN5.3 .91388 4269- CLASS5.2 REGEN1.3 -.91388 REGEN6.3 .91388 4270- CLASS6.2 REGEN1.3 -.91388 REGEN7.3 .91388 4271- CLASS7.2 REGEN1.3 -.91388 REGEN8.3 .91388 4272- CLASS8.2 REGEN1.3 -.91388 REGEN8.3 .91388 4273- STATE1.2 REGEN1.3 -.08612 REGEN2.3 -.91388 4274- STATE2.2 REGEN1.3 -.08612 REGEN3.3 -.91388 4275- STATE3.2 REGEN1.3 -.08612 REGEN4.3 -.91388 4276- STATE4.2 REGEN1.3 -.08612 REGEN5.3 -.91388 4277- STATE5.2 REGEN1.3 -.08612 REGEN6.3 -.91388 4278- STATE6.2 REGEN1.3 -.08612 REGEN7.3 -.91388 4279- STATE7.2 REGEN1.3 -.08612 REGEN8.3 -.91388 4280- STATE8.2 REGEN1.3 -.08612 REGEN8.3 -.91388 4281- BL BLOCK3 PERIOD4 .1736 4282- CLASS3.3 REGEN1.4 -1.0000 REGEN4.4 1.0000 4283- CLASS4.3 REGEN1.4 -1.0000 REGEN5.4 1.0000 4284- CLASS5.3 REGEN1.4 -1.0000 REGEN6.4 1.0000 4285- CLASS6.3 REGEN1.4 -1.0000 REGEN7.4 1.0000 4286- CLASS7.3 REGEN1.4 -1.0000 REGEN8.4 1.0000 4287- CLASS8.3 REGEN1.4 -1.0000 REGEN8.4 1.0000 4288- STATE1.3 REGEN1.4 -.00000 REGEN2.4 -1.0000 4289- STATE2.3 REGEN1.4 -.00000 REGEN3.4 -1.0000 4290- STATE3.3 REGEN1.4 -.00000 REGEN4.4 -1.0000 4291- STATE4.3 REGEN1.4 -.00000 REGEN5.4 -1.0000 4292- STATE5.3 REGEN1.4 -.00000 REGEN6.4 -1.0000 4293- STATE6.3 REGEN1.4 -.00000 REGEN7.4 -1.0000 4294- STATE7.3 REGEN1.4 -.00000 REGEN8.4 -1.0000 4295- STATE8.3 REGEN1.4 -.00000 REGEN8.4 -1.0000 4296- BL BLOCK3 PERIOD4 .0299 4297- CLASS3.3 REGEN1.4 -.79732 REGEN4.4 .79732 4298- CLASS4.3 REGEN1.4 -.79732 REGEN5.4 .79732 4299- CLASS5.3 REGEN1.4 -.79732 REGEN6.4 .79732 4300- CLASS6.3 REGEN1.4 -.79732 REGEN7.4 .79732 4301- CLASS7.3 REGEN1.4 -.79732 REGEN8.4 .79732 4302- CLASS8.3 REGEN1.4 -.79732 REGEN8.4 .79732 4303- STATE1.3 REGEN1.4 -.20268 REGEN2.4 -.79732 4304- STATE2.3 REGEN1.4 -.20268 REGEN3.4 -.79732 4305- STATE3.3 REGEN1.4 -.20268 REGEN4.4 -.79732 4306- STATE4.3 REGEN1.4 -.20268 REGEN5.4 -.79732 4307- STATE5.3 REGEN1.4 -.20268 REGEN6.4 -.79732 4308- STATE6.3 REGEN1.4 -.20268 REGEN7.4 -.79732 4309- STATE7.3 REGEN1.4 -.20268 REGEN8.4 -.79732 4310- STATE8.3 REGEN1.4 -.20268 REGEN8.4 -.79732 4311- BL BLOCK3 PERIOD4 .5128 4312- CLASS3.3 REGEN1.4 -.93742 REGEN4.4 .93742 4313- CLASS4.3 REGEN1.4 -.93742 REGEN5.4 .93742 4314- CLASS5.3 REGEN1.4 -.93742 REGEN6.4 .93742 4315- CLASS6.3 REGEN1.4 -.93742 REGEN7.4 .93742 4316- CLASS7.3 REGEN1.4 -.93742 REGEN8.4 .93742 4317- CLASS8.3 REGEN1.4 -.93742 REGEN8.4 .93742 4318- STATE1.3 REGEN1.4 -.06258 REGEN2.4 -.93742 4319- STATE2.3 REGEN1.4 -.06258 REGEN3.4 -.93742 4320- STATE3.3 REGEN1.4 -.06258 REGEN4.4 -.93742 4321- STATE4.3 REGEN1.4 -.06258 REGEN5.4 -.93742 4322- STATE5.3 REGEN1.4 -.06258 REGEN6.4 -.93742 4323- STATE6.3 REGEN1.4 -.06258 REGEN7.4 -.93742 4324- STATE7.3 REGEN1.4 -.06258 REGEN8.4 -.93742 4325- STATE8.3 REGEN1.4 -.06258 REGEN8.4 -.93742 4326- BL BLOCK3 PERIOD4 .2837 4327- CLASS3.3 REGEN1.4 -.91388 REGEN4.4 .91388 4328- CLASS4.3 REGEN1.4 -.91388 REGEN5.4 .91388 4329- CLASS5.3 REGEN1.4 -.91388 REGEN6.4 .91388 4330- CLASS6.3 REGEN1.4 -.91388 REGEN7.4 .91388 4331- CLASS7.3 REGEN1.4 -.91388 REGEN8.4 .91388 4332- CLASS8.3 REGEN1.4 -.91388 REGEN8.4 .91388 4333- STATE1.3 REGEN1.4 -.08612 REGEN2.4 -.91388 4334- STATE2.3 REGEN1.4 -.08612 REGEN3.4 -.91388 4335- STATE3.3 REGEN1.4 -.08612 REGEN4.4 -.91388 4336- STATE4.3 REGEN1.4 -.08612 REGEN5.4 -.91388 4337- STATE5.3 REGEN1.4 -.08612 REGEN6.4 -.91388 4338- STATE6.3 REGEN1.4 -.08612 REGEN7.4 -.91388 4339- STATE7.3 REGEN1.4 -.08612 REGEN8.4 -.91388 4340- STATE8.3 REGEN1.4 -.08612 REGEN8.4 -.91388 4341- BL BLOCK4 PERIOD5 .6912 4342- CLASS3.4 REGEN1.5 -1.0000 REGEN4.5 1.0000 4343- CLASS4.4 REGEN1.5 -1.0000 REGEN5.5 1.0000 4344- CLASS5.4 REGEN1.5 -1.0000 REGEN6.5 1.0000 4345- CLASS6.4 REGEN1.5 -1.0000 REGEN7.5 1.0000 4346- CLASS7.4 REGEN1.5 -1.0000 REGEN8.5 1.0000 4347- CLASS8.4 REGEN1.5 -1.0000 REGEN8.5 1.0000 4348- STATE1.4 REGEN1.5 -.00000 REGEN2.5 -1.0000 4349- STATE2.4 REGEN1.5 -.00000 REGEN3.5 -1.0000 4350- STATE3.4 REGEN1.5 -.00000 REGEN4.5 -1.0000 4351- STATE4.4 REGEN1.5 -.00000 REGEN5.5 -1.0000 4352- STATE5.4 REGEN1.5 -.00000 REGEN6.5 -1.0000 4353- STATE6.4 REGEN1.5 -.00000 REGEN7.5 -1.0000 4354- STATE7.4 REGEN1.5 -.00000 REGEN8.5 -1.0000 4355- STATE8.4 REGEN1.5 -.00000 REGEN8.5 -1.0000 4356- BL BLOCK4 PERIOD5 .3088 4357- CLASS3.4 REGEN1.5 -.79732 REGEN4.5 .79732 4358- CLASS4.4 REGEN1.5 -.79732 REGEN5.5 .79732 4359- CLASS5.4 REGEN1.5 -.79732 REGEN6.5 .79732 4360- CLASS6.4 REGEN1.5 -.79732 REGEN7.5 .79732 4361- CLASS7.4 REGEN1.5 -.79732 REGEN8.5 .79732 4362- CLASS8.4 REGEN1.5 -.79732 REGEN8.5 .79732 4363- STATE1.4 REGEN1.5 -.20268 REGEN2.5 -.79732 4364- STATE2.4 REGEN1.5 -.20268 REGEN3.5 -.79732 4365- STATE3.4 REGEN1.5 -.20268 REGEN4.5 -.79732 4366- STATE4.4 REGEN1.5 -.20268 REGEN5.5 -.79732 4367- STATE5.4 REGEN1.5 -.20268 REGEN6.5 -.79732 4368- STATE6.4 REGEN1.5 -.20268 REGEN7.5 -.79732 4369- STATE7.4 REGEN1.5 -.20268 REGEN8.5 -.79732 4370- STATE8.4 REGEN1.5 -.20268 REGEN8.5 -.79732 4371- BL BLOCK5 PERIOD6 .6912 4372- CLASS3.5 REGEN1.6 -1.0000 REGEN4.6 1.0000 4373- CLASS4.5 REGEN1.6 -1.0000 REGEN5.6 1.0000 4374- CLASS5.5 REGEN1.6 -1.0000 REGEN6.6 1.0000 4375- CLASS6.5 REGEN1.6 -1.0000 REGEN7.6 1.0000 4376- CLASS7.5 REGEN1.6 -1.0000 REGEN8.6 1.0000 4377- CLASS8.5 REGEN1.6 -1.0000 REGEN8.6 1.0000 4378- STATE1.5 REGEN1.6 -.00000 REGEN2.6 -1.0000 4379- STATE2.5 REGEN1.6 -.00000 REGEN3.6 -1.0000 4380- STATE3.5 REGEN1.6 -.00000 REGEN4.6 -1.0000 4381- STATE4.5 REGEN1.6 -.00000 REGEN5.6 -1.0000 4382- STATE5.5 REGEN1.6 -.00000 REGEN6.6 -1.0000 4383- STATE6.5 REGEN1.6 -.00000 REGEN7.6 -1.0000 4384- STATE7.5 REGEN1.6 -.00000 REGEN8.6 -1.0000 4385- STATE8.5 REGEN1.6 -.00000 REGEN8.6 -1.0000 4386- BL BLOCK5 PERIOD6 .3088 4387- CLASS3.5 REGEN1.6 -.79732 REGEN4.6 .79732 4388- CLASS4.5 REGEN1.6 -.79732 REGEN5.6 .79732 4389- CLASS5.5 REGEN1.6 -.79732 REGEN6.6 .79732 4390- CLASS6.5 REGEN1.6 -.79732 REGEN7.6 .79732 4391- CLASS7.5 REGEN1.6 -.79732 REGEN8.6 .79732 4392- CLASS8.5 REGEN1.6 -.79732 REGEN8.6 .79732 4393- STATE1.5 REGEN1.6 -.20268 REGEN2.6 -.79732 4394- STATE2.5 REGEN1.6 -.20268 REGEN3.6 -.79732 4395- STATE3.5 REGEN1.6 -.20268 REGEN4.6 -.79732 4396- STATE4.5 REGEN1.6 -.20268 REGEN5.6 -.79732 4397- STATE5.5 REGEN1.6 -.20268 REGEN6.6 -.79732 4398- STATE6.5 REGEN1.6 -.20268 REGEN7.6 -.79732 4399- STATE7.5 REGEN1.6 -.20268 REGEN8.6 -.79732 4400- STATE8.5 REGEN1.6 -.20268 REGEN8.6 -.79732 4401- BL BLOCK6 PERIOD7 .6912 4402- CLASS3.6 REGEN1.7 -1.0000 REGEN4.7 1.0000 4403- CLASS4.6 REGEN1.7 -1.0000 REGEN5.7 1.0000 4404- CLASS5.6 REGEN1.7 -1.0000 REGEN6.7 1.0000 4405- CLASS6.6 REGEN1.7 -1.0000 REGEN7.7 1.0000 4406- CLASS7.6 REGEN1.7 -1.0000 REGEN8.7 1.0000 4407- CLASS8.6 REGEN1.7 -1.0000 REGEN8.7 1.0000 4408- STATE1.6 REGEN1.7 -.00000 REGEN2.7 -1.0000 4409- STATE2.6 REGEN1.7 -.00000 REGEN3.7 -1.0000 4410- STATE3.6 REGEN1.7 -.00000 REGEN4.7 -1.0000 4411- STATE4.6 REGEN1.7 -.00000 REGEN5.7 -1.0000 4412- STATE5.6 REGEN1.7 -.00000 REGEN6.7 -1.0000 4413- STATE6.6 REGEN1.7 -.00000 REGEN7.7 -1.0000 4414- STATE7.6 REGEN1.7 -.00000 REGEN8.7 -1.0000 4415- STATE8.6 REGEN1.7 -.00000 REGEN8.7 -1.0000 4416- BL BLOCK6 PERIOD7 .3088 4417- CLASS3.6 REGEN1.7 -.79732 REGEN4.7 .79732 4418- CLASS4.6 REGEN1.7 -.79732 REGEN5.7 .79732 4419- CLASS5.6 REGEN1.7 -.79732 REGEN6.7 .79732 4420- CLASS6.6 REGEN1.7 -.79732 REGEN7.7 .79732 4421- CLASS7.6 REGEN1.7 -.79732 REGEN8.7 .79732 4422- CLASS8.6 REGEN1.7 -.79732 REGEN8.7 .79732 4423- STATE1.6 REGEN1.7 -.20268 REGEN2.7 -.79732 4424- STATE2.6 REGEN1.7 -.20268 REGEN3.7 -.79732 4425- STATE3.6 REGEN1.7 -.20268 REGEN4.7 -.79732 4426- STATE4.6 REGEN1.7 -.20268 REGEN5.7 -.79732 4427- STATE5.6 REGEN1.7 -.20268 REGEN6.7 -.79732 4428- STATE6.6 REGEN1.7 -.20268 REGEN7.7 -.79732 4429- STATE7.6 REGEN1.7 -.20268 REGEN8.7 -.79732 4430- STATE8.6 REGEN1.7 -.20268 REGEN8.7 -.79732 4431-ENDATA 4432//GO.SYSIN DD stoch3.frs 4433echo paper.lis 1>&2 4434sed >paper.lis <<'//GO.SYSIN DD paper.lis' 's/^-//' 4435- This is a condensation of the paper "A standard input format for 4436-multistage stochastic linear programs" by Birge et al., which appears in COAL 4437-Newsletter No. 17 (Dec. 1987). 4438- 4439- Every multistage stochastic programming problem consists of three types of 4440-data: deterministic information, dynamic information and stochastic information. 4441- 4442- Deterministic information includes location and number of nonzero elements, 4443-certain constant coefficients (often +1 and -1) in inventory and other 4444-constraints, and any other piece of information the modeler may wish to regard 4445-as fixed. Dynamic information describes the number and dimension of the time 4446-stages, and stochastic information gives the distribution of the random 4447-elements. We only deal here with discrete distributions and assume that the 4448-modeler knows all discretizations and their probabilities. 4449- 4450- All this information can be described in MPS-like format using three input 4451-files. The CORE file is used to fix variable names and sparsity structure for 4452-all realizations. This is useful if one wants to solve a small pilot problem 4453-to obtain an advanced basis. For instance, the median problem or the mean value 4454-problem could be used here. The core file has completely standard MPS structure, 4455-but we assume that row and column names are ordered stage by stage, with the 4456-objective row being part of the first stage. 4457- 4458- This allows a very simple description of the dynamic structure in the TIME 4459-file. All that is necessary are the names of the first row and column for each 4460-stage, together with a string identifier for the stage. Below is a sample time 4461-file for a four-stage problem. The three name fields are in the same position 4462-as the name fields on an MPS data record, i.e., in columns 5-12, 15-22, 40-47. 4463- 4464-TIME EXAMPLE 4465-PERIODS 4466- COLUMN1 ROW1 PERIOD1 4467- COLUMN2 ROW2 PERIOD2 4468- COLUMN3 ROW3 PERIOD3 4469- COLUMN4 ROW4 PERIOD4 4470-ENDATA 4471- 4472-The header on the `TIME' line must match the header in the core file. 4473- 4474- Finally, there is the stochastic information. We distinguish three types 4475-of distributions: Independent random variables, where each random variable 4476-has a distribution independent of all the others; block structure for random 4477-vectors (blocks) with joint distributions which are independent of other blocks 4478-- this is especially useful if the random elements are independent from one 4479-period to the next. Period-to-period dependence can be modeled using scenarios. 4480- 4481- Independent random variables can be put into MPS format as follows: 4482- 4483-STOCH EXAMPLE 4484-INDEP DISCRETE 4485- RHS ROW1 3. .4 4486- RHS ROW1 4. .6 4487- COL1 ROW2 1. .5 4488- COL1 ROW2 2. .3 4489- COL1 ROW2 3. .2 4490-ENDATA 4491- 4492-This stoch file defines two independent random variables in the right hand side 4493-and in the constraint matrix. They are independent of each other, with two and 4494-three realizations, respectively, which defines SIX nodes in the decision tree. 4495-All other coefficients are assumed to have their values given in the core file. 4496- 4497- Block structure is similarly translated into MPS format as given in the 4498-next example. 4499- 4500-STOCH EXAMPLE2 4501-BLOCKS DISCRETE 4502- BL BLOCK1 PERIOD2 .4 4503- RHS ROW1 3. 4504- RHS ROW2 5. 4505- RHS ROW3 10. 4506- BL BLOCK1 PERIOD2 .3 4507- RHS ROW1 4. 4508- RHS ROW3 12. 4509- BL BLOCK1 PERIOD2 .3 4510- RHS ROW1 2. 4511- RHS ROW2 6. 4512- BL BLOCK2 PERIOD3 .5 4513- COL2 ROW2 1. 4514- BL BLOCK2 PERIOD3 .5 4515- COL2 ROW3 -1. 4516-ENDATA 4517- 4518-The records having code `BL' in the code field are markers which signal the 4519-start of a new block. Each block has an identifying name, a period to indicate 4520-when the information becomes known, and an associated probability. 4521-The locations and values are next listed in MPS format. On subsequent 4522-realizations, any location not explicitly stated is copied from the first 4523-realization. BLOCK2 is a univariate random variable which must be stated in 4524-this form because mixing of distribution types is not allowed. 4525- 4526- Scenarios are used to describe period-to-period dependence. It is customary 4527-to represent the sequence of possible realizations and decisions in form of a 4528-decision or event tree with branches at any node indicating the possible 4529-realizations in the following period contingent on what has been observed in 4530-the past. Each scenario can then be thought of as a path through the decision 4531-tree, starting at the node associated with the deterministic first stage and 4532-ending at one of the nodes in the last period. Equivalently, scenarios can be 4533-identified with last-period nodes. 4534- 4535- For each scenario we need the following information: 4536-- a path probability which indicates how likely it is to observe this particular 4537-sample path at the beginning of the problem. (Path probabilities must sum to 1.) 4538-- a name to identify each scenario 4539-- a pointer to the scenario it branches from 4540-- the period when the branching occurred, i.e., the first period in which the 4541-two scenarios differ. 4542- 4543- The example below might make this more transparent: 4544- 4545-STOCH EXAMPLE3 4546-SCENARIOS DISCRETE 4547- SC SCEN1 ROOT 0.5 PERIOD1 4548- COL1 ROW1 1.0 4549- COL2 ROW2 1.0 4550- COL3 ROW3 1.0 4551- COL4 ROW4 1.0 4552- SC SCEN2 SCEN1 0.2 PERIOD3 4553- COL3 ROW3 1.0 4554- COL4 ROW4 1.0 4555- SC SCEN3 SCEN2 0.2 PERIOD4 4556- COL4 ROW4 0.0 4557- SC SCEN4 SCEN1 0.1 PERIOD2 4558- COL2 ROW2 0.0 4559- COL3 ROW3 0.0 4560- COL4 ROW4 0.0 4561-ENDATA 4562- 4563-The stochastic information in this file corresponds to the following 4564-decision tree 4565- 4566- 4567-PERIOD1 PERIOD2 PERIOD3 PERIOD4 4568- 4569- 1.0 1.0 1.0 1.0 4570-o--+------o----------------+-----o---------+----------------+-- SCEN1 Prob=.5 4571- \ \ 4572- \ \ 4573- \ \ 1.0 1.0 4574- \ -----+------o---------+-- SCEN2 Prob=.2 4575- \ \ 4576- \ \ 4577- \ \ 0.0 4578- \ -----+-- SCEN3 Prob=.2 4579- \ 4580- \ 4581- \ 0.0 0.0 0.0 4582- ----+---------------+----------------+-- SCEN4 Prob=.1 4583- 4584- 4585- 4586- These are the bare bones of the standard. Some extensions, e.g., continuous 4587-distributions are available, but they will in general not lead to large-scale 4588-LP formulations, so they have been omitted from this brief write-up. For a copy 4589-of the full paper, write to 4590- 4591- Gus Gassmann 4592- School of Business Administration 4593- Dalhousie University 4594- Halifax, Nova Scotia 4595- Canada B3H 1Z5 4596- 4597- ph:(902)-424-7080 4598- e-mail:Gassmann@dalac.bitnet 4599- stars!gassmann@dalcs.uucp 4600//GO.SYSIN DD paper.lis 4601