$DO66
C........................................................AQIN
      SUBROUTINE AQIN(II,JJ,KK,DELT,ETI)
C      MACHINE DEPENDENT INCLUDE STATEMENT
$INCLUDE:'PARAMS.FOR'
C      AQUIFER MODEL P EQ. TERMS.
        REAL KROT,KRWT,KRGT,KROGT,MUOT,MUWT,MUGT
      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 /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 /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)
      DO 2000 K=1,KK
      DO 2000 J=1,JJ
      DO 2000 I=1,II
      IF(IAQREG(I,J,K).LT.1) GO TO 2000
      PPN=PN(I,J,K)
      IPVTR=IPVT(I,J,K)
      CALL INTERP(IPVTR,PWT,BWT,MPWT(IPVTR),PPN,BBW)
      CALL INTERP(IPVTR,PGT,BGT,MPGT(IPVTR),PPN,BBG)
      CALL INTERP(IPVTR,PWT,RSWT,MPWT(IPVTR),PPN,RSW)
      FACTOR=BBW-BBG*RSW
C**    POT AQUIFER
      IF(IAQREG(I,J,K).NE.1) GO TO 1050
      PAQ(I,J,K)=PPN
      IF(DELT.NE.0)
     & CPI1(I,J,K)= CPIAQ1(I,J,K)/DELT
      CPI2(I,J,K)=0.
      GO TO 1900
C**    STEADY-STATE AQUIFER
 1050 IF(IAQREG(I,J,K).NE.2) GO TO 1100
      CPI1(I,J,K)= CPIAQ1(I,J,K)
      CPI2(I,J,K)=0.0
      GO TO 1900
C**    CARTER-TRACY AQUIFER
 1100 ETP=ETI+DELT
      TD=ETI*CPIAQ1(I,J,K)
      TDP=ETP*CPIAQ1(I,J,K)
C      RATIO=1.5
      IF(IAQREG(I,J,K).NE.3) GO TO 1150
      PTD=FPTD(0.10371,1.66657,-0.04579,-0.01023,TDP)
      DPTD=FDPTD(1.66657,-0.04579,-0.01023,TDP)
      GO TO 1800
C      RATIO=2.0
 1150 IF(IAQREG(I,J,K).NE.4) GO TO 1200
      PTD=FPTD(0.30210,0.68178,-0.01599,-0.01356,TDP)
      DPTD=FDPTD(0.68178,-0.01599,-0.01356,TDP)
      GO TO 1800
C      RATIO=3.0
 1200 IF(IAQREG(I,J,K).NE.5) GO TO 1250
      PTD=FPTD(0.51243,0.29317,0.01534,-0.06732,TDP)
      DPTD=FDPTD(0.29317,0.01534,-0.06732,TDP)
      GO TO 1800
C      RATIO=4.0
 1250 IF(IAQREG(I,J,K).NE.6) GO TO 1300
      PTD=FPTD(0.63656,0.16101,0.15812,-0.09104,TDP)
      DPTD=FDPTD(0.16101,0.15812,-0.09104,TDP)
      GO TO 1800
C      RATIO=5.0
 1300 IF(IAQREG(I,J,K).NE.7) GO TO 1350
      PTD=FPTD(0.65106,0.10414,0.30953,-0.11258,TDP)
      DPTD=FDPTD(0.10414,0.30953,-0.11258,TDP)
      GO TO 1800
C      RATIO=6.0
 1350 IF(IAQREG(I,J,K).NE.8) GO TO 1400
      PTD=FPTD(0.63367,0.06940,0.41750,-0.11137,TDP)
      DPTD=FDPTD(0.06940,0.41750,-0.11137,TDP)
      GO TO 1800
C      RATIO=8.0
 1400 IF(IAQREG(I,J,K).NE.9) GO TO 1450
      PTD=FPTD(0.40132,0.04104,0.69592,-0.14350,TDP)
      DPTD=FDPTD(0.04104,0.69592,-0.14350,TDP)
      GO TO 1800
C      RATIO=10.0
 1450 IF(IAQREG(I,J,K).NE.10) GO TO 1500
      PTD=FPTD(0.14386,0.02649,0.89646,-0.15502,TDP)
      DPTD=FDPTD(0.02649,0.89646,-0.15502,TDP)
      GO TO 1800
