$DO66
       PROGRAM BOASTII
C      BOAST II: BLACK OIL APPLIED SIMULATION TOOL
C      J.R. FANCHI
C      APRIL 1987       RELEASE 1.2
C      MACHINE DEPENDENT INCLUDE STATEMENT (SEE APPENDIX I OF THE
C      BOAST II USER'S MANUAL FOR FURTHER COMMENTS)
      PARAMETER (LP1=13,LP2=10,LP3=4)
      PARAMETER (LP7=3,LP8=3,LP9=25,LP10=3,LP11=50,LP12=1000)
      PARAMETER (LP14=1,LP15=13,LP17=5)
      PARAMETER (LP4=LP1+1,LP5=LP2+1,LP6=LP3+1,LP13=LP1+LP2+LP3)
      PARAMETER (LP19=LP4*LP2*LP3,LP20=LP1*LP5*LP3)
      PARAMETER (LP21=LP1*LP2*LP6,LP22=LP1*LP2*LP3,LP23=LP11*LP3)
C
      CHARACTER*10 INDAT,OUTDAT,RESIN,RESOUT
      CHARACTER*5 WELNAM
      REAL KROT,KROGT,KRWT,KRGT,MUWT,MUOT,MUGT,KX,KY,KZ
     & ,MUO,MUW,MUG,KRO,KRW,MBEWI,MBEGI,MCFGI
     & ,MBEO,MBEW,MBEG,MCFG,MBEOI,MIN,MCFG1,MCFGT
C
       COMMON /BUBBLE/ PBO,VSLOPE(LP8),BSLOPE(LP8),RSLOPE(LP8),PMAXT,
     & IREPRS,MPGT(LP8),
     & RHOSCO(LP8),RHOSCW(LP8),RHOSCG(LP8),MSAT(LP7),MPOT(LP8),
     & MPWT(LP8),PBOT(LP1,LP2,LP3),PBOTN(LP1,LP2,LP3)
      COMMON /COEF/ AW(LP1,LP2,LP3),AE(LP1,LP2,LP3),AN(LP1,LP2,LP3),
     & AS(LP1,LP2,LP3),AB(LP1,LP2,LP3),AT(LP1,LP2,LP3),E(LP1,LP2,LP3),
     & B(LP1,LP2,LP3)
      COMMON /RUNSUM/ ITSNO(LP12),STIME(LP12),SOPROD(LP12),
     & SGPROD(LP12),
     & SWPROD(LP12),SGOR(LP12),SWOR(LP12),SGINJ(LP12),SWINJ(LP12)
      COMMON /RUN2/SPVWTP(LP12),SOCUMP(LP12),SWCUMP(LP12),SGCUMP(LP12),
     & SGCUMI(LP12),SWCUMI(LP12),SAQUIR(LP12),SAQUIC(LP12)
      COMMON /SAQUI/ IAQOPT,CPIAQ1(LP1,LP2,LP3),CPIAQ2(LP1,LP2,LP3),
     & CPI1(LP1,LP2,LP3),CPI2(LP1,LP2,LP3),EWAQ(LP1,LP2,LP3),
     & CUMAQW(LP1,LP2,LP3),
     & QWAQ(LP1,LP2,LP3),CUMEW(LP1,LP2,LP3),QWAQR(LP7),CUMAQR(LP7)
     & ,IAQREG(LP1,LP2,LP3),PAQ(LP1,LP2,LP3),PIAQ(LP1,LP2,LP3)
      COMMON /SARRAY/ PN(LP1,LP2,LP3),IOCODE,IDMAX,
     & SON(LP1,LP2,LP3),SWN(LP1,LP2,LP3),SGN(LP1,LP2,LP3),
     & A1(LP1,LP2,LP3),A2(LP1,LP2,LP3),A3(LP1,LP2,LP3),
     & SUM(LP1,LP2,LP3),GAM(LP1,LP2,LP3),QS(LP1,LP2,LP3)
      COMMON /SLIMIT/ GORT(LP11),WORT(LP11),ILIMOP(LP11),
     & GORL(LP11),WORL(LP11),QOC(LP11,LP3),QWC(LP11,LP3),QGC(LP11,LP3)
      COMMON /SPARM/ KX(LP1,LP2,LP3),KY(LP1,LP2,LP3),KZ(LP1,LP2,LP3),
     & EL(LP1,LP2,LP3),TX(LP4,LP2,LP3),TY(LP1,LP5,LP3),TZ(LP1,LP2,LP6),
     & PDAT(LP1,LP2,LP3),PDATUM,GRAD
      COMMON /SPOST/ KOPR,KGPR,KWPR,KGOR,KWOR,KGIR,KWIR,KRESP,
     & KAIR,KAIC,KCOP,KCGP,KCWP,KCGI,KCWI,ITSMAX
      COMMON /SPRTPS/ P(LP1,LP2,LP3),SO(LP1,LP2,LP3),SW(LP1,LP2,LP3),
     & SG(LP1,LP2,LP3)
      COMMON /SPVT/ SAT(LP7,LP9),KROT(LP7,LP9),KRWT(LP7,LP9),
     & BGT(LP7,LP9),
     & KRGT(LP7,LP9),ITHREE(LP7),RSOT(LP7,LP9),BWPT(LP7,LP9),
     & PCOWT(LP7,LP9),PCGOT(LP7,LP9),KROGT(LP7,LP9),SWR(LP7),
     & POT(LP7,LP9),MUOT(LP7,LP9),BOT(LP7,LP9),BOPT(LP7,LP9),
     & RSOPT(LP7,LP9),PWT(LP7,LP9),MUWT(LP7,LP9),BWT(LP7,LP9),
     & RSWT(LP7,LP9),RSWPT(LP7,LP9),PGT(LP7,LP9),MUGT(LP7,LP9),
     & BGPT(LP7,LP9),CRT(LP7,LP9),IPVT(LP1,LP2,LP3),IROCK(LP1,LP2,LP3),
     & NROCK,NPVT,PSIT(LP7,LP9),PRT(LP7,LP9),WOROCK(LP7),GOROCK(LP7)
      COMMON /SRATE/ PID(LP11,LP3),PWF(LP11,LP3),PWFC(LP11,LP3),
     & KIP(LP11),LAYER(LP11),QVO(LP11),CUMG(LP11,LP3),
     & GMO(LP11,LP3),GMW(LP11,LP3),GMG(LP11,LP3),
     & QVW(LP11),QVG(LP11),QVT(LP11),CUMO(LP11,LP3),CUMW(LP11,LP3),
     & IDWELL(LP11),ALIT(LP11),BLIT(LP11)
      COMMON /SSOLN/ BO(LP1,LP2,LP3),BW(LP1,LP2,LP3),BG(LP1,LP2,LP3),
     & QO(LP1,LP2,LP3),QW(LP1,LP2,LP3),QG(LP1,LP2,LP3),
     & GOWT(LP1,LP2,LP3),GWWT(LP1,LP2,LP3),GGWT(LP1,LP2,LP3),
     & OW(LP4,LP2,LP3),OE(LP4,LP2,LP3),WW(LP4,LP2,LP3),WE(LP4,LP2,LP3),
     & OS(LP1,LP5,LP3),ON(LP1,LP5,LP3),WS(LP1,LP5,LP3),WN(LP1,LP5,LP3),
     & OT(LP1,LP2,LP6),OB(LP1,LP2,LP6),WT(LP1,LP2,LP6),WB(LP1,LP2,LP6),
     & QOWG(LP1,LP2,LP3),VP(LP1,LP2,LP3),CT(LP1,LP2,LP3)
      COMMON /TRIDI/ UM(LP15),AZL(LP15),BZL(LP15),CZL(LP15),DZL(LP15),
     & UZL(LP15),X(LP15),BETA(LP15),GAMMA(LP15),W(LP15)
      COMMON /TSTDAT/ IFATAL,IWARN
      COMMON /VECTOR/ DX(LP1,LP2,LP3),DY(LP1,LP2,LP3),DZ(LP1,LP2,LP3),
     & DZNET(LP1,LP2,LP3),IQN1(LP11),IQN2(LP11),IQN3(LP11),IHEDIN(80)
      COMMON /CHAR/ WELNAM(LP11)
C
      DIMENSION FTIO(50),OOIP(LP3),OWIP(LP3),ODGIP(LP3),OFGIP(LP3)
      DIMENSION IRETYM(LP17),REDATE(LP17)
      DIMENSION RKCOEF(7,7),THRUA(LP1,LP2,LP3)
      DIMENSION WOC(LP7),GOC(LP7)
C
      DATA KRUNGE/1/
      DATA RKCOEF
     & /1.0,6*0.0,
     & 0.13157894,1.0,5*0.0,
     & 0.03937504,0.15625736,1.0,4*0.0,
     & 0.01666967,0.053199139,0.16491829,1.0,3*0.0,
     & 0.0085487791,0.024394839,0.059605275,0.16893119,1.0,2*0.0,
     & .0049515953,.013195402,.028593749,.06308716,.17111215,1.0,0.0,
     & .0031198738,.0079382925,.015998138,.031126418,.06518731,
     & .17242757,1.0/
      DATA ETI,FT,FTMAX/0.0,0.0,0.0/
      DATA COP,CWP,CGP,CWI,CGI/0.0,0.0,0.0,0.0,0.0/
      DATA IOMETH,IFTCOD,IRSCNT/0,0,1/
C
      DATA NX,NY,NZ,NTER,NTEP,NW,
     & NTMAX,NRST,N1DIR,N23DIR,NITER,NTRI
     & /LP1,LP2,LP3,LP9,LP9,LP11,LP12,LP17,LP15,
     & LP14,LP22,LP15/
      IDMAX=0.0
      CMBEO=0.0
      CMBEW=0.0
      CMBEG=0.0
C      OPEN FILES FOR I/O ON DEC 20/60
C      MACHINE DEPENDENT OPEN STATEMENTS
      WRITE(*,3)
    3 FORMAT(1X,'ENTER INPUT DATA FILE NAME ... ')
      READ(*,7) INDAT
      OPEN(UNIT=20,MODE='READ',
     & FILE=INDAT,STATUS='OLD')
      WRITE(*,6)
    6 FORMAT(/,1X,'ENTER OUTPUT DATA FILE NAME ... ')
      READ(*,7) OUTDAT
    7 FORMAT(2A10)
      OPEN(UNIT=21,MODE='WRITE',STATUS='NEW',
     & FILE=OUTDAT)
      IOCODE=21
C      WRITE BANNER
      WRITE(IOCODE,3005)
      WRITE(IOCODE,3007)
      WRITE(IOCODE,3006)
 3007 FORMAT(T30,'*',T50,'          BOAST II:',T98,'*',/T30,'*',
     & T48,'BLACK OIL APPLIED SIMULATION TOOL',T98,'*',
     & /T30,'*',T57,'(RELEASE 1.1)',T98,'*')
 3005 FORMAT(//T30,69('*'),/T30,'*',T98,'*'/T30,'*',T98,'*')
 3006 FORMAT(T30,'*',T98,'*'/T30,'*',T98,'*'/T30,69('*'),///)
      READ(20,69) (IHEDIN(IH),IH=1,40)
      WRITE(IOCODE,68) (IHEDIN(IH),IH=1,40)
69    FORMAT(40A2)
   68 FORMAT(///,T24,82('*'),/,T24,('*'),T105,('*'),/,
     & T24,('*'),40A2,T105,('*'),/,T24,('*'),T105,
     & ('*'),/,T24,82('*'),//)
C      WRITE DIMENSION INFO
      WRITE(IOCODE,3100) NX,NY,NZ,NROCK,NTER,NPVT,NTEP,NW,
     & NTMAX,NRST,N1DIR,N23DIR,NITER,NTRI,N23DIR
 3100 FORMAT(T37,'REDIMENSIONING INFORMATION:',
     & /T32,'MAX X-DIRECTION GRID BLOCKS',T92,I5,
     & /T32,'MAX Y-DIRECTION GRID BLOCKS',T92,I5,
     & /T32,'MAX Z-DIRECTION GRID BLOCKS',T92,I5,
     & /T32,'MAX ROCK REGIONS',T92,I5,
     & /T32,'MAX ROCK REGION TABLE ENTRIES',T92,I5,
     & /T32,'MAX PVT REGIONS',T92,I5,
     & /T32,'MAX PVT REGION TABLE ENTRIES',T92,I5,
     & /T32,'MAX WELLS',T92,I5,
     & /T32,'MAX TIME STEPS',T92,I5,
     & /T32,'MAX RESTART RECORDS',T92,I5,
     & /T32,'TOTAL BLOCKS USING 1D DIRECT SOLN METHODS',T92,I5,
     & /T32,'TOTAL BLOCKS USING 2D OR 3D DIRECT SOLN METHODS',T92,I5,
     & /T32,'TOTAL BLOCKS USING ITERATIVE SOLN METHOD',T92,I5,
     & /T32,'MAX NO OF BLOCKS IN 1D FOR LSOR',T92,I5,
     & /T32,'MAX NO OF BLOCKS IN 2D FOR L2SOR',T92,I5)
      WRITE(IOCODE,70) (IHEDIN(IH),IH=1,40)
   70 FORMAT(1H1/T24,82('*'),/,T24,('*'),T105,('*'),/,
     & T24,('*'),40A2,T105,('*'),/,T24,('*'),T105,
     & ('*'),/,T24,82('*'),//)
C** RESTART OPTION READ
      READ(20,69)
      READ(20,*) IREOPT,IPLOTP
      IF(IREOPT.GT.-1) READ(20,*) IRNUM,IRSTRT,NN,TMAX
      IF(IREOPT.EQ.-1) WRITE(IOCODE,12)
      IF(IREOPT.EQ.0) WRITE(IOCODE,13)
      IF(IREOPT.EQ.1) WRITE(IOCODE,14) IRSTRT
      IF(IREOPT.GT.-1)
     & WRITE(IOCODE,11) IREOPT,IRNUM,IRSTRT,NN,TMAX
   11 FORMAT(/30X,'RESTART CODES:',
     & /25X,'RESTART OPTION (IREOPT)  ',T70,I5,
     & /25X,'NUMBER OF RESTART ENTRIES (IRNUM)  ',T70,I5,
     & /25X,'RESTART TIME STEP (IRSTRT)  ',T70,I5,
     & /25X,'MAXIMUM NUMBER OF TIME STEPS (NN)  ',T70,I5,
     & /25X,'MAXIMUM NUMBER OF DAYS (TMAX)',T70,F10.1/)
   12 FORMAT(/T52,5('*'),' RESTART OPTION ',5('*'),
     & //T45,'RESTART OPTION HAS NOT BEEN ACTIVATED.',//)
   13 FORMAT(/T52,5('*'),' RESTART OPTION ',5('*'),
     & //T45,'RESTART OPTION HAS BEEN ACTIVATED.',//)
   14 FORMAT(/T52,5('*'),' RESTART OPTION ',5('*'),
     & //T41,'THIS IS A RESTART RUN BEGINNING AT TIME STEP',
     & I5,//)
      IF(IREOPT.LT.0) GO TO 18
      READ(20,7) RESIN,RESOUT
      WRITE(IOCODE,3003) RESIN,RESOUT
 3003 FORMAT(/25X,'INPUT RESTART FILE    ',T70,A10,
     & /,25X,'INPUT RESTART FILE    ',T70,A10,/)
C      MACHINE DEPENDENT OPEN STATEMENTS
      OPEN(UNIT=24,FORM='BINARY',ACCESS='SEQUENTIAL',
     & FILE=RESIN,STATUS='UNKNOWN')
      OPEN(UNIT=25,FORM='BINARY',ACCESS='SEQUENTIAL',
     & FILE=RESOUT,STATUS='UNKNOWN')
      READ(20,*) (IRETYM(I),I=1,IRNUM)
      READ(20,*) (REDATE(I),I=1,IRNUM)
      WRITE(IOCODE,15) (IRETYM(I),I=1,IRNUM)
   15 FORMAT(25X,'RESTART TIME STEPS:',5(6X,I5))
      WRITE(IOCODE,16) (REDATE(I),I=1,IRNUM)
   16 FORMAT(25X,'RESTART TIMES (DAYS):',5(1X,F10.2))
      WRITE(IOCODE,33)
  33  FORMAT(//)
   18 CONTINUE
C**** POST-PLOT PACKAGE CODES
      IF(IPLOTP.EQ.1) READ(20,*) NPLINE,
     & KOPR,KGPR,KWPR,KGOR,KWOR,
     & KGIR,KWIR,KRESP,KAIR,KAIC,
     & KCOP,KCGP,KCWP,KCGI,KCWI
      IF(IPLOTP.GE.0) WRITE(IOCODE,3015)
 3015 FORMAT(/T50,5('*'),' POST-PLOT OPTIONS ',5('*'),
     & //T40,'POST-PLOT TABLE WILL BE WRITTEN.')
      IF(IPLOTP.EQ.1) WRITE(IOCODE,3020) NPLINE,
     & KOPR,KGPR,KWPR,KGOR,KWOR,
     & KGIR,KWIR,KRESP,KAIR,KAIC,
     & KCOP,KCGP,KCWP,KCGI,KCWI
 3020 FORMAT(/T40,'PLOT LINES/TIME STEP = ',I5,
     & /T40,'OIL PROD RATE CODE   = ',I5,
     & /T40,'GAS PROD RATE CODE   = ',I5,
     & /T40,'WATER PROD RATE CODE = ',I5,
     & /T40,'PROD G/O RATIO CODE  = ',I5,
     & /T40,'PROD W/O RATIO CODE  = ',I5,
     & /T40,'GAS INJ RATE CODE    = ',I5,
     & /T40,'WATER INJ RATE CODE  = ',I5,
     & /T40,'PV WT AVG RES P CODE = ',I5,
     & /T40,'AQ INFLUX RATE CODE  = ',I5,
     & /T40,'AQ INFLUX CUM  CODE  = ',I5,
     & /T40,'CUM OIL PROD CODE    = ',I5,
     & /T40,'CUM GAS PROD CODE    = ',I5,
     & /T40,'CUM WATER PROD CODE  = ',I5,
     & /T40,'CUM GAS INJ CODE     = ',I5,
     & /T40,'CUM WATER INJ CODE   = ',I5,//)
      IF(IREOPT.GT.0) GO TO 20
C**** ESTABLISH RESERVOIR AND BLOCK DIMENSIONS
      CALL GRIDSZ(IOCODE,II,JJ,KK)
C      GRID DIMENSION LIMIT CHECK
      IF(II.LE.NX) GO TO 1520
      IFATAL=IFATAL+1
      WRITE(IOCODE,1510) NX
 1510 FORMAT(/5X,5('-'),'NO. OF X-DIRECTION BLOCKS CANNOT',
     & ' EXCEED ',I5)
 1520 IF(JJ.LE.NY) GO TO 1540
      IFATAL=IFATAL+1
      WRITE(IOCODE,1530) NY
 1530 FORMAT(/5X,5('-'),'NO. OF Y-DIRECTION BLOCKS CANNOT',
     & ' EXCEED ',I5)
 1540 IF(KK.LE.NZ) GO TO 1560
      IFATAL=IFATAL+1
      WRITE(IOCODE,1550) NZ
 1550 FORMAT(/5X,5('-'),'NO. OF Z-DIRECTION BLOCKS CANNOT',
     & ' EXCEED ',I5)
 1560 CONTINUE
C**** ESTABLISH POROSITY AND PERMEABILITY AT EACH ZONE
      CALL PORPRM(IOCODE,II,JJ,KK)
C**** CALCULATE INTERBLOCK TRANSMISSIBILITIES
      CALL TRANS(II,JJ,KK)
C**** EMPIRICAL DATA
      CALL TABLE(IOCODE,II,JJ,KK)
C**** ESTABLISH INITIAL CONDITIONS
      CALL UINITL(KPI,II,JJ,KK,PI,ET0,CUMPO,MBEO,
     &CUMPW,MBEW,CUMPG,MBEG,SOI,SWI,SGI,
     &WOC,GOC,PGOC,CUMIW,CUMIG)
C**** SOLUTION METHOD, DEBUG PRINT, AND TIME-STEP CONTROL PARAMETERS.
      CALL CODES(IOCODE,KSM1,KSN1,KCO1,NN,
     &FACT1,FACT2,TMAX,KSOL,MITER,OMEGA,TOL,TOL1,
     & KSN,KSM,KCO,KCOFF,DSMAX,DPMAX,
     & NUMDIS,IRK,THRUIN,
     &WORMAX,GORMAX,PAMIN,PAMAX)
C** AQUIFER DATA ENTRY
      CALL AQUI(TMAX)
C**** IF A FATAL INPUT ERROR OCCURS, DO NOT BEGIN RUN
       IF(IFATAL.GE.1) GO TO 1006
      IF(IWARN.GT.0) WRITE(IOCODE,19) IWARN
   19 FORMAT(/5X,5('-'),'A TOTAL OF',I5,
     & ' WARNINGS HAVE BEEN NOTED',5('-'),/)
   20 READ(20,69)
      D5615=1.0/5.615
      D288=1.0/288.
      D144=1.0/144.
C      DETERMINE TIME STEP INDEX RANGE
      NINIT=1
      IF(IREOPT.NE.1) GO TO 24
      NINIT=IRSTRT
   24 NMAX=NN+1
C      RECURRENT CALC LOOP
      DO 1000 N=NINIT,NMAX
      NLOOP=N
C** RESTART ALGORITHM
      IF(IREOPT.EQ.-1) GO TO 30
      IF(IREOPT.EQ.0) GO TO 25
      IF(N.LT.IRSTRT) GO TO 1000
      IF(N.GT.IRSTRT) GO TO 25
      IRS=0
   22 IRS=IRS+1
      READ (24) CPIAQ1,CPIAQ2,CPI1,CPI2,EWAQ,CUMAQW,
     & QWAQ,CUMEW,IAQREG,PAQ,PIAQ,
     & P,SO,SW,SG,PN,SON,SWN,SGN,
     & CUMO,CUMW,CUMG,TX,TY,TZ,
     & QOC,QWC,QGC,PID,PWF,PWFC,GMO,GMW,GMG,
     & BO,BW,BG,VP,CT,EL,PBOT,PBOTN
C**    VECTORS
      READ (24) QWAQR,CUMAQR,
     & ITSNO,STIME,SOPROD,SGPROD,SWPROD,SGOR,SWOR,
     & SGINJ,SWINJ,SPVWTP,SOCUMP,SWCUMP,SGCUMP,
     & SGCUMI,SWCUMI,SAQUIR,SAQUIC,
     & GORT,WORT,GORL,WORL,
     & ILIMOP,KIP,WELNAM,LAYER,IDWELL,
     & QVO,QVG,QVW,QVT,
     & IQN1,IQN2,IQN3,
     & MSAT,MPOT,MPWT,MPGT,RHOSCO,RHOSCW,RHOSCG,
     & VSLOPE,BSLOPE,RSLOPE,
     & SAT,KROT,KRWT,KRGT,KROGT,PCOWT,PCGOT,
     & POT,MUOT,BOT,BOPT,RSOT,RSOPT,
     & PWT,MUWT,BWT,BWPT,RSWT,RSWPT,
     & PGT,PSIT,MUGT,BGT,BGPT,PRT,CRT
C**    SCALARS
      READ (24) II,JJ,KK,KSM1,KSN1,KCO1,KSOL,MITER,
     & NUMDIS,IRK,THRUIN,
     & FACT1,FACT2,OMEGA,TOL,TOL1,WORMAX,GORMAX,PAMIN,PAMAX,
     & NVQN,CWI,CGI,ETI,PBO,PMAXT,
     & STBO,STBOI,STBW,STBWI,MCFG,MCFGI,MBEO,MBEW,MBEG,
     & CMBEO,CMBEW,CMBEG,TOOIP,TOWIP,TOGIP,TODGIP,TOFGIP,
     & DELT0,RESVOL,OP,WP,GP,WI,GI,PAVG0,PAVG,OPR,WPR,
     & GPR,WIR,GIR,COP,CWP,CGP,MCFG1,MCFGT,CWOR,WOR,
     & CGOR,GOR,DSMAX,DPMAX,KCOFF,KSN,KSM,KCO,
     & SWR,PDATUM,GRAD,DSMC,DPMC,IAQOPT,
     & NTSTEP,IREPRS,ITHREE,
     & NROCK,NPVT,IROCK,IPVT
      WRITE(IOCODE,31) N,NTSTEP,ETI
   31 FORMAT(/T10,110('-'),/T10,
     & 'RESTART DATA READ AT BEGINNING OF TIME STEP ',I5,
     & '; NTSTEP =',I5,' AND ELAPSED TIME (ETI) =',F10.2,
     & ' DAYS.',/T10,110('-'),/)
      IF(N.EQ.NTSTEP) GO TO 25
      IF(IRS.LT.5) GO TO 22
      WRITE(IOCODE,23) IRS,N,ETI,NTSTEP
   23 FORMAT(/T10,110('-'),/T10,
     & 'ATTEMPT TO READ RESTART DATA FAILED AFTER',I3,
     & ' TRIES AT TIME STEP',I5,' (TIME =',F10.2,' DAYS).',
     & /T10,'LAST RESTART TIME STEP READ =',I5,
     & /T10,110('-'),/)
      GO TO 1006
   25 CONTINUE
      IF(IRETYM(IRSCNT).GT.0.AND.N.NE.IRETYM(IRSCNT)) GO TO 30
      IF(REDATE(IRSCNT).GT.0.AND.ETI.NE.REDATE(IRSCNT)) GO TO 30
      IF(IRETYM(IRSCNT).EQ.0.AND.REDATE(IRSCNT).EQ.0.0) GO TO 30
      IF(IRSCNT.GT.5) GO TO 28
      NTSTEP=N
C**    ARRAYS
      WRITE (25) CPIAQ1,CPIAQ2,CPI1,CPI2,EWAQ,CUMAQW,
     & QWAQ,CUMEW,IAQREG,PAQ,PIAQ,
     & P,SO,SW,SG,PN,SON,SWN,SGN,
     & CUMO,CUMW,CUMG,TX,TY,TZ,
     & QOC,QWC,QGC,PID,PWF,PWFC,GMO,GMW,GMG,
     & BO,BW,BG,VP,CT,EL,PBOT,PBOTN
C**    VECTORS
      WRITE (25) QWAQR,CUMAQR,
     & ITSNO,STIME,SOPROD,SGPROD,SWPROD,SGOR,SWOR,
     & SGINJ,SWINJ,SPVWTP,SOCUMP,SWCUMP,SGCUMP,
     & SGCUMI,SWCUMI,SAQUIR,SAQUIC,
     & GORT,WORT,GORL,WORL,
     & ILIMOP,KIP,WELNAM,LAYER,IDWELL,
     & QVO,QVG,QVW,QVT,
     & IQN1,IQN2,IQN3,
     & MSAT,MPOT,MPWT,MPGT,RHOSCO,RHOSCW,RHOSCG,
     & VSLOPE,BSLOPE,RSLOPE,
     & SAT,KROT,KRWT,KRGT,KROGT,PCOWT,PCGOT,
     & POT,MUOT,BOT,BOPT,RSOT,RSOPT,
     & PWT,MUWT,BWT,BWPT,RSWT,RSWPT,
     & PGT,PSIT,MUGT,BGT,BGPT,PRT,CRT
C**    SCALARS
      WRITE (25) II,JJ,KK,KSM1,KSN1,KCO1,KSOL,MITER,
     & NUMDIS,IRK,THRUIN,
     & FACT1,FACT2,OMEGA,TOL,TOL1,WORMAX,GORMAX,PAMIN,PAMAX,
     & NVQN,CWI,CGI,ETI,PBO,PMAXT,
     & STBO,STBOI,STBW,STBWI,MCFG,MCFGI,MBEO,MBEW,MBEG,
     & CMBEO,CMBEW,CMBEG,TOOIP,TOWIP,TOGIP,TODGIP,TOFGIP,
     & DELT0,RESVOL,OP,WP,GP,WI,GI,PAVG0,PAVG,OPR,WPR,
     & GPR,WIR,GIR,COP,CWP,CGP,MCFG1,MCFGT,CWOR,WOR,
     & CGOR,GOR,DSMAX,DPMAX,KCOFF,KSN,KSM,KCO,
     & SWR,PDATUM,GRAD,DSMC,DPMC,IAQOPT,
     & NTSTEP,IREPRS,ITHREE,
     & NROCK,NPVT,IROCK,IPVT
      WRITE(IOCODE,26) NTSTEP,ETI
   26 FORMAT(/T10,100('-'),/T10,'RESTART RECORD WRITTEN',
     & ' AT BEGINNING OF TIME STEP',I5,' (TIME =',F10.2,' DAYS)',
     & /T10,100('-'),//)
      IRSCNT=IRSCNT+1
      GO TO 30
   28 WRITE(IOCODE,29) IRSCNT,NTSTEP,ETI
   29 FORMAT(/T10,100('-'),/T10,
     & 'THE NUMBER OF RESTART WRITE (',I2,') EXCEEDS THE',
     & ' ALLOWED NUMBER AT TIME STEP',I5,
     & ' (TIME =',F10.2,' DAYS)',/T10,100('-'),/)
      GO TO 1006
   30 CONTINUE
C      END OF RESTART
C**** RECURRENT DATA.
      IF(N.EQ.1) GO TO 40
      IF(FT.LT.FTMAX) GO TO 46
      IF(IOMETH.EQ.0) GO TO 40
      IF(IFTCOD.EQ.IOMETH) GO TO 40
      IFTCOD=IFTCOD+1
      FTMAX=FTIO(IFTCOD)
      IF(FTMAX.GT.TMAX) FTMAX=TMAX
      GO TO 46
   40 READ(20,69,END=1006)
      READ(20,*) ICHANG,IWLCNG,IOMETH
      IF(IOMETH.NE.0) GO TO 42
      READ(20,*) IWLREP,ISUMRY
      READ(20,*) IPMAP,ISOMAP,ISWMAP,ISGMAP,IPBMAP,IAQMAP
      READ(20,*) DAY,DTMIN,DTMAX
      DELT=DAY
      FTMAX=ETI+ICHANG*DELT
      IF(FTMAX.GT.TMAX) FTMAX=TMAX
      IFREQW=0
      IFREQS=0
      GO TO 43
   42 READ(20,*) (FTIO(I),I=1,IOMETH)
      READ(20,*) IPMAP,ISOMAP,ISWMAP,ISGMAP,IPBMAP,IAQMAP
      READ(20,*) DAY,DTMIN,DTMAX
      DELT=DAY
      IFTCOD=1
      FTMAX=FTIO(IFTCOD)
      IF(FTMAX.GT.TMAX) FTMAX=TMAX
   43 CONTINUE
      IF(IWLCNG.EQ.0) GO TO 45
      CALL NODES(NVQN)
C      TIME STEP SUMMARY HEADING ACTIVATED
      ITSS=0
   45 CONTINUE
   46 IF(N.EQ.1)DELT0=DELT
      IF(N.EQ.1)GO TO 1050
C      AUTO TIME STEP ADJUSTMENT
      IF(DSMC.LT.DSMAX.AND.DPMC.LT.DPMAX) DELT=DELT*FACT1
      IF(DSMC.GT.DSMAX.OR.DPMC.GT.DPMAX) DELT=DELT*FACT2
      IF(DELT.GT.DTMAX)DELT=DTMAX
      IF(IRK.EQ.0) GO TO 1045
C      R-K SOLN LOOP MAX.
      DO 47 I=1,II
      DO 47 J=1,JJ
      DO 47 K=1,KK
   47 THRUA(I,J,K)=0.0
      DO 48 J=1,NVQN
      IQ1=IQN1(J)
      IQ2=IQN2(J)
      IQ3=IQN3(J)
      IJLOC=IDWELL(J)
C MAY NEED TO CHANGE THIS BACK TO 481?
      IF(IJLOC.EQ.0) GO TO 48
      LAY=IQ3+(LAYER(J)-1)
      DO 48 K=IQ3,LAY
      BPT=PBOT(IQ1,IQ2,K)
      PP=P(IQ1,IQ2,K)
      IPVTR=IPVT(IQ1,IQ2,K)
      CALL INTPVT(IPVTR,BPT,BSLOPE(IPVTR),POT,BOT,MPOT(IPVTR),PP,BBO)
      CALL INTERP(IPVTR,PWT,BWT,MPWT(IPVTR),PP,BBW)
      CALL INTERP(IPVTR,PGT,BGT,MPGT(IPVTR),PP,BBG)
      THRUA(IQ1,IQ2,K)=THRUA(IQ1,IQ2,K) + DELT*
     & (QOC(IJLOC,K)*BBO+QWC(IJLOC,K)*BBW+QGC(IJLOC,K)*BBG)
   48 CONTINUE
      THRU=0.
      DO 49 J=1,NVQN
      IQ1=IQN1(J)
      IQ2=IQN2(J)
      IQ3=IQN3(J)
      LAY=IQ3+(LAYER(J)-1)
      DO 49 K=IQ3,LAY
      IF(VP(IQ1,IQ2,K).LE.0.0) GO TO 49
      THRUPV=ABS(THRUA(IQ1,IQ2,K))/VP(IQ1,IQ2,K)
      IF(THRU.LT.THRUPV) THRU=THRUPV
   49 CONTINUE
      KRUNGE=1.+SQRT(THRU/THRUIN)
      IF(KRUNGE.LE.7) GO TO 1045
      DELT=DELT*7./KRUNGE
      KRUNGE=7
 1045 CONTINUE
      IF(DELT.LT.DTMIN)DELT=DTMIN
      IF(ETI+DELT.GT.FTMAX)DELT=FTMAX-ETI
1050  FT=ETI+DELT
      IF(ETI+DELT*0.5.GE.TMAX)GO TO 1006
C****ITFLAG COUNTS THE NUMBER OF TIME STEP REPETITIONS.
      ITFLAG=0
C****REENTRY POINT FOR REPEATED TIME STEP.
 1060 CONTINUE
      DIV1=1.0/DELT
      IF(N.GT.1.OR.ITFLAG.GT.0)GO TO 105
C**  INITIAL FLUID CALCULATIONS
      WRITE(IOCODE,80)
   80 FORMAT(1H1/T15,'******* INITIAL FLUID VOLUMES *******',/)
      RESVOL=0.0
      SCFO=0.0
      SCFG=0.0
      SCFG1=0.0
      DO 102 K=1,KK
      OOIP(K)=0.
      OWIP(K)=0.
      ODGIP(K)=0.
      OFGIP(K)=0.
      DO 100 J=1,JJ
      DO 100 I=1,II
      PP=P(I,J,K)
      BPT=PBOT(I,J,K)
      RESVOL=RESVOL+VP(I,J,K)
      IPVTR=IPVT(I,J,K)
C**** NOTE: WE ARE ASSUMING INITIAL PHI IS AT INITIAL RESERVOIR PRESSURE
      CALL INTPVT(IPVTR,BPT,RSLOPE(IPVTR),POT,RSOT,MPOT(IPVTR),PP,RSO)
      CALL INTERP(IPVTR,PWT,RSWT,MPWT(IPVTR),PP,RSW)
      CALL INTPVT(IPVTR,BPT,BSLOPE(IPVTR),POT,BOT,MPOT(IPVTR),
     & PP,BO(I,J,K))
      CALL INTERP(IPVTR,PWT,BWT,MPWT(IPVTR),PP,BW(I,J,K))
      CALL INTERP(IPVTR,PGT,BGT,MPGT(IPVTR),PP,BG(I,J,K))
      FF1=SO(I,J,K)/BO(I,J,K)
      FF2=SW(I,J,K)/BW(I,J,K)
      SCFO=SCFO+VP(I,J,K)*FF1
      SCFW=SCFW+VP(I,J,K)*FF2
      SCFG=SCFG+VP(I,J,K)*SG(I,J,K)/BG(I,J,K)
      SCFG1=SCFG1+VP(I,J,K)*(RSO*FF1+RSW*FF2)
C      CALC COMPRESSIBILITY
      CALL INTCOM(IPVTR,POT,BOPT,MPOT(IPVTR),PP,BODER)
      CALL INTCOM(IPVTR,POT,RSOPT,MPOT(IPVTR),PP,RSODER)
      CALL INTCOM(IPVTR,PWT,BWPT,MPWT(IPVTR),PP,BWDER)
      CALL INTCOM(IPVTR,PWT,RSWPT,MPWT(IPVTR),PP,RSWDER)
      CALL INTCOM(IPVTR,PGT,BGPT,MPGT(IPVTR),PP,BGDER)
      IF(PP.GT.PBOT(I,J,K))BODER=BSLOPE(IPVTR)
      IF(PP.GT.PBOT(I,J,K))RSODER=RSLOPE(IPVTR)
      CO=-(BODER-BG(I,J,K)*RSODER)/BO(I,J,K)
      CW=-(BWDER-BG(I,J,K)*RSWDER)/BW(I,J,K)
      CG=-BGDER/BG(I,J,K)
      CALL INTERP(IPVTR,PRT,CRT,MPGT(IPVTR),PP,CR)
      CT(I,J,K)=CR + CO*SO(I,J,K) +CW*SW(I,J,K) + CG*SG(I,J,K)
C      CALC INITIAL FLUIDS IN PLACE
      OOIP(K)=OOIP(K)+D5615*0.000001*SON(I,J,K)*VP(I,J,K)/BO(I,J,K)
      OWIP(K)=OWIP(K)+D5615*0.000001*SWN(I,J,K)*VP(I,J,K)/BW(I,J,K)
      ODGIP(K)=ODGIP(K)+0.001*0.000001*(RSO*SON(I,J,K)*
     & VP(I,J,K)/BO(I,J,K)+RSW*SWN(I,J,K)*VP(I,J,K)/BW(I,J,K))
      OFGIP(K)=OFGIP(K)+0.001*0.000001*SGN(I,J,K)*VP(I,J,K)/BG(I,J,K)
      IF(KCO1.EQ.0)GO TO 100
      WRITE(IOCODE,21)I,J,K,VP(I,J,K),CT(I,J,K),BO(I,J,K),SO(I,J,K),
     &BW(I,J,K),SW(I,J,K),BG(I,J,K),SG(I,J,K)
  100 CONTINUE
      WRITE(IOCODE,110)K,OOIP(K),OWIP(K),ODGIP(K),OFGIP(K)
  110 FORMAT(/,T15,'LAYER',I3,' INITIAL FLUID VOLUMES:',
     & /,T20,'OIL IN PLACE (MILLION STB)',T65,F10.4,
     & /,T20,'WATER IN PLACE (MILLION STB)',T65,F10.4,
     & /,T20,'SOLUTION GAS IN PLACE (BILLION SCF)',T65,F10.4,
     & /,T20,'FREE GAS IN PLACE (BILLION SCF)',T65,F10.4/)
  102 CONTINUE
      TOOIP=0.
      TOWIP=0.
      TODGIP=0.
      TOFGIP=0.
      DO 103 K=1,KK
      TOOIP=TOOIP+OOIP(K)
      TOWIP=TOWIP+OWIP(K)
      TODGIP=TODGIP+ODGIP(K)
  103 TOFGIP=TOFGIP+OFGIP(K)
      TOGIP = TODGIP + TOFGIP
      WRITE(IOCODE,115) TOOIP,TOWIP,TODGIP,TOFGIP
  115 FORMAT(/,T15,'TOTAL INITIAL FLUID VOLUMES IN RESERVOIR:',
     & /,T20,'OIL IN PLACE (MILLION STB)',T65,F10.4,
     & /,T20,'WATER IN PLACE (MILLION STB)',T65,F10.4,
     & /,T20,'SOLUTION GAS IN PLACE (BILLION SCF)',T65,F10.4,
     & /,T20,'FREE GAS IN PLACE (BILLION SCF)',T65,F10.4/)
      STBO=SCFO*D5615
      STBW=SCFW*D5615
      MCFG=SCFG*0.001
      MCFG1=SCFG1*0.001
      STBOI=STBO
      STBWI=STBW
      MCFGT=MCFG+MCFG1
      IF(MCFGI.LE.1.D-7.AND.MCFGT.LE.1.D-7)MBEG=0.0
         NLOOP=N
  105 IF(N.EQ.1.AND.ITFLAG.LE.0)
     & CALL PRTPS(NLOOP,II,JJ,KK,PAVG0,PAVG,CMBEO,CMBEW,CMBEG,
     & COP,CWP,CWI,CGP,CGI,MBEO,MBEW,MBEG,DELT0,
     & OPR,WPR,GPR,WIR,GIR,ETI,
     &CWOR,CGOR,WOR,GOR,IPMAP,ISOMAP,ISWMAP,ISGMAP,IPBMAP,IAQMAP)
      IF(N.EQ.NMAX)GO TO 1006
C      BEGIN OUTER ITERATION LOOP FOR STABILISED IMPES
      ITNCNT=0
 4000 ITNCNT=ITNCNT+1
C**** ESTABLISH RATES & CALCULATE BHFP(IF PID IS NONZERO)
      IF(NVQN.EQ.0)GO TO 1160
      CALL QRATE(II,JJ,KK,NVQN,GORMAX,WORMAX,ETI)
1160   CONTINUE
C**** CALCULATE SEVEN DIAGONAL MATRIX FOR FLOW EQ SOLUTION
      IF(NUMDIS.EQ.0) CALL SOLONE(II,JJ,KK,DIV1,D288,
     &KSM,KSM1,N,NN,KCOFF)
      IF(NUMDIS.EQ.1) CALL SOLTWO(II,JJ,KK,DIV1,D288,
     &KSM,KSM1,N,NN,KCOFF)
C**** MODIFY MATRIX ELEMENTS FOR WELLS UNDER IMPLICIT CONTROL.
      IF(NVQN.EQ.0) GO TO 1170
      CALL PRATEI(NVQN)
 1170 CONTINUE
C    AQUIFER MODEL: P EQ COEF. MODIFICATIONS
      IF(IAQOPT.NE.0) CALL AQIN(II,JJ,KK,DELT,ETI)
C**** CALCULATE NEW PRESSURE DISTRIBUTION
C      SKIP P CALC WHEN OUTER ITER EXCEEDS 1
      IF(ITNCNT.GT.1) GO TO 1175
      IF(KSOL.EQ.1) CALL GAUS1D(IOCODE,IFATAL,II,JJ,KK)
      IF(IFATAL.GE.1) GO TO 1006
      IF(KSOL.EQ.2) CALL LSORX(II,JJ,KK,OMEGA,TOL,TOL1,MITER,
     & DELT,DELT0,KSN,NLOOP,NLITER)
      IF(KSOL.EQ.3) CALL LSORY(II,JJ,KK,OMEGA,TOL,TOL1,MITER,
     & DELT,DELT0,KSN,NLOOP,NLITER)
      IF(KSOL.EQ.4) CALL LSORZ(II,JJ,KK,OMEGA,TOL,TOL1,MITER,
     & DELT,DELT0,KSN,NLOOP,NLITER)
C**** CALCULATE IMPLICIT RATES.
 1175 CONTINUE
      IF(NVQN.EQ.0) GO TO 1180
      CALL PRATEO(NVQN)
 1180 CONTINUE
C** AQUIFER MODEL RATES
      IF(IAQOPT.NE.0) CALL AQOUT(II,JJ,KK,DELT)
C**** CALCULATE NEW FLUID SATURATIONS
      SCFO=0.0
      SCFW=0.0
      SCFG=0.0
      SCFG1=0.0
      RESVOL=0.0
      DO 400 K=1,KK
      DO 400 J=1,JJ
      DO 400 I=1,II
C      CALC NEW RES PORE VOLUME
      PPN=PN(I,J,K)
      PP=P(I,J,K)
      BPT=PBOT(I,J,K)
      IPVTR=IPVT(I,J,K)
      CALL INTPVT(IPVTR,BPT,RSLOPE(IPVTR),POT,RSOT,MPOT(IPVTR),PP,RSO)
      CALL INTERP(IPVTR,PWT,RSWT,MPWT(IPVTR),PP,RSW)
      CALL INTERP(IPVTR,PRT,CRT,MPGT(IPVTR),PPN,CR)
      CALL INTPVT(IPVTR,BPT,BSLOPE(IPVTR),POT,BOT,MPOT(IPVTR),PP,BBO)
      CALL INTERP(IPVTR,PWT,BWT,MPWT(IPVTR),PP,BBW)
      CALL INTERP(IPVTR,PGT,BGT,MPGT(IPVTR),PP,BBG)
      VPP=VP(I,J,K) * (1.0+CR*(P(I,J,K)-PPN))
      RESVOL=RESVOL+VPP
      DP1=0.0
      DP2=0.0
      DP3=0.0
      DP4=0.0
      DP5=0.0
      DP6=0.0
      IF((I-1).GT.0)  DP1=P(I-1,J,K)-PP
      IF((I+1).LE.II) DP2=P(I+1,J,K)-PP
      IF((J-1).GT.0)  DP3=P(I,J-1,K)-PP
      IF((J+1).LE.JJ) DP4=P(I,J+1,K)-PP
      IF((K-1).GT.0)  DP5=P(I,J,K-1)-PP
      IF((K+1).LE.KK) DP6=P(I,J,K+1)-PP
      DAODP=OW(I,J,K)*DP1+OE(I,J,K)*DP2+OS(I,J,K)*DP3
     &     +ON(I,J,K)*DP4+OT(I,J,K)*DP5+OB(I,J,K)*DP6
      DAWDP=WW(I,J,K)*DP1+WE(I,J,K)*DP2+WS(I,J,K)*DP3
     &     +WN(I,J,K)*DP4+WT(I,J,K)*DP5+WB(I,J,K)*DP6
C*** SKIP SAT. CALC. FOR 0. PV BLOCKS.  ASSUME NO SAT CHANGE.
      IF(VPP.EQ.0.0) GO TO 405
      SW(I,J,K)=((DAWDP+GWWT(I,J,K)-(QW(I,J,K)+EWAQ(I,J,K)))*DELT
     & +VP(I,J,K)*SWN(I,J,K)/BW(I,J,K)) * BBW/VPP
      IF(SW(I,J,K).GT.1.0) GO TO 401
      SO(I,J,K)=((DAODP+GOWT(I,J,K)-QO(I,J,K))*DELT
     & +VP(I,J,K)*SON(I,J,K)/BO(I,J,K)) * BBO/VPP
      SG(I,J,K)=1.0-SO(I,J,K)-SW(I,J,K)
      IF(SG(I,J,K).GT.0.0) GO TO 405
  401 IF(SW(I,J,K).GT.1.0) SW(I,J,K)=1.0
      SG(I,J,K)=0.0
      SO(I,J,K)=1.0-SW(I,J,K)
  405 CONTINUE
      IF(KCOFF.EQ.0) GO TO 397
      RHO1=VPP*SO(I,J,K)/BBO
      RHO2=VP(I,J,K)*SON(I,J,K)/BO(I,J,K)
      DIFFO=RHO1-RHO2
      RHW1=VPP*SW(I,J,K)/BBW
      RHW2=VP(I,J,K)*SWN(I,J,K)/BW(I,J,K)
      DIFFW=RHW1-RHW2
      RHG1=VPP*SG(I,J,K)/BBG
      RHG2=VP(I,J,K)*SGN(I,J,K)/BG(I,J,K)
      DIFFG=RHG1-RHG2
      WRITE(IOCODE,33)
      WRITE(IOCODE,21)I,J,K,P(I,J,K),SO(I,J,K),SON(I,J,K),SW(I,J,K),
     &SWN(I,J,K),SG(I,J,K),SGN(I,J,K),VPP
      WRITE(IOCODE,21)I,J,K,GOWT(I,J,K),QO(I,J,K),GWWT(I,J,K),
     &QW(I,J,K)
      WRITE(IOCODE,21)I,J,K,DAODP,DAWDP,DELT
      WRITE(IOCODE,21)I,J,K,RHO1,RHO2,DIFFO
      WRITE(IOCODE,21)I,J,K,RHW1,RHW2,DIFFW
      WRITE(IOCODE,21)I,J,K,RHG1,RHG2,DIFFG,GGWT(I,J,K),QG(I,J,K)
21    FORMAT(1X,3I3,8E15.6)
  397 CONTINUE
  400 CONTINUE
C      NEW SET OF INTERPOLATED VALUES FOR NEXT R-K OUTER ITER.
      IF(IRK.EQ.0) GO TO 4300
      DO 4200 I=1,II
      DO 4200 J=1,JJ
      DO 4200 K=1,KK
      SO(I,J,K)=SON(I,J,K)+RKCOEF(ITNCNT,KRUNGE)*(SO(I,J,K)-SON(I,J,K))
      SW(I,J,K)=SWN(I,J,K)+RKCOEF(ITNCNT,KRUNGE)*(SW(I,J,K)-SWN(I,J,K))
      SG(I,J,K)=SGN(I,J,K)+RKCOEF(ITNCNT,KRUNGE)*(SG(I,J,K)-SGN(I,J,K))
C      INTERPOLATE BUBBLE POINT PRESSURE FOR NEXT R-K ITERATION
      IF(IREPRS.EQ.1) GO TO 4200
      IBP=I
      JBP=J
      KBP=K
      IF(IREPRS.EQ.0) CALL REPRS1(IBP,JBP,KBP)
 4200 CONTINUE
      IF(ITNCNT.EQ.KRUNGE) GO TO 4300
      GO TO 4000
 4300 CONTINUE
C      UPDATE FVF AND COMPRESSIBILITY
      DO 450 I=1,II
      DO 450 J=1,JJ
      DO 450 K=1,KK
      PPN=PN(I,J,K)
      PP=P(I,J,K)
      BPT=PBOT(I,J,K)
      IPVTR=IPVT(I,J,K)
      CALL INTPVT(IPVTR,BPT,RSLOPE(IPVTR),POT,RSOT,MPOT(IPVTR),PP,RSO)
      CALL INTERP(IPVTR,PWT,RSWT,MPWT(IPVTR),PP,RSW)
      CALL INTERP(IPVTR,PRT,CRT,MPGT(IPVTR),PPN,CR)
      CALL INTPVT(IPVTR,BPT,BSLOPE(IPVTR),POT,BOT,MPOT(IPVTR),PP,BBO)
      CALL INTERP(IPVTR,PWT,BWT,MPWT(IPVTR),PP,BBW)
      CALL INTERP(IPVTR,PGT,BGT,MPGT(IPVTR),PP,BBG)
      VPP=VP(I,J,K) * (1.0+CR*(P(I,J,K)-PPN))
      VP(I,J,K)=VPP
      BO(I,J,K)=BBO
      BW(I,J,K)=BBW
      BG(I,J,K)=BBG
      FF1=SO(I,J,K)/BO(I,J,K)
      FF2=SW(I,J,K)/BW(I,J,K)
      SCFO=SCFO+VP(I,J,K)*FF1
      SCFW=SCFW+VP(I,J,K)*FF2
      SCFG=SCFG+VP(I,J,K)*SG(I,J,K)/BG(I,J,K)
      SCFG1=SCFG1+VP(I,J,K)*(RSO*FF1+RSW*FF2)
      CALL INTCOM(IPVTR,POT,BOPT,MPOT(IPVTR),PP,BODER)
      CALL INTCOM(IPVTR,POT,RSOPT,MPOT(IPVTR),PP,RSODER)
      CALL INTCOM(IPVTR,PWT,BWPT,MPWT(IPVTR),PP,BWDER)
      CALL INTCOM(IPVTR,PWT,RSWPT,MPWT(IPVTR),PP,RSWDER)
      CALL INTCOM(IPVTR,PGT,BGPT,MPGT(IPVTR),PP,BGDER)
      IF(PP.GT.PBOT(I,J,K))BODER=BSLOPE(IPVTR)
      IF(PP.GT.PBOT(I,J,K))RSODER=RSLOPE(IPVTR)
      CO=-(BODER-BG(I,J,K)*RSODER)/BO(I,J,K)
      CW=-(BWDER-BG(I,J,K)*RSWDER)/BW(I,J,K)
      CG=-BGDER/BG(I,J,K)
      CALL INTERP(IPVTR,PRT,CRT,MPGT(IPVTR),PP,CR)
      CT(I,J,K)=CR + CO*SO(I,J,K) +CW*SW(I,J,K) + CG*SG(I,J,K)
      IF(N.EQ.KCO)WRITE(IOCODE,21)I,J,K,CR,CO,RSO,CW,RSW,CG
  450 CONTINUE
C      AUTO. TIME STEP CONTROL CALC. OF PRESSURE AND SAT. MAXIMA.
      PPM=0.
      SOM=0.
      SWM=0.
      SGM=0.
      DO 240 K=1,KK
      DO 240 J=1,JJ
      DO 240 I=1,II
      DPO=P(I,J,K)-PN(I,J,K)
      DSO=SO(I,J,K)-SON(I,J,K)
      DSW=SW(I,J,K)-SWN(I,J,K)
      DSG=SG(I,J,K)-SGN(I,J,K)
      IF(ABS(DPO).LE.ABS(PPM))GO TO 210
      PPM=DPO
      IPM=I
      JPM=J
      KPM=K
  210 IF(ABS(DSO).LE.ABS(SOM))GO TO 220
      SOM=DSO
      IOM=I
      JOM=J
      KOM=K
  220 IF(ABS(DSW).LE.ABS(SWM))GO TO 230
      SWM=DSW
      IWM=I
      JWM=J
      KWM=K
  230 IF(ABS(DSG).LE.ABS(SGM))GO TO 240
      SGM=DSG
      IGM=I
      JGM=J
      KGM=K
  240 CONTINUE
      DPMC=ABS(PPM)
      DSMC=ABS(SOM)
C
      ISM=IOM
      JSM=JOM
      KSM=KOM
      IF(DSMC.GT.ABS(SGM)) GO TO 245
      DSMC=ABS(SGM)
      ISM=IGM
      JSM=JGM
      KSM=KGM
  245 IF(DSMC.GT.ABS(SWM)) GO TO 248
      DSMC=ABS(SWM)
      ISM=IWM
      JSM=JWM
      KSM=KWM
  248 CONTINUE
C****REPEAT TIME STEP?
      IF(DSMC.LT.DSMAX.AND.DPMC.LT.DPMAX)GO TO 402
      IF(DELT.LE.DTMIN.OR.FACT2.GE.1.0)GO TO 402
      ITFLAG=ITFLAG+1
      DELT=DELT*FACT2
      IF(DELT.LT.DTMIN) DELT=DTMIN
      FT=ETI+DELT
      IF(FT.GT.FTMAX)DELT=FTMAX-ETI
C****RESET VARIABLES.
      DO 260 I=1,II
      DO 260 J=1,JJ
      DO 260 K=1,KK
      P(I,J,K)=PN(I,J,K)
      SO(I,J,K)=SON(I,J,K)
      SW(I,J,K)=SWN(I,J,K)
      SG(I,J,K)=SGN(I,J,K)
      PBOT(I,J,K)=PBOTN(I,J,K)
  260 CONTINUE
      GO TO 1060
  402 CONTINUE
C****UNDERSATURATED GRID BLOCK SATURATION CALCULATION.
C      SKIP CALC IF NO OIL IN BLOCK
      DO 410 I=1,II
      DO 410 J=1,JJ
      DO 410 K=1,KK
      IF(SO(I,J,K).LE.0.0) GO TO 410
      IF(P(I,J,K).GT.PN(I,J,K)) GO TO 410
      IF(P(I,J,K).LT.PBOT(I,J,K)) GO TO 410
      IP=I+1
      IM=I-1
      JP=J+1
      JM=J-1
      KP=K+1
      KM=K-1
      IF(IP.GT.II) GO TO 412
      IF(SGN(IP,J,K).GT.0.0001) GO TO 410
  412 IF(IM.LT.1) GO TO 414
      IF(SGN(IM,J,K).GT.0.0001) GO TO 410
  414 IF(JP.GT.JJ) GO TO 416
      IF(SGN(I,JP,K).GT.0.0001) GO TO 410
  416 IF(JM.LT.1) GO TO 418
      IF(SGN(I,JM,K).GT.0.0001) GO TO 410
  418 IF(KP.GT.KK) GO TO 420
      IF(SGN(I,J,KP).GT.0.0001) GO TO 410
  420 IF(KM.LT.1) GO TO 422
      IF(SGN(I,J,KM).GT.0.0001) GO TO 410
  422 SG(I,J,K)=0.0
      SO(I,J,K)=1.0-SW(I,J,K)
  410 CONTINUE
C**** REPRESSURIZATION ALGORITHM.
      IF(IREPRS.EQ.1) GO TO 5011
      DO 50 I=1,II
      DO 50 J=1,JJ
      DO 50 K=1,KK
      IBP=I
      JBP=J
      KBP=K
      IF(IREPRS.EQ.0) CALL REPRS1(IBP,JBP,KBP)
   50 CONTINUE
5011  CONTINUE
C**** UPDATE OLD FLUID VOLUMES FOR MATERIAL BALANCE.
      STBOI=STBO
      STBWI=STBW
      MCFGI=MCFGT
C**** UPDATE  NEW FLUID VOLUMES.
      STBO=SCFO*D5615
      STBW=SCFW*D5615
      MCFG=SCFG*0.001
      MCFG1=SCFG1*0.001
      MCFGT=MCFG+MCFG1
C***** DEBUG PRINT OF PRESENT AND FUTURE P,SO,SW,SG VALUES.
      IF(KCOFF.EQ.0)GO TO 2901
      DO 290 K=1,KK
      DO 290 J=1,JJ
      DO 290 I=1,II
      WRITE(IOCODE,21)I,J,K,PN(I,J,K),SON(I,J,K),SWN(I,J,K),SGN(I,J,K)
      WRITE(IOCODE,21)I,J,K,P(I,J,K),SO(I,J,K),SW(I,J,K),SG(I,J,K)
290   CONTINUE
2901  CONTINUE
C     AQUIFER MODEL: CUMULATIVES
      IF(IAQOPT.NE.0) CALL AQCUM(NLOOP)
C**** WELL REPORT (ALL RATE & PRESSURE DATA APPLICABLE THIS STEP)
      IJ=0
      TOR=0.
      TGR=0.
      TWR=0.
      TOC=0.
      TGC=0.
      TWC=0.
      IFREQW=IFREQW+1
      DO 2040 J=1,NVQN
      IQ1=IQN1(J)
      IQ2=IQN2(J)
      IQ3=IQN3(J)
      IJLOC=IDWELL(J)
      IF(IJLOC.EQ.0) GO TO 2040
      IJ=IJ+1
      LAY=IQ3+(LAYER(J)-1)
      DO 2040 K=IQ3,LAY
      GOR=0.
      WOR=0.
      QOO=QOC(IJLOC,K)*D5615
      QWW=QWC(IJLOC,K)*D5615
      QGG=QGC(IJLOC,K)*0.001
      CUMO(J,K)=CUMO(J,K)+QOO*DELT*0.001
      CUMW(J,K)=CUMW(J,K)+QWW*DELT*0.001
      CUMG(J,K)=CUMG(J,K)+QGG*DELT*0.001
      IF(IOMETH.GT.0) GO TO 992
      IF(IWLREP.GT.IFREQW.AND.FT.LT.FTMAX) GO TO 2040
      GO TO 994
  992 IF(FT.LT.FTMAX) GO TO 2040
  994 CONTINUE
      IF(IJ.NE.1.OR.K.NE.IQ3) GO TO 996
      WRITE(IOCODE,70) (IHEDIN(IH),IH=1,40)
      WRITE(IOCODE,591) N,FT
      WRITE(IOCODE,592)
  591 FORMAT(/,T45,41('*'),/,T45,'*',T85,'*',/,T45,
     & '*  WELL REPORT: BOAST II (RELEASE 1.1)  *',/,
     & T45,'*',T85,'*',/,T45,41('*'),//,
     & T5,10('*'),' WELL REPORT FOR TIME STEP NUMBER ',I3,
     &1X,'  ELAPSED TIME =',F9.3,' DAYS FROM BEGINNING OF SIMULATION ',
     & 10('*'),//)
  592 FORMAT(/,T56,'------ RATE ------',22X,'--- CUMULATIVE ---',
     & /,6X,'   WELL     LOCATION',4X,'CALC    SPEC    SPEC',4X,
     & 'OIL     GAS    WATER    GOR     WOR',5X,
     & 'OIL     GAS    WATER',/,
     & 8X,'#     ID',3X,'I  J  K    BHFP    BHFP     PI',
     & 3X,'STB/D    MCF/D   STB/D',20X,'MSTB    MMCF    MSTB',/)
  996 CONTINUE
      IF(QOO.EQ.0.)GO TO 998
      GOR=QGG*1000./QOO
      WOR=QWW/QOO
  998 CONTINUE
      FLDCUM=ABS(CUMO(J,K))+ABS(CUMG(J,K))+ABS(CUMW(J,K))
C      IF FLDCUM LE 0, SKIP OUTPUT
      IF(FLDCUM.LE.0.) GO TO 999
      WRITE(IOCODE,593) IDWELL(J),WELNAM(J),IQN1(J),IQN2(J),K,PWFC(J,K),
     & PWF(J,K),PID(J,K),QOO,QGG,QWW,GOR,WOR,CUMO(J,K),CUMG(J,K),
     & CUMW(J,K)
  593 FORMAT(4X,I5,2X,A5,1X,3I3,2F8.0,F7.3,F9.1,F9.0,F9.1,F7.1,F7.3,F8.1,
     &F8.0,F8.1)
  999 CONTINUE
C      TIME STEP SUMMARY HEADING ACTIVATED
      ITSS=0
      TOR=TOR+QOO
      TGR=TGR+QGG
      TWR=TWR+QWW
      TOC=TOC+CUMO(J,K)
      TGC=TGC+CUMG(J,K)
      TWC=TWC+CUMW(J,K)
 2040 CONTINUE
      IF(IOMETH.GT.0) GO TO 2542
      IF(IWLREP.GT.IFREQW.AND.FT.LT.FTMAX) GO TO 2552
      IFREQW=0
      GO TO 2544
 2542 IF(FT.LT.FTMAX) GO TO 2552
 2544 CONTINUE
      WRITE(IOCODE,594)TOR,TGR,TWR,TOC,TGC,TWC
  594 FORMAT(6X,108('-'),/,
     &12X,'TOTALS',31X,3F9.1,14X,3F8.1,/)
      WRITE(IOCODE,2551)
 2551 FORMAT(///T5,49('*'),'  END OF WELL REPORT  ',49('*'),6(/))
 2552 CONTINUE
C*****CALCULATE MATERIAL BALANCE ERRORS & AVERAGE RESERVOIR PRESSURE
      DELT0=DELT
      ETI=ETI+DELT
      CALL MATBAL(II,JJ,KK,STBO,STBOI,STBW,STBWI,TOWIP,TOOIP,TOGIP,
     &MCFGI,MBEO,MBEW,MBEG,CMBEO,CMBEW,CMBEG,DELT0,RESVOL,
     &OP,WP,GP,WI,GI,PAVG0,PAVG,OPR,WPR,GPR,WIR,GIR,D5615,
     &COP,CWP,CGP,CWI,CGI,MCFGT,CWOR,WOR,CGOR,GOR)
      IF(WOR.GT.WORMAX)GO TO 1002
      IF(1000.0*GOR.GT.GORMAX)GO TO 1003
      IF(PAVG.LT.PAMIN)GO TO 1004
      IF(PAVG.GT.PAMAX)GO TO 1005
C***** SUMMARY REPORT.
      IFREQS=IFREQS+1
      IF(IOMETH.GT.0) GO TO 2554
      IF(ISUMRY.GT.IFREQS.AND.FT.LT.FTMAX) GO TO 2557
      IFREQS=0
      GO TO 2556
 2554 IF(FT.LT.FTMAX) GO TO 2557
 2556 NLP=N+1
C      TIME STEP SUMMARY HEADING ACTIVATED
      ITSS=0
      WRITE(IOCODE,70) (IHEDIN(IH),IH=1,40)
      CALL PRTPS(NLP,II,JJ,KK,PAVG0,PAVG,CMBEO,CMBEW,CMBEG,
     &COP,CWP,CWI,CGP,CGI,MBEO,MBEW,MBEG,DELT0,
     &OPR,WPR,GPR,WIR,GIR,ETI,
     &CWOR,CGOR,WOR,GOR,IPMAP,ISOMAP,ISWMAP,ISGMAP,IPBMAP,IAQMAP)
 2557 IF(N.NE.KCO.OR.KCO1.EQ.0)GO TO 500
      DO 300 K=1,KK
      DO 300 J=1,JJ
      DO 300 I=1,II
      WRITE(IOCODE,21)I,J,K,VP(I,J,K),CT(I,J,K),BO(I,J,K),SO(I,J,K),
     &BW(I,J,K),SW(I,J,K),BG(I,J,K),SG(I,J,K)
300   CONTINUE
  500 CONTINUE
      IF(N.EQ.KSN)KSN=KSN+KSN1
      IF(N.EQ.KSM)KSM=KSM+KSM1
      IF(N.EQ.KCO)KCO=KCO+KCO1
C**** UPDATE ARRAYS.
      DO 1150 K=1,KK
      DO 1150 J=1,JJ
      DO 1150 I=1,II
      QO(I,J,K)=0.0
      QW(I,J,K)=0.0
      QG(I,J,K)=0.0
       PN(I,J,K)=P(I,J,K)
       SON(I,J,K)=SO(I,J,K)
       SWN(I,J,K)=SW(I,J,K)
       SGN(I,J,K)=SG(I,J,K)
       PBOTN(I,J,K)=PBOT(I,J,K)
1150  CONTINUE
C**  REQUIRED ONE LINE TIME STEP SUMMARY
      IF(ITSS.GT.0) GO TO 1275
      ITSS=1
      WRITE(IOCODE,1200)
 1200 FORMAT(1H1/T54,29('*'),/,
     & T54,'*   TIME   STEP   SUMMARY   *',/,
     & T54,29('*'),//,
     & T2,'TIME STEP',15X,'PRODUCTION',21X,'INJECTION',
     & 5X,'PV WT   MATERIAL  BALANCES',2X,
     & 'MAX SATN CHANGE MAX PRES CHANGE  ITN ',/,
     & T2,9('-'),1X,40('-'),1X,16('-'),2X,' AVG',3X,
     & 20('-'),1X,15('-'),1X,15('-'),1X,5('-'))
      WRITE(IOCODE,1250)
 1250 FORMAT(T3,13X,'OIL     GAS     WATER    GOR   WATER',
     & 3X,' GAS     WATER   RES     OIL    GAS',
     & 3X,'WATER  I  J  K  DSMAX  I  J  K  DPMAX O   I',/,
     & T3,38X,'SCF/   /OIL',20X,'PRES',5X,'%',2(6X,'%'),/,
     & T1,2X,'NO. DAYS    STB/D  MSCF/D    STB/D',
     & 3X,' STB   RATIO  MSCF/D    STB/D   PSIA',/,
     & T2,4('-'),1X,4('-'),1X,8('-'),2(2X,7('-')),
     & 1X,6('-'),2X,5('-'),1X,8('-'),1X,7('-'),1X,6('-'),2X,3(6('-'),1X),
     & 3(2('-'),1X),6('-'),1X,3(2('-'),1X),6('-'),
     & 1X,5('-'),/)
 1275 GORS=0.
      WORS=0.
      IF(OPR.GT.0.) GORS=GPR*1000./OPR
      IF(OPR.GT.0.) WORS=WPR/OPR
C      TOTAL RUN SUMMARY SAVED INFORMATION
      ITSMAX=N
      ITSNO(N)=N
      STIME(N)=ETI
      SOPROD(N)=OPR
      SGPROD(N)=GPR
      SWPROD(N)=WPR
      SGOR(N)=GORS
      SWOR(N)=WORS
      SGINJ(N)=GIR
      SWINJ(N)=WIR
      SPVWTP(N)=PAVG
      NM=N-1
      IF(NM.EQ.0) NM=1
      SOCUMP(N)=SOPROD(N)*DELT/1000. + SOCUMP(NM)
      SWCUMP(N)=SWPROD(N)*DELT/1000. + SWCUMP(NM)
      SGCUMP(N)=SGPROD(N)*DELT/1000. + SGCUMP(NM)
      SWCUMI(N)=SWINJ(N)*DELT/1000. + SWCUMI(NM)
      SGCUMI(N)=SGINJ(N)*DELT/1000. + SGCUMI(NM)
      WRITE(IOCODE,1280) N,ETI,OPR,GPR,WPR,GORS,WORS,GIR,WIR,PAVG,
     & MBEO,MBEG,MBEW,ISM,JSM,KSM,DSMC,IPM,JPM,KPM,DPMC,
     & ITNCNT,NLITER
 1280 FORMAT(I4,F6.0,1X,F8.1,1X,F8.1,1X,F8.1,F7.1,           
     & 1X,F5.1,1X,F9.1,1X,F7.0,1X,F6.0,3(1X,F6.3),3(1X,I2),1X,F6.3,1X,
     & 3(1X,I2),1X,F6.2,1X,I1,1X,I3)
C      END OF TIME?
      IF(FT.GE.TMAX) GO TO 1006
1000  CONTINUE
1002  WRITE(IOCODE,2902)
      GO TO 1006
1003  WRITE(IOCODE,2903)
      GO TO 1006
1004  WRITE(IOCODE,2904)
      GO TO 1006
1005  WRITE(IOCODE,2905)
C******  EXIT POINT
1006  CONTINUE
      IF(IFATAL.LT.1) GO TO 2020
      WRITE(IOCODE,1010) IFATAL
 1010 FORMAT(//5X,5('-'),'FATAL INPUT ERRORS HAVE BEEN',
     & ' DETECTED (# =',I9,'). RUN TERMINATED.',5('-'),/)
      GO TO 2250
 2020 CONTINUE
C      POST-PLOT PACKAGE CALL
      IF(IPLOTP.GE.0) CALL POSTP(NPLINE,IOCODE)
 2250 CONTINUE
      WRITE(IOCODE,2300)
 2300 FORMAT(///,T4,40('*'),
     & ' BOAST II (RELEASE 1.1) SIMULATION TERMINATED ',
     & 40('*'),//)
2902  FORMAT(/T15,'MAXIMUM WOR HAS BEEN EXCEEDED --- SIMULATION',
     &' IS BEING TERMINATED'//)
2903  FORMAT(/T15,'MAXIMUM GOR HAS BEEN EXCEEDED --- SIMULATION',
     &' IS BEING TERMINATED'//)
2904  FORMAT(/T15,'MINIMUM AVERAGE RESERVOIR PRESSURE WAS NOT',
     &' ACHIEVED --- SIMULATION IS BEING TERMINATED'//)
 2905 FORMAT(/T15,'MAXIMUM AVERAGE RESERVOIR PRESSURE
     1 HAS BEEN EXCEEDED --- SIMULATION IS BEING TERMINATED'//)
C      CLOSE I/O FILES FOR DEC 20/60.
C      MACHINE DEPENDENT CLOSE STATEMENTS
      CLOSE(UNIT=20)
      CLOSE(UNIT=21)
      CLOSE(UNIT=24)
      CLOSE(UNIT=25)
      STOP
      END
C..................................................BLOCK DATA
      BLOCK DATA 
      PARAMETER (LP1=13,LP2=10,LP3=4)
      PARAMETER (LP7=3,LP8=3,LP9=25,LP10=3,LP11=50,LP12=1000)
      PARAMETER (LP14=1,LP15=13,LP17=5)
      PARAMETER (LP4=LP1+1,LP5=LP2+1,LP6=LP3+1,LP13=LP1+LP2+LP3)
      PARAMETER (LP19=LP4*LP2*LP3,LP20=LP1*LP5*LP3)
      PARAMETER (LP21=LP1*LP2*LP6,LP22=LP1*LP2*LP3,LP23=LP11*LP3)
      REAL KROT,KROGT,KRWT,KRGT,MUWT,MUOT,MUGT,KX,KY,KZ
     & ,MUO,MUW,MUG,KRO,KRW,MBEWI,MBEGI,MCFGI
     & ,MBEO,MBEW,MBEG,MCFG,MBEOI,MIN,MCFG1,MCFGT
      COMMON /COEF/ AW(LP1,LP2,LP3),AE(LP1,LP2,LP3),AN(LP1,LP2,LP3),
     & AS(LP1,LP2,LP3),AB(LP1,LP2,LP3),AT(LP1,LP2,LP3),E(LP1,LP2,LP3),
     & B(LP1,LP2,LP3)
      COMMON /SAQUI/ IAQOPT,CPIAQ1(LP1,LP2,LP3),CPIAQ2(LP1,LP2,LP3),
     & CPI1(LP1,LP2,LP3),CPI2(LP1,LP2,LP3),EWAQ(LP1,LP2,LP3),
     & CUMAQW(LP1,LP2,LP3),
     & QWAQ(LP1,LP2,LP3),CUMEW(LP1,LP2,LP3),QWAQR(LP7),CUMAQR(LP7)
     & ,IAQREG(LP1,LP2,LP3),PAQ(LP1,LP2,LP3),PIAQ(LP1,LP2,LP3)   
        COMMON /RUNSUM/ ITSNO(LP12),STIME(LP12),SOPROD(LP12),
     & SGPROD(LP12),
     & SWPROD(LP12),SGOR(LP12),SWOR(LP12),SGINJ(LP12),SWINJ(LP12)
      COMMON /RUN2/SPVWTP(LP12),SOCUMP(LP12),SWCUMP(LP12),SGCUMP(LP12),
     & SGCUMI(LP12),SWCUMI(LP12),SAQUIR(LP12),SAQUIC(LP12)
      COMMON /SPARM/ KX(LP1,LP2,LP3),KY(LP1,LP2,LP3),KZ(LP1,LP2,LP3),
     & EL(LP1,LP2,LP3),TX(LP4,LP2,LP3),TY(LP1,LP5,LP3),TZ(LP1,LP2,LP6),
     & PDAT(LP1,LP2,LP3),PDATUM,GRAD
      COMMON /SPVT/ SAT(LP7,LP9),KROT(LP7,LP9),KRWT(LP7,LP9),
     & BGT(LP7,LP9),
     & KRGT(LP7,LP9),ITHREE(LP7),RSOT(LP7,LP9),BWPT(LP7,LP9),
     & PCOWT(LP7,LP9),PCGOT(LP7,LP9),KROGT(LP7,LP9),SWR(LP7),
     & POT(LP7,LP9),MUOT(LP7,LP9),BOT(LP7,LP9),BOPT(LP7,LP9),
     & RSOPT(LP7,LP9),PWT(LP7,LP9),MUWT(LP7,LP9),BWT(LP7,LP9),
     & RSWT(LP7,LP9),RSWPT(LP7,LP9),PGT(LP7,LP9),MUGT(LP7,LP9),
     & BGPT(LP7,LP9),CRT(LP7,LP9),IPVT(LP1,LP2,LP3),IROCK(LP1,LP2,LP3),
     & NROCK,NPVT,PSIT(LP7,LP9),PRT(LP7,LP9),WOROCK(LP7),GOROCK(LP7)
      COMMON /SRATE/ PID(LP11,LP3),PWF(LP11,LP3),PWFC(LP11,LP3),
     & KIP(LP11),LAYER(LP11),QVO(LP11),CUMG(LP11,LP3),
     & GMO(LP11,LP3),GMW(LP11,LP3),GMG(LP11,LP3),
     & QVW(LP11),QVG(LP11),QVT(LP11),CUMO(LP11,LP3),CUMW(LP11,LP3),
     & IDWELL(LP11),ALIT(LP11),BLIT(LP11)
      COMMON /SSOLN/ BO(LP1,LP2,LP3),BW(LP1,LP2,LP3),BG(LP1,LP2,LP3),
     & QO(LP1,LP2,LP3),QW(LP1,LP2,LP3),QG(LP1,LP2,LP3),
     & GOWT(LP1,LP2,LP3),GWWT(LP1,LP2,LP3),GGWT(LP1,LP2,LP3),
     & OW(LP4,LP2,LP3),OE(LP4,LP2,LP3),WW(LP4,LP2,LP3),WE(LP4,LP2,LP3),
     & OS(LP1,LP5,LP3),ON(LP1,LP5,LP3),WS(LP1,LP5,LP3),WN(LP1,LP5,LP3),
     & OT(LP1,LP2,LP6),OB(LP1,LP2,LP6),WT(LP1,LP2,LP6),WB(LP1,LP2,LP6),
     & QOWG(LP1,LP2,LP3),VP(LP1,LP2,LP3),CT(LP1,LP2,LP3)
      COMMON /TSTDAT/ IFATAL,IWARN
      DATA IFATAL,IWARN/0,0/
       DATA NROCK,NPVT /LP7,LP8/
      DATA TX,TY,TZ/LP19*0.0,LP20*0.0,LP21*0.0/
      DATA    CUMO,CUMW,CUMG/LP23*0.0,LP23*0.0,LP23*0.0/
      DATA            AW,AS,AT/LP22*0.0,LP22*0.0,LP22*0.0/
      DATA            AE,AN,AB/LP22*0.0,LP22*0.0,LP22*0.0/
      DATA  OW,OE,WW,WE/LP19*0.0,LP19*0.0,LP19*0.0,LP19*0.0/
      DATA  OS,ON,WS,WN/LP20*0.0,LP20*0.0,LP20*0.0,LP20*0.0/
      DATA  OT,OB,WT,WB/LP21*0.0,LP21*0.0,LP21*0.0,LP21*0.0/
      DATA     IROCK,IPVT/LP22*1,LP22*1/
      DATA     CPIAQ1,CPIAQ2/LP22*0.,LP22*0./
      END
