API tools faq
paste
Advertisement
Guest User

Untitled

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