C      RATIO=INFINITY
 1500 IF(IAQREG(I,J,K).NE.11) GO TO 1800
      PTD=FPTD(0.82092,-0.000368,0.28908,0.28817,TDP)
      DPTD=FDPTD(-0.000368,0.28908,0.28817,TDP)
 1800 CONTINUE
C**    CALC. CARTER-TRACY COEF.
      DENOM=PTD-TD*DPTD
      CPI1(I,J,K)= CPIAQ1(I,J,K)*CPIAQ2(I,J,K)/DENOM
      CPI2(I,J,K)=CPIAQ1(I,J,K)*(CPIAQ2(I,J,K)*(PIAQ(I,J,K)-PPN)
     & +CUMEW(I,J,K)*DPTD)/DENOM
      PAQ(I,J,K)=PPN
 1900 CONTINUE
      B(I,J,K)=B(I,J,K)-(CPI1(I,J,K)*PAQ(I,J,K)
     & +CPI2(I,J,K))*FACTOR
      E(I,J,K)=E(I,J,K)-CPI1(I,J,K)*FACTOR
 2000 CONTINUE
      RETURN
      END
C..........................................................AQOUT
      SUBROUTINE AQOUT(II,JJ,KK,DELT)
C      MACHINE DEPENDENT INCLUDE STATEMENT
$INCLUDE:'PARAMS.FOR'
C      AQUIFER MODEL RATES
       REAL KROT,KRWT,KRGT,KROGT,MUOT,MUWT,MUGT
      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 /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)
      DO 10 IROC=1,NROCK
   10 QWAQR(IROC)=0.0
      DO 1000 K=1,KK
      DO 1000 J=1,JJ
      DO 1000 I=1,II
      IF(IAQREG(I,J,K).LT.1) GO TO 1000
      PPN=PN(I,J,K)
      PP=P(I,J,K)
C**    POT AQUIFER
      IF(IAQREG(I,J,K).NE.1) GO TO 100
      EWAQ(I,J,K)=-CPI1(I,J,K)*(PPN-PP)
      GO TO 1000
C**    STEADY-STATE AQUIFER
  100 IF(IAQREG(I,J,K).NE.2) GO TO 200
      EWAQ(I,J,K)=-CPI1(I,J,K)*(PAQ(I,J,K)-PP)
      GO TO 1000
C**    CARTER-TRACY AQUIFER
  200 CONTINUE
      EWAQ(I,J,K)=-CPI2(I,J,K)+CPI1(I,J,K)*(PP-PPN)
 1000 CONTINUE
      RETURN
C      CALC CUM AQ INFLUX
      ENTRY AQCUM(NLOOP)
      DO 1050 K=1,KK
      DO 1050 J=1,JJ
      DO 1050 I=1,II
      IF(IAQREG(I,J,K).LT.1) GO TO 1050
      CUMEW(I,J,K)=CUMEW(I,J,K)+EWAQ(I,J,K)*DELT
C    CONVERT SCF TO STB
      QWAQ(I,J,K)=EWAQ(I,J,K)/5.615
      CUMAQW(I,J,K)=CUMEW(I,J,K)/5.615
      IROC=IROCK(I,J,K)
C**     ROCK REGION AQUI INFLUX RATES AND CUM.
      QWAQR(IROC)=QWAQ(I,J,K)+QWAQR(IROC)
      CUMAQR(IROC)=DELT*QWAQ(I,J,K)+CUMAQR(IROC)
 1050 CONTINUE
C      TOTAL RUN SUMMARY AQUIFER ENTRIES
      CUMRAT=0.
      CUMPRD=0.
      DO 1075 IROC=1,NROCK
      CUMRAT=QWAQR(IROC)+CUMRAT
      CUMPRD=CUMAQR(IROC)+CUMPRD
 1075 CONTINUE
      SAQUIR(NLOOP)=CUMRAT/1000.
      SAQUIC(NLOOP)=CUMPRD/1.E+6
      RETURN
