home *** CD-ROM | disk | FTP | other *** search
/ Hall of Fame / HallofFameCDROM.cdr / oilfield / spe-46-2.lzh / BLOCK5.FOR < prev    next >
Text File  |  1988-06-24  |  20KB  |  624 lines
  1. $DO66
  2. C.................................................................QRATE
  3.       SUBROUTINE QRATE(II,JJ,KK,NVQN,GORMAX,WORMAX,ETI)
  4. C      MACHINE DEPENDENT INCLUDE STATEMENT
  5. $INCLUDE:'PARAMS.FOR'
  6. C     WELL MODELS
  7.       REAL KROT,KROGT,KRWT,KRGT,MUWT,MUOT,MUGT
  8.      & ,MUO,MUW,MUG,KRO,KRW,KRG
  9.       COMMON /BUBBLE/ PBO,VSLOPE(LP8),BSLOPE(LP8),RSLOPE(LP8),PMAXT,
  10.      & IREPRS,MPGT(LP8),
  11.      & RHOSCO(LP8),RHOSCW(LP8),RHOSCG(LP8),MSAT(LP7),MPOT(LP8),
  12.      & MPWT(LP8),PBOT(LP1,LP2,LP3),PBOTN(LP1,LP2,LP3)
  13.       COMMON /COEF/ AW(LP1,LP2,LP3),AE(LP1,LP2,LP3),AN(LP1,LP2,LP3),
  14.      & AS(LP1,LP2,LP3),AB(LP1,LP2,LP3),AT(LP1,LP2,LP3),E(LP1,LP2,LP3),
  15.      & B(LP1,LP2,LP3)
  16.       COMMON /SARRAY/ PN(LP1,LP2,LP3),IOCODE,IDMAX,
  17.      & SON(LP1,LP2,LP3),SWN(LP1,LP2,LP3),SGN(LP1,LP2,LP3),
  18.      & A1(LP1,LP2,LP3),A2(LP1,LP2,LP3),A3(LP1,LP2,LP3),
  19.      & SUM(LP1,LP2,LP3),GAM(LP1,LP2,LP3),QS(LP1,LP2,LP3)
  20.       COMMON /SLIMIT/ GORT(LP11),WORT(LP11),ILIMOP(LP11),
  21.      & GORL(LP11),WORL(LP11),QOC(LP11,LP3),QWC(LP11,LP3),QGC(LP11,LP3)
  22.       COMMON /SPRTPS/ P(LP1,LP2,LP3),SO(LP1,LP2,LP3),SW(LP1,LP2,LP3),
  23.      & SG(LP1,LP2,LP3)
  24.       COMMON /SPVT/ SAT(LP7,LP9),KROT(LP7,LP9),KRWT(LP7,LP9),
  25.      & BGT(LP7,LP9),
  26.      & KRGT(LP7,LP9),ITHREE(LP7),RSOT(LP7,LP9),BWPT(LP7,LP9),
  27.      & PCOWT(LP7,LP9),PCGOT(LP7,LP9),KROGT(LP7,LP9),SWR(LP7),
  28.      & POT(LP7,LP9),MUOT(LP7,LP9),BOT(LP7,LP9),BOPT(LP7,LP9),
  29.      & RSOPT(LP7,LP9),PWT(LP7,LP9),MUWT(LP7,LP9),BWT(LP7,LP9),
  30.      & RSWT(LP7,LP9),RSWPT(LP7,LP9),PGT(LP7,LP9),MUGT(LP7,LP9),
  31.      & BGPT(LP7,LP9),CRT(LP7,LP9),IPVT(LP1,LP2,LP3),IROCK(LP1,LP2,LP3),
  32.      & NROCK,NPVT,PSIT(LP7,LP9),PRT(LP7,LP9),WOROCK(LP7),GOROCK(LP7)
  33.       COMMON /SRATE/ PID(LP11,LP3),PWF(LP11,LP3),PWFC(LP11,LP3),
  34.      & KIP(LP11),LAYER(LP11),QVO(LP11),CUMG(LP11,LP3),
  35.      & GMO(LP11,LP3),GMW(LP11,LP3),GMG(LP11,LP3),
  36.      & QVW(LP11),QVG(LP11),QVT(LP11),CUMO(LP11,LP3),CUMW(LP11,LP3),
  37.      &  IDWELL(LP11),ALIT(LP11),BLIT(LP11)
  38.       COMMON /SSOLN/ BO(LP1,LP2,LP3),BW(LP1,LP2,LP3),BG(LP1,LP2,LP3),
  39.      & QO(LP1,LP2,LP3),QW(LP1,LP2,LP3),QG(LP1,LP2,LP3),
  40.      & GOWT(LP1,LP2,LP3),GWWT(LP1,LP2,LP3),GGWT(LP1,LP2,LP3),
  41.      & OW(LP4,LP2,LP3),OE(LP4,LP2,LP3),WW(LP4,LP2,LP3),WE(LP4,LP2,LP3),
  42.      & OS(LP1,LP5,LP3),ON(LP1,LP5,LP3),WS(LP1,LP5,LP3),WN(LP1,LP5,LP3),
  43.      & OT(LP1,LP2,LP6),OB(LP1,LP2,LP6),WT(LP1,LP2,LP6),WB(LP1,LP2,LP6),
  44.      & QOWG(LP1,LP2,LP3),VP(LP1,LP2,LP3),CT(LP1,LP2,LP3)
  45.       COMMON /VECTOR/ DX(LP1,LP2,LP3),DY(LP1,LP2,LP3),DZ(LP1,LP2,LP3),
  46.      & DZNET(LP1,LP2,LP3),IQN1(LP11),IQN2(LP11),IQN3(LP11),IHEDIN(80)
  47. C** GORT IN SCF/STB; WORT IN STB/STB OR SCF/SCF.
  48.       DO 1 J=1,NVQN
  49.       GORT(J)=GORMAX
  50.       WORT(J)=WORMAX
  51.       GORL(J)=0.
  52.       WORL(J)=0.
  53.       ILIMOP(J)=1
  54. C      WOR AND/OR GOR VARY WITH ROCK REGION
  55.       IQ1=IQN1(J)
  56.       IQ2=IQN2(J)
  57.       IQ3=IQN3(J)
  58.       IF(GORT(J).NE.0.0) GO TO 3
  59.       LAY=IQ3+(LAYER(J)-1)
  60.       IROCKR=IROCK(IQ1,IQ2,IQ3)
  61.       GORT(J)=GOROCK(IROCKR)
  62.       WRITE(IOCODE,*) 'STARTING LOOP 2'
  63.       DO 2 K=IQ3,LAY
  64.       IROCKR=IROCK(IQ1,IQ2,K)
  65.       IF(GOROCK(IROCKR).GT.GORT(J)) GORT(J)=GOROCK(IROCKR)
  66.     2 CONTINUE
  67.     3 IF(WORT(J).NE.0.0) GO TO 1
  68.       LAY=IQ3+(LAYER(J)-1)
  69.       IROCKR=IROCK(IQ1,IQ2,IQ3)
  70.       WORT(J)=WOROCK(IROCKR)
  71.       DO 4 K=IQ3,LAY
  72.       IROCKR=IROCK(IQ1,IQ2,K)
  73.       IF(WOROCK(IROCKR).GT.WORT(J)) WORT(J)=WOROCK(IROCKR)
  74.     4 CONTINUE
  75.     1 CONTINUE
  76. C** INITIALIZE RATES
  77.       DO 5 K=1,KK
  78.       DO 5 J=1,JJ
  79.       DO 5 I=1,II
  80.       QO(I,J,K)=0.0
  81.       QW(I,J,K)=0.0
  82.       QG(I,J,K)=0.0
  83.       DO 5 M=1,NVQN
  84.       IJ=IDWELL(M)
  85.       QOC(IJ,K)=0.0
  86.       QWC(IJ,K)=0.0
  87.       QGC(IJ,K)=0.0
  88.     5 CONTINUE
  89.       DO 105 J=1,NVQN
  90.       IQ1=IQN1(J)
  91.       IQ2=IQN2(J)
  92.       IQ3=IQN3(J)
  93.       IJ=IDWELL(J)
  94.       IF(IJ.EQ.0) GO TO 105
  95.       LAY=IQ3+(LAYER(J)-1)
  96.       DO 1170 K=IQ3,LAY
  97.       PWFC(J,K)=-1.0
  98.       PP=P(IQ1,IQ2,K)
  99.       BPT=PBOT(IQ1,IQ2,K)
  100.       IPVTR=IPVT(IQ1,IQ2,K)
  101.       IROCKR=IROCK(IQ1,IQ2,K)
  102.       CALL INTPVT(IPVTR,BPT,VSLOPE(IPVTR),POT,MUOT,MPOT(IPVTR),PP,MUO)
  103.       CALL INTERP(IPVTR,PWT,MUWT,MPWT(IPVTR),PP,MUW)
  104.       CALL INTERP(IPVTR,PGT,MUGT,MPGT(IPVTR),PP,MUG)
  105.       SSO=SO(IQ1,IQ2,K)
  106.       SSW=SW(IQ1,IQ2,K)
  107.       SSG=SG(IQ1,IQ2,K)
  108.       CALL INTERP(IROCKR,SAT,KRWT,MSAT(IROCKR),SSW,KRW)
  109.       IF(ITHREE(IROCKR).EQ.0) GO TO 1160
  110.       CALL TRIKRO(IROCKR,SSO,SSW,KRO)
  111.       GO TO 1165
  112.  1160 CALL INTERP(IROCKR,SAT,KROT,MSAT(IROCKR),SSO,KRO)
  113.  1165 CONTINUE
  114.       CALL INTERP(IROCKR,SAT,KRGT,MSAT(IROCKR),SSG,KRG)
  115.       GMW(J,K)=KRW/MUW
  116.       GMO(J,K)=KRO/MUO
  117.       GMG(J,K)=KRG/MUG
  118.  1170 CONTINUE
  119.       IF(KIP(J).LT.0) GO TO 105
  120.       IF(KIP(J).NE.1) GO TO 1190
  121. C****** OIL INJECTION FOR SOLUBLE OIL PROCESS.
  122.       IF(QVO(J).LE.-0.001) GO TO 1190
  123. C****** OIL INJECTION CODE CONTINUES AT FORTRAN LINE 1194 BELOW.
  124.       ITERQ=0
  125.       QDENOM=0.0
  126.       ALPHAO=0.0
  127.       ALPHAW=0.0
  128.       ALPHAG=0.0
  129.       BBOSUM=0.0
  130.       LAY=IQ3+(LAYER(J)-1)
  131.  1172 ITERQ=ITERQ+1
  132.       DO 1189 K=IQ3,LAY
  133.       PP=P(IQ1,IQ2,K)
  134.       BPT=PBOT(IQ1,IQ2,K)
  135.       IPVTR=IPVT(IQ1,IQ2,K)
  136.       CALL INTPVT(IPVTR,BPT,BSLOPE(IPVTR),POT,BOT,MPOT(IPVTR),PP,BBO)
  137.       CALL INTERP(IPVTR,PWT,BWT,MPWT(IPVTR),PP,BBW)
  138.       CALL INTERP(IPVTR,PGT,BGT,MPGT(IPVTR),PP,BBG)
  139.       CALL INTPVT(IPVTR,BPT,RSLOPE(IPVTR),POT,RSOT,MPOT(IPVTR),PP,RSO)
  140.       CALL INTERP(IPVTR,PWT,RSWT,MPWT(IPVTR),PP,RSW)
  141.       IF(ITERQ.NE.1) GO TO 1174
  142.       QDENOM=QDENOM+PID(J,K)*GMO(J,K)/BBO
  143.       IF(QVW(J).NE.0.0) QDENOM=QDENOM+PID(J,K)*GMW(J,K)/BBW
  144.       IF(QVG(J).NE.0.0) QDENOM=QDENOM+PID(J,K)*GMG(J,K)/BBG
  145.       GMT=GMO(J,K)+GMW(J,K)+GMG(J,K)
  146.       ALPHAO=GMO(J,K)/GMT+ALPHAO
  147.       ALPHAW=GMW(J,K)/GMT+ALPHAW
  148.       ALPHAG=GMG(J,K)/GMT+ALPHAG
  149.       BBOSUM=BBOSUM+BBO
  150.       GO TO 1189
  151.  1174 IF(QVT(J).EQ.0.0) GO TO 1176
  152. C** CONVERT INPUT QVT(RB/D) TO QVT(STB/D)
  153.       BBOAVG=BBOSUM/LAYER(J)
  154.       TOTOR=(QVT(J)/BBOAVG)*ALPHAO/(ALPHAO+ALPHAW+ALPHAG)
  155.       GO TO 1178
  156.  1176 TOTOR=QVO(J)
  157.  1178 CONTINUE
  158.       IF(QDENOM.EQ.0.0) GO TO 1189
  159.       IF(QVO(J).LE.0.0.AND.QVT(J).LE.0.0) GO TO 1181
  160.       IF(GMO(J,K).EQ.0.0) GO TO 1189
  161.       QOC(IJ,K)=TOTOR*5.615*PID(J,K)*GMO(J,K)
  162.      & /(BBO*QDENOM)
  163.       QWC(IJ,K)=QOC(IJ,K)*GMW(J,K)*BBO
  164.      & /(BBW*GMO(J,K))
  165.       QGC(IJ,K)=QOC(IJ,K)*(GMG(J,K)*BBO
  166.      & /(BBG*GMO(J,K))+RSO)+RSW*QWC(IJ,K)
  167.       GO TO 1189
  168. C**WATER PROD RATE SPECIFIED
  169.  1181 CONTINUE
  170.       IF(QVW(J).LE.0.0.OR.GMW(J,K).EQ.0.0) GO TO 1183
  171.       QWC(IJ,K)=QVW(J)*5.615*PID(J,K)*GMW(J,K)
  172.      & /(BBW*QDENOM)
  173.       QOC(IJ,K)=QWC(IJ,K)*GMO(J,K)*BBW
  174.      & /(BBO*GMW(J,K))
  175.       QGC(IJ,K)=QWC(IJ,K)*(GMG(J,K)*BBW
  176.      & /(BBG*GMW(J,K))+RSW)+RSO*QOC(IJ,K)
  177.       GO TO 1189
  178. C**GAS PRODUCTION RATE SPECIFIED
  179.  1183 CONTINUE
  180.       IF(QVG(J).LE.0.0.OR.GMG(J,K).EQ.0.0) GO TO 1189
  181.       QGC(IJ,K)=QVG(J)*1000.*PID(J,K)*GMG(J,K)
  182.      & /(BBG*QDENOM)
  183.       QWC(IJ,K)=QGC(IJ,K)*GMW(J,K)*BBG
  184.      & /(BBW*GMG(J,K))
  185.       QOC(IJ,K)=QGC(IJ,K)*GMO(J,K)*BBG
  186.      & /(BBO*GMG(J,K))
  187.  1189 CONTINUE
  188.       IF(ITERQ.EQ.1) GO TO 1172
  189.       GO TO 105
  190.  1190 CONTINUE
  191.       LAY=IQ3+(LAYER(J)-1)
  192.       ITERQ=0
  193.       QDENOM=0
  194.  1192 ITERQ=ITERQ+1
  195.       DO 1200 K=IQ3,LAY
  196.       IF(ITERQ.NE.1)GO TO 1194
  197.       QDENOM=QDENOM+PID(J,K)*(GMO(J,K)+GMW(J,K)+GMG(J,K))
  198.       GO TO 1200
  199. C****** OIL INJECTION FOR SOLUBLE OIL PROCESS.
  200.  1194 IF(QDENOM.EQ.0.0) GO TO 1200
  201.       IF(QVO(J).GE.-0.001) GO TO 1195
  202.       QOC(IJ,K)=QVO(J)*5.615*PID(J,K)*
  203.      & (GMO(J,K)+GMW(J,K)+GMG(J,K))/QDENOM
  204.       GO TO 1200
  205. C****** END OF OIL INJECTION.
  206.  1195 IF(KIP(J).NE.2) GO TO 1196
  207. C***** WATER INJECTION RATE SPECIFIED
  208.       QWC(IJ,K)=QVW(J)*5.615*PID(J,K)
  209.      & *(GMO(J,K)+GMW(J,K)+GMG(J,K))/QDENOM
  210.       GO TO 1200
  211. C***** GAS INJECTION RATE SPECIFIED
  212.  1196 QGC(IJ,K)=QVG(J)*1000.*PID(J,K)
  213.      & *(GMO(J,K)+GMW(J,K)+GMG(J,K))/QDENOM
  214.  1200 CONTINUE
  215.       IF(ITERQ.EQ.1) GO TO 1192
  216.   105 CONTINUE
  217. C**** PRESSURE CONSTRAINT
  218.       DO 1340 J=1,NVQN
  219.       IF(KIP(J).GE.0) GO TO 1340
  220.       IQ1=IQN1(J)
  221.       IQ2=IQN2(J)
  222.       IQ3=IQN3(J)
  223.       IJ=IDWELL(J)
  224.       IF(IJ.EQ.0) GO TO 1340
  225.       LAY=IQ3+(LAYER(J)-1)
  226.        DO 9340 K=IQ3,LAY
  227.       PPN=PN(IQ1,IQ2,K)
  228.       BPT=PBOT(IQ1,IQ2,K)
  229.       IPVTR=IPVT(IQ1,IQ2,K)
  230.       CALL INTPVT(IPVTR,BPT,BSLOPE(IPVTR),POT,BOT,MPOT(IPVTR),PPN,BBO)
  231.       CALL INTERP(IPVTR,PWT,BWT,MPWT(IPVTR),PPN,BBW)
  232.       CALL INTERP(IPVTR,PGT,BGT,MPGT(IPVTR),PPN,BBG)
  233.       CALL INTPVT(IPVTR,BPT,RSLOPE(IPVTR),POT,RSOT,MPOT(IPVTR),PPN,RSO)
  234.       CALL INTERP(IPVTR,PWT,RSWT,MPWT(IPVTR),PPN,RSW)
  235. C**** OIL PRODUCER
  236.       IF(KIP(J).NE.-1) GO TO 1310
  237.       QOC(IJ,K)=PID(J,K)*5.615*GMO(J,K)
  238.      & *(PPN-PWF(J,K))/BBO
  239.       IF(PPN.LE.PWF(J,K)) QOC(IJ,K)=0.0
  240.       QWC(IJ,K)=PID(J,K)*5.615*GMW(J,K)
  241.      & *(PPN-PWF(J,K))/BBW
  242.       IF(PPN.LE.PWF(J,K)) QWC(IJ,K)=0.0
  243.       IF(QOC(IJ,K).LE.0.0) GO TO 1305
  244.       QG1=QOC(IJ,K)*(GMG(J,K)*BBO
  245.      & /(BBG*GMO(J,K))+RSO)
  246.       GO TO 1307
  247.  1305 QG1=0.0
  248.  1307 QGC(IJ,K)=QG1+RSW*QWC(IJ,K)
  249.       GO TO 9340
  250. C**** WATER INJECTOR
  251.  1310 IF(KIP(J).NE.-2) GO TO 1320
  252.       QWC(IJ,K)=PID(J,K)*5.615*(GMO(J,K)
  253.      & +GMW(J,K)+GMG(J,K))*(PPN-PWF(J,K))/BBW
  254.       IF(PPN.GE.PWF(J,K)) QWC(IJ,K)=0.0
  255.       GO TO 9340
  256. C**** GAS INJECTOR
  257.  1320 IF(KIP(J).NE.-3) GO TO 9340
  258.       QGC(IJ,K)=PID(J,K)*5.615*(GMO(J,K)
  259.      & +GMW(J,K)+GMG(J,K))*(PPN-PWF(J,K))/BBG
  260.       IF(PPN.GE.PWF(J,K)) QGC(IJ,K)=0.0
  261. 9340  CONTINUE
  262.  1340 CONTINUE
  263. C**** GAS WELL
  264.       DO 1390 J=1,NVQN
  265.       IQ1=IQN1(J)
  266.       IQ2=IQN2(J)
  267.       IQ3=IQN3(J)
  268.       IJ=IDWELL(J)
  269.       IF(IJ.EQ.0) GO TO 1390
  270.       IF(KIP(J).NE.-4) GO TO 1390
  271.       LAY=IQ3+(LAYER(J)-1)
  272.       ITERQ=0
  273.       QDENOM=0.0
  274.  1345 ITERQ=ITERQ+1
  275.       DO 1360 K=IQ3,LAY
  276.       PP=P(IQ1,IQ2,K)
  277.       BPT=PBOT(IQ1,IQ2,K)
  278.       IPVTR=IPVT(IQ1,IQ2,K)
  279.       CALL INTPVT(IPVTR,BPT,BSLOPE(IPVTR),POT,BOT,MPOT(IPVTR),PP,BBO)
  280.       CALL INTERP(IPVTR,PWT,BWT,MPWT(IPVTR),PP,BBW)
  281.       CALL INTERP(IPVTR,PGT,BGT,MPGT(IPVTR),PP,BBG)
  282.       CALL INTPVT(IPVTR,BPT,RSLOPE(IPVTR),POT,RSOT,MPOT(IPVTR),PP,RSO)
  283.       CALL INTERP(IPVTR,PWT,RSWT,MPWT(IPVTR),PP,RSW)
  284.       IF(ITERQ.NE.1) GO TO 1350
  285.       QDENOM=QDENOM+PID(J,K)*GMG(J,K)/BBG
  286.       GO TO 1360
  287.  1350 CONTINUE
  288.       QOC(IJ,K)=PID(J,K)*5.615*GMO(J,K)
  289.      & *(PP-PWF(J,K))/BBO
  290.       IF(PP.LE.PWF(J,K)) QOC(IJ,K)=0.0
  291.       QWC(IJ,K)=PID(J,K)*5.615*GMW(J,K)
  292.      & *(PP-PWF(J,K))/BBW
  293.       IF(PP.LE.PWF(J,K)) QWC(IJ,K)=0.0
  294.       PWLFLO=PWF(J,K)
  295.       CALL INTERP(IPVTR,PGT,PSIT,MPGT(IPVTR),PP,PSIR)
  296.       CALL INTERP(IPVTR,PGT,PSIT,MPGT(IPVTR),PWLFLO,PSIWF)
  297.       QLIT=0.
  298.       QLITK=0.
  299.       IF(PSIR.LT.PSIWF) GO TO 1355
  300.       IF(QDENOM.EQ.0. ) GO TO 1355
  301. C**  CONVERT MMSCF/D TO SCF/D
  302.       QLIT= (1.0E+6)*(-ALIT(IJ)+SQRT(ALIT(IJ)*ALIT(IJ)
  303.      & +4.*BLIT(IJ)*(PSIR-PSIWF)))/(2.*BLIT(IJ))
  304.       QLITK=QLIT*PID(J,K)*GMG(J,K)/(QDENOM*BBG)
  305.  1355 QGC(IJ,K)=QLITK+RSO*QOC(IJ,K)+RSW*QWC(IJ,K)
  306.  1360 CONTINUE
  307.       IF(ITERQ.EQ.1) GO TO 1345
  308.  1390 CONTINUE
  309. C**** MIN. OIL PROD. AND MAX. LIQUID WITHDRAWAL CONSTRAINTS.
  310.       DO 1580 J=1,NVQN
  311.       IF(KIP(J).NE.-1) GO TO 1580
  312.       IQ1=IQN1(J)
  313.       IQ2=IQN2(J)
  314.       IQ3=IQN3(J)
  315.       IJ=IDWELL(J)
  316.       IF(IJ.EQ.0) GO TO 1580
  317.       LAY=IQ3+(LAYER(J)-1)
  318.       QOT=0.
  319.       QWT=0.
  320.       PIDSUM=0.0
  321.       DO 1510 K=IQ3,LAY
  322.       QOT=QOT+QOC(IJ,K)
  323.       QWT=QWT+QWC(IJ,K)
  324.       PIDSUM=PIDSUM+PID(J,K)
  325.  1510 CONTINUE
  326. C      SKIP MESSAGE IF WELL HAS BEEN SHUT-IN
  327.       IF(PIDSUM.LE.0.0) GO TO 1580
  328. C** IS MIN. OIL PROD. RATE ACHIEVED?
  329. C  5.615 CONVERTS STB TO SCF FOR COMPARISON WITH INTERNAL RATES.
  330.       IF(QOT.GE.QVO(J)*5.615) GO TO 1520
  331.       DO 1515 K=IQ3,LAY
  332.       QOC(IJ,K)=0.
  333.       QWC(IJ,K)=0.
  334.       QGC(IJ,K)=0.
  335. C** SHUT-IN WELL
  336.       PID(J,K)=0.
  337.  1515 CONTINUE
  338.       WRITE(IOCODE,1518) J,IQ1,IQ2,ETI
  339.  1518 FORMAT(/T10,110('-'),/T10,
  340.      & 'MINIMUM OIL RATE NOT ACHIEVED BY WELL #',
  341.      & I3,', AREAL LOCATION',I3,',',I3,' AFTER',F10.2,
  342.      & ' DAYS OF ELAPSED TIME.',/T10,110('-'))
  343.       GO TO 1580
  344.  1520 CONTINUE
  345. C      IS MAX OIL RATE EXCEEDED?
  346.       FAC1=1.0
  347.       IF(QVW(J).LE.0.0) GO TO 1521
  348.       IF(QOT.LE.5.615*QVW(J)) GO TO 1521
  349.       FAC1=5.615*QVW(J)/QOT
  350.  1521 FAC2=1.0
  351.       IF(QVT(J).LE.0.0) GO TO 1522
  352.       QLIQT=(QOT+QWT)*FAC1
  353. C      IS MAX LIQUID WITHDRAWAL RATE EXCEEDED?
  354.       IF(QLIQT.LE.5.615*QVT(J)) GO TO 1522
  355.       FAC2=5.615*QVT(J)/QLIQT
  356.  1522 CONTINUE
  357.       FAC=FAC1*FAC2
  358.       IF(FAC.GE.1.0) GO TO 1540
  359.       DO 1530 K=IQ3,LAY
  360.       QOC(IJ,K)=QOC(IJ,K)*FAC
  361.       QWC(IJ,K)=QWC(IJ,K)*FAC
  362.       PPN=PN(IQ1,IQ2,K)
  363.       BPT=PBOT(IQ1,IQ2,K)
  364.       IPVTR=IPVT(IQ1,IQ2,K)
  365.       CALL INTPVT(IPVTR,BPT,BSLOPE(IPVTR),POT,BOT,MPOT(IPVTR),PPN,BBO)
  366.       CALL INTERP(IPVTR,PGT,BGT,MPGT(IPVTR),PPN,BBG)
  367.       CALL INTPVT(IPVTR,BPT,RSLOPE(IPVTR),POT,RSOT,MPOT(IPVTR),PPN,RSO)
  368.       CALL INTERP(IPVTR,PWT,RSWT,MPWT(IPVTR),PPN,RSW)
  369.       IF(QOC(IJ,K).LE.0.0) GO TO 1523
  370.       QG1=QOC(IJ,K)*(GMG(J,K)*BBO
  371.      & /(BBG*GMO(J,K))+RSO)
  372.       GO TO 1524
  373.  1523 QG1=0.0
  374.  1524 QGC(IJ,K)=QG1+RSW*QWC(IJ,K)
  375.  1530 CONTINUE
  376.  1540 CONTINUE
  377.  1580 CONTINUE
  378. C** RATE CONSTRAINTS ON PRESSURE CONTROLLED INJECTION WELLS
  379.       DO 1680 J=1,NVQN
  380.       IQ1=IQN1(J)
  381.       IQ2=IQN2(J)
  382.       IQ3=IQN3(J)
  383.       IJ=IDWELL(J)
  384.       LAY=IQ3+(LAYER(J)-1)
  385.       FACW=1.0
  386.       FACG=1.0
  387. C      WATER INJECTION WELL CONSTRAINT
  388.       IF(KIP(J).NE.-2) GO TO 1640
  389.       QWI=0.0
  390.       DO 1600 K=IQ3,LAY
  391.       QWI=QWI+QWC(IJ,K)
  392.  1600 CONTINUE
  393.       IF(QVW(J).GE.0.0) GO TO 1640
  394.       IF(ABS(QWI).LE.ABS(QVW(J))*5.615) GO TO 1640
  395.       FACW=QVW(J)*5.615/QWI
  396. C      GAS INJECTION WELL CONSTRAINT
  397.  1640 CONTINUE
  398.       IF(KIP(J).NE.-3) GO TO 1660
  399.       QGI=0.0
  400.       DO 1650 K=IQ3,LAY
  401.       QGI=QGI+QGC(IJ,K)
  402.  1650 CONTINUE
  403.       IF(QVG(J).GE.0.0) GO TO 1660
  404.       IF(ABS(QGI).LE.ABS(QVG(J))*1000.) GO TO 1660
  405.       FACG=QVG(J)*1000./QGI
  406.  1660 CONTINUE
  407.       IF(FACW.GE.1.0.AND.FACG.GE.1.0) GO TO 1680
  408.       DO 1670 K=IQ3,LAY
  409.       QWC(IJ,K)=QWC(IJ,K)*FACW
  410.       QGC(IJ,K)=QGC(IJ,K)*FACG
  411.  1670 CONTINUE
  412.  1680 CONTINUE
  413. C** GOR AND WOR CONSTRAINTS
  414.       DO 5000 J=1,NVQN
  415.       IQ1=IQN1(J)
  416.       IQ2=IQN2(J)
  417.       IQ3=IQN3(J)
  418.       IJ=IDWELL(J)
  419.       IF(IJ.EQ.0) GO TO 5000
  420.       LAY=IQ3+(LAYER(J)-1)
  421.       IF(ILIMOP(J).EQ.0.OR.KIP(J).LT.-10) GO TO 5000
  422.  4001 CONTINUE
  423.       QOT=0.
  424.       QWT=0.
  425.       QGT=0.
  426.       GOR=0.0
  427.       WOR=0.0
  428.       DO 4010 K=IQ3,LAY
  429.       QOT=QOT+QOC(IJ,K)
  430.       QWT=QWT+QWC(IJ,K)
  431.       QGT=QGT+QGC(IJ,K)
  432.  4010 CONTINUE
  433.       IF(QOT.EQ.0.0) GO TO 4100
  434.       GOR=QGT*5.615/QOT
  435.       WOR=QWT/QOT
  436.  4100 CONTINUE
  437. C** GOR CONSTRAINTS
  438.       IF(GOR.LE.GORT(J)) GO TO 4150
  439.       DO 4110 K=IQ3,LAY
  440.       IF(QOC(IJ,K).NE.0.0) GO TO 4105
  441.       PID(J,K)=0.0
  442.       QWC(IJ,K)=0.0
  443.       QGC(IJ,K)=0.0
  444.       GORL(K)=0.0
  445.       GO TO 4110
  446.  4105 GORL(K)=QGC(IJ,K)*5.615/QOC(IJ,K)
  447.  4110 CONTINUE
  448. C** FIND LAYER WITH MAX. GOR
  449.       GORSI=GORL(IQ3)
  450.       KMAX=IQ3
  451.       DO 4120 K=IQ3,LAY
  452.       IF(GORL(K).LE.GORSI) GO TO 4120
  453.       GORSI=GORL(K)
  454.       KMAX=K
  455.  4120 CONTINUE
  456. C** SHUT-IN LAYER WITH MAX. GOR
  457.       PID(J,KMAX)=0.0
  458.       QOC(IJ,KMAX)=0.0
  459.       QWC(IJ,KMAX)=0.0
  460.       QGC(IJ,KMAX)=0.0
  461.       WRITE(IOCODE,4130) KMAX,J,IQ1,IQ2,ETI
  462.  4130 FORMAT(/T10,110('-'),/T10,
  463.      & 'GOR LIMIT EXCEEDED BY LAYER K =',I3,', WELL #',I3,
  464.      & ', AREAL LOCATION'I3,',',I3,' AFTER',F10.2,
  465.      & ' DAYS OF ELAPSED TIME.',/T10,110('-'))
  466. C** REPEAT PROCEDURE
  467.       GO TO 4001
  468.  4150 CONTINUE
  469. C** WOR CONSTRAINTS
  470.       IF(WOR.LE.WORT(J)) GO TO 4250
  471.       DO 4210 K=IQ3,LAY
  472.       IF(QOC(IJ,K).NE.0.0) GO TO 4205
  473.       PID(J,K)=0.0
  474.       QWC(IJ,K)=0.0
  475.       QGC(IJ,K)=0.0
  476.       WORL(K)=0.0
  477.       GO TO 4210
  478.  4205 WORL(K)=QWC(IJ,K)/QOC(IJ,K)
  479.  4210 CONTINUE
  480. C** FIND LAYER WITH MAX. WOR
  481.       WORSI=WORL(LAY)
  482.       KMAX=LAY
  483.       DO 4220 K=IQ3,LAY
  484.       IF(WORL(K).LT.WORSI) GO TO 4220
  485.       WORSI=WORL(K)
  486.       KMAX=K
  487.  4220 CONTINUE
  488. C** SHUT-IN LAYER WITH MAX. WOR
  489.       PID(J,KMAX)=0.0
  490.       QOC(IJ,KMAX)=0.0
  491.       QWC(IJ,KMAX)=0.0
  492.       QGC(IJ,KMAX)=0.0
  493.       WRITE(IOCODE,4230) KMAX,J,IQ1,IQ2,ETI
  494.  4230 FORMAT(/T10,110('-'),/T10,
  495.      & 'WOR LIMIT EXCEEDED BY LAYER K =',I3,', WELL #',I3,
  496.      & ', AREAL LOCATION'I3,',',I3,' AFTER',F10.2,
  497.      & ' DAYS OF ELAPSED TIME.',/T10,110('-'))
  498. C** REPEAT PROCEDURE
  499.       GO TO 4001
  500.  4250 CONTINUE
  501.  5000 CONTINUE
  502. C***** CALCULATE BOTTOM-HOLE FLOWING PRESSURE
  503.       DO 5010 J=1,NVQN
  504.       IQ1=IQN1(J)
  505.       IQ2=IQN2(J)
  506.       IQ3=IQN3(J)
  507.       IJ=IDWELL(J)
  508.       IF(IJ.EQ.0) GO TO 5010
  509.       IF(KIP(J).LT.-10) GO TO 5010
  510.       LAY=IQ3+(LAYER(J)-1)
  511.       DO 5005 K=IQ3,LAY
  512.       PWFC(J,K)=0.0
  513.       IF(PID(J,K).LE.0.0001) GO TO 5005
  514.       PP=P(IQ1,IQ2,K)
  515.       IF(PP.LE.0.0) GO TO 5005
  516.       BPT=PBOT(IQ1,IQ2,K)
  517.       IPVTR=IPVT(IQ1,IQ2,K)
  518.       CALL INTPVT(IPVTR,BPT,BSLOPE(IPVTR),POT,BOT,MPOT(IPVTR),PP,BBO)
  519.       CALL INTERP(IPVTR,PWT,BWT,MPWT(IPVTR),PP,BBW)
  520.       CALL INTERP(IPVTR,PGT,BGT,MPGT(IPVTR),PP,BBG)
  521.       CALL INTPVT(IPVTR,BPT,RSLOPE(IPVTR),POT,RSOT,MPOT(IPVTR),PP,RSO)
  522.       CALL INTERP(IPVTR,PWT,RSWT,MPWT(IPVTR),PP,RSW)
  523.       FAC=PID(J,K)*5.615
  524.       GMTB=GMO(J,K)/BBO+GMW(J,K)/BBW+GMG(J,K)/BBG
  525.       SOLN=RSO*QOC(IJ,K)+RSW*QWC(IJ,K)
  526.       QT=QOC(IJ,K)+QWC(IJ,K)+QGC(IJ,K)
  527.       PWFC(J,K)=PP-(QT-SOLN)/(FAC*GMTB)
  528.  5005 CONTINUE
  529.  5010 CONTINUE
  530. C** TOTAL SOURCE/SINK TERMS BY GRID BLOCK (EXCEPT IMPLICIT RATES)
  531.       DO 5200 J=1,NVQN
  532.       IF(KIP(J).LT.-10) GO TO 5200
  533.       IQ1=IQN1(J)
  534.       IQ2=IQN2(J)
  535.       IQ3=IQN3(J)
  536.       IJ=IDWELL(J)
  537.       IF(IJ.EQ.0) GO TO 5200
  538.       LAY=IQ3+(LAYER(J)-1)
  539.       DO 5100 K=IQ3,LAY
  540.       QO(IQ1,IQ2,K)=QO(IQ1,IQ2,K)+QOC(IJ,K)
  541.       QW(IQ1,IQ2,K)=QW(IQ1,IQ2,K)+QWC(IJ,K)
  542.       QG(IQ1,IQ2,K)=QG(IQ1,IQ2,K)+QGC(IJ,K)
  543.  5100 CONTINUE
  544.  5200 CONTINUE
  545.       RETURN
  546.       ENTRY PRATEI(NVQN)
  547.       DO 205 J=1,NVQN
  548.       IF(KIP(J).GE.-10) GO TO 205
  549.       IQ1=IQN1(J)
  550.       IQ2=IQN2(J)
  551.       IQ3=IQN3(J)
  552.       LAY=IQ3+(LAYER(J)-1)
  553.       DO 203 K=IQ3,LAY
  554.       P56=PID(J,K)*5.615
  555.       PPN=PN(IQ1,IQ2,K)
  556.       BPT=PBOT(IQ1,IQ2,K)
  557.       IPVTR=IPVT(IQ1,IQ2,K)
  558.       CALL INTPVT(IPVTR,BPT,BSLOPE(IPVTR),POT,BOT,MPOT(IPVTR),PPN,BBO)
  559.       CALL INTPVT(IPVTR,BPT,RSLOPE(IPVTR),POT,RSOT,MPOT(IPVTR),PPN,RSO)
  560.       CALL INTERP(IPVTR,PWT,BWT,MPWT(IPVTR),PPN,BBW)
  561.       CALL INTERP(IPVTR,PGT,BGT,MPGT(IPVTR),PPN,BBG)
  562.       CALL INTERP(IPVTR,PWT,RSWT,MPWT(IPVTR),PPN,RSW)
  563.       CPIO=GMO(J,K)*P56*(BBO-BBG*RSO)/BBO
  564.       CPIW=GMW(J,K)*P56*(BBW-BBG*RSW)/BBW
  565.       CPIG=GMG(J,K)*P56
  566.       CPI=CPIO+CPIW+CPIG
  567.       B(IQ1,IQ2,K)=B(IQ1,IQ2,K)-CPI*PWF(J,K)
  568.       E(IQ1,IQ2,K)=E(IQ1,IQ2,K)-CPI
  569.   203 CONTINUE
  570.   205 CONTINUE
  571.       RETURN
  572. C     IMPLICIT PRESSURE RATE
  573.       ENTRY PRATEO(NVQN)
  574.       DO 2059 J=1,NVQN
  575.       IF(KIP(J).GE.-10) GO TO 2059
  576.       IQ1=IQN1(J)
  577.       IQ2=IQN2(J)
  578.       IQ3=IQN3(J)
  579.       IJ=IDWELL(J)
  580.       IF(IJ.EQ.0) GO TO 2059
  581.       LAY=IQ3+(LAYER(J)-1)
  582.       DO 2057 K=IQ3,LAY
  583.       PP=P(IQ1,IQ2,K)
  584.       PPN=PN(IQ1,IQ2,K)
  585.       BPT=PBOT(IQ1,IQ2,K)
  586.       IPVTR=IPVT(IQ1,IQ2,K)
  587.       CALL INTPVT(IPVTR,BPT,RSLOPE(IPVTR),POT,RSOT,MPOT(IPVTR),PPN,RSON)
  588.       CALL INTPVT(IPVTR,BPT,RSLOPE(IPVTR),POT,RSOT,MPOT(IPVTR),PP,RSO)
  589.       CALL INTERP(IPVTR,PWT,RSWT,MPWT(IPVTR),PPN,RSWN)
  590.       CALL INTERP(IPVTR,PWT,RSWT,MPWT(IPVTR),PP,RSW)
  591.       RSOAV=0.5*(RSO+RSON)
  592.       RSWAV=0.5*(RSW+RSWN)
  593.       FACTOR=PID(J,K)*5.615*(PP-PWF(J,K))
  594.       IF(KIP(J).EQ.-13) GO TO 2053
  595.       QWC(IJ,K)=GMW(J,K)/BW(IQ1,IQ2,K)*FACTOR
  596.       IF(KIP(J).EQ.-12)QWC(IJ,K)=
  597.      & (GMO(J,K)+GMW(J,K)+GMG(J,K))/BW(IQ1,IQ2,K)*FACTOR
  598.       IF(KIP(J).EQ.-12) GO TO 2057
  599.       QOC(IJ,K)=GMO(J,K)/BO(IQ1,IQ2,K)*FACTOR
  600.       QGC(IJ,K)=GMG(J,K)/BG(IQ1,IQ2,K)*FACTOR
  601.      & +RSOAV*QOC(IJ,K)+RSWAV*QWC(IJ,K)
  602.       GO TO 2057
  603.  2053 QGC(IJ,K)=(GMO(J,K)+GMW(J,K)+GMG(J,K))
  604.      & /BG(IQ1,IQ2,K)*FACTOR
  605.  2057 CONTINUE
  606.  2059 CONTINUE
  607. C** TOTAL SOURCE/SINK TERMS BY GRID BLOCK INCLUDING IMPLICIT RATES.
  608.       DO 2200 J=1,NVQN
  609.       IF(KIP(J).GE.-10) GO TO 2200
  610.       IQ1=IQN1(J)
  611.       IQ2=IQN2(J)
  612.       IQ3=IQN3(J)
  613.       IJ=IDWELL(J)
  614.       IF(IJ.EQ.0) GO TO 2200
  615.       LAY=IQ3+(LAYER(J)-1)
  616.       DO 2100 K=IQ3,LAY
  617.       QO(IQ1,IQ2,K)=QO(IQ1,IQ2,K)+QOC(IJ,K)
  618.       QW(IQ1,IQ2,K)=QW(IQ1,IQ2,K)+QWC(IJ,K)
  619.       QG(IQ1,IQ2,K)=QG(IQ1,IQ2,K)+QGC(IJ,K)
  620.  2100 CONTINUE
  621.  2200 CONTINUE
  622.       RETURN
  623.       END
  624.