home *** CD-ROM | disk | FTP | other *** search
/ Hall of Fame / HallofFameCDROM.cdr / oilfield / spe-46-2.lzh / BLOCK3.FOR < prev    next >
Text File  |  1988-07-28  |  32KB  |  1,001 lines
  1. $DO66
  2. C.................................................................PLOT
  3.       SUBROUTINE PLOT(APLOT,II,JJ,KK,IOCODE,NACODE)
  4. C      MACHINE DEPENDENT INCLUDE STATEMENT
  5. $INCLUDE:'PARAMS.FOR'
  6. C      DIGITAL CONTOUR PLOT
  7.       CHARACTER*2 ANAME(6)
  8.       DIMENSION APLOT(LP1,LP2,LP3),IXHEAD(LP1),
  9.      & IYHEAD(LP2),AOUT(LP1,LP2,LP3)
  10.       DATA ZERO,ONE,TWO,THREE,FOUR,FIVE,SIX,SEVEN,EIGHT,
  11.      & RNINE,TEN/'-','1','2','3','4','5','6','7','8','9','T'/
  12.       DATA ANAME/'P ','SO','SW','SG','PB','AQ'/
  13.       AMIN=APLOT(1,1,1)
  14.       AMAX=AMIN
  15.       DO 100 I=1,II
  16.       IXHEAD(I)=I
  17.       DO 100 J=1,JJ
  18.       IYHEAD(J)=J
  19.       DO 100 K=1,KK
  20.       IF(APLOT(I,J,K).LT.AMIN) AMIN=APLOT(I,J,K)
  21.       IF(APLOT(I,J,K).GT.AMAX) AMAX=APLOT(I,J,K)
  22.   100 CONTINUE
  23.       ADIF=AMAX-AMIN
  24.       WRITE(IOCODE,150) ANAME(NACODE),AMIN,AMAX,ADIF
  25.   150 FORMAT(//,5X,A2,' ARRAY PLOT:',
  26.      & /,10X,'MINIMUM ARRAY VALUE =',T50,F10.4,
  27.      & /,10X,'MAXIMUM ARRAY VALUE =',T50,F10.4,
  28.      & /,10X,'DIFFERENCE (MAX-MIN)=',T50,F10.4)
  29.       DO 175 I=1,II
  30.       DO 175 J=1,JJ
  31.       DO 175 K=1,KK
  32.       IF(ABS(ADIF).LE.0.001) GO TO 160
  33.       AV=(APLOT(I,J,K)-AMIN)/ADIF
  34.       IF(AV.LT.0.050) AOUT(I,J,K)=ZERO
  35.       IF(AV.GE.0.050.AND.AV.LT.0.150) AOUT(I,J,K)=ONE
  36.       IF(AV.GE.0.150.AND.AV.LT.0.250) AOUT(I,J,K)=TWO
  37.       IF(AV.GE.0.250.AND.AV.LT.0.350) AOUT(I,J,K)=THREE
  38.       IF(AV.GE.0.350.AND.AV.LT.0.450) AOUT(I,J,K)=FOUR
  39.       IF(AV.GE.0.450.AND.AV.LT.0.550) AOUT(I,J,K)=FIVE
  40.       IF(AV.GE.0.550.AND.AV.LT.0.650) AOUT(I,J,K)=SIX
  41.       IF(AV.GE.0.650.AND.AV.LT.0.750) AOUT(I,J,K)=SEVEN
  42.       IF(AV.GE.0.750.AND.AV.LT.0.850) AOUT(I,J,K)=EIGHT
  43.       IF(AV.GE.0.850.AND.AV.LT.0.950) AOUT(I,J,K)=RNINE
  44.       IF(AV.GE.0.950) AOUT(I,J,K)=TEN
  45.       GO TO 175
  46.   160 AOUT(I,J,K)=ZERO
  47.   175 CONTINUE
  48.       DO 300 K=1,KK
  49.       WRITE(IOCODE,210) K,(IXHEAD(I),I=1,II)
  50.   210 FORMAT(//,10X,'LAYER K =',I5,
  51.      & //,7X,'I ',40(I2,1X))
  52.       WRITE(IOCODE,215)
  53.   215 FORMAT(5X,'J',/)
  54.       DO 300 J=1,JJ
  55.       WRITE(IOCODE,220) IYHEAD(J),(AOUT(I,J,K),I=1,II)
  56.   220 FORMAT(4X,I2,4X,40(A2,1X))
  57.   300 CONTINUE
  58.       RETURN
  59.       END
  60. C................................................................PLOTI
  61.       SUBROUTINE PLOTI
  62.      1 (NCX,TCX,YCX,XAXIS,YAXIS,TMN,TMX,YMN,YMX,TSI,LCI,IOCODE)
  63. C      MACHINE DEPENDENT INCLUDE STATEMENT
  64. $INCLUDE:'PARAMS.FOR'
  65. C      LINE PRINTER PLOT
  66.       CHARACTER*5 XAXIS,YAXIS,XAA,XAB
  67.       DIMENSION TCX(1),YCX(1)
  68.       DIMENSION TC(LP12),YC(LP12),YAXIS(5),XAXIS(2),Y(6),
  69.      1 LINE(101)
  70.       DATA IBLNK,IAST/1H ,1H*/
  71.       NC=NCX
  72.       DO 1111 I=1,NCX
  73.       TC(I)=TCX(I)
  74.  1111 YC(I)=YCX(I)
  75.       TS= TSI
  76.       LC= LCI
  77.       TR= TMX-TMN
  78.       IF (TS.EQ.0.) GO TO 20
  79.       LX= TR/TS+.5
  80.       IF (LX.LE.LC) GO TO 10
  81.       TS= 0.
  82.       GO TO 20
  83.    10 LC= LX
  84.       GO TO 30
  85.    20 U= LC
  86.       TS= TR/U
  87.    30 LX= LC/10
  88.       LX= LX*10
  89.       IF (LX.NE.LC) LC= LX+10
  90.       LC= LC+1
  91.       IF (NC.EQ.0) GO TO 38
  92.       TA= 0.
  93.       TT= TS*0.5
  94.       I= 1
  95.    32 IF (TC(I).GE.TT) GO TO 34
  96.       TC(I)= TA
  97.       I= I+1
  98.       IF (I.GT.NC) GO TO 38
  99.       GO TO 32
  100.    34 TT= TT+TS
  101.       TA= TA+TS
  102.       GO TO 32
  103.    38 CONTINUE
  104.       IF (NC.EQ.0) GO TO 92
  105.       IND= 0
  106.       I  = 0
  107.       K  = 0
  108.       TL= TC(1)
  109.       SY= 0.
  110.    65 I= I+1
  111.       IF (TC(I).EQ.TL) GO TO 75
  112.    12 U= K
  113.       YA= SY/U
  114.       L2= I-1
  115.       L1= I-K
  116.       DO 70 L=L1,L2
  117.    70 YC(L)= YA
  118.       IF (IND.EQ.1) GO TO 80
  119.       SY= 0.
  120.       K= 0
  121.    75 TL= TC(I)
  122.       SY= SY+YC(I)
  123.       K= K+1
  124.       IF (I.LT.NC) GO TO 65
  125.       IND= 1
  126.       I= I+1
  127.       GO TO 12
  128.    80 K= 0
  129.       TL= 0.
  130.       I= 1
  131.    85 IF (TC(I).EQ.TL) GO TO 90
  132.       TL= TC(I)
  133.       K= K+1
  134.       TC(K)= TC(I)
  135.       YC(K)= YC(I)
  136.    90 I= I+1
  137.       IF (I.LE.NC) GO TO 85
  138.       NC= K
  139.    92 CONTINUE
  140.       WRITE(IOCODE, 1000) YAXIS
  141.       DY= (YMX-YMN)*0.2
  142.       Y(1)= YMN
  143.       Y(6)= YMX
  144.       DO 95 I=2,5
  145.    95 Y(I)= Y(I-1)+DY
  146.       WRITE(IOCODE, 1001) Y
  147.       WRITE(IOCODE, 1002)
  148.       WRITE(IOCODE, 1003)
  149. C     DETERMINE FIRST TIME TO IDENTIFY X-AXIS
  150.       IX1= LC/2 - 1
  151.       IX2= IX1+2
  152. C     START PLOTTING
  153.       TC(NC+1)= 99999999.
  154.       KC= 1
  155.   105 IF (TC(KC).GE.TMN) GO TO 108
  156.       KC= KC+1
  157.       GO TO 105
  158.   108 CONTINUE
  159.       T= TMN
  160.       TP= TMN
  161.       DY= YMX-YMN
  162.       DT= TS*10.
  163.       L= 1
  164.       K= 10
  165.       TOL= TS*0.5
  166.   110 DO 120 I=1,101
  167.   120 LINE(I)= IBLNK
  168.       IF (ABS(TC(KC)-T).GE.TOL) GO TO 140
  169.       IL= (YC(KC)-YMN)/DY*100.+1.5
  170.       IF (IL.LE.0) GO TO 135
  171.       IF (IL.GT.101) IL= 101
  172.       IF (LINE(IL).EQ.IBLNK) LINE(IL)= IAST
  173.   135 KC= KC+1
  174.   140 K= K+1
  175.       IF (L.NE.IX1) GO TO 152
  176.       XAA = XAXIS(1)
  177.       XAB = XAXIS(2)
  178.       IF(K.EQ.10) GO TO 156
  179.       GO TO 155
  180.   152 IF (K.LT.10) GO TO 153
  181.       WRITE(IOCODE, 1004) TP,LINE
  182.       TP= TP+DT
  183.       K= 0
  184.       GO TO 160
  185.   153 WRITE(IOCODE, 1005)  LINE
  186.       GO TO 160
  187.   155 WRITE(IOCODE, 1006) XAA, XAB, LINE
  188.       GO TO 160
  189.   156 WRITE(IOCODE, 1008) XAA, XAB, LINE
  190.       TP = TP+DT
  191.       K = 0
  192.   160 L= L+1
  193.       IF (L.GT.LC+1) GO TO 200
  194.       T= T+TS
  195.       GO TO 110
  196.   200 WRITE(IOCODE, 1003)
  197.       RETURN
  198.  1000 FORMAT(1H1/30X,'FIELDWIDE PERFORMANCE RESULTS: ',10A5)
  199.  1001 FORMAT(3H0  ,6F20.2)
  200.  1002 FORMAT(1X)
  201.  1003 FORMAT(20X,10(10H+---------  ), 1H+)
  202.  1004 FORMAT(10X,F8.1, 2H +, 101A1, 1H+ )
  203.  1005 FORMAT(19X,1HI,101A1, 1HI)
  204.  1006 FORMAT(6X, 2A5, 4H   I, 101A1, 1HI)
  205.  1008 FORMAT(6X, 2A5, 4H   +, 101A1, 1H+)
  206.       END
  207. C.................................................................PORPRM
  208.       SUBROUTINE PORPRM(IOCODE,II,JJ,KK)
  209. C      MACHINE DEPENDENT INCLUDE STATEMENT
  210. $INCLUDE:'PARAMS.FOR'
  211. C      READ POROSITY AND PERMEABILITY DISTRIBUTIONS
  212.       DIMENSION RPHL(LP3),RKXL(LP1),RKYL(LP2),RKZL(LP3)
  213.       REAL KX,KY,KZ,KXC,KYC,KZC
  214.       COMMON /TSTDAT/ IFATAL,IWARN
  215.       COMMON /SSOLN/ BO(LP1,LP2,LP3),BW(LP1,LP2,LP3),BG(LP1,LP2,LP3),
  216.      & QO(LP1,LP2,LP3),QW(LP1,LP2,LP3),QG(LP1,LP2,LP3),
  217.      & GOWT(LP1,LP2,LP3),GWWT(LP1,LP2,LP3),GGWT(LP1,LP2,LP3),
  218.      & OW(LP4,LP2,LP3),OE(LP4,LP2,LP3),WW(LP4,LP2,LP3),WE(LP4,LP2,LP3),
  219.      & OS(LP1,LP5,LP3),ON(LP1,LP5,LP3),WS(LP1,LP5,LP3),WN(LP1,LP5,LP3),
  220.      & OT(LP1,LP2,LP6),OB(LP1,LP2,LP6),WT(LP1,LP2,LP6),WB(LP1,LP2,LP6),
  221.      & QOWG(LP1,LP2,LP3),VP(LP1,LP2,LP3),CT(LP1,LP2,LP3)
  222.       COMMON /SPARM/ KX(LP1,LP2,LP3),KY(LP1,LP2,LP3),KZ(LP1,LP2,LP3),
  223.      & EL(LP1,LP2,LP3),TX(LP4,LP2,LP3),TY(LP1,LP5,LP3),TZ(LP1,LP2,LP6),
  224.      & PDAT(LP1,LP2,LP3),PDATUM,GRAD
  225.       READ(20,69)
  226. C*****READ INPUT CODES FOR PHI,KX,KY,KZ
  227.       READ(20,*)KPH,KKX,KKY,KKZ
  228. C*****ESTABLISH POROSITY (PHI) DISTRIBUTION
  229.       IF(KPH.GE.0)GO TO 135
  230.       READ(20,*)PHIC
  231.       DO 140 K=1,KK
  232.       DO 140 J=1,JJ
  233.       DO 140 I=1,II
  234. 140   VP(I,J,K)=PHIC
  235.       WRITE(IOCODE,56)
  236.       WRITE(IOCODE,26)PHIC
  237.       GO TO 165
  238.   135 IF(KPH.GT.0)GO TO 145
  239.       READ(20,*)(RPHL(K),K=1,KK)
  240.       DO 550 K=1,KK
  241.       DO 550 J=1,JJ
  242.       DO 550 I=1,II
  243.   550 VP(I,J,K)=RPHL(K)
  244.       DO 560 K=1,KK
  245.   560 WRITE(IOCODE,510)K,RPHL(K)
  246.       GO TO 165
  247. 145   WRITE(IOCODE,39)
  248.       DO 160 K=1,KK
  249.       WRITE(IOCODE,38)K
  250.       DO 155 J=1,JJ
  251.       READ(20,*)(VP(I,J,K),I=1,II)
  252.   155 WRITE(IOCODE,73)(VP(I,J,K),I=1,II)
  253. 160   CONTINUE
  254. 165   CONTINUE
  255.       WRITE(IOCODE,56)
  256. C*****ESTABLISH PERMEABILITY (KX) DISTRIBUTION
  257.       IF(KKX.GE.0)GO TO 180
  258.       READ(20,*)KXC
  259.       DO 175 K=1,KK
  260.       DO 175 J=1,JJ
  261.       DO 175 I=1,II
  262. 175   KX(I,J,K)=KXC
  263.       WRITE(IOCODE,56)
  264.       WRITE(IOCODE,29)KXC
  265.       GO TO 195
  266.   180 IF(KKX.GT.0)GO TO 185
  267.       READ(20,*)(RKXL(K),K=1,KK)
  268.       DO 187 K=1,KK
  269.       DO 187 J=1,JJ
  270.       DO 187 I=1,II
  271.   187 KX(I,J,K)=RKXL(K)
  272.       DO 182 K=1,KK
  273.   182 WRITE(IOCODE,511)K,RKXL(K)
  274.       GO TO 195
  275. 185   WRITE(IOCODE,43)
  276.       DO 192 K=1,KK
  277.       WRITE(IOCODE,38)K
  278.       DO 190 J=1,JJ
  279.       READ(20,*)(KX(I,J,K),I=1,II)
  280.   190 WRITE(IOCODE,72)(KX(I,J,K),I=1,II)
  281. 192   CONTINUE
  282. 195   CONTINUE
  283.       WRITE(IOCODE,56)
  284. C*****ESTABLISH PERMEABILITY (KY) DISTRIBUTION
  285.       IF(KKY.GE.0)GO TO 200
  286.       READ(20,*)KYC
  287.       DO 202 K=1,KK
  288.       DO 202 J=1,JJ
  289.       DO 202 I=1,II
  290. 202   KY(I,J,K)=KYC
  291.       WRITE(IOCODE,56)
  292.       WRITE(IOCODE,33)KYC
  293.       GO TO 220
  294.   200 IF(KKY.GT.0)GO TO 207
  295.       READ(20,*)(RKYL(K),K=1,KK)
  296.       DO 205 K=1,KK
  297.       DO 205 J=1,JJ
  298.       DO 205 I=1,II
  299.   205 KY(I,J,K)=RKYL(K)
  300.       DO 210 K=1,KK
  301.   210 WRITE(IOCODE,512)K,RKYL(K)
  302.       GO TO 220
  303. 207   WRITE(IOCODE,47)
  304.       DO 212 K=1,KK
  305.       WRITE(IOCODE,38)K
  306.       DO 215 J=1,JJ
  307.       READ(20,*)(KY(I,J,K),I=1,II)
  308.   215 WRITE(IOCODE,72)(KY(I,J,K),I=1,II)
  309. 212   CONTINUE
  310. 220   CONTINUE
  311.       WRITE(IOCODE,56)
  312. C*****ESTABLISH PERMEABILITY (KZ) DISTRIBUTION
  313.       IF(KKZ.GE.0)GO TO 225
  314.       READ(20,*)KZC
  315.       DO 230 K=1,KK
  316.       DO 230 J=1,JJ
  317.       DO 230 I=1,II
  318. 230   KZ(I,J,K)=KZC
  319.       WRITE(IOCODE,56)
  320.       WRITE(IOCODE,36)KZC
  321.       GO TO 245
  322.   225 IF(KKZ.GT.0)GO TO 232
  323.       READ(20,*)(RKZL(K),K=1,KK)
  324.       DO 235 K=1,KK
  325.       DO 235 J=1,JJ
  326.       DO 235 I=1,II
  327.   235 KZ(I,J,K)=RKZL(K)
  328.       DO 237 K=1,KK
  329.   237 WRITE(IOCODE,513)K,RKZL(K)
  330.       GO TO 245
  331. 232   WRITE(IOCODE,48)
  332.       DO 240 K=1,KK
  333.       WRITE(IOCODE,38)K
  334.       DO 242 J=1,JJ
  335.       READ(20,*)(KZ(I,J,K),I=1,II)
  336.   242 WRITE(IOCODE,72)(KZ(I,J,K),I=1,II)
  337. 240   CONTINUE
  338. 245   CONTINUE
  339.       WRITE(IOCODE,56)
  340. C**********POROSITY AND PERMEABILITY MODIFICATIONS
  341.       READ(20,69)
  342.       READ(20,*) NUMP,NUMKX,NUMKY,NUMKZ,IPCODE
  343.       IF(NUMP.EQ.0) GO TO 8511
  344.       WRITE(IOCODE,27)
  345.       DO 274 L=1,NUMP
  346.       READ(20,*) I1,I2,J1,J2,K1,K2,REGVAL
  347.       WRITE(IOCODE,32) I1,I2,J1,J2,K1,K2,REGVAL
  348.       DO 274 K=K1,K2
  349.       DO 274 J=J1,J2
  350.       DO 274 I=I1,I2
  351.       VP(I,J,K)=REGVAL
  352.   274 CONTINUE
  353.       IF(IPCODE.NE.1) GO TO 8511
  354.       WRITE(IOCODE,39)
  355.       DO 851 K=1,KK
  356.       WRITE(IOCODE,38)K
  357.       DO 852 J=1,JJ
  358. C THE 852 SHOULD GO ON THE NEXT STATEMENT
  359. 852      WRITE(IOCODE,73)(VP(I,J,K),I=1,II)
  360.   851 CONTINUE
  361. 8511  CONTINUE
  362.       IF(NUMKX.EQ.0) GO TO 8531
  363.       WRITE(IOCODE,31)
  364.       DO 275 L=1,NUMKX
  365.       READ(20,*) I1,I2,J1,J2,K1,K2,REGVAL
  366.       WRITE(IOCODE,32) I1,I2,J1,J2,K1,K2,REGVAL
  367.       DO 275 K=K1,K2
  368.       DO 275 J=J1,J2
  369.       DO 275 I=I1,I2
  370.       KX(I,J,K)=REGVAL
  371.   275 CONTINUE
  372.       IF(IPCODE.NE.1)GO TO 8531
  373.       WRITE(IOCODE,43)
  374.       DO 853 K=1,KK
  375.       WRITE(IOCODE,38)K
  376.       DO 854 J=1,JJ
  377.   854 WRITE(IOCODE,72)(KX(I,J,K),I=1,II)
  378. 853   CONTINUE
  379. 8531  CONTINUE
  380.       IF(NUMKY.EQ.0) GO TO 8551
  381.       WRITE(IOCODE,34)
  382.       DO 276 L=1,NUMKY
  383.       READ(20,*) I1,I2,J1,J2,K1,K2,REGVAL
  384.       WRITE(IOCODE,32) I1,I2,J1,J2,K1,K2,REGVAL
  385.       DO 276 K=K1,K2
  386.       DO 276 J=J1,J2
  387.       DO 276 I=I1,I2
  388.       KY(I,J,K)=REGVAL
  389.   276 CONTINUE
  390.       IF(IPCODE.NE.1) GO TO 8551
  391.       WRITE(IOCODE,47)
  392.       DO 855 K=1,KK
  393.       WRITE(IOCODE,38)K
  394.       DO 856 J=1,JJ
  395.   856 WRITE(IOCODE,72)(KY(I,J,K),I=1,II)
  396. 855   CONTINUE
  397. 8551  CONTINUE
  398.       IF(NUMKZ.EQ.0) GO TO 8571
  399.       WRITE(IOCODE,37)
  400.       DO 277 L=1,NUMKZ
  401.       READ(20,*) I1,I2,J1,J2,K1,K2,REGVAL
  402.       WRITE(IOCODE,32) I1,I2,J1,J2,K1,K2,REGVAL
  403.       DO 277 K=K1,K2
  404.       DO 277 J=J1,J2
  405.       DO 277 I=I1,I2
  406.       KZ(I,J,K)=REGVAL
  407.   277 CONTINUE
  408.       IF(IPCODE.NE.1) GO TO 8571
  409.       WRITE(IOCODE,48)
  410.       DO 857 K=1,KK
  411.       WRITE(IOCODE,38)K
  412.       DO 858 J=1,JJ
  413.   858 WRITE(IOCODE,72)(KZ(I,J,K),I=1,II)
  414. 857   CONTINUE
  415. 8571  CONTINUE
  416. C      POROSITY AND PERMEABILITY ARRAY CHECK
  417.       DO 900 K=1,KK
  418.       DO 900 J=1,JJ
  419.       DO 900 I=1,II
  420.       IF(VP(I,J,K).GE.0.0.AND.VP(I,J,K).LE.1.0) GO TO 892
  421.       IFATAL=IFATAL+1
  422.       WRITE(IOCODE,891) I,J,K
  423.   891 FORMAT(/,5X,5('-'),'POROSITY ERROR AT IJK =',3I5)
  424.   892 IF(KX(I,J,K).GE.0.0) GO TO 894
  425.       IFATAL=IFATAL+1
  426.       WRITE(IOCODE,893) I,J,K
  427.   893 FORMAT(/,5X,5('-'),'GRID BLOCK KX ERROR AT IJK =',3I5)
  428.   894 IF(KY(I,J,K).GE.0.0) GO TO 896
  429.       IFATAL=IFATAL+1
  430.       WRITE(IOCODE,895) I,J,K
  431.   895 FORMAT(/,5X,5('-'),'GRID BLOCK KY ERROR AT IJK =',3I5)
  432.   896 IF(KZ(I,J,K).GE.0.0) GO TO 900
  433.       IFATAL=IFATAL+1
  434.       WRITE(IOCODE,897) I,J,K
  435.   897 FORMAT(/,5X,5('-'),'GRID BLOCK KZ ERROR AT IJK =',3I5)
  436.   900 CONTINUE
  437. 69    FORMAT(40A2)
  438. 56    FORMAT(//)
  439.    72 FORMAT(1X,15F8.1)
  440.    73 FORMAT(1X,15F8.4)
  441. 26    FORMAT(T15,'POROSITY (PHI) IS INITIALLY SET AT',F8.4,' FOR ALL',
  442.      &' NODES'//)
  443.    27 FORMAT(//T15,'**********POROSITY NODE MODIFICATIONS**********',
  444.      &//T15,'   I1  I2  J1  J2  K1  K2  NEW PHI VALUE')
  445. 29    FORMAT(T15,'PERMEABILITY (KX) IS INITIALLY',
  446.      &' SET AT',F10.4,' FOR ALL NODES'//)
  447.    31 FORMAT(//T15,'**********PERMEABILITY (KX) NODE MODIFICATIONS',
  448.      & '**********',//T15,
  449.      & '   I1  I2  J1  J2  K1  K2  NEW KX VALUE')
  450.    32 FORMAT(15X,6I4,2X,E10.4)
  451. 33    FORMAT(T15,'PERMEABILITY (KY) IS INITIALLY',
  452.      &' SET AT',F10.4,' FOR ALL NODES'//)
  453.    34 FORMAT(//T15,'**********PERMEABILITY (KY) NODE MODIFICATIONS',
  454.      & '**********',//T15,
  455.      & '   I1  I2  J1  J2  K1  K2  NEW KY VALUE')
  456. 36    FORMAT(T15,'PERMEABILITY (KZ) IS INITIALLY',
  457.      &' SET AT',F10.4,' FOR ALL NODES'//)
  458.    37 FORMAT(//T15,'**********PERMEABILITY (KZ) NODE MODIFICATIONS',
  459.      & '**********',//T15,
  460.      & '   I1  I2  J1  J2  K1  K2  NEW KZ VALUE')
  461. 38    FORMAT(/1X,'K =',I2/)
  462. 39    FORMAT(//T15,'**********POROSITY DISTRIBUTION FOLLOWS**********'/)
  463. 43    FORMAT(//T15,'**********PERMEABILITY (KX) DISTRIBUTION**********'
  464.      &/)
  465. 47    FORMAT(//T15,'**********PERMEABILITY (KY) DISTRIBUTION**********'
  466.      &/)
  467. 48    FORMAT(//T15,'**********PERMEABILITY (KZ) DISTRIBUTION**********'
  468.      &/)
  469.   510 FORMAT(//T15,'POROSITY IN LAYER',I5,' IS INITIALLY SET AT',F8.5,
  470.      &' FOR ALL NODES',/)
  471.   511 FORMAT(T15,'PERMEABILITY (KX) IN LAYER',I5,' IS INITIALLY SET AT'
  472.      &,F8.2,' FOR ALL NODES',/)
  473.   512 FORMAT(T15,'PERMEABILITY (KY) IN LAYER',I5,' IS INITIALLY SET AT'
  474.      &,F8.2,' FOR ALL NODES',/)
  475.   513 FORMAT(T15,'PERMEABILITY (KZ) IN LAYER',I5,' IS INITIALLY SET AT'
  476.      &,F8.2,' FOR ALL NODES',/)
  477.       RETURN
  478.       END
  479. C..................................................................POSTP
  480.       SUBROUTINE POSTP(NPLINE,IOCODE)
  481. C      MACHINE DEPENDENT INCLUDE STATEMENT
  482. $INCLUDE:'PARAMS.FOR'
  483. C      POST-PLOT PACKAGE
  484.       CHARACTER*5 ATSNO(2),AOPR(5),AGPR(5),AWPR(5),AGOR(5),
  485.      & AWOR(5),AGIR(5),AWIR(5),ARESP(5),AAIR(5),AAIC(5),ACOP(5),
  486.      & ACGP(5),ACWP(5),ACGI(5),ACWI(5)
  487.       COMMON /RUNSUM/ ITSNO(LP12),STIME(LP12),SOPROD(LP12),
  488.      & SGPROD(LP12),
  489.      & SWPROD(LP12),SGOR(LP12),SWOR(LP12),SGINJ(LP12),SWINJ(LP12)
  490.       COMMON /RUN2/SPVWTP(LP12),SOCUMP(LP12),SWCUMP(LP12),SGCUMP(LP12),
  491.      & SGCUMI(LP12),SWCUMI(LP12),SAQUIR(LP12),SAQUIC(LP12)
  492.       COMMON /SPOST/ KOPR,KGPR,KWPR,KGOR,KWOR,KGIR,KWIR,KRESP,
  493.      & KAIR,KAIC,KCOP,KCGP,KCWP,KCGI,KCWI,ITSMAX
  494.       COMMON /VECTOR/ DX(LP1,LP2,LP3),DY(LP1,LP2,LP3),DZ(LP1,LP2,LP3),
  495.      & DZNET(LP1,LP2,LP3),IQN1(LP11),IQN2(LP11),IQN3(LP11),IHEDIN(80)
  496. C      CHARACTER*5 ATSNO,AOPR,AGPR,AWPR,AGOR,AWOR,AGIR,AWIR,ARESP,
  497. C     &AAIR,AAIC,ACOP,ACGP,ACWP,ACGI,ACWI       
  498.       DATA ATSNO/'TIME:',' DAYS'/
  499.       DATA AOPR/' OIL ','PROD ','RATE ','(STB/','D)   '/
  500.       DATA AGPR/' GAS ','PROD ','RATE ','(MSCF','/D)  '/
  501.       DATA AWPR/'WATER',' PROD',' RATE',' (STB','/D)  '/
  502.       DATA AGOR/'PROD ','G/O R','ATIO ','(SCF/','STB) '/
  503.       DATA AWOR/'PROD ','W/O R','ATIO ','(STB/','STB) '/
  504.       DATA AGIR/' GAS ','INJ R','ATE (','MSCF/','D)   '/
  505.       DATA AWIR/'WATER',' INJ ','RATE ','(STB/','D)   '/
  506.       DATA ARESP/'PV WT',' AVG ','RES P',' (PSI','A)   '/
  507.       DATA AAIR/'AQ IN','FLUX ','RATE ','(MSTB','/D)  '/
  508.       DATA AAIC/'AQ IN','FLUX ','CUM  ','(MMST','B)   '/
  509.       DATA ACOP/' CUM ','OIL P','ROD  ','(MSTB',')    '/
  510.       DATA ACGP/' CUM ','GAS P','ROD  ','(MMSC','F)   '/
  511.       DATA ACWP/' CUM ','WATER',' PROD',' (MST','B)   '/
  512.       DATA ACGI/'  CUM',' GAS ','INJ  ','(MMSC','F)   '/
  513.       DATA ACWI/' CUM ','WATER',' INJ ','(MSTB',')    '/
  514. C      TOTAL RUN SUMMARY
  515.       WRITE(IOCODE,70) (IHEDIN(IH),IH=1,40)
  516.    70 FORMAT(1H1/T24,82('*'),/,T24,('*'),T105,('*'),/,
  517.      & T24,('*'),40A2,T105,('*'),/,T24,('*'),T105,
  518.      & ('*'),/,T24,82('*'),//)
  519.       WRITE(IOCODE,2100)
  520.  2100 FORMAT(///,T51,29('*'),/,
  521.      & T51,'*  TOTAL    RUN    SUMMARY  *',/,
  522.      & T51,29('*'),//,
  523.      & T5,' TIME STEP',14X,'PRODUCTION',19X,'INJECTION',
  524.      & 5X,'PV WT AQUIFER INFLUX      CUM PRODUCTION',
  525.      & 7X,'CUM INJECTION',/,
  526.      & T5,10('-'),1X,37('-'),1X,16('-'),3X,'AVG',2X,
  527.      & 14('-'),1X,24('-'),1X,15('-'))
  528.       WRITE(IOCODE,2120)
  529.  2120 FORMAT(T5,14X,'OIL     GAS     WATER    GOR   WATER',
  530.      & 3X,'GAS   WATER    RES   RATE    CUM     OIL',
  531.      & 5X,'GAS    WATER    GAS    WATER',/,
  532.      & T5,37X,'SCF/  /OIL',20X,'PRES',/,
  533.      & T6,'NO.  DAYS   STB/D  MSCF/D   STB/D',
  534.      & 3X,'STB   RATIO  MSCF/D   STB/D   PSIA',
  535.      & 2X,'MSTB/D  MMSTB    MSTB   MMSCF   MSTB',
  536.      & 4X,'MMSCF   MSTB',/,
  537.      & T5,4('-'),1X,5('-'),1X,8('-'),2(1X,7('-')),
  538.      & 1X,6('-'),1X,5('-'),1X,8('-'),1X,7('-'),1X,2(6('-'),1X),
  539.      & 6(7('-'),1X))
  540.       DO 2200 N=1,ITSMAX
  541.       WRITE(IOCODE,2140) ITSNO(N),STIME(N),SOPROD(N),
  542.      & SGPROD(N),SWPROD(N),SGOR(N),SWOR(N),SGINJ(N),SWINJ(N),
  543.      & SPVWTP(N),SAQUIR(N),SAQUIC(N),SOCUMP(N),SGCUMP(N),
  544.      & SWCUMP(N),SGCUMI(N),SWCUMI(N)
  545.  2140 FORMAT(T4,I4,1X,F6.0,1X,F8.0,1X,F7.0,F8.1,1X,F6.0,1X,
  546.      & F5.1,1X,F8.0,1X,F7.0,1X,F6.0,F7.1,F8.0,5F8.0)
  547.  2200 CONTINUE
  548.       TMN=0.
  549.       TMX=STIME(ITSMAX)
  550.       IF(NPLINE.GT.0) GO TO 5
  551.       LCI=250
  552.       IF(ITSMAX.LE.400) LCI=200
  553.       IF(ITSMAX.LE.250) LCI=150
  554.       IF(ITSMAX.LE.100) LCI=100
  555.       IF(ITSMAX.LE.50) LCI=50
  556.       GO TO 8
  557.     5 LCI=NPLINE*ITSMAX
  558.     8 CONTINUE
  559.       IF(KOPR.LT.1) GO TO 100
  560.       YMX=SOPROD(1)
  561.       DO 10 I=1,ITSMAX
  562.       IF(SOPROD(I).GT.YMX) YMX=SOPROD(I)
  563.    10 CONTINUE
  564.       YMN=0.
  565.       IF(YMN.EQ.YMX) GO TO 100
  566.       CALL PLOTI(ITSMAX,STIME,SOPROD,ATSNO,AOPR,
  567.      & TMN,TMX,YMN,YMX,0.,LCI,IOCODE)
  568.   100 CONTINUE
  569.       IF(KGPR.LT.1) GO TO 200
  570.       YMX=SGPROD(1)
  571.       DO 110 I=1,ITSMAX
  572.       IF(SGPROD(I).GT.YMX) YMX=SGPROD(I)
  573.   110 CONTINUE
  574.       YMN=0.
  575.       IF(YMN.EQ.YMX) GO TO 200
  576.       CALL PLOTI(ITSMAX,STIME,SGPROD,ATSNO,AGPR,
  577.      & TMN,TMX,YMN,YMX,0.,LCI,IOCODE)
  578.   200 CONTINUE
  579.       IF(KWPR.LT.1) GO TO 300
  580.       YMX=SWPROD(1)
  581.       DO 210 I=1,ITSMAX
  582.       IF(SWPROD(I).GT.YMX) YMX=SWPROD(I)
  583.   210 CONTINUE
  584.       YMN=0.
  585.       IF(YMN.EQ.YMX) GO TO 300
  586.       CALL PLOTI(ITSMAX,STIME,SWPROD,ATSNO,AWPR,
  587.      & TMN,TMX,YMN,YMX,0.,LCI,IOCODE)
  588.   300 CONTINUE
  589.       IF(KGOR.LT.1) GO TO 400
  590.       YMX=SGOR(1)
  591.       DO 310 I=1,ITSMAX
  592.       IF(SGOR(I).GT.YMX) YMX=SGOR(I)
  593.   310 CONTINUE
  594.       YMN=0.
  595.       IF(YMN.EQ.YMX) GO TO 400
  596.       CALL PLOTI(ITSMAX,STIME,SGOR,ATSNO,AGOR,
  597.      & TMN,TMX,YMN,YMX,0.,LCI,IOCODE)
  598.   400 CONTINUE
  599.       IF(KWOR.LT.1) GO TO 500
  600.       YMX=SWOR(1)
  601.       DO 410 I=1,ITSMAX
  602.       IF(SWOR(I).GT.YMX) YMX=SWOR(I)
  603.   410 CONTINUE
  604.       YMN=0.
  605.       IF(YMN.EQ.YMX) GO TO 500
  606.       CALL PLOTI(ITSMAX,STIME,SWOR,ATSNO,AWOR,
  607.      & TMN,TMX,YMN,YMX,0.,LCI,IOCODE)
  608.   500 CONTINUE
  609.       IF(KGIR.LT.1) GO TO 600
  610.       YMN=SGINJ(1)
  611.       DO 510 I=1,ITSMAX
  612.       IF(SGINJ(I).LT.YMN) YMN=SGINJ(I)
  613.   510 CONTINUE
  614.       YMX=0.
  615.       IF(YMN.EQ.YMX) GO TO 600
  616.       CALL PLOTI(ITSMAX,STIME,SGINJ,ATSNO,AGIR,
  617.      & TMN,TMX,YMN,YMX,0.,LCI,IOCODE)
  618.   600 CONTINUE
  619.       IF(KWIR.LT.1) GO TO 700
  620.       YMN=SWINJ(1)
  621.       DO 610 I=1,ITSMAX
  622.       IF(SWINJ(I).LT.YMN) YMN=SWINJ(I)
  623.   610 CONTINUE
  624.       YMX=0.
  625.       IF(YMN.EQ.YMX) GO TO 700
  626.       CALL PLOTI(ITSMAX,STIME,SWINJ,ATSNO,AWIR,
  627.      & TMN,TMX,YMN,YMX,0.,LCI,IOCODE)
  628.   700 CONTINUE
  629.       IF(KRESP.LT.1) GO TO 800
  630.       YMX=SPVWTP(1)
  631.       DO 710 I=1,ITSMAX
  632.       IF(SPVWTP(I).GT.YMX) YMX=SPVWTP(I)
  633.   710 CONTINUE
  634.       YMN=0.
  635.       IF(YMN.EQ.YMX) GO TO 800
  636.       CALL PLOTI(ITSMAX,STIME,SPVWTP,ATSNO,ARESP,
  637.      & TMN,TMX,YMN,YMX,0.,LCI,IOCODE)
  638.   800 CONTINUE
  639.       IF(KAIR.LT.1) GO TO 900
  640.       YMN=SAQUIR(1)
  641.       YMX=0.
  642.       DO 810 I=1,ITSMAX
  643.       IF(SAQUIR(I).LT.YMN) YMN=SAQUIR(I)
  644.       IF(SAQUIR(I).GT.YMX) YMX=SAQUIR(I)
  645.   810 CONTINUE
  646.       IF(YMN.EQ.YMX) GO TO 900
  647.       CALL PLOTI(ITSMAX,STIME,SAQUIR,ATSNO,AAIR,
  648.      & TMN,TMX,YMN,YMX,0.,LCI,IOCODE)
  649.   900 CONTINUE
  650.       IF(KAIC.LT.1) GO TO 1000
  651.       YMN=SAQUIC(1)
  652.       YMX=0.
  653.       DO 910 I=1,ITSMAX
  654.       IF(SAQUIC(I).LT.YMN) YMN=SAQUIC(I)
  655.       IF(SAQUIC(I).GT.YMX) YMX=SAQUIC(I)
  656.   910 CONTINUE
  657.       IF(YMN.EQ.YMX) GO TO 1000
  658.       CALL PLOTI(ITSMAX,STIME,SAQUIC,ATSNO,AAIC,
  659.      & TMN,TMX,YMN,YMX,0.,LCI,IOCODE)
  660.  1000 CONTINUE
  661.       IF(KCOP.LT.1) GO TO 1100
  662.       YMX=SOCUMP(1)
  663.       DO 1010 I=1,ITSMAX
  664.       IF(SOCUMP(I).GT.YMX) YMX=SOCUMP(I)
  665.  1010 CONTINUE
  666.       YMN=0.
  667.       IF(YMN.EQ.YMX) GO TO 1100
  668.       CALL PLOTI(ITSMAX,STIME,SOCUMP,ATSNO,ACOP,
  669.      & TMN,TMX,YMN,YMX,0.,LCI,IOCODE)
  670.  1100 CONTINUE
  671.       IF(KCGP.LT.1) GO TO 1200
  672.       YMX=SGCUMP(1)
  673.       DO 1110 I=1,ITSMAX
  674.       IF(SGCUMP(I).GT.YMX) YMX=SGCUMP(I)
  675.  1110 CONTINUE
  676.       YMN=0.
  677.       IF(YMN.EQ.YMX) GO TO 1200
  678.       CALL PLOTI(ITSMAX,STIME,SGCUMP,ATSNO,ACGP,
  679.      & TMN,TMX,YMN,YMX,0.,LCI,IOCODE)
  680.  1200 CONTINUE
  681.       IF(KCWP.LT.1) GO TO 1300
  682.       YMX=SWCUMP(1)
  683.       DO 1210 I=1,ITSMAX
  684.       IF(SWCUMP(I).GT.YMX) YMX=SWCUMP(I)
  685.  1210 CONTINUE
  686.       YMN=0.
  687.       IF(YMN.EQ.YMX) GO TO 1300
  688.       CALL PLOTI(ITSMAX,STIME,SWCUMP,ATSNO,ACWP,
  689.      & TMN,TMX,YMN,YMX,0.,LCI,IOCODE)
  690.  1300 CONTINUE
  691.       IF(KCGI.LT.1) GO TO 1400
  692.       YMN=SGCUMI(1)
  693.       DO 1310 I=1,ITSMAX
  694.       IF(SGCUMI(I).LT.YMN) YMN=SGCUMI(I)
  695.  1310 CONTINUE
  696.       YMX=0.
  697.       IF(YMN.EQ.YMX) GO TO 1400
  698.       CALL PLOTI(ITSMAX,STIME,SGCUMI,ATSNO,ACGI,
  699.      & TMN,TMX,YMN,YMX,0.,LCI,IOCODE)
  700.  1400 IF(KCWI.LT.1) GO TO 1500
  701.       YMN=SWCUMI(1)
  702.       DO 1410 I=1,ITSMAX
  703.       IF(SWCUMI(I).LT.YMN) YMN=SWCUMI(I)
  704.  1410 CONTINUE
  705.       YMX=0.
  706.       IF(YMN.EQ.YMX) GO TO 1500
  707.       CALL PLOTI(ITSMAX,STIME,SWCUMI,ATSNO,ACWI,
  708.      & TMN,TMX,YMN,YMX,0.,LCI,IOCODE)
  709.  1500 CONTINUE
  710.       RETURN
  711.       END
  712. C.................................................................PRTPS
  713.       SUBROUTINE PRTPS(NLOOP,II,JJ,KK,PAVG0,PAVG,CMBEO,CMBEW,CMBEG,
  714.      &COP,CWP,CWI,CGP,CGI,MBEO,MBEW,MBEG,DELT0,
  715.      &OPR,WPR,GPR,WIR,GIR,ETI,
  716.      &CWOR,CGOR,WOR,GOR,IPMAP,ISOMAP,ISWMAP,ISGMAP,IPBMAP,IAQMAP)
  717. C      MACHINE DEPENDENT INCLUDE STATEMENT
  718. $INCLUDE:'PARAMS.FOR'
  719. C      SUMMARY REPORT
  720.       REAL MCFGI,MBEO,MBEW,MBEG,MCFG,MCFG1,MCFGT,KX,KY,KZ
  721.       COMMON /BUBBLE/ PBO,VSLOPE(LP8),BSLOPE(LP8),RSLOPE(LP8),PMAXT,
  722.      & IREPRS,MPGT(LP8),
  723.      & RHOSCO(LP8),RHOSCW(LP8),RHOSCG(LP8),MSAT(LP7),MPOT(LP8),
  724.      & MPWT(LP8),PBOT(LP1,LP2,LP3),PBOTN(LP1,LP2,LP3)
  725.       COMMON /SAQUI/ IAQOPT,CPIAQ1(LP1,LP2,LP3),CPIAQ2(LP1,LP2,LP3),
  726.      & CPI1(LP1,LP2,LP3),CPI2(LP1,LP2,LP3),EWAQ(LP1,LP2,LP3),
  727.      & CUMAQW(LP1,LP2,LP3),
  728.      & QWAQ(LP1,LP2,LP3),CUMEW(LP1,LP2,LP3),QWAQR(LP7),CUMAQR(LP7)
  729.      & ,IAQREG(LP1,LP2,LP3),PAQ(LP1,LP2,LP3),PIAQ(LP1,LP2,LP3)
  730.       COMMON /SARRAY/ PN(LP1,LP2,LP3),IOCODE,IDMAX,
  731.      & SON(LP1,LP2,LP3),SWN(LP1,LP2,LP3),SGN(LP1,LP2,LP3),
  732.      & A1(LP1,LP2,LP3),A2(LP1,LP2,LP3),A3(LP1,LP2,LP3),
  733.      & SUM(LP1,LP2,LP3),GAM(LP1,LP2,LP3),QS(LP1,LP2,LP3)
  734.       COMMON /SPARM/ KX(LP1,LP2,LP3),KY(LP1,LP2,LP3),KZ(LP1,LP2,LP3),
  735.      & EL(LP1,LP2,LP3),TX(LP4,LP2,LP3),TY(LP1,LP5,LP3),TZ(LP1,LP2,LP6),
  736.      & PDAT(LP1,LP2,LP3),PDATUM,GRAD
  737.       COMMON /SPRTPS/ P(LP1,LP2,LP3),SO(LP1,LP2,LP3),SW(LP1,LP2,LP3),
  738.      & SG(LP1,LP2,LP3)
  739.       COMMON /SSOLN/ BO(LP1,LP2,LP3),BW(LP1,LP2,LP3),BG(LP1,LP2,LP3),
  740.      & QO(LP1,LP2,LP3),QW(LP1,LP2,LP3),QG(LP1,LP2,LP3),
  741.      & GOWT(LP1,LP2,LP3),GWWT(LP1,LP2,LP3),GGWT(LP1,LP2,LP3),
  742.      & OW(LP4,LP2,LP3),OE(LP4,LP2,LP3),WW(LP4,LP2,LP3),WE(LP4,LP2,LP3),
  743.      & OS(LP1,LP5,LP3),ON(LP1,LP5,LP3),WS(LP1,LP5,LP3),WN(LP1,LP5,LP3),
  744.      & OT(LP1,LP2,LP6),OB(LP1,LP2,LP6),WT(LP1,LP2,LP6),WB(LP1,LP2,LP6),
  745.      & QOWG(LP1,LP2,LP3),VP(LP1,LP2,LP3),CT(LP1,LP2,LP3)
  746.       DIMENSION IHED(150)
  747.       DO 15  I=1,100
  748.    15 IHED(I)=I
  749.       PPM=0.
  750.       SOM=0.
  751.       SWM=0.
  752.       SGM=0.
  753.       IF(NLOOP.EQ.1) GO TO 300
  754.       DO 240 K=1,KK
  755.       DO 240 J=1,JJ
  756.       DO 240 I=1,II
  757.       DPO=P(I,J,K)-PN(I,J,K)
  758.       DSO=SO(I,J,K)-SON(I,J,K)
  759.       DSW=SW(I,J,K)-SWN(I,J,K)
  760.       DSG=SG(I,J,K)-SGN(I,J,K)
  761.       IF(ABS(DPO).LE.ABS(PPM))GO TO 210
  762.       PPM=DPO
  763.       IPM=I
  764.       JPM=J
  765.       KPM=K
  766.   210 IF(ABS(DSO).LE.ABS(SOM))GO TO 220
  767.       SOM=DSO
  768.       IOM=I
  769.       JOM=J
  770.       KOM=K
  771.   220 IF(ABS(DSW).LE.ABS(SWM))GO TO 230
  772.       SWM=DSW
  773.       IWM=I
  774.       JWM=J
  775.       KWM=K
  776.   230 IF(ABS(DSG).LE.ABS(SGM))GO TO 240
  777.       SGM=DSG
  778.       IGM=I
  779.       JGM=J
  780.       KGM=K
  781.   240 CONTINUE
  782.       WRITE(IOCODE,5)
  783.       WRITE(IOCODE,105)
  784.       WRITE(IOCODE,6)
  785.       NLM=NLOOP-1
  786.       GORM=1000.*GOR
  787.       WRITE(IOCODE,110)ETI,NLM,DELT0,PAVG,PAVG0,IPM,JPM,KPM,PPM,
  788.      & IOM,JOM,KOM,SOM,IGM,JGM,KGM,SGM,IWM,JWM,KWM,SWM,
  789.      & MBEO,MBEG,MBEW,CMBEO,CMBEG,CMBEW,OPR,COP,GPR,CGP,WPR
  790.         WRITE(IOCODE,1109)CWP,GIR,CGI,WIR,CWI,WOR,CWOR,GORM,CGOR
  791.   110 FORMAT(/,1X,'ELAPSED TIME (DAYS)         =',F9.2,3X,
  792.      & 'TIME STEP NUMBER             =',I5,6X,
  793.      & 'TIME STEP SIZE (DAYS)         =',F9.2,//,1X,
  794.      & 'CURRENT AVG RES PRESSURE    =',F9.1,3X,
  795.      & 'PREVIOUS AVG RES PRESSURE    =',F9.1,2X,
  796.      & 'PRESSURE DPMAX(',I3,',',I3,',',I3,')   =',F9.1,/,1X,
  797.      & 'OIL DSMAX(',I3,',',I3,',',I3,')      =',F9.5,3X,
  798.      & 'GAS DSMAX(',I3,',',I3,',',I3,')       =',F9.5,2X,
  799.      & 'WATER DSMAX(',I3,',',I3,',',I3,')      =',F9.5,/,1X,
  800.      & 'OIL MATERIAL BALANCE (%)    =',F9.6,3X,
  801.      & 'GAS MATERIAL BALANCE (%)     =',F9.6,2X,
  802.      & 'WATER MATERIAL BALANCE (%)    =',F9.6,/,1X,
  803.      & 'CUM. OIL MATERIAL BALANCE(%)=',F9.6,3X,
  804.      & 'CUM. GAS MATERIAL BALANCE(%) =',F9.6,2X,
  805.      & 'CUM. WATER MATERIAL BALANCE(%)=',F9.6,//,1X,
  806.      & 'OIL PRODUCTION RATE (STB/D) =',F9.1,3X,
  807.      & 'CUM. OIL PRODUCTION (STB)    =',E10.4,/,1X,
  808.      & 'GAS PRODUCTION RATE (MSCF/D)=',F9.1,3X,
  809.      & 'CUM. GAS PRODUCTION (MSCF)   =',E10.4,/,1X,
  810.      & 'WATER PRODUCTION RATE(STB/D)=',F9.1)
  811.  1109 FORMAT(1X,T42,'CUM. WATER PRODUCTION (STB)  =',E10.4,//,1X,
  812.      & 'GAS INJECTION RATE (MSCF/D) =',F9.1,3X,
  813.      & 'CUM. GAS INJECTION (MSCF)    =',E10.4,/,1X,
  814.      & 'WATER INJECTION RATE (STB/D)=',F9.1,3X,
  815.      & 'CUM. WATER INJECTION (STB)   =',E10.4,//,1X,
  816.      & 'PRODUCING WOR (STB/STB)     =',F9.3,3X,
  817.      & 'CUM. WOR (STB/STB)           =',F9.3,/,1X,
  818.      & 'PRODUCING GOR (SCF/STB)     =',F9.1,3X,
  819.      & 'CUM. GOR (SCF/STB)           =',F9.1,//)
  820. C      AQUIFER PRINT
  821.       CALL AQPRNT
  822.   300 WRITE(IOCODE,302)
  823.   302 FORMAT(1H1)
  824.       IF(NLOOP.EQ.1) WRITE(IOCODE,304)
  825.   304 FORMAT(/,T15,7('*'),' INITIAL ARRAYS ',7('*')//)
  826.       IF(IPMAP.EQ.0.AND.NLOOP.NE.1)GO TO 315
  827. C      PRESSURE ARRAY
  828.       WRITE(IOCODE,61)
  829.       ICNT=0
  830.       INTRVL=15
  831.       ICHOP=II/INTRVL
  832.       IEXTRA=II-(ICHOP*INTRVL)
  833.       IR2=0
  834.   308 ICNT=ICNT+1
  835.       IR1=IR2+1
  836.       IR2=INTRVL+IR2
  837.       IF(IR2.GT.ICHOP*INTRVL) IR2=II
  838.       DO 310 K=1,KK
  839.       WRITE(IOCODE,51) K,(IHED(IT),IT=IR1,IR2)
  840.       WRITE(IOCODE,53)
  841.       DO 310 J=1,JJ
  842.       WRITE(IOCODE,41) J, (P(I,J,K),I=IR1,IR2)
  843. 310   CONTINUE
  844.       IF(ICNT.LE.ICHOP.AND.IR2.LT.II) GO TO 308
  845.       IF(GRAD.LE.0.0) GO TO 311
  846.       DO 312 K=1,KK
  847.       DO 312 J=1,JJ
  848.       DO 312 I=1,II
  849.       IF(VP(I,J,K).LE.0.0) GO TO 312
  850.       PDAT(I,J,K)=P(I,J,K)+(PDATUM-EL(I,J,K))*GRAD
  851. 312   CONTINUE
  852.       WRITE(IOCODE,62) PDATUM
  853.       ICNT=0
  854.       INTRVL=15
  855.       ICHOP=II/INTRVL
  856.       IEXTRA=II-(ICHOP*INTRVL)
  857.       IR2=0
  858.   313 ICNT=ICNT+1
  859.       IR1=IR2+1
  860.       IR2=INTRVL+IR2
  861.       IF(IR2.GT.ICHOP*INTRVL) IR2=II
  862.       DO 314 K=1,KK
  863.       WRITE(IOCODE,51) K,(IHED(IT),IT=IR1,IR2)
  864.       WRITE(IOCODE,53)
  865.       DO 314 J=1,JJ
  866.       WRITE(IOCODE,41) J, (PDAT(I,J,K),I=IR1,IR2)
  867. 314   CONTINUE
  868.       IF(ICNT.LE.ICHOP.AND.IR2.LT.II) GO TO 313
  869.   311 IF(IPMAP.EQ.1.OR.NLOOP.EQ.1) GO TO 315
  870.       CALL PLOT(P,II,JJ,KK,IOCODE,1)
  871.   315 IF(ISOMAP.EQ.0.AND.NLOOP.NE.1)GO TO 422
  872. C      OIL SAT ARRAY
  873.       WRITE(IOCODE,71)
  874.       ICNT=0
  875.       INTRVL=15
  876.       ICHOP=II/INTRVL
  877.       IEXTRA=II-(ICHOP*INTRVL)
  878.       IR2=0
  879.   418 ICNT=ICNT+1
  880.       IR1=IR2+1
  881.       IR2=INTRVL+IR2
  882.       IF(IR2.GT.ICHOP*INTRVL) IR2=II
  883.       DO 420 K=1,KK
  884.       WRITE(IOCODE,51) K,(IHED(IT),IT=IR1,IR2)
  885.       WRITE(IOCODE,53)
  886.       DO 420 J=1,JJ
  887.       WRITE(IOCODE,101) J,(SO(I,J,K),I=IR1,IR2)
  888. 420   CONTINUE
  889.       IF(ICNT.LE.ICHOP.AND.IR2.LT.II) GO TO 418
  890.       IF(ISOMAP.EQ.1.OR.NLOOP.EQ.1) GO TO 422
  891.       CALL PLOT(SO,II,JJ,KK,IOCODE,2)
  892.   422 IF(ISWMAP.EQ.0.AND.NLOOP.NE.1)GO TO 432
  893. C      WATER SAT ARRAY
  894.       WRITE(IOCODE,81)
  895.       ICNT=0
  896.       INTRVL=15
  897.       ICHOP=II/INTRVL
  898.       IEXTRA=II-(ICHOP*INTRVL)
  899.       IR2=0
  900.   428 ICNT=ICNT+1
  901.       IR1=IR2+1
  902.       IR2=INTRVL+IR2
  903.       IF(IR2.GT.ICHOP*INTRVL) IR2=II
  904.       DO 430 K=1,KK
  905.       WRITE(IOCODE,51) K,(IHED(IT),IT=IR1,IR2)
  906.       WRITE(IOCODE,53)
  907.       DO 430 J=1,JJ
  908.       WRITE(IOCODE,101) J,(SW(I,J,K),I=IR1,IR2)
  909. 430   CONTINUE
  910.       IF(ICNT.LE.ICHOP.AND.IR2.LT.II) GO TO 428
  911.       IF(ISWMAP.EQ.1.OR.NLOOP.EQ.1) GO TO 432
  912.       CALL PLOT(SW,II,JJ,KK,IOCODE,3)
  913.   432 IF(ISGMAP.EQ.0.AND.NLOOP.NE.1)GO TO 442
  914. C      GAS SAT ARRAY
  915.       WRITE(IOCODE,91)
  916.       ICNT=0
  917.       INTRVL=15
  918.       ICHOP=II/INTRVL
  919.       IEXTRA=II-(ICHOP*INTRVL)
  920.       IR2=0
  921.   438 ICNT=ICNT+1
  922.       IR1=IR2+1
  923.       IR2=INTRVL+IR2
  924.       IF(IR2.GT.ICHOP*INTRVL) IR2=II
  925.       DO 440 K=1,KK
  926.       WRITE(IOCODE,51) K,(IHED(IT),IT=IR1,IR2)
  927.       WRITE(IOCODE,53)
  928.       DO 440 J=1,JJ
  929.       WRITE(IOCODE,101) J,(SG(I,J,K),I=IR1,IR2)
  930.   440 CONTINUE
  931.       IF(ICNT.LE.ICHOP.AND.IR2.LT.II) GO TO 438
  932.       IF(ISGMAP.EQ.1.OR.NLOOP.EQ.1) GO TO 442
  933.       CALL PLOT(SG,II,JJ,KK,IOCODE,4)
  934.   442 IF(IPBMAP.EQ.0.AND.NLOOP.NE.1)GO TO 452
  935. C      BUBBLE POINT PRESSURE ARRAY
  936.       WRITE(IOCODE,102)
  937.   102 FORMAT(///,T15,'***** BUBBLE POINT PRESSURE DISTRIBUTION *****'/)
  938.       ICNT=0
  939.       INTRVL=15
  940.       ICHOP=II/INTRVL
  941.       IEXTRA=II-(ICHOP*INTRVL)
  942.       IR2=0
  943.   448 ICNT=ICNT+1
  944.       IR1=IR2+1
  945.       IR2=INTRVL+IR2
  946.       IF(IR2.GT.ICHOP*INTRVL) IR2=II
  947.       DO 450 K=1,KK
  948.       WRITE(IOCODE,51) K,(IHED(IT),IT=IR1,IR2)
  949.       WRITE(IOCODE,53)
  950.       DO 450 J=1,JJ
  951.       WRITE(IOCODE,41) J,(PBOT(I,J,K),I=IR1,IR2)
  952.   450 CONTINUE
  953.       IF(ICNT.LE.ICHOP.AND.IR2.LT.II) GO TO 448
  954.       IF(IPBMAP.EQ.1.OR.NLOOP.EQ.1) GO TO 452
  955.       CALL PLOT(PBOT,II,JJ,KK,IOCODE,5)
  956.   452 IF(IAQOPT.LE.0) GO TO 462
  957.       IF(IAQMAP.EQ.0.AND.NLOOP.NE.1) GO TO 462
  958. C      CUM AQ INFLUX ARRAY
  959.       WRITE(IOCODE,104)
  960.   104 FORMAT(///,T15,'***** CUM. AQ INFLUX (STB) DISTRIBUTION *****',/)
  961.       ICNT=0
  962.       INTRVL=10
  963.       ICHOP=II/INTRVL
  964.       IEXTRA=II-(ICHOP*INTRVL)
  965.       IR2=0
  966.   458 ICNT=ICNT+1
  967.       IR1=IR2+1
  968.       IR2=INTRVL+IR2
  969.       IF(IR2.GT.ICHOP*INTRVL) IR2=II
  970.       DO 460 K=1,KK
  971.       WRITE(IOCODE,52) K,(IHED(IT),IT=IR1,IR2)
  972.       WRITE(IOCODE,53)
  973.       DO 460 J=1,JJ
  974.       WRITE(IOCODE,42) J,(CUMAQW(I,J,K),I=IR1,IR2)
  975.    42 FORMAT(1X,I3,1X,10E10.4)
  976.   460 CONTINUE
  977.       IF(ICNT.LE.ICHOP.AND.IR2.LT.II) GO TO 458
  978.       IF(IAQMAP.EQ.1.OR.NLOOP.EQ.1) GO TO 462
  979.       CALL PLOT(CUMAQW,II,JJ,KK,IOCODE,6)
  980.   462 IF(NLOOP.NE.1)WRITE(IOCODE,7)
  981.       IF(NLOOP.EQ.1) WRITE(IOCODE,8)
  982. 5     FORMAT(//T30,69('*'),/T30,'*',T98,'*'/T30,'*',T98,'*')
  983. 6     FORMAT(T30,'*',T98,'*'/T30,'*',T98,'*'/T30,69('*'),///)
  984. 7     FORMAT(///T4,49('*'),'  END OF SUMMARY REPORT  ',49('*'),6(/))
  985. 8     FORMAT(///T4,49('*'),'  END OF INITIALIZATION  ',49('*'),6(/))
  986. 105   FORMAT(T30,'*',T45,'SUMMARY REPORT: BOAST II (RELEASE 1.1)  '
  987.      &,T98,'*')
  988. 41    FORMAT(1X,I3,1X,15F8.0)
  989. 51    FORMAT(/1X,'K =',I2/,5X,15(2X,I4,2X))
  990. 52    FORMAT(/1X,'K =',I2/,5X,10(4X,I4,2X))
  991. 53     FORMAT(/)
  992. 61    FORMAT(///,T15,'***** RESERVOIR PRESSURE DISTRIBUTION *****'/)
  993. 62    FORMAT(///,T15,'****** RESERVOIR PRESSURE DISTRIBUTION ******'/,
  994.      & T15,'(CORRECTED TO REFERENCE DEPTH OF ',F6.0,' FEET)'/)
  995. 71    FORMAT(///,T15,'*********  OIL SATURATION  *********'/)
  996. 81    FORMAT(///,T15,'******** WATER SATURATION *********'/)
  997. 91    FORMAT(///,T15,'*********  GAS SATURATION  *********'/)
  998. 101   FORMAT(1X,I3,1X,15F8.3)
  999.       RETURN
  1000.       END
  1001.