C      PRINT AQ INFLUX INFO
      ENTRY AQPRNT
      DO 2000 N=1,NROCK
      WRITE(IOCODE,1100) N,QWAQR(N),CUMAQR(N)
 1100 FORMAT(1X,'AQUIFER MODEL FOR ROCK REGION ',I3,':',
     & /1X,'AQUIFER INFLUX RATE (STB/D) =',F9.1,
     & 3X,'CUM. AQUIFER INFLUX (STB)    =',E10.4,//)
 2000 CONTINUE
      RETURN
      END
C................................................................AQUI
      SUBROUTINE AQUI(TMAX)
C      MACHINE DEPENDENT INCLUDE STATEMENT
$INCLUDE:'PARAMS.FOR'
C          CALC AQUIFER INFLUX	
      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)
C      MAX DIM TIM CORRELATION VALUES
      DIMENSION TDCMAX(11)
      DATA TDCMAX/0.,0.,0.6,5.,5.,10.,15.,30.,45.,70.,1000./
      READ(20,5)
    5 FORMAT(40A2)
      READ(20,*) IAQOPT
      IF(IAQOPT.EQ.0) RETURN
      IF(IAQOPT.NE.1) GO TO 100
C**  POT AQUIFER
      WRITE(IOCODE,10)
   10 FORMAT(//T15,'POT AQUIFER PARAMETERS:',
     & //,T20,'  I1  I2  J1  J2  K1  K2      POT')
      READ(20,*) NAQEN
      DO 20 N=1,NAQEN
      READ(20,*) I1,I2,J1,J2,K1,K2,POT
      WRITE(IOCODE,15) I1,I2,J1,J2,K1,K2,POT
   15 FORMAT(T20,6I4,F10.2)
      DO 20 K=K1,K2
      DO 20 J=J1,J2
      DO 20 I=I1,I2
      CPIAQ1(I,J,K)=POT
      IAQREG(I,J,K)=IAQOPT
   20 CONTINUE
      RETURN
  100 CONTINUE
C**  STEADY-STATE AQUIFER
      IF(IAQOPT.NE.2) GO TO 200
      WRITE(IOCODE,110)
  110 FORMAT(//T15,'STEADY-STATE AQUIFER PARAMETERS:',
     & //,T20,'  I1  I2  J1  J2  K1  K2     SSAQ')
      READ(20,*) NAQEN
      DO 120 N=1,NAQEN
      READ(20,*) I1,I2,J1,J2,K1,K2,SSAQ
      WRITE(IOCODE,15) I1,I2,J1,J2,K1,K2,SSAQ
      DO 120 K=K1,K2
      DO 120 J=J1,J2
      DO 120 I=I1,I2
      CPIAQ1(I,J,K)=SSAQ
      IAQREG(I,J,K)=IAQOPT
      PAQ(I,J,K)=PN(I,J,K)
  120 CONTINUE
      RETURN
  200 CONTINUE
C**  CARTER-TRACY AQUIFER
      READ(20,*) NAQREG
      DO 300 NR=1,NAQREG
      WRITE(IOCODE,202) NR
  202 FORMAT(//T15,'CARTER-TRACY AQUIFER PARAMETERS FOR',
     & ' REGION',I3,':')
      IF(IAQOPT.EQ.3) WRITE(IOCODE,203)
  203 FORMAT(T20,'RE/RW',T65,'  1.5')
      IF(IAQOPT.EQ.4) WRITE(IOCODE,204)
  204 FORMAT(T20,'RE/RW',T65,'  2.0')
      IF(IAQOPT.EQ.5) WRITE(IOCODE,205)
  205 FORMAT(T20,'RE/RW',T65,'  3.0')
      IF(IAQOPT.EQ.6) WRITE(IOCODE,206)
  206 FORMAT(T20,'RE/RW',T65,'  4.0')
      IF(IAQOPT.EQ.7) WRITE(IOCODE,207)
  207 FORMAT(T20,'RE/RW',T65,'  5.0')
      IF(IAQOPT.EQ.8) WRITE(IOCODE,208)
  208 FORMAT(T20,'RE/RW',T65,'  6.0')
      IF(IAQOPT.EQ.9) WRITE(IOCODE,209)
  209 FORMAT(T20,'RE/RW',T65,'  8.0')
      IF(IAQOPT.EQ.10) WRITE(IOCODE,210)
  210 FORMAT(T20,'RE/RW',T65,' 10.0')
      IF(IAQOPT.EQ.11) WRITE(IOCODE,211)
  211 FORMAT(T20,'INFINITE-ACTING AQUIFER CASE')
      READ(20,*) AQCR,AQCW,AQMUW,AQK,AQPHI,AQH,AQS,AQRE
      WRITE(IOCODE,220) AQCR,AQCW,AQMUW,AQK,AQPHI,AQH,AQS,AQRE
  220 FORMAT(T20,'AQ ROCK COMP (1/PSI)',T60,E10.4,
     & /,T20,'AQ WATER COMP (1/PSI)',T60,E10.4,
     & /,T20,'AQ WATER VISCOSITY (CP)',T60,F10.4,
     & /,T20,'AQ PERMEABILITY (MD)',T60,F10.4,
     & /,T20,'AQ POROSITY (FRACTION)',T60,F10.4,
     & /,T20,'AQ NET THICKNESS (FT)',T60,F10.4,
     & /,T20,'AQ/RES BOUNDARY INTERFACE (FRACTION)',T60,F10.4,
     & /,T20,'EXTERNAL RES RADIUS (FT)',T60,F10.4,/)
      AQCOMP=AQCR+AQCW
      AQKT=0.00633*AQK/(AQMUW*AQPHI*AQCOMP*AQRE*AQRE)
      AQBETA=6.1832*AQPHI*AQH*AQCOMP*AQRE*AQRE*AQS
      WRITE(IOCODE,225)
  225 FORMAT(//T18,'REGION LIMITS AND C-T PARAMETERS:',
     & /,T20,'  I1  I2  J1  J2  K1  K2  AQ PAR 1  AQ PAR 2')
      READ(20,*) NAQEN
      DO 250 N=1,NAQEN
      READ(20,*) I1,I2,J1,J2,K1,K2
      WRITE(IOCODE,230) I1,I2,J1,J2,K1,K2,AQKT,AQBETA
  230 FORMAT(T20,6I4,2E10.3)
      DO 250 K=K1,K2
      DO 250 J=J1,J2
      DO 250 I=I1,I2
      CPIAQ1(I,J,K)=AQKT
      CPIAQ2(I,J,K)=AQBETA
      IAQREG(I,J,K)=IAQOPT
      PIAQ(I,J,K)=PN(I,J,K)
  250 CONTINUE
      TDMAX=TMAX*AQKT
      IF(TDCMAX(IAQOPT).LT.TDMAX)
     & WRITE(IOCODE,275) TDMAX,TDCMAX(IAQOPT),IAQOPT
  275 FORMAT(/,T15,'MAX DIMENSIONLESS TIME ',E10.4,
     & ' EXCEEDS CORRELATION MAX DIM TIME ',F6.1,
     & ' FOR AQUI OPTION ',I3)
  300 CONTINUE
      RETURN
      END
C........................................................................MATBA
      SUBROUTINE 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)
C      MACHINE DEPENDENT INCLUDE STATEMENT
$INCLUDE:'PARAMS.FOR'
C      MATERIAL BALANCE CHECK
      REAL MCFGI,MBEO,MBEW,MBEG,MCFG,MCFG1,MCFGT
      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 /SPRTPS/ P(LP1,LP2,LP3),SO(LP1,LP2,LP3),SW(LP1,LP2,LP3),
     & SG(LP1,LP2,LP3)
      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)
      FACT=D5615*DELT0
      PAVG0=0.0
      PAVG=0.0
      OP=0.0
      WP=0.0
      GP=0.0
      WI=0.0
      GI=0.0
      DO 100 K=1,KK
      DO 100 J=1,JJ
      DO 100 I=1,II
      PAVG0=PAVG0+PN(I,J,K)*VP(I,J,K)
      PAVG=PAVG+P(I,J,K)*VP(I,J,K)
      OP=OP+QO(I,J,K)*FACT
      IF(QW(I,J,K).GT.0.0)WP=WP+QW(I,J,K)*FACT
      IF(QW(I,J,K).LE.0.0)WI=WI+QW(I,J,K)*FACT+EWAQ(I,J,K)*FACT
      IF(IAQOPT.NE.0.AND.QW(I,J,K).GT.0.0)WI=WI+EWAQ(I,J,K)*FACT
      IF(QG(I,J,K).GT.0.0)GP=GP+QG(I,J,K)*DELT0
      IF(QG(I,J,K).LT.0.0)GI=GI+QG(I,J,K)*DELT0
