home *** CD-ROM | disk | FTP | other *** search
/ Hall of Fame / HallofFameCDROM.cdr / oilfield / spe-46-2.lzh / BLOCK1.FOR next >
Text File  |  1988-07-28  |  23KB  |  601 lines
  1. $DO66
  2. C........................................................AQIN
  3.       SUBROUTINE AQIN(II,JJ,KK,DELT,ETI)
  4. C      MACHINE DEPENDENT INCLUDE STATEMENT
  5. $INCLUDE:'PARAMS.FOR'
  6. C      AQUIFER MODEL P EQ. TERMS.
  7.         REAL KROT,KRWT,KRGT,KROGT,MUOT,MUWT,MUGT
  8.       COMMON /BUBBLE/ PBO,VSLOPE(LP8),BSLOPE(LP8),RSLOPE(LP8),PMAXT,
  9.      & IREPRS,MPGT(LP8),
  10.      & RHOSCO(LP8),RHOSCW(LP8),RHOSCG(LP8),MSAT(LP7),MPOT(LP8),
  11.      & MPWT(LP8),PBOT(LP1,LP2,LP3),PBOTN(LP1,LP2,LP3)
  12.       COMMON /COEF/ AW(LP1,LP2,LP3),AE(LP1,LP2,LP3),AN(LP1,LP2,LP3),
  13.      & AS(LP1,LP2,LP3),AB(LP1,LP2,LP3),AT(LP1,LP2,LP3),E(LP1,LP2,LP3),
  14.      & B(LP1,LP2,LP3)
  15.       COMMON /SAQUI/ IAQOPT,CPIAQ1(LP1,LP2,LP3),CPIAQ2(LP1,LP2,LP3),
  16.      & CPI1(LP1,LP2,LP3),CPI2(LP1,LP2,LP3),EWAQ(LP1,LP2,LP3),
  17.      & CUMAQW(LP1,LP2,LP3),
  18.      & QWAQ(LP1,LP2,LP3),CUMEW(LP1,LP2,LP3),QWAQR(LP7),CUMAQR(LP7)
  19.      & ,IAQREG(LP1,LP2,LP3),PAQ(LP1,LP2,LP3),PIAQ(LP1,LP2,LP3)
  20.       COMMON /SARRAY/ PN(LP1,LP2,LP3),IOCODE,IDMAX,
  21.      & SON(LP1,LP2,LP3),SWN(LP1,LP2,LP3),SGN(LP1,LP2,LP3),
  22.      & A1(LP1,LP2,LP3),A2(LP1,LP2,LP3),A3(LP1,LP2,LP3),
  23.      & SUM(LP1,LP2,LP3),GAM(LP1,LP2,LP3),QS(LP1,LP2,LP3)
  24.       COMMON /SPRTPS/ P(LP1,LP2,LP3),SO(LP1,LP2,LP3),SW(LP1,LP2,LP3),
  25.      & SG(LP1,LP2,LP3)
  26.       COMMON /SPVT/ SAT(LP7,LP9),KROT(LP7,LP9),KRWT(LP7,LP9),
  27.      & BGT(LP7,LP9),
  28.      & KRGT(LP7,LP9),ITHREE(LP7),RSOT(LP7,LP9),BWPT(LP7,LP9),
  29.      & PCOWT(LP7,LP9),PCGOT(LP7,LP9),KROGT(LP7,LP9),SWR(LP7),
  30.      & POT(LP7,LP9),MUOT(LP7,LP9),BOT(LP7,LP9),BOPT(LP7,LP9),
  31.      & RSOPT(LP7,LP9),PWT(LP7,LP9),MUWT(LP7,LP9),BWT(LP7,LP9),
  32.      & RSWT(LP7,LP9),RSWPT(LP7,LP9),PGT(LP7,LP9),MUGT(LP7,LP9),
  33.      & BGPT(LP7,LP9),CRT(LP7,LP9),IPVT(LP1,LP2,LP3),IROCK(LP1,LP2,LP3),
  34.      & NROCK,NPVT,PSIT(LP7,LP9),PRT(LP7,LP9),WOROCK(LP7),GOROCK(LP7)
  35.       COMMON /SRATE/ PID(LP11,LP3),PWF(LP11,LP3),PWFC(LP11,LP3),
  36.      & KIP(LP11),LAYER(LP11),QVO(LP11),CUMG(LP11,LP3),
  37.      & GMO(LP11,LP3),GMW(LP11,LP3),GMG(LP11,LP3),
  38.      & QVW(LP11),QVG(LP11),QVT(LP11),CUMO(LP11,LP3),CUMW(LP11,LP3),
  39.      & IDWELL(LP11),ALIT(LP11),BLIT(LP11)
  40.       DO 2000 K=1,KK
  41.       DO 2000 J=1,JJ
  42.       DO 2000 I=1,II
  43.       IF(IAQREG(I,J,K).LT.1) GO TO 2000
  44.       PPN=PN(I,J,K)
  45.       IPVTR=IPVT(I,J,K)
  46.       CALL INTERP(IPVTR,PWT,BWT,MPWT(IPVTR),PPN,BBW)
  47.       CALL INTERP(IPVTR,PGT,BGT,MPGT(IPVTR),PPN,BBG)
  48.       CALL INTERP(IPVTR,PWT,RSWT,MPWT(IPVTR),PPN,RSW)
  49.       FACTOR=BBW-BBG*RSW
  50. C**    POT AQUIFER
  51.       IF(IAQREG(I,J,K).NE.1) GO TO 1050
  52.       PAQ(I,J,K)=PPN
  53.       IF(DELT.NE.0)
  54.      & CPI1(I,J,K)= CPIAQ1(I,J,K)/DELT
  55.       CPI2(I,J,K)=0.
  56.       GO TO 1900
  57. C**    STEADY-STATE AQUIFER
  58.  1050 IF(IAQREG(I,J,K).NE.2) GO TO 1100
  59.       CPI1(I,J,K)= CPIAQ1(I,J,K)
  60.       CPI2(I,J,K)=0.0
  61.       GO TO 1900
  62. C**    CARTER-TRACY AQUIFER
  63.  1100 ETP=ETI+DELT
  64.       TD=ETI*CPIAQ1(I,J,K)
  65.       TDP=ETP*CPIAQ1(I,J,K)
  66. C      RATIO=1.5
  67.       IF(IAQREG(I,J,K).NE.3) GO TO 1150
  68.       PTD=FPTD(0.10371,1.66657,-0.04579,-0.01023,TDP)
  69.       DPTD=FDPTD(1.66657,-0.04579,-0.01023,TDP)
  70.       GO TO 1800
  71. C      RATIO=2.0
  72.  1150 IF(IAQREG(I,J,K).NE.4) GO TO 1200
  73.       PTD=FPTD(0.30210,0.68178,-0.01599,-0.01356,TDP)
  74.       DPTD=FDPTD(0.68178,-0.01599,-0.01356,TDP)
  75.       GO TO 1800
  76. C      RATIO=3.0
  77.  1200 IF(IAQREG(I,J,K).NE.5) GO TO 1250
  78.       PTD=FPTD(0.51243,0.29317,0.01534,-0.06732,TDP)
  79.       DPTD=FDPTD(0.29317,0.01534,-0.06732,TDP)
  80.       GO TO 1800
  81. C      RATIO=4.0
  82.  1250 IF(IAQREG(I,J,K).NE.6) GO TO 1300
  83.       PTD=FPTD(0.63656,0.16101,0.15812,-0.09104,TDP)
  84.       DPTD=FDPTD(0.16101,0.15812,-0.09104,TDP)
  85.       GO TO 1800
  86. C      RATIO=5.0
  87.  1300 IF(IAQREG(I,J,K).NE.7) GO TO 1350
  88.       PTD=FPTD(0.65106,0.10414,0.30953,-0.11258,TDP)
  89.       DPTD=FDPTD(0.10414,0.30953,-0.11258,TDP)
  90.       GO TO 1800
  91. C      RATIO=6.0
  92.  1350 IF(IAQREG(I,J,K).NE.8) GO TO 1400
  93.       PTD=FPTD(0.63367,0.06940,0.41750,-0.11137,TDP)
  94.       DPTD=FDPTD(0.06940,0.41750,-0.11137,TDP)
  95.       GO TO 1800
  96. C      RATIO=8.0
  97.  1400 IF(IAQREG(I,J,K).NE.9) GO TO 1450
  98.       PTD=FPTD(0.40132,0.04104,0.69592,-0.14350,TDP)
  99.       DPTD=FDPTD(0.04104,0.69592,-0.14350,TDP)
  100.       GO TO 1800
  101. C      RATIO=10.0
  102.  1450 IF(IAQREG(I,J,K).NE.10) GO TO 1500
  103.       PTD=FPTD(0.14386,0.02649,0.89646,-0.15502,TDP)
  104.       DPTD=FDPTD(0.02649,0.89646,-0.15502,TDP)
  105.       GO TO 1800
  106. C      RATIO=INFINITY
  107.  1500 IF(IAQREG(I,J,K).NE.11) GO TO 1800
  108.       PTD=FPTD(0.82092,-0.000368,0.28908,0.28817,TDP)
  109.       DPTD=FDPTD(-0.000368,0.28908,0.28817,TDP)
  110.  1800 CONTINUE
  111. C**    CALC. CARTER-TRACY COEF.
  112.       DENOM=PTD-TD*DPTD
  113.       CPI1(I,J,K)= CPIAQ1(I,J,K)*CPIAQ2(I,J,K)/DENOM
  114.       CPI2(I,J,K)=CPIAQ1(I,J,K)*(CPIAQ2(I,J,K)*(PIAQ(I,J,K)-PPN)
  115.      & +CUMEW(I,J,K)*DPTD)/DENOM
  116.       PAQ(I,J,K)=PPN
  117.  1900 CONTINUE
  118.       B(I,J,K)=B(I,J,K)-(CPI1(I,J,K)*PAQ(I,J,K)
  119.      & +CPI2(I,J,K))*FACTOR
  120.       E(I,J,K)=E(I,J,K)-CPI1(I,J,K)*FACTOR
  121.  2000 CONTINUE
  122.       RETURN
  123.       END
  124. C..........................................................AQOUT
  125.       SUBROUTINE AQOUT(II,JJ,KK,DELT)
  126. C      MACHINE DEPENDENT INCLUDE STATEMENT
  127. $INCLUDE:'PARAMS.FOR'
  128. C      AQUIFER MODEL RATES
  129.        REAL KROT,KRWT,KRGT,KROGT,MUOT,MUWT,MUGT
  130.       COMMON /COEF/ AW(LP1,LP2,LP3),AE(LP1,LP2,LP3),AN(LP1,LP2,LP3),
  131.      & AS(LP1,LP2,LP3),AB(LP1,LP2,LP3),AT(LP1,LP2,LP3),E(LP1,LP2,LP3),
  132.      & B(LP1,LP2,LP3)
  133.       COMMON /RUNSUM/ ITSNO(LP12),STIME(LP12),SOPROD(LP12),
  134.      & SGPROD(LP12),
  135.      & SWPROD(LP12),SGOR(LP12),SWOR(LP12),SGINJ(LP12),SWINJ(LP12)
  136.       COMMON /RUN2/SPVWTP(LP12),SOCUMP(LP12),SWCUMP(LP12),SGCUMP(LP12),
  137.      & SGCUMI(LP12),SWCUMI(LP12),SAQUIR(LP12),SAQUIC(LP12)
  138.       COMMON /SAQUI/ IAQOPT,CPIAQ1(LP1,LP2,LP3),CPIAQ2(LP1,LP2,LP3),
  139.      & CPI1(LP1,LP2,LP3),CPI2(LP1,LP2,LP3),EWAQ(LP1,LP2,LP3),
  140.      & CUMAQW(LP1,LP2,LP3),
  141.      & QWAQ(LP1,LP2,LP3),CUMEW(LP1,LP2,LP3),QWAQR(LP7),CUMAQR(LP7)
  142.      & ,IAQREG(LP1,LP2,LP3),PAQ(LP1,LP2,LP3),PIAQ(LP1,LP2,LP3)
  143.       COMMON /SARRAY/ PN(LP1,LP2,LP3),IOCODE,IDMAX,
  144.      & SON(LP1,LP2,LP3),SWN(LP1,LP2,LP3),SGN(LP1,LP2,LP3),
  145.      & A1(LP1,LP2,LP3),A2(LP1,LP2,LP3),A3(LP1,LP2,LP3),
  146.      & SUM(LP1,LP2,LP3),GAM(LP1,LP2,LP3),QS(LP1,LP2,LP3)
  147.       COMMON /SPRTPS/ P(LP1,LP2,LP3),SO(LP1,LP2,LP3),SW(LP1,LP2,LP3),
  148.      & SG(LP1,LP2,LP3)
  149.       COMMON /SPVT/ SAT(LP7,LP9),KROT(LP7,LP9),KRWT(LP7,LP9),
  150.      & BGT(LP7,LP9),
  151.      & KRGT(LP7,LP9),ITHREE(LP7),RSOT(LP7,LP9),BWPT(LP7,LP9),
  152.      & PCOWT(LP7,LP9),PCGOT(LP7,LP9),KROGT(LP7,LP9),SWR(LP7),
  153.      & POT(LP7,LP9),MUOT(LP7,LP9),BOT(LP7,LP9),BOPT(LP7,LP9),
  154.      & RSOPT(LP7,LP9),PWT(LP7,LP9),MUWT(LP7,LP9),BWT(LP7,LP9),
  155.      & RSWT(LP7,LP9),RSWPT(LP7,LP9),PGT(LP7,LP9),MUGT(LP7,LP9),
  156.      & BGPT(LP7,LP9),CRT(LP7,LP9),IPVT(LP1,LP2,LP3),IROCK(LP1,LP2,LP3),
  157.      & NROCK,NPVT,PSIT(LP7,LP9),PRT(LP7,LP9),WOROCK(LP7),GOROCK(LP7)
  158.       COMMON /SRATE/ PID(LP11,LP3),PWF(LP11,LP3),PWFC(LP11,LP3),
  159.      & KIP(LP11),LAYER(LP11),QVO(LP11),CUMG(LP11,LP3),
  160.      & GMO(LP11,LP3),GMW(LP11,LP3),GMG(LP11,LP3),
  161.      & QVW(LP11),QVG(LP11),QVT(LP11),CUMO(LP11,LP3),CUMW(LP11,LP3),
  162.      & IDWELL(LP11),ALIT(LP11),BLIT(LP11)
  163.       DO 10 IROC=1,NROCK
  164.    10 QWAQR(IROC)=0.0
  165.       DO 1000 K=1,KK
  166.       DO 1000 J=1,JJ
  167.       DO 1000 I=1,II
  168.       IF(IAQREG(I,J,K).LT.1) GO TO 1000
  169.       PPN=PN(I,J,K)
  170.       PP=P(I,J,K)
  171. C**    POT AQUIFER
  172.       IF(IAQREG(I,J,K).NE.1) GO TO 100
  173.       EWAQ(I,J,K)=-CPI1(I,J,K)*(PPN-PP)
  174.       GO TO 1000
  175. C**    STEADY-STATE AQUIFER
  176.   100 IF(IAQREG(I,J,K).NE.2) GO TO 200
  177.       EWAQ(I,J,K)=-CPI1(I,J,K)*(PAQ(I,J,K)-PP)
  178.       GO TO 1000
  179. C**    CARTER-TRACY AQUIFER
  180.   200 CONTINUE
  181.       EWAQ(I,J,K)=-CPI2(I,J,K)+CPI1(I,J,K)*(PP-PPN)
  182.  1000 CONTINUE
  183.       RETURN
  184. C      CALC CUM AQ INFLUX
  185.       ENTRY AQCUM(NLOOP)
  186.       DO 1050 K=1,KK
  187.       DO 1050 J=1,JJ
  188.       DO 1050 I=1,II
  189.       IF(IAQREG(I,J,K).LT.1) GO TO 1050
  190.       CUMEW(I,J,K)=CUMEW(I,J,K)+EWAQ(I,J,K)*DELT
  191. C    CONVERT SCF TO STB
  192.       QWAQ(I,J,K)=EWAQ(I,J,K)/5.615
  193.       CUMAQW(I,J,K)=CUMEW(I,J,K)/5.615
  194.       IROC=IROCK(I,J,K)
  195. C**     ROCK REGION AQUI INFLUX RATES AND CUM.
  196.       QWAQR(IROC)=QWAQ(I,J,K)+QWAQR(IROC)
  197.       CUMAQR(IROC)=DELT*QWAQ(I,J,K)+CUMAQR(IROC)
  198.  1050 CONTINUE
  199. C      TOTAL RUN SUMMARY AQUIFER ENTRIES
  200.       CUMRAT=0.
  201.       CUMPRD=0.
  202.       DO 1075 IROC=1,NROCK
  203.       CUMRAT=QWAQR(IROC)+CUMRAT
  204.       CUMPRD=CUMAQR(IROC)+CUMPRD
  205.  1075 CONTINUE
  206.       SAQUIR(NLOOP)=CUMRAT/1000.
  207.       SAQUIC(NLOOP)=CUMPRD/1.E+6
  208.       RETURN
  209. C      PRINT AQ INFLUX INFO
  210.       ENTRY AQPRNT
  211.       DO 2000 N=1,NROCK
  212.       WRITE(IOCODE,1100) N,QWAQR(N),CUMAQR(N)
  213.  1100 FORMAT(1X,'AQUIFER MODEL FOR ROCK REGION ',I3,':',
  214.      & /1X,'AQUIFER INFLUX RATE (STB/D) =',F9.1,
  215.      & 3X,'CUM. AQUIFER INFLUX (STB)    =',E10.4,//)
  216.  2000 CONTINUE
  217.       RETURN
  218.       END
  219. C................................................................AQUI
  220.       SUBROUTINE AQUI(TMAX)
  221. C      MACHINE DEPENDENT INCLUDE STATEMENT
  222. $INCLUDE:'PARAMS.FOR'
  223. C          CALC AQUIFER INFLUX    
  224.       COMMON /SAQUI/ IAQOPT,CPIAQ1(LP1,LP2,LP3),CPIAQ2(LP1,LP2,LP3),
  225.      & CPI1(LP1,LP2,LP3),CPI2(LP1,LP2,LP3),EWAQ(LP1,LP2,LP3),
  226.      & CUMAQW(LP1,LP2,LP3),
  227.      & QWAQ(LP1,LP2,LP3),CUMEW(LP1,LP2,LP3),QWAQR(LP7),CUMAQR(LP7)
  228.      & ,IAQREG(LP1,LP2,LP3),PAQ(LP1,LP2,LP3),PIAQ(LP1,LP2,LP3)
  229.       COMMON /SARRAY/ PN(LP1,LP2,LP3),IOCODE,IDMAX,
  230.      & SON(LP1,LP2,LP3),SWN(LP1,LP2,LP3),SGN(LP1,LP2,LP3),
  231.      & A1(LP1,LP2,LP3),A2(LP1,LP2,LP3),A3(LP1,LP2,LP3),
  232.      & SUM(LP1,LP2,LP3),GAM(LP1,LP2,LP3),QS(LP1,LP2,LP3)
  233. C      MAX DIM TIM CORRELATION VALUES
  234.       DIMENSION TDCMAX(11)
  235.       DATA TDCMAX/0.,0.,0.6,5.,5.,10.,15.,30.,45.,70.,1000./
  236.       READ(20,5)
  237.     5 FORMAT(40A2)
  238.       READ(20,*) IAQOPT
  239.       IF(IAQOPT.EQ.0) RETURN
  240.       IF(IAQOPT.NE.1) GO TO 100
  241. C**  POT AQUIFER
  242.       WRITE(IOCODE,10)
  243.    10 FORMAT(//T15,'POT AQUIFER PARAMETERS:',
  244.      & //,T20,'  I1  I2  J1  J2  K1  K2      POT')
  245.       READ(20,*) NAQEN
  246.       DO 20 N=1,NAQEN
  247.       READ(20,*) I1,I2,J1,J2,K1,K2,POT
  248.       WRITE(IOCODE,15) I1,I2,J1,J2,K1,K2,POT
  249.    15 FORMAT(T20,6I4,F10.2)
  250.       DO 20 K=K1,K2
  251.       DO 20 J=J1,J2
  252.       DO 20 I=I1,I2
  253.       CPIAQ1(I,J,K)=POT
  254.       IAQREG(I,J,K)=IAQOPT
  255.    20 CONTINUE
  256.       RETURN
  257.   100 CONTINUE
  258. C**  STEADY-STATE AQUIFER
  259.       IF(IAQOPT.NE.2) GO TO 200
  260.       WRITE(IOCODE,110)
  261.   110 FORMAT(//T15,'STEADY-STATE AQUIFER PARAMETERS:',
  262.      & //,T20,'  I1  I2  J1  J2  K1  K2     SSAQ')
  263.       READ(20,*) NAQEN
  264.       DO 120 N=1,NAQEN
  265.       READ(20,*) I1,I2,J1,J2,K1,K2,SSAQ
  266.       WRITE(IOCODE,15) I1,I2,J1,J2,K1,K2,SSAQ
  267.       DO 120 K=K1,K2
  268.       DO 120 J=J1,J2
  269.       DO 120 I=I1,I2
  270.       CPIAQ1(I,J,K)=SSAQ
  271.       IAQREG(I,J,K)=IAQOPT
  272.       PAQ(I,J,K)=PN(I,J,K)
  273.   120 CONTINUE
  274.       RETURN
  275.   200 CONTINUE
  276. C**  CARTER-TRACY AQUIFER
  277.       READ(20,*) NAQREG
  278.       DO 300 NR=1,NAQREG
  279.       WRITE(IOCODE,202) NR
  280.   202 FORMAT(//T15,'CARTER-TRACY AQUIFER PARAMETERS FOR',
  281.      & ' REGION',I3,':')
  282.       IF(IAQOPT.EQ.3) WRITE(IOCODE,203)
  283.   203 FORMAT(T20,'RE/RW',T65,'  1.5')
  284.       IF(IAQOPT.EQ.4) WRITE(IOCODE,204)
  285.   204 FORMAT(T20,'RE/RW',T65,'  2.0')
  286.       IF(IAQOPT.EQ.5) WRITE(IOCODE,205)
  287.   205 FORMAT(T20,'RE/RW',T65,'  3.0')
  288.       IF(IAQOPT.EQ.6) WRITE(IOCODE,206)
  289.   206 FORMAT(T20,'RE/RW',T65,'  4.0')
  290.       IF(IAQOPT.EQ.7) WRITE(IOCODE,207)
  291.   207 FORMAT(T20,'RE/RW',T65,'  5.0')
  292.       IF(IAQOPT.EQ.8) WRITE(IOCODE,208)
  293.   208 FORMAT(T20,'RE/RW',T65,'  6.0')
  294.       IF(IAQOPT.EQ.9) WRITE(IOCODE,209)
  295.   209 FORMAT(T20,'RE/RW',T65,'  8.0')
  296.       IF(IAQOPT.EQ.10) WRITE(IOCODE,210)
  297.   210 FORMAT(T20,'RE/RW',T65,' 10.0')
  298.       IF(IAQOPT.EQ.11) WRITE(IOCODE,211)
  299.   211 FORMAT(T20,'INFINITE-ACTING AQUIFER CASE')
  300.       READ(20,*) AQCR,AQCW,AQMUW,AQK,AQPHI,AQH,AQS,AQRE
  301.       WRITE(IOCODE,220) AQCR,AQCW,AQMUW,AQK,AQPHI,AQH,AQS,AQRE
  302.   220 FORMAT(T20,'AQ ROCK COMP (1/PSI)',T60,E10.4,
  303.      & /,T20,'AQ WATER COMP (1/PSI)',T60,E10.4,
  304.      & /,T20,'AQ WATER VISCOSITY (CP)',T60,F10.4,
  305.      & /,T20,'AQ PERMEABILITY (MD)',T60,F10.4,
  306.      & /,T20,'AQ POROSITY (FRACTION)',T60,F10.4,
  307.      & /,T20,'AQ NET THICKNESS (FT)',T60,F10.4,
  308.      & /,T20,'AQ/RES BOUNDARY INTERFACE (FRACTION)',T60,F10.4,
  309.      & /,T20,'EXTERNAL RES RADIUS (FT)',T60,F10.4,/)
  310.       AQCOMP=AQCR+AQCW
  311.       AQKT=0.00633*AQK/(AQMUW*AQPHI*AQCOMP*AQRE*AQRE)
  312.       AQBETA=6.1832*AQPHI*AQH*AQCOMP*AQRE*AQRE*AQS
  313.       WRITE(IOCODE,225)
  314.   225 FORMAT(//T18,'REGION LIMITS AND C-T PARAMETERS:',
  315.      & /,T20,'  I1  I2  J1  J2  K1  K2  AQ PAR 1  AQ PAR 2')
  316.       READ(20,*) NAQEN
  317.       DO 250 N=1,NAQEN
  318.       READ(20,*) I1,I2,J1,J2,K1,K2
  319.       WRITE(IOCODE,230) I1,I2,J1,J2,K1,K2,AQKT,AQBETA
  320.   230 FORMAT(T20,6I4,2E10.3)
  321.       DO 250 K=K1,K2
  322.       DO 250 J=J1,J2
  323.       DO 250 I=I1,I2
  324.       CPIAQ1(I,J,K)=AQKT
  325.       CPIAQ2(I,J,K)=AQBETA
  326.       IAQREG(I,J,K)=IAQOPT
  327.       PIAQ(I,J,K)=PN(I,J,K)
  328.   250 CONTINUE
  329.       TDMAX=TMAX*AQKT
  330.       IF(TDCMAX(IAQOPT).LT.TDMAX)
  331.      & WRITE(IOCODE,275) TDMAX,TDCMAX(IAQOPT),IAQOPT
  332.   275 FORMAT(/,T15,'MAX DIMENSIONLESS TIME ',E10.4,
  333.      & ' EXCEEDS CORRELATION MAX DIM TIME ',F6.1,
  334.      & ' FOR AQUI OPTION ',I3)
  335.   300 CONTINUE
  336.       RETURN
  337.       END
  338. C........................................................................MATBA
  339.       SUBROUTINE MATBAL(II,JJ,KK,STBO,STBOI,STBW,STBWI,TOWIP,TOOIP,
  340.      &TOGIP,MCFGI,MBEO,MBEW,MBEG,CMBEO,CMBEW,CMBEG,DELT0,RESVOL,
  341.      &OP,WP,GP,WI,GI,PAVG0,PAVG,OPR,WPR,GPR,WIR,GIR,D5615,
  342.      &COP,CWP,CGP,CWI,CGI,MCFGT,CWOR,WOR,CGOR,GOR)
  343. C      MACHINE DEPENDENT INCLUDE STATEMENT
  344. $INCLUDE:'PARAMS.FOR'
  345. C      MATERIAL BALANCE CHECK
  346.       REAL MCFGI,MBEO,MBEW,MBEG,MCFG,MCFG1,MCFGT
  347.       COMMON /SAQUI/ IAQOPT,CPIAQ1(LP1,LP2,LP3),CPIAQ2(LP1,LP2,LP3),
  348.      & CPI1(LP1,LP2,LP3),CPI2(LP1,LP2,LP3),EWAQ(LP1,LP2,LP3),
  349.      & CUMAQW(LP1,LP2,LP3),
  350.      & QWAQ(LP1,LP2,LP3),CUMEW(LP1,LP2,LP3),QWAQR(LP7),CUMAQR(LP7)
  351.      & ,IAQREG(LP1,LP2,LP3),PAQ(LP1,LP2,LP3),PIAQ(LP1,LP2,LP3)
  352.       COMMON /SARRAY/ PN(LP1,LP2,LP3),IOCODE,IDMAX,
  353.      & SON(LP1,LP2,LP3),SWN(LP1,LP2,LP3),SGN(LP1,LP2,LP3),
  354.      & A1(LP1,LP2,LP3),A2(LP1,LP2,LP3),A3(LP1,LP2,LP3),
  355.      & SUM(LP1,LP2,LP3),GAM(LP1,LP2,LP3),QS(LP1,LP2,LP3)
  356.       COMMON /SPRTPS/ P(LP1,LP2,LP3),SO(LP1,LP2,LP3),SW(LP1,LP2,LP3),
  357.      & SG(LP1,LP2,LP3)
  358.       COMMON /SSOLN/ BO(LP1,LP2,LP3),BW(LP1,LP2,LP3),BG(LP1,LP2,LP3),
  359.      & QO(LP1,LP2,LP3),QW(LP1,LP2,LP3),QG(LP1,LP2,LP3),
  360.      & GOWT(LP1,LP2,LP3),GWWT(LP1,LP2,LP3),GGWT(LP1,LP2,LP3),
  361.      & OW(LP4,LP2,LP3),OE(LP4,LP2,LP3),WW(LP4,LP2,LP3),WE(LP4,LP2,LP3),
  362.      & OS(LP1,LP5,LP3),ON(LP1,LP5,LP3),WS(LP1,LP5,LP3),WN(LP1,LP5,LP3),
  363.      & OT(LP1,LP2,LP6),OB(LP1,LP2,LP6),WT(LP1,LP2,LP6),WB(LP1,LP2,LP6),
  364.      & QOWG(LP1,LP2,LP3),VP(LP1,LP2,LP3),CT(LP1,LP2,LP3)
  365.       FACT=D5615*DELT0
  366.       PAVG0=0.0
  367.       PAVG=0.0
  368.       OP=0.0
  369.       WP=0.0
  370.       GP=0.0
  371.       WI=0.0
  372.       GI=0.0
  373.       DO 100 K=1,KK
  374.       DO 100 J=1,JJ
  375.       DO 100 I=1,II
  376.       PAVG0=PAVG0+PN(I,J,K)*VP(I,J,K)
  377.       PAVG=PAVG+P(I,J,K)*VP(I,J,K)
  378.       OP=OP+QO(I,J,K)*FACT
  379.       IF(QW(I,J,K).GT.0.0)WP=WP+QW(I,J,K)*FACT
  380.       IF(QW(I,J,K).LE.0.0)WI=WI+QW(I,J,K)*FACT+EWAQ(I,J,K)*FACT
  381.       IF(IAQOPT.NE.0.AND.QW(I,J,K).GT.0.0)WI=WI+EWAQ(I,J,K)*FACT
  382.       IF(QG(I,J,K).GT.0.0)GP=GP+QG(I,J,K)*DELT0
  383.       IF(QG(I,J,K).LT.0.0)GI=GI+QG(I,J,K)*DELT0
  384. 100   CONTINUE
  385.       COP=COP+OP
  386.       CWP=CWP+WP
  387.       CGP=CGP+GP*0.001
  388.       CWI=CWI+WI
  389.       CGI=CGI+GI*0.001
  390. C****CONVERT SCF TO MCF.
  391.       GP=GP*0.001
  392.       GI=GI*0.001
  393.       DIV=1.0/DELT0
  394.       OPR=OP*DIV
  395.       WPR=WP*DIV
  396.       GPR=GP*DIV
  397.       WIR=WI*DIV
  398.       GIR=GI*DIV
  399.       PAVG=PAVG/RESVOL
  400.       PAVG0=PAVG0/RESVOL
  401.       DENOM1=STBOI - OP
  402.       IF(ABS(DENOM1-STBO).LT.1.E-4) MBEO=0.0
  403.       IF(ABS(DENOM1-STBO).LT.1.E-4) GO TO 200
  404.       MBEO=(STBO/(STBOI-OP) - 1.0)*100.0
  405.  200  CONTINUE
  406.       DENOM2=STBWI-WP-WI
  407.       IF(ABS(DENOM2-STBW).LT.1.E-4) MBEW=0.0
  408.       IF(ABS(DENOM2-STBW).LT.1.E-4) GO TO 201
  409.       MBEW=(STBW/(STBWI-WP-WI) - 1.0)*100.0
  410.  201  CONTINUE
  411.       DENOM3=MCFGI-GP-GI
  412.       IF(ABS(DENOM3-MCFGT).LT.1.E-4) MBEG=0.0
  413.       IF(ABS(DENOM3-MCFGT).LT.1.E-4) GO TO 203
  414.       MBEG=(MCFGT/(MCFGI-GP-GI) - 1.0)*100.0
  415.  203  CONTINUE
  416.       DENOMO = TOOIP*1.0E06 - COP
  417.       DENOMW = TOWIP*1.0E06 - CWP - CWI
  418.       DENOMG = TOGIP*1.0E06 - CGP - CGI
  419.       IF(ABS(DENOMO-STBO).LT.1.E-4) CMBEO = 0.0
  420.       IF(ABS(DENOMO-STBO).LT.1.E-4) GO TO 204
  421.       CMBEO =(STBO/(TOOIP*1.0E06-COP)-1.)*100.0
  422.  204  CONTINUE
  423.       IF(ABS(DENOMW-STBW).LT.1.E-4) CMBEW = 0.0
  424.       IF(ABS(DENOMW-STBW).LT.1.E-4) GO TO 205
  425.       CMBEW =(STBW/(TOWIP*1.0E06-CWP-CWI)-1.)*100.0
  426.  205  CONTINUE
  427.       IF(ABS(DENOMG-MCFGT).LT.1.E-4) CMBEG = 0.0
  428.       IF(ABS(DENOMG-MCFGT).LT.1.E-4) GO TO 206
  429.       CMBEG=(MCFGT/(TOGIP*1.0E06-CGP-CGI) - 1.0)*100.0
  430.  206  CONTINUE
  431.       IF(OP.EQ.0.0)GOR=0.0
  432.       IF(OP.EQ.0.0)WOR=0.0
  433.       IF(OP.EQ.0.0)GO TO 333
  434.       GOR=GP/OP
  435.       WOR=WP/OP
  436. 333   IF(COP.EQ.0.0)CGOR=0.0
  437.       IF(COP.EQ.0.0)CWOR=0.0
  438.       IF(COP.EQ.0.0)GO TO 666
  439.       CGOR=CGP/COP*1000.0
  440.       CWOR=CWP/COP
  441. 666   CONTINUE
  442.       GP=GP*0.001
  443.       GI=GI*0.001
  444.       RETURN
  445.       END
  446. C.................................................................NODES
  447.       SUBROUTINE NODES(NVQN)
  448. C      MACHINE DEPENDENT INCLUDE STATEMENT
  449. $INCLUDE:'PARAMS.FOR'
  450.       CHARACTER*5 WELNAM,VAR1
  451.       COMMON /SARRAY/ PN(LP1,LP2,LP3),IOCODE,IDMAX,
  452.      & SON(LP1,LP2,LP3),SWN(LP1,LP2,LP3),SGN(LP1,LP2,LP3),
  453.      & A1(LP1,LP2,LP3),A2(LP1,LP2,LP3),A3(LP1,LP2,LP3),
  454.      & SUM(LP1,LP2,LP3),GAM(LP1,LP2,LP3),QS(LP1,LP2,LP3)
  455.       COMMON /SPRTPS/ P(LP1,LP2,LP3),SO(LP1,LP2,LP3),SW(LP1,LP2,LP3),
  456.      & SG(LP1,LP2,LP3)
  457.       COMMON /SRATE/ PID(LP11,LP3),PWF(LP11,LP3),PWFC(LP11,LP3),
  458.      & KIP(LP11),LAYER(LP11),QVO(LP11),CUMG(LP11,LP3),
  459.      & GMO(LP11,LP3),GMW(LP11,LP3),GMG(LP11,LP3),
  460.      & QVW(LP11),QVG(LP11),QVT(LP11),CUMO(LP11,LP3),CUMW(LP11,LP3),
  461.      & IDWELL(LP11),ALIT(LP11),BLIT(LP11)
  462.       COMMON /VECTOR/ DX(LP1,LP2,LP3),DY(LP1,LP2,LP3),DZ(LP1,LP2,LP3),
  463.      & DZNET(LP1,LP2,LP3),IQN1(LP11),IQN2(LP11),IQN3(LP11),IHEDIN(80)
  464.       COMMON /CHAR/ WELNAM(LP11)
  465.       DIMENSION NCOUNT(LP11)
  466.       DATA NCOUNT/LP11*0/
  467. C**** ESTABLISH RATE-SPECIFIED & PRESSURE-SPECIFIED WELLS
  468.       READ(20,69)
  469.       READ(20,*) NWELLN,NWELLO
  470.       IF(NWELLN.EQ.0.AND.NWELLO.EQ.0)RETURN
  471.       NCHANG=NWELLN+NWELLO
  472.       WRITE(IOCODE,67)
  473.       WRITE(IOCODE,68)
  474.       IF(NWELLN.EQ.0) GO TO 2200
  475.       READ(20,69)
  476.       DO 2000 J=1,NWELLN
  477. C**   INPUT RATE SIGNS BY CONVENTION:
  478. C**   INJECTORS ARE NEGATIVE; PRODUCERS ARE POSITIVE.
  479.       READ(20,3) VAR1,I1,I2,I3,I4,I5
  480.     3 FORMAT(A5,5I3)
  481.       IF(IDMAX.LT.I1)IDMAX=I1
  482.       WELNAM(I1)=VAR1
  483.       IDWELL(I1)=I1
  484.       IQN1(I1)=I2
  485.       IQN2(I1)=I3
  486.       IQN3(I1)=I4
  487.       LAYER(I1)=I5
  488.       IQ3=IQN3(I1)
  489.       LAY=IQ3+(LAYER(I1)-1)
  490.       READ(20,*) (PID(I1,K),K=IQ3,LAY)
  491.       READ(20,*) (PWF(I1,K),K=IQ3,LAY)
  492.       READ(20,6) VAR1,IDWELL(I1),KIP(I1),QVO(I1),QVW(I1),QVG(I1),QVT(I1)
  493.       IF(KIP(I1).EQ.-4) READ(20,8)
  494.      & VAR1,IDWELL(I1),ALIT(I1),BLIT(I1)
  495.     8 FORMAT(A5,I3,2E12.5)
  496.     6 FORMAT(A5,2I3,4F10.0)
  497.       NCOUNT(J)=IDWELL(I1)
  498.       DO 1900 K=IQ3,LAY
  499.       QWV = QVW(I1)
  500.       IF(KIP(I1).EQ.-1) QWV = 0.0
  501.       WRITE(IOCODE,70) WELNAM(I1),IDWELL(I1),IQN1(I1),IQN2(I1),K,
  502.      & QVO(I1),QWV,QVG(I1),
  503.      & QVT(I1),PWF(I1,K),PID(I1,K),
  504.      & ALIT(I1),BLIT(I1)
  505.  1900 CONTINUE
  506. 2000  CONTINUE
  507.       NVQN=IDMAX
  508.  2200 CONTINUE
  509.       IF(NWELLO.EQ.0) GO TO 2600
  510.       READ(20,69)
  511.       DO 2500 NC=1,NWELLO
  512.       READ(20,6) VAR1,I1,I2,F1,F2,F3,F4
  513.       IDWELL(I1)=I1
  514.       KIP(I1)=I2
  515.       QVO(I1)=F1
  516.       QVW(I1)=F2
  517.       QVG(I1)=F3
  518.       QVT(I1)=F4
  519.       IQ3=IQN3(I1)
  520.       LAY=IQ3+(LAYER(I1)-1)
  521.       NCOUNT(NWELLN+NC)=IDWELL(I1)
  522.       DO 2400 K=IQ3,LAY
  523.       WRITE(IOCODE,70) WELNAM(I1),IDWELL(I1),IQN1(I1),IQN2(I1),K,
  524.      & QVO(I1),QVW(I1),QVG(I1),
  525.      & QVT(I1),PWF(I1,K),PID(I1,K),
  526.      & ALIT(I1),BLIT(I1)
  527.  2400 CONTINUE
  528.  2500 CONTINUE
  529.  2600 CONTINUE
  530.       WRITE(IOCODE,33)
  531.       DO 3000 I=1,NCHANG
  532.       J=NCOUNT(I)
  533.       IQ3=IQN3(J)
  534.       LAY=IQ3+(LAYER(J)-1)
  535.       DO 3000 K=IQ3,LAY
  536.       IF(KIP(J).EQ.1.AND.QVO(J).GT.0.0)
  537.      & WRITE(IOCODE,2995) IQN1(J),IQN2(J),K,IDWELL(J)
  538.       IF(KIP(J).EQ.1.AND.QVT(J).GT.0.0)
  539.      & WRITE(IOCODE,2995) IQN1(J),IQN2(J),K,IDWELL(J)
  540.       IF(KIP(J).EQ.1.AND.QVW(J).GT.0.0)
  541.      & WRITE(IOCODE,2996) IQN1(J),IQN2(J),K,IDWELL(J)
  542.       IF(KIP(J).EQ.1.AND.QVG(J).GT.0.0)
  543.      & WRITE(IOCODE,2997) IQN1(J),IQN2(J),K,IDWELL(J)
  544.       IF(KIP(J).EQ.2) WRITE(IOCODE,2998) IQN1(J),IQN2(J),K,IDWELL(J)
  545.       IF(KIP(J).EQ.3) WRITE(IOCODE,2999) IQN1(J),IQN2(J),K,IDWELL(J)
  546.       IF(KIP(J).EQ.-1) WRITE(IOCODE,3005) IQN1(J),IQN2(J),K,IDWELL(J)
  547.       IF(KIP(J).EQ.-2) WRITE(IOCODE,3006) IQN1(J),IQN2(J),K,IDWELL(J)
  548.       IF(KIP(J).EQ.-3) WRITE(IOCODE,3007) IQN1(J),IQN2(J),K,IDWELL(J)
  549.       IF(KIP(J).EQ.-4) WRITE(IOCODE,3008) IQN1(J),IQN2(J),K,IDWELL(J)
  550.       IF(KIP(J).EQ.-11) WRITE(IOCODE,3015) IQN1(J),IQN2(J),K,IDWELL(J)
  551.       IF(KIP(J).EQ.-12) WRITE(IOCODE,3016) IQN1(J),IQN2(J),K,IDWELL(J)
  552.       IF(KIP(J).EQ.-13) WRITE(IOCODE,3017) IQN1(J),IQN2(J),K,IDWELL(J)
  553. 3000  CONTINUE
  554. 69    FORMAT(40A2)
  555.    67 FORMAT(1H1/T55,21('*'),/,T55,
  556.      & '*   WELL   UPDATE   *',/,T55,21('*'),//,
  557.      & T20,'RESERVOIR CONTAINS THE FOLLOWING RATE NODES:'/)
  558. 68    FORMAT(T3,' WELL  NO.     NODE   ',3X,'  OIL(STBD)',
  559.      &3X,'WATER(RBD)',3X,'GAS(MCFD)',3X,'TOTAL(RBD)',3X,'BHFP(PSIA)'
  560.      &,6X,'PID',6X,'ALIT',6X,'BLIT')
  561. 70    FORMAT(2X,A5,I5,1X,3I3,3X,F11.2,4F13.2,F10.4,2E10.3)
  562. 33    FORMAT(/)
  563.  2995 FORMAT(T15,'BLOCK ',3I3,
  564.      & ' CONTAINS THE OIL RATE SPECIFIED PRODUCING WELL',
  565.      & ' NUMBER ',I5)
  566.  2996 FORMAT(T15,'BLOCK ',3I3,
  567.      & ' CONTAINS THE WATER RATE SPECIFIED PRODUCING WELL',
  568.      & ' NUMBER ',I5)
  569.  2997 FORMAT(T15,'BLOCK ',3I3,
  570.      & ' CONTAINS THE GAS RATE SPECIFIED PRODUCING WELL',
  571.      & ' NUMBER ',I5)
  572.  2998 FORMAT(T15,'BLOCK ',3I3,
  573.      & ' CONTAINS THE RATE SPECIFIED WATER INJECTION WELL',
  574.      & ' NUMBER ',I5)
  575.  2999 FORMAT(T15,'BLOCK ',3I3,
  576.      & ' CONTAINS THE RATE SPECIFIED GAS INJECTION WELL',
  577.      & ' NUMBER ',I5)
  578.  3005 FORMAT(T15,'BLOCK ',3I3,' CONTAINS THE ',
  579.      & 'EXPLICIT PRESSURE SPECIFIED PRODUCING WELL',
  580.      & ' NUMBER ',I5)
  581.  3006 FORMAT(T15,'BLOCK ',3I3, ' CONTAINS THE ',
  582.      & 'EXPLICIT PRESSURE SPECIFIED WATER INJECTION WELL',
  583.      & ' NUMBER ',I5)
  584.  3007 FORMAT(T15,'BLOCK ',3I3,' CONTAINS THE ',
  585.      & 'EXPLICIT PRESSURE SPECIFIED GAS INJECTION WELL',
  586.      & ' NUMBER ',I5)
  587.  3008 FORMAT(T15,'BLOCK ',3I3,' CONTAINS THE ',
  588.      & 'EXPLICIT PRESSURE SPECIFIED GAS PRODUCTION WELL',
  589.      & ' NUMBER ',I5)
  590.  3015 FORMAT(T15,'BLOCK ',3I3,' CONTAINS THE ',
  591.      & 'IMPLICIT PRESSURE SPECIFIED PRODUCING WELL',
  592.      & ' NUMBER ',I5)
  593.  3016 FORMAT(T15,'BLOCK ',3I3,' CONTAINS THE ',
  594.      & 'IMPLICIT PRESSURE SPECIFIED WATER INJECTION WELL',
  595.      & ' NUMBER ',I5)
  596.  3017 FORMAT(T15,'BLOCK ',3I3,' CONTAINS THE ',
  597.      & 'IMPLICIT PRESSURE SPECIFIED GAS INJECTION WELL',
  598.      & ' NUMBER ',I5)
  599.       RETURN
  600.       END
  601.