100   CONTINUE
      COP=COP+OP
      CWP=CWP+WP
      CGP=CGP+GP*0.001
      CWI=CWI+WI
      CGI=CGI+GI*0.001
C****CONVERT SCF TO MCF.
      GP=GP*0.001
      GI=GI*0.001
      DIV=1.0/DELT0
      OPR=OP*DIV
      WPR=WP*DIV
      GPR=GP*DIV
      WIR=WI*DIV
      GIR=GI*DIV
      PAVG=PAVG/RESVOL
      PAVG0=PAVG0/RESVOL
      DENOM1=STBOI - OP
      IF(ABS(DENOM1-STBO).LT.1.E-4) MBEO=0.0
      IF(ABS(DENOM1-STBO).LT.1.E-4) GO TO 200
      MBEO=(STBO/(STBOI-OP) - 1.0)*100.0
 200  CONTINUE
      DENOM2=STBWI-WP-WI
      IF(ABS(DENOM2-STBW).LT.1.E-4) MBEW=0.0
      IF(ABS(DENOM2-STBW).LT.1.E-4) GO TO 201
      MBEW=(STBW/(STBWI-WP-WI) - 1.0)*100.0
 201  CONTINUE
      DENOM3=MCFGI-GP-GI
      IF(ABS(DENOM3-MCFGT).LT.1.E-4) MBEG=0.0
      IF(ABS(DENOM3-MCFGT).LT.1.E-4) GO TO 203
      MBEG=(MCFGT/(MCFGI-GP-GI) - 1.0)*100.0
 203  CONTINUE
      DENOMO = TOOIP*1.0E06 - COP
      DENOMW = TOWIP*1.0E06 - CWP - CWI
      DENOMG = TOGIP*1.0E06 - CGP - CGI
      IF(ABS(DENOMO-STBO).LT.1.E-4) CMBEO = 0.0
      IF(ABS(DENOMO-STBO).LT.1.E-4) GO TO 204
      CMBEO =(STBO/(TOOIP*1.0E06-COP)-1.)*100.0
 204  CONTINUE
      IF(ABS(DENOMW-STBW).LT.1.E-4) CMBEW = 0.0
      IF(ABS(DENOMW-STBW).LT.1.E-4) GO TO 205
      CMBEW =(STBW/(TOWIP*1.0E06-CWP-CWI)-1.)*100.0
 205  CONTINUE
      IF(ABS(DENOMG-MCFGT).LT.1.E-4) CMBEG = 0.0
      IF(ABS(DENOMG-MCFGT).LT.1.E-4) GO TO 206
      CMBEG=(MCFGT/(TOGIP*1.0E06-CGP-CGI) - 1.0)*100.0
 206  CONTINUE
      IF(OP.EQ.0.0)GOR=0.0
      IF(OP.EQ.0.0)WOR=0.0
      IF(OP.EQ.0.0)GO TO 333
      GOR=GP/OP
      WOR=WP/OP
333   IF(COP.EQ.0.0)CGOR=0.0
      IF(COP.EQ.0.0)CWOR=0.0
      IF(COP.EQ.0.0)GO TO 666
      CGOR=CGP/COP*1000.0
      CWOR=CWP/COP
666   CONTINUE
      GP=GP*0.001
      GI=GI*0.001
      RETURN
      END
C.................................................................NODES
      SUBROUTINE NODES(NVQN)
C      MACHINE DEPENDENT INCLUDE STATEMENT
$INCLUDE:'PARAMS.FOR'
      CHARACTER*5 WELNAM,VAR1
      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 /SPRTPS/ P(LP1,LP2,LP3),SO(LP1,LP2,LP3),SW(LP1,LP2,LP3),
     & SG(LP1,LP2,LP3)
      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 /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)
      DIMENSION NCOUNT(LP11)
      DATA NCOUNT/LP11*0/
C**** ESTABLISH RATE-SPECIFIED & PRESSURE-SPECIFIED WELLS
      READ(20,69)
      READ(20,*) NWELLN,NWELLO
      IF(NWELLN.EQ.0.AND.NWELLO.EQ.0)RETURN
      NCHANG=NWELLN+NWELLO
      WRITE(IOCODE,67)
      WRITE(IOCODE,68)
      IF(NWELLN.EQ.0) GO TO 2200
      READ(20,69)
      DO 2000 J=1,NWELLN
C**   INPUT RATE SIGNS BY CONVENTION:
C**   INJECTORS ARE NEGATIVE; PRODUCERS ARE POSITIVE.
      READ(20,3) VAR1,I1,I2,I3,I4,I5
    3 FORMAT(A5,5I3)
      IF(IDMAX.LT.I1)IDMAX=I1
      WELNAM(I1)=VAR1
      IDWELL(I1)=I1
      IQN1(I1)=I2
      IQN2(I1)=I3
      IQN3(I1)=I4
      LAYER(I1)=I5
      IQ3=IQN3(I1)
      LAY=IQ3+(LAYER(I1)-1)
      READ(20,*) (PID(I1,K),K=IQ3,LAY)
      READ(20,*) (PWF(I1,K),K=IQ3,LAY)
      READ(20,6) VAR1,IDWELL(I1),KIP(I1),QVO(I1),QVW(I1),QVG(I1),QVT(I1)
      IF(KIP(I1).EQ.-4) READ(20,8)
     & VAR1,IDWELL(I1),ALIT(I1),BLIT(I1)
    8 FORMAT(A5,I3,2E12.5)
    6 FORMAT(A5,2I3,4F10.0)
      NCOUNT(J)=IDWELL(I1)
      DO 1900 K=IQ3,LAY
      QWV = QVW(I1)
      IF(KIP(I1).EQ.-1) QWV = 0.0
      WRITE(IOCODE,70) WELNAM(I1),IDWELL(I1),IQN1(I1),IQN2(I1),K,
     & QVO(I1),QWV,QVG(I1),
     & QVT(I1),PWF(I1,K),PID(I1,K),
     & ALIT(I1),BLIT(I1)
 1900 CONTINUE
2000  CONTINUE
      NVQN=IDMAX
 2200 CONTINUE
      IF(NWELLO.EQ.0) GO TO 2600
      READ(20,69)
      DO 2500 NC=1,NWELLO
      READ(20,6) VAR1,I1,I2,F1,F2,F3,F4
      IDWELL(I1)=I1
      KIP(I1)=I2
      QVO(I1)=F1
      QVW(I1)=F2
      QVG(I1)=F3
      QVT(I1)=F4
      IQ3=IQN3(I1)
      LAY=IQ3+(LAYER(I1)-1)
      NCOUNT(NWELLN+NC)=IDWELL(I1)
      DO 2400 K=IQ3,LAY
      WRITE(IOCODE,70) WELNAM(I1),IDWELL(I1),IQN1(I1),IQN2(I1),K,
     & QVO(I1),QVW(I1),QVG(I1),
     & QVT(I1),PWF(I1,K),PID(I1,K),
     & ALIT(I1),BLIT(I1)
 2400 CONTINUE
 2500 CONTINUE
 2600 CONTINUE
      WRITE(IOCODE,33)
      DO 3000 I=1,NCHANG
      J=NCOUNT(I)
      IQ3=IQN3(J)
      LAY=IQ3+(LAYER(J)-1)
      DO 3000 K=IQ3,LAY
      IF(KIP(J).EQ.1.AND.QVO(J).GT.0.0)
     & WRITE(IOCODE,2995) IQN1(J),IQN2(J),K,IDWELL(J)
      IF(KIP(J).EQ.1.AND.QVT(J).GT.0.0)
     & WRITE(IOCODE,2995) IQN1(J),IQN2(J),K,IDWELL(J)
      IF(KIP(J).EQ.1.AND.QVW(J).GT.0.0)
     & WRITE(IOCODE,2996) IQN1(J),IQN2(J),K,IDWELL(J)
      IF(KIP(J).EQ.1.AND.QVG(J).GT.0.0)
     & WRITE(IOCODE,2997) IQN1(J),IQN2(J),K,IDWELL(J)
      IF(KIP(J).EQ.2) WRITE(IOCODE,2998) IQN1(J),IQN2(J),K,IDWELL(J)
      IF(KIP(J).EQ.3) WRITE(IOCODE,2999) IQN1(J),IQN2(J),K,IDWELL(J)
      IF(KIP(J).EQ.-1) WRITE(IOCODE,3005) IQN1(J),IQN2(J),K,IDWELL(J)
      IF(KIP(J).EQ.-2) WRITE(IOCODE,3006) IQN1(J),IQN2(J),K,IDWELL(J)
      IF(KIP(J).EQ.-3) WRITE(IOCODE,3007) IQN1(J),IQN2(J),K,IDWELL(J)
      IF(KIP(J).EQ.-4) WRITE(IOCODE,3008) IQN1(J),IQN2(J),K,IDWELL(J)
      IF(KIP(J).EQ.-11) WRITE(IOCODE,3015) IQN1(J),IQN2(J),K,IDWELL(J)
      IF(KIP(J).EQ.-12) WRITE(IOCODE,3016) IQN1(J),IQN2(J),K,IDWELL(J)
      IF(KIP(J).EQ.-13) WRITE(IOCODE,3017) IQN1(J),IQN2(J),K,IDWELL(J)
3000  CONTINUE
69    FORMAT(40A2)
   67 FORMAT(1H1/T55,21('*'),/,T55,
     & '*   WELL   UPDATE   *',/,T55,21('*'),//,
     & T20,'RESERVOIR CONTAINS THE FOLLOWING RATE NODES:'/)
68    FORMAT(T3,' WELL  NO.     NODE   ',3X,'  OIL(STBD)',
     &3X,'WATER(RBD)',3X,'GAS(MCFD)',3X,'TOTAL(RBD)',3X,'BHFP(PSIA)'
     &,6X,'PID',6X,'ALIT',6X,'BLIT')
70    FORMAT(2X,A5,I5,1X,3I3,3X,F11.2,4F13.2,F10.4,2E10.3)
33    FORMAT(/)
 2995 FORMAT(T15,'BLOCK ',3I3,
     & ' CONTAINS THE OIL RATE SPECIFIED PRODUCING WELL',
     & ' NUMBER ',I5)
 2996 FORMAT(T15,'BLOCK ',3I3,
     & ' CONTAINS THE WATER RATE SPECIFIED PRODUCING WELL',
     & ' NUMBER ',I5)
 2997 FORMAT(T15,'BLOCK ',3I3,
     & ' CONTAINS THE GAS RATE SPECIFIED PRODUCING WELL',
     & ' NUMBER ',I5)
 2998 FORMAT(T15,'BLOCK ',3I3,
     & ' CONTAINS THE RATE SPECIFIED WATER INJECTION WELL',
     & ' NUMBER ',I5)
 2999 FORMAT(T15,'BLOCK ',3I3,
     & ' CONTAINS THE RATE SPECIFIED GAS INJECTION WELL',
     & ' NUMBER ',I5)
 3005 FORMAT(T15,'BLOCK ',3I3,' CONTAINS THE ',
     & 'EXPLICIT PRESSURE SPECIFIED PRODUCING WELL',
     & ' NUMBER ',I5)
 3006 FORMAT(T15,'BLOCK ',3I3, ' CONTAINS THE ',
     & 'EXPLICIT PRESSURE SPECIFIED WATER INJECTION WELL',
     & ' NUMBER ',I5)
 3007 FORMAT(T15,'BLOCK ',3I3,' CONTAINS THE ',
     & 'EXPLICIT PRESSURE SPECIFIED GAS INJECTION WELL',
     & ' NUMBER ',I5)
 3008 FORMAT(T15,'BLOCK ',3I3,' CONTAINS THE ',
     & 'EXPLICIT PRESSURE SPECIFIED GAS PRODUCTION WELL',
     & ' NUMBER ',I5)
 3015 FORMAT(T15,'BLOCK ',3I3,' CONTAINS THE ',
     & 'IMPLICIT PRESSURE SPECIFIED PRODUCING WELL',
     & ' NUMBER ',I5)
 3016 FORMAT(T15,'BLOCK ',3I3,' CONTAINS THE ',
     & 'IMPLICIT PRESSURE SPECIFIED WATER INJECTION WELL',
     & ' NUMBER ',I5)
 3017 FORMAT(T15,'BLOCK ',3I3,' CONTAINS THE ',
     & 'IMPLICIT PRESSURE SPECIFIED GAS INJECTION WELL',
     & ' NUMBER ',I5)
      RETURN
      END
