$DO66
C.................................................................PLOT
      SUBROUTINE PLOT(APLOT,II,JJ,KK,IOCODE,NACODE)
C      MACHINE DEPENDENT INCLUDE STATEMENT
$INCLUDE:'PARAMS.FOR'
C      DIGITAL CONTOUR PLOT
      CHARACTER*2 ANAME(6)
      DIMENSION APLOT(LP1,LP2,LP3),IXHEAD(LP1),
     & IYHEAD(LP2),AOUT(LP1,LP2,LP3)
      DATA ZERO,ONE,TWO,THREE,FOUR,FIVE,SIX,SEVEN,EIGHT,
     & RNINE,TEN/'-','1','2','3','4','5','6','7','8','9','T'/
      DATA ANAME/'P ','SO','SW','SG','PB','AQ'/
      AMIN=APLOT(1,1,1)
      AMAX=AMIN
      DO 100 I=1,II
      IXHEAD(I)=I
      DO 100 J=1,JJ
      IYHEAD(J)=J
      DO 100 K=1,KK
      IF(APLOT(I,J,K).LT.AMIN) AMIN=APLOT(I,J,K)
      IF(APLOT(I,J,K).GT.AMAX) AMAX=APLOT(I,J,K)
  100 CONTINUE
      ADIF=AMAX-AMIN
      WRITE(IOCODE,150) ANAME(NACODE),AMIN,AMAX,ADIF
  150 FORMAT(//,5X,A2,' ARRAY PLOT:',
     & /,10X,'MINIMUM ARRAY VALUE =',T50,F10.4,
     & /,10X,'MAXIMUM ARRAY VALUE =',T50,F10.4,
     & /,10X,'DIFFERENCE (MAX-MIN)=',T50,F10.4)
      DO 175 I=1,II
      DO 175 J=1,JJ
      DO 175 K=1,KK
      IF(ABS(ADIF).LE.0.001) GO TO 160
      AV=(APLOT(I,J,K)-AMIN)/ADIF
      IF(AV.LT.0.050) AOUT(I,J,K)=ZERO
      IF(AV.GE.0.050.AND.AV.LT.0.150) AOUT(I,J,K)=ONE
      IF(AV.GE.0.150.AND.AV.LT.0.250) AOUT(I,J,K)=TWO
      IF(AV.GE.0.250.AND.AV.LT.0.350) AOUT(I,J,K)=THREE
      IF(AV.GE.0.350.AND.AV.LT.0.450) AOUT(I,J,K)=FOUR
      IF(AV.GE.0.450.AND.AV.LT.0.550) AOUT(I,J,K)=FIVE
      IF(AV.GE.0.550.AND.AV.LT.0.650) AOUT(I,J,K)=SIX
      IF(AV.GE.0.650.AND.AV.LT.0.750) AOUT(I,J,K)=SEVEN
      IF(AV.GE.0.750.AND.AV.LT.0.850) AOUT(I,J,K)=EIGHT
      IF(AV.GE.0.850.AND.AV.LT.0.950) AOUT(I,J,K)=RNINE
      IF(AV.GE.0.950) AOUT(I,J,K)=TEN
      GO TO 175
  160 AOUT(I,J,K)=ZERO
  175 CONTINUE
      DO 300 K=1,KK
      WRITE(IOCODE,210) K,(IXHEAD(I),I=1,II)
  210 FORMAT(//,10X,'LAYER K =',I5,
     & //,7X,'I ',40(I2,1X))
      WRITE(IOCODE,215)
  215 FORMAT(5X,'J',/)
      DO 300 J=1,JJ
      WRITE(IOCODE,220) IYHEAD(J),(AOUT(I,J,K),I=1,II)
  220 FORMAT(4X,I2,4X,40(A2,1X))
  300 CONTINUE
      RETURN
      END
C................................................................PLOTI
      SUBROUTINE PLOTI
     1 (NCX,TCX,YCX,XAXIS,YAXIS,TMN,TMX,YMN,YMX,TSI,LCI,IOCODE)
C      MACHINE DEPENDENT INCLUDE STATEMENT
$INCLUDE:'PARAMS.FOR'
C      LINE PRINTER PLOT
      CHARACTER*5 XAXIS,YAXIS,XAA,XAB
      DIMENSION TCX(1),YCX(1)
      DIMENSION TC(LP12),YC(LP12),YAXIS(5),XAXIS(2),Y(6),
     1 LINE(101)
      DATA IBLNK,IAST/1H ,1H*/
      NC=NCX
      DO 1111 I=1,NCX
      TC(I)=TCX(I)
 1111 YC(I)=YCX(I)
      TS= TSI
      LC= LCI
      TR= TMX-TMN
      IF (TS.EQ.0.) GO TO 20
      LX= TR/TS+.5
      IF (LX.LE.LC) GO TO 10
      TS= 0.
      GO TO 20
   10 LC= LX
      GO TO 30
   20 U= LC
      TS= TR/U
   30 LX= LC/10
      LX= LX*10
      IF (LX.NE.LC) LC= LX+10
      LC= LC+1
      IF (NC.EQ.0) GO TO 38
      TA= 0.
      TT= TS*0.5
      I= 1
   32 IF (TC(I).GE.TT) GO TO 34
      TC(I)= TA
      I= I+1
      IF (I.GT.NC) GO TO 38
      GO TO 32
   34 TT= TT+TS
      TA= TA+TS
      GO TO 32
   38 CONTINUE
      IF (NC.EQ.0) GO TO 92
      IND= 0
      I  = 0
      K  = 0
      TL= TC(1)
      SY= 0.
   65 I= I+1
      IF (TC(I).EQ.TL) GO TO 75
   12 U= K
      YA= SY/U
      L2= I-1
      L1= I-K
      DO 70 L=L1,L2
   70 YC(L)= YA
      IF (IND.EQ.1) GO TO 80
      SY= 0.
      K= 0
   75 TL= TC(I)
      SY= SY+YC(I)
      K= K+1
      IF (I.LT.NC) GO TO 65
      IND= 1
      I= I+1
      GO TO 12
   80 K= 0
      TL= 0.
      I= 1
   85 IF (TC(I).EQ.TL) GO TO 90
      TL= TC(I)
      K= K+1
      TC(K)= TC(I)
      YC(K)= YC(I)
   90 I= I+1
      IF (I.LE.NC) GO TO 85
      NC= K
   92 CONTINUE
      WRITE(IOCODE, 1000) YAXIS
      DY= (YMX-YMN)*0.2
      Y(1)= YMN
      Y(6)= YMX
      DO 95 I=2,5
   95 Y(I)= Y(I-1)+DY
      WRITE(IOCODE, 1001) Y
      WRITE(IOCODE, 1002)
      WRITE(IOCODE, 1003)
C     DETERMINE FIRST TIME TO IDENTIFY X-AXIS
      IX1= LC/2 - 1
      IX2= IX1+2
C     START PLOTTING
      TC(NC+1)= 99999999.
      KC= 1
  105 IF (TC(KC).GE.TMN) GO TO 108
      KC= KC+1
      GO TO 105
  108 CONTINUE
      T= TMN
      TP= TMN
      DY= YMX-YMN
      DT= TS*10.
      L= 1
      K= 10
      TOL= TS*0.5
  110 DO 120 I=1,101
  120 LINE(I)= IBLNK
      IF (ABS(TC(KC)-T).GE.TOL) GO TO 140
      IL= (YC(KC)-YMN)/DY*100.+1.5
      IF (IL.LE.0) GO TO 135
      IF (IL.GT.101) IL= 101
      IF (LINE(IL).EQ.IBLNK) LINE(IL)= IAST
  135 KC= KC+1
  140 K= K+1
      IF (L.NE.IX1) GO TO 152
      XAA = XAXIS(1)
      XAB = XAXIS(2)
      IF(K.EQ.10) GO TO 156
      GO TO 155
  152 IF (K.LT.10) GO TO 153
      WRITE(IOCODE, 1004) TP,LINE
      TP= TP+DT
      K= 0
      GO TO 160
  153 WRITE(IOCODE, 1005)  LINE
      GO TO 160
  155 WRITE(IOCODE, 1006) XAA, XAB, LINE
      GO TO 160
  156 WRITE(IOCODE, 1008) XAA, XAB, LINE
      TP = TP+DT
      K = 0
  160 L= L+1
      IF (L.GT.LC+1) GO TO 200
      T= T+TS
      GO TO 110
  200 WRITE(IOCODE, 1003)
      RETURN
 1000 FORMAT(1H1/30X,'FIELDWIDE PERFORMANCE RESULTS: ',10A5)
 1001 FORMAT(3H0  ,6F20.2)
 1002 FORMAT(1X)
 1003 FORMAT(20X,10(10H+---------  ), 1H+)
 1004 FORMAT(10X,F8.1, 2H +, 101A1, 1H+ )
 1005 FORMAT(19X,1HI,101A1, 1HI)
 1006 FORMAT(6X, 2A5, 4H   I, 101A1, 1HI)
 1008 FORMAT(6X, 2A5, 4H   +, 101A1, 1H+)
      END
C.................................................................PORPRM
      SUBROUTINE PORPRM(IOCODE,II,JJ,KK)
C      MACHINE DEPENDENT INCLUDE STATEMENT
$INCLUDE:'PARAMS.FOR'
C      READ POROSITY AND PERMEABILITY DISTRIBUTIONS
      DIMENSION RPHL(LP3),RKXL(LP1),RKYL(LP2),RKZL(LP3)
      REAL KX,KY,KZ,KXC,KYC,KZC
      COMMON /TSTDAT/ IFATAL,IWARN
      COMMON /SSOLN/ BO(LP1,LP2,LP3),BW(LP1,LP2,LP3),BG(LP1,LP2,LP3),
     & QO(LP1,LP2,LP3),QW(LP1,LP2,LP3),QG(LP1,LP2,LP3),
     & GOWT(LP1,LP2,LP3),GWWT(LP1,LP2,LP3),GGWT(LP1,LP2,LP3),
     & OW(LP4,LP2,LP3),OE(LP4,LP2,LP3),WW(LP4,LP2,LP3),WE(LP4,LP2,LP3),
     & OS(LP1,LP5,LP3),ON(LP1,LP5,LP3),WS(LP1,LP5,LP3),WN(LP1,LP5,LP3),
     & OT(LP1,LP2,LP6),OB(LP1,LP2,LP6),WT(LP1,LP2,LP6),WB(LP1,LP2,LP6),
     & QOWG(LP1,LP2,LP3),VP(LP1,LP2,LP3),CT(LP1,LP2,LP3)
      COMMON /SPARM/ KX(LP1,LP2,LP3),KY(LP1,LP2,LP3),KZ(LP1,LP2,LP3),
     & EL(LP1,LP2,LP3),TX(LP4,LP2,LP3),TY(LP1,LP5,LP3),TZ(LP1,LP2,LP6),
     & PDAT(LP1,LP2,LP3),PDATUM,GRAD
      READ(20,69)
C*****READ INPUT CODES FOR PHI,KX,KY,KZ
      READ(20,*)KPH,KKX,KKY,KKZ
C*****ESTABLISH POROSITY (PHI) DISTRIBUTION
      IF(KPH.GE.0)GO TO 135
      READ(20,*)PHIC
      DO 140 K=1,KK
      DO 140 J=1,JJ
      DO 140 I=1,II
140   VP(I,J,K)=PHIC
      WRITE(IOCODE,56)
      WRITE(IOCODE,26)PHIC
      GO TO 165
  135 IF(KPH.GT.0)GO TO 145
      READ(20,*)(RPHL(K),K=1,KK)
      DO 550 K=1,KK
      DO 550 J=1,JJ
      DO 550 I=1,II
  550 VP(I,J,K)=RPHL(K)
      DO 560 K=1,KK
  560 WRITE(IOCODE,510)K,RPHL(K)
      GO TO 165
145   WRITE(IOCODE,39)
      DO 160 K=1,KK
      WRITE(IOCODE,38)K
      DO 155 J=1,JJ
      READ(20,*)(VP(I,J,K),I=1,II)
  155 WRITE(IOCODE,73)(VP(I,J,K),I=1,II)
160   CONTINUE
165   CONTINUE
      WRITE(IOCODE,56)
C*****ESTABLISH PERMEABILITY (KX) DISTRIBUTION
      IF(KKX.GE.0)GO TO 180
      READ(20,*)KXC
      DO 175 K=1,KK
      DO 175 J=1,JJ
      DO 175 I=1,II
175   KX(I,J,K)=KXC
      WRITE(IOCODE,56)
      WRITE(IOCODE,29)KXC
      GO TO 195
  180 IF(KKX.GT.0)GO TO 185
      READ(20,*)(RKXL(K),K=1,KK)
      DO 187 K=1,KK
      DO 187 J=1,JJ
      DO 187 I=1,II
  187 KX(I,J,K)=RKXL(K)
      DO 182 K=1,KK
  182 WRITE(IOCODE,511)K,RKXL(K)
      GO TO 195
185   WRITE(IOCODE,43)
      DO 192 K=1,KK
      WRITE(IOCODE,38)K
      DO 190 J=1,JJ
      READ(20,*)(KX(I,J,K),I=1,II)
  190 WRITE(IOCODE,72)(KX(I,J,K),I=1,II)
192   CONTINUE
195   CONTINUE
      WRITE(IOCODE,56)
C*****ESTABLISH PERMEABILITY (KY) DISTRIBUTION
      IF(KKY.GE.0)GO TO 200
      READ(20,*)KYC
      DO 202 K=1,KK
      DO 202 J=1,JJ
      DO 202 I=1,II
202   KY(I,J,K)=KYC
      WRITE(IOCODE,56)
      WRITE(IOCODE,33)KYC
      GO TO 220
  200 IF(KKY.GT.0)GO TO 207
      READ(20,*)(RKYL(K),K=1,KK)
      DO 205 K=1,KK
      DO 205 J=1,JJ
      DO 205 I=1,II
  205 KY(I,J,K)=RKYL(K)
      DO 210 K=1,KK
  210 WRITE(IOCODE,512)K,RKYL(K)
      GO TO 220
207   WRITE(IOCODE,47)
      DO 212 K=1,KK
      WRITE(IOCODE,38)K
      DO 215 J=1,JJ
      READ(20,*)(KY(I,J,K),I=1,II)
  215 WRITE(IOCODE,72)(KY(I,J,K),I=1,II)
212   CONTINUE
220   CONTINUE
      WRITE(IOCODE,56)
C*****ESTABLISH PERMEABILITY (KZ) DISTRIBUTION
      IF(KKZ.GE.0)GO TO 225
      READ(20,*)KZC
      DO 230 K=1,KK
      DO 230 J=1,JJ
      DO 230 I=1,II
230   KZ(I,J,K)=KZC
      WRITE(IOCODE,56)
      WRITE(IOCODE,36)KZC
      GO TO 245
  225 IF(KKZ.GT.0)GO TO 232
      READ(20,*)(RKZL(K),K=1,KK)
      DO 235 K=1,KK
      DO 235 J=1,JJ
      DO 235 I=1,II
  235 KZ(I,J,K)=RKZL(K)
      DO 237 K=1,KK
  237 WRITE(IOCODE,513)K,RKZL(K)
      GO TO 245
232   WRITE(IOCODE,48)
      DO 240 K=1,KK
      WRITE(IOCODE,38)K
      DO 242 J=1,JJ
      READ(20,*)(KZ(I,J,K),I=1,II)
  242 WRITE(IOCODE,72)(KZ(I,J,K),I=1,II)
240   CONTINUE
245   CONTINUE
      WRITE(IOCODE,56)
C**********POROSITY AND PERMEABILITY MODIFICATIONS
      READ(20,69)
      READ(20,*) NUMP,NUMKX,NUMKY,NUMKZ,IPCODE
      IF(NUMP.EQ.0) GO TO 8511
      WRITE(IOCODE,27)
      DO 274 L=1,NUMP
      READ(20,*) I1,I2,J1,J2,K1,K2,REGVAL
      WRITE(IOCODE,32) I1,I2,J1,J2,K1,K2,REGVAL
      DO 274 K=K1,K2
      DO 274 J=J1,J2
      DO 274 I=I1,I2
      VP(I,J,K)=REGVAL
  274 CONTINUE
      IF(IPCODE.NE.1) GO TO 8511
      WRITE(IOCODE,39)
      DO 851 K=1,KK
      WRITE(IOCODE,38)K
      DO 852 J=1,JJ
C THE 852 SHOULD GO ON THE NEXT STATEMENT
852      WRITE(IOCODE,73)(VP(I,J,K),I=1,II)
  851 CONTINUE
8511  CONTINUE
      IF(NUMKX.EQ.0) GO TO 8531
      WRITE(IOCODE,31)
      DO 275 L=1,NUMKX
      READ(20,*) I1,I2,J1,J2,K1,K2,REGVAL
      WRITE(IOCODE,32) I1,I2,J1,J2,K1,K2,REGVAL
      DO 275 K=K1,K2
      DO 275 J=J1,J2
      DO 275 I=I1,I2
      KX(I,J,K)=REGVAL
  275 CONTINUE
      IF(IPCODE.NE.1)GO TO 8531
      WRITE(IOCODE,43)
      DO 853 K=1,KK
      WRITE(IOCODE,38)K
      DO 854 J=1,JJ
  854 WRITE(IOCODE,72)(KX(I,J,K),I=1,II)
853   CONTINUE
8531  CONTINUE
      IF(NUMKY.EQ.0) GO TO 8551
      WRITE(IOCODE,34)
      DO 276 L=1,NUMKY
      READ(20,*) I1,I2,J1,J2,K1,K2,REGVAL
      WRITE(IOCODE,32) I1,I2,J1,J2,K1,K2,REGVAL
      DO 276 K=K1,K2
      DO 276 J=J1,J2
      DO 276 I=I1,I2
      KY(I,J,K)=REGVAL
  276 CONTINUE
      IF(IPCODE.NE.1) GO TO 8551
      WRITE(IOCODE,47)
      DO 855 K=1,KK
      WRITE(IOCODE,38)K
      DO 856 J=1,JJ
  856 WRITE(IOCODE,72)(KY(I,J,K),I=1,II)
855   CONTINUE
8551  CONTINUE
      IF(NUMKZ.EQ.0) GO TO 8571
      WRITE(IOCODE,37)
      DO 277 L=1,NUMKZ
      READ(20,*) I1,I2,J1,J2,K1,K2,REGVAL
      WRITE(IOCODE,32) I1,I2,J1,J2,K1,K2,REGVAL
      DO 277 K=K1,K2
      DO 277 J=J1,J2
      DO 277 I=I1,I2
      KZ(I,J,K)=REGVAL
  277 CONTINUE
      IF(IPCODE.NE.1) GO TO 8571
      WRITE(IOCODE,48)
      DO 857 K=1,KK
      WRITE(IOCODE,38)K
      DO 858 J=1,JJ
  858 WRITE(IOCODE,72)(KZ(I,J,K),I=1,II)
857   CONTINUE
8571  CONTINUE
C      POROSITY AND PERMEABILITY ARRAY CHECK
      DO 900 K=1,KK
      DO 900 J=1,JJ
      DO 900 I=1,II
      IF(VP(I,J,K).GE.0.0.AND.VP(I,J,K).LE.1.0) GO TO 892
      IFATAL=IFATAL+1
      WRITE(IOCODE,891) I,J,K
  891 FORMAT(/,5X,5('-'),'POROSITY ERROR AT IJK =',3I5)
  892 IF(KX(I,J,K).GE.0.0) GO TO 894
      IFATAL=IFATAL+1
      WRITE(IOCODE,893) I,J,K
  893 FORMAT(/,5X,5('-'),'GRID BLOCK KX ERROR AT IJK =',3I5)
  894 IF(KY(I,J,K).GE.0.0) GO TO 896
      IFATAL=IFATAL+1
      WRITE(IOCODE,895) I,J,K
  895 FORMAT(/,5X,5('-'),'GRID BLOCK KY ERROR AT IJK =',3I5)
  896 IF(KZ(I,J,K).GE.0.0) GO TO 900
      IFATAL=IFATAL+1
      WRITE(IOCODE,897) I,J,K
  897 FORMAT(/,5X,5('-'),'GRID BLOCK KZ ERROR AT IJK =',3I5)
  900 CONTINUE
69    FORMAT(40A2)
56    FORMAT(//)
   72 FORMAT(1X,15F8.1)
   73 FORMAT(1X,15F8.4)
26    FORMAT(T15,'POROSITY (PHI) IS INITIALLY SET AT',F8.4,' FOR ALL',
     &' NODES'//)
   27 FORMAT(//T15,'**********POROSITY NODE MODIFICATIONS**********',
     &//T15,'   I1  I2  J1  J2  K1  K2  NEW PHI VALUE')
29    FORMAT(T15,'PERMEABILITY (KX) IS INITIALLY',
     &' SET AT',F10.4,' FOR ALL NODES'//)
   31 FORMAT(//T15,'**********PERMEABILITY (KX) NODE MODIFICATIONS',
     & '**********',//T15,
     & '   I1  I2  J1  J2  K1  K2  NEW KX VALUE')
   32 FORMAT(15X,6I4,2X,E10.4)
33    FORMAT(T15,'PERMEABILITY (KY) IS INITIALLY',
     &' SET AT',F10.4,' FOR ALL NODES'//)
   34 FORMAT(//T15,'**********PERMEABILITY (KY) NODE MODIFICATIONS',
     & '**********',//T15,
     & '   I1  I2  J1  J2  K1  K2  NEW KY VALUE')
36    FORMAT(T15,'PERMEABILITY (KZ) IS INITIALLY',
     &' SET AT',F10.4,' FOR ALL NODES'//)
   37 FORMAT(//T15,'**********PERMEABILITY (KZ) NODE MODIFICATIONS',
     & '**********',//T15,
     & '   I1  I2  J1  J2  K1  K2  NEW KZ VALUE')
38    FORMAT(/1X,'K =',I2/)
39    FORMAT(//T15,'**********POROSITY DISTRIBUTION FOLLOWS**********'/)
43    FORMAT(//T15,'**********PERMEABILITY (KX) DISTRIBUTION**********'
     &/)
47    FORMAT(//T15,'**********PERMEABILITY (KY) DISTRIBUTION**********'
     &/)
48    FORMAT(//T15,'**********PERMEABILITY (KZ) DISTRIBUTION**********'
     &/)
  510 FORMAT(//T15,'POROSITY IN LAYER',I5,' IS INITIALLY SET AT',F8.5,
     &' FOR ALL NODES',/)
  511 FORMAT(T15,'PERMEABILITY (KX) IN LAYER',I5,' IS INITIALLY SET AT'
     &,F8.2,' FOR ALL NODES',/)
  512 FORMAT(T15,'PERMEABILITY (KY) IN LAYER',I5,' IS INITIALLY SET AT'
     &,F8.2,' FOR ALL NODES',/)
  513 FORMAT(T15,'PERMEABILITY (KZ) IN LAYER',I5,' IS INITIALLY SET AT'
     &,F8.2,' FOR ALL NODES',/)
      RETURN
      END
C..................................................................POSTP
      SUBROUTINE POSTP(NPLINE,IOCODE)
C      MACHINE DEPENDENT INCLUDE STATEMENT
$INCLUDE:'PARAMS.FOR'
C      POST-PLOT PACKAGE
      CHARACTER*5 ATSNO(2),AOPR(5),AGPR(5),AWPR(5),AGOR(5),
     & AWOR(5),AGIR(5),AWIR(5),ARESP(5),AAIR(5),AAIC(5),ACOP(5),
     & ACGP(5),ACWP(5),ACGI(5),ACWI(5)
      COMMON /RUNSUM/ ITSNO(LP12),STIME(LP12),SOPROD(LP12),
     & SGPROD(LP12),
     & SWPROD(LP12),SGOR(LP12),SWOR(LP12),SGINJ(LP12),SWINJ(LP12)
      COMMON /RUN2/SPVWTP(LP12),SOCUMP(LP12),SWCUMP(LP12),SGCUMP(LP12),
     & SGCUMI(LP12),SWCUMI(LP12),SAQUIR(LP12),SAQUIC(LP12)
      COMMON /SPOST/ KOPR,KGPR,KWPR,KGOR,KWOR,KGIR,KWIR,KRESP,
     & KAIR,KAIC,KCOP,KCGP,KCWP,KCGI,KCWI,ITSMAX
      COMMON /VECTOR/ DX(LP1,LP2,LP3),DY(LP1,LP2,LP3),DZ(LP1,LP2,LP3),
     & DZNET(LP1,LP2,LP3),IQN1(LP11),IQN2(LP11),IQN3(LP11),IHEDIN(80)
C      CHARACTER*5 ATSNO,AOPR,AGPR,AWPR,AGOR,AWOR,AGIR,AWIR,ARESP,
C     &AAIR,AAIC,ACOP,ACGP,ACWP,ACGI,ACWI       
      DATA ATSNO/'TIME:',' DAYS'/
      DATA AOPR/' OIL ','PROD ','RATE ','(STB/','D)   '/
      DATA AGPR/' GAS ','PROD ','RATE ','(MSCF','/D)  '/
      DATA AWPR/'WATER',' PROD',' RATE',' (STB','/D)  '/
      DATA AGOR/'PROD ','G/O R','ATIO ','(SCF/','STB) '/
      DATA AWOR/'PROD ','W/O R','ATIO ','(STB/','STB) '/
      DATA AGIR/' GAS ','INJ R','ATE (','MSCF/','D)   '/
      DATA AWIR/'WATER',' INJ ','RATE ','(STB/','D)   '/
      DATA ARESP/'PV WT',' AVG ','RES P',' (PSI','A)   '/
      DATA AAIR/'AQ IN','FLUX ','RATE ','(MSTB','/D)  '/
      DATA AAIC/'AQ IN','FLUX ','CUM  ','(MMST','B)   '/
      DATA ACOP/' CUM ','OIL P','ROD  ','(MSTB',')    '/
      DATA ACGP/' CUM ','GAS P','ROD  ','(MMSC','F)   '/
      DATA ACWP/' CUM ','WATER',' PROD',' (MST','B)   '/
      DATA ACGI/'  CUM',' GAS ','INJ  ','(MMSC','F)   '/
      DATA ACWI/' CUM ','WATER',' INJ ','(MSTB',')    '/
C      TOTAL RUN SUMMARY
      WRITE(IOCODE,70) (IHEDIN(IH),IH=1,40)
   70 FORMAT(1H1/T24,82('*'),/,T24,('*'),T105,('*'),/,
     & T24,('*'),40A2,T105,('*'),/,T24,('*'),T105,
     & ('*'),/,T24,82('*'),//)
      WRITE(IOCODE,2100)
 2100 FORMAT(///,T51,29('*'),/,
     & T51,'*  TOTAL    RUN    SUMMARY  *',/,
     & T51,29('*'),//,
     & T5,' TIME STEP',14X,'PRODUCTION',19X,'INJECTION',
     & 5X,'PV WT AQUIFER INFLUX      CUM PRODUCTION',
     & 7X,'CUM INJECTION',/,
     & T5,10('-'),1X,37('-'),1X,16('-'),3X,'AVG',2X,
     & 14('-'),1X,24('-'),1X,15('-'))
      WRITE(IOCODE,2120)
 2120 FORMAT(T5,14X,'OIL     GAS     WATER    GOR   WATER',
     & 3X,'GAS   WATER    RES   RATE    CUM     OIL',
     & 5X,'GAS    WATER    GAS    WATER',/,
     & T5,37X,'SCF/  /OIL',20X,'PRES',/,
     & T6,'NO.  DAYS   STB/D  MSCF/D   STB/D',
     & 3X,'STB   RATIO  MSCF/D   STB/D   PSIA',
     & 2X,'MSTB/D  MMSTB    MSTB   MMSCF   MSTB',
     & 4X,'MMSCF   MSTB',/,
     & T5,4('-'),1X,5('-'),1X,8('-'),2(1X,7('-')),
     & 1X,6('-'),1X,5('-'),1X,8('-'),1X,7('-'),1X,2(6('-'),1X),
     & 6(7('-'),1X))
      DO 2200 N=1,ITSMAX
      WRITE(IOCODE,2140) ITSNO(N),STIME(N),SOPROD(N),
     & SGPROD(N),SWPROD(N),SGOR(N),SWOR(N),SGINJ(N),SWINJ(N),
     & SPVWTP(N),SAQUIR(N),SAQUIC(N),SOCUMP(N),SGCUMP(N),
     & SWCUMP(N),SGCUMI(N),SWCUMI(N)
 2140 FORMAT(T4,I4,1X,F6.0,1X,F8.0,1X,F7.0,F8.1,1X,F6.0,1X,
     & F5.1,1X,F8.0,1X,F7.0,1X,F6.0,F7.1,F8.0,5F8.0)
 2200 CONTINUE
      TMN=0.
      TMX=STIME(ITSMAX)
      IF(NPLINE.GT.0) GO TO 5
      LCI=250
      IF(ITSMAX.LE.400) LCI=200
      IF(ITSMAX.LE.250) LCI=150
      IF(ITSMAX.LE.100) LCI=100
      IF(ITSMAX.LE.50) LCI=50
      GO TO 8
    5 LCI=NPLINE*ITSMAX
    8 CONTINUE
      IF(KOPR.LT.1) GO TO 100
      YMX=SOPROD(1)
      DO 10 I=1,ITSMAX
      IF(SOPROD(I).GT.YMX) YMX=SOPROD(I)
   10 CONTINUE
      YMN=0.
      IF(YMN.EQ.YMX) GO TO 100
      CALL PLOTI(ITSMAX,STIME,SOPROD,ATSNO,AOPR,
     & TMN,TMX,YMN,YMX,0.,LCI,IOCODE)
  100 CONTINUE
      IF(KGPR.LT.1) GO TO 200
      YMX=SGPROD(1)
      DO 110 I=1,ITSMAX
      IF(SGPROD(I).GT.YMX) YMX=SGPROD(I)
  110 CONTINUE
      YMN=0.
      IF(YMN.EQ.YMX) GO TO 200
      CALL PLOTI(ITSMAX,STIME,SGPROD,ATSNO,AGPR,
     & TMN,TMX,YMN,YMX,0.,LCI,IOCODE)
  200 CONTINUE
      IF(KWPR.LT.1) GO TO 300
      YMX=SWPROD(1)
      DO 210 I=1,ITSMAX
      IF(SWPROD(I).GT.YMX) YMX=SWPROD(I)
  210 CONTINUE
      YMN=0.
      IF(YMN.EQ.YMX) GO TO 300
      CALL PLOTI(ITSMAX,STIME,SWPROD,ATSNO,AWPR,
     & TMN,TMX,YMN,YMX,0.,LCI,IOCODE)
  300 CONTINUE
      IF(KGOR.LT.1) GO TO 400
      YMX=SGOR(1)
      DO 310 I=1,ITSMAX
      IF(SGOR(I).GT.YMX) YMX=SGOR(I)
  310 CONTINUE
      YMN=0.
      IF(YMN.EQ.YMX) GO TO 400
      CALL PLOTI(ITSMAX,STIME,SGOR,ATSNO,AGOR,
     & TMN,TMX,YMN,YMX,0.,LCI,IOCODE)
  400 CONTINUE
      IF(KWOR.LT.1) GO TO 500
      YMX=SWOR(1)
      DO 410 I=1,ITSMAX
      IF(SWOR(I).GT.YMX) YMX=SWOR(I)
  410 CONTINUE
      YMN=0.
      IF(YMN.EQ.YMX) GO TO 500
      CALL PLOTI(ITSMAX,STIME,SWOR,ATSNO,AWOR,
     & TMN,TMX,YMN,YMX,0.,LCI,IOCODE)
  500 CONTINUE
      IF(KGIR.LT.1) GO TO 600
      YMN=SGINJ(1)
      DO 510 I=1,ITSMAX
      IF(SGINJ(I).LT.YMN) YMN=SGINJ(I)
  510 CONTINUE
      YMX=0.
      IF(YMN.EQ.YMX) GO TO 600
      CALL PLOTI(ITSMAX,STIME,SGINJ,ATSNO,AGIR,
     & TMN,TMX,YMN,YMX,0.,LCI,IOCODE)
  600 CONTINUE
      IF(KWIR.LT.1) GO TO 700
      YMN=SWINJ(1)
      DO 610 I=1,ITSMAX
      IF(SWINJ(I).LT.YMN) YMN=SWINJ(I)
  610 CONTINUE
      YMX=0.
      IF(YMN.EQ.YMX) GO TO 700
      CALL PLOTI(ITSMAX,STIME,SWINJ,ATSNO,AWIR,
     & TMN,TMX,YMN,YMX,0.,LCI,IOCODE)
  700 CONTINUE
      IF(KRESP.LT.1) GO TO 800
      YMX=SPVWTP(1)
      DO 710 I=1,ITSMAX
      IF(SPVWTP(I).GT.YMX) YMX=SPVWTP(I)
  710 CONTINUE
      YMN=0.
      IF(YMN.EQ.YMX) GO TO 800
      CALL PLOTI(ITSMAX,STIME,SPVWTP,ATSNO,ARESP,
     & TMN,TMX,YMN,YMX,0.,LCI,IOCODE)
  800 CONTINUE
      IF(KAIR.LT.1) GO TO 900
      YMN=SAQUIR(1)
      YMX=0.
      DO 810 I=1,ITSMAX
      IF(SAQUIR(I).LT.YMN) YMN=SAQUIR(I)
      IF(SAQUIR(I).GT.YMX) YMX=SAQUIR(I)
  810 CONTINUE
      IF(YMN.EQ.YMX) GO TO 900
      CALL PLOTI(ITSMAX,STIME,SAQUIR,ATSNO,AAIR,
     & TMN,TMX,YMN,YMX,0.,LCI,IOCODE)
  900 CONTINUE
      IF(KAIC.LT.1) GO TO 1000
      YMN=SAQUIC(1)
      YMX=0.
      DO 910 I=1,ITSMAX
      IF(SAQUIC(I).LT.YMN) YMN=SAQUIC(I)
      IF(SAQUIC(I).GT.YMX) YMX=SAQUIC(I)
  910 CONTINUE
      IF(YMN.EQ.YMX) GO TO 1000
      CALL PLOTI(ITSMAX,STIME,SAQUIC,ATSNO,AAIC,
     & TMN,TMX,YMN,YMX,0.,LCI,IOCODE)
 1000 CONTINUE
      IF(KCOP.LT.1) GO TO 1100
      YMX=SOCUMP(1)
      DO 1010 I=1,ITSMAX
      IF(SOCUMP(I).GT.YMX) YMX=SOCUMP(I)
 1010 CONTINUE
      YMN=0.
      IF(YMN.EQ.YMX) GO TO 1100
      CALL PLOTI(ITSMAX,STIME,SOCUMP,ATSNO,ACOP,
     & TMN,TMX,YMN,YMX,0.,LCI,IOCODE)
 1100 CONTINUE
      IF(KCGP.LT.1) GO TO 1200
      YMX=SGCUMP(1)
      DO 1110 I=1,ITSMAX
      IF(SGCUMP(I).GT.YMX) YMX=SGCUMP(I)
 1110 CONTINUE
      YMN=0.
      IF(YMN.EQ.YMX) GO TO 1200
      CALL PLOTI(ITSMAX,STIME,SGCUMP,ATSNO,ACGP,
     & TMN,TMX,YMN,YMX,0.,LCI,IOCODE)
 1200 CONTINUE
      IF(KCWP.LT.1) GO TO 1300
      YMX=SWCUMP(1)
      DO 1210 I=1,ITSMAX
      IF(SWCUMP(I).GT.YMX) YMX=SWCUMP(I)
 1210 CONTINUE
      YMN=0.
      IF(YMN.EQ.YMX) GO TO 1300
      CALL PLOTI(ITSMAX,STIME,SWCUMP,ATSNO,ACWP,
     & TMN,TMX,YMN,YMX,0.,LCI,IOCODE)
 1300 CONTINUE
      IF(KCGI.LT.1) GO TO 1400
      YMN=SGCUMI(1)
      DO 1310 I=1,ITSMAX
      IF(SGCUMI(I).LT.YMN) YMN=SGCUMI(I)
 1310 CONTINUE
      YMX=0.
      IF(YMN.EQ.YMX) GO TO 1400
      CALL PLOTI(ITSMAX,STIME,SGCUMI,ATSNO,ACGI,
     & TMN,TMX,YMN,YMX,0.,LCI,IOCODE)
 1400 IF(KCWI.LT.1) GO TO 1500
      YMN=SWCUMI(1)
      DO 1410 I=1,ITSMAX
      IF(SWCUMI(I).LT.YMN) YMN=SWCUMI(I)
 1410 CONTINUE
      YMX=0.
      IF(YMN.EQ.YMX) GO TO 1500
      CALL PLOTI(ITSMAX,STIME,SWCUMI,ATSNO,ACWI,
     & TMN,TMX,YMN,YMX,0.,LCI,IOCODE)
 1500 CONTINUE
      RETURN
      END
C.................................................................PRTPS
      SUBROUTINE PRTPS(NLOOP,II,JJ,KK,PAVG0,PAVG,CMBEO,CMBEW,CMBEG,
     &COP,CWP,CWI,CGP,CGI,MBEO,MBEW,MBEG,DELT0,
     &OPR,WPR,GPR,WIR,GIR,ETI,
     &CWOR,CGOR,WOR,GOR,IPMAP,ISOMAP,ISWMAP,ISGMAP,IPBMAP,IAQMAP)
C      MACHINE DEPENDENT INCLUDE STATEMENT
$INCLUDE:'PARAMS.FOR'
C      SUMMARY REPORT
      REAL MCFGI,MBEO,MBEW,MBEG,MCFG,MCFG1,MCFGT,KX,KY,KZ
      COMMON /BUBBLE/ PBO,VSLOPE(LP8),BSLOPE(LP8),RSLOPE(LP8),PMAXT,
     & IREPRS,MPGT(LP8),
     & RHOSCO(LP8),RHOSCW(LP8),RHOSCG(LP8),MSAT(LP7),MPOT(LP8),
     & MPWT(LP8),PBOT(LP1,LP2,LP3),PBOTN(LP1,LP2,LP3)
      COMMON /SAQUI/ IAQOPT,CPIAQ1(LP1,LP2,LP3),CPIAQ2(LP1,LP2,LP3),
     & CPI1(LP1,LP2,LP3),CPI2(LP1,LP2,LP3),EWAQ(LP1,LP2,LP3),
     & CUMAQW(LP1,LP2,LP3),
     & QWAQ(LP1,LP2,LP3),CUMEW(LP1,LP2,LP3),QWAQR(LP7),CUMAQR(LP7)
     & ,IAQREG(LP1,LP2,LP3),PAQ(LP1,LP2,LP3),PIAQ(LP1,LP2,LP3)
      COMMON /SARRAY/ PN(LP1,LP2,LP3),IOCODE,IDMAX,
     & SON(LP1,LP2,LP3),SWN(LP1,LP2,LP3),SGN(LP1,LP2,LP3),
     & A1(LP1,LP2,LP3),A2(LP1,LP2,LP3),A3(LP1,LP2,LP3),
     & SUM(LP1,LP2,LP3),GAM(LP1,LP2,LP3),QS(LP1,LP2,LP3)
      COMMON /SPARM/ KX(LP1,LP2,LP3),KY(LP1,LP2,LP3),KZ(LP1,LP2,LP3),
     & EL(LP1,LP2,LP3),TX(LP4,LP2,LP3),TY(LP1,LP5,LP3),TZ(LP1,LP2,LP6),
     & PDAT(LP1,LP2,LP3),PDATUM,GRAD
      COMMON /SPRTPS/ P(LP1,LP2,LP3),SO(LP1,LP2,LP3),SW(LP1,LP2,LP3),
     & SG(LP1,LP2,LP3)
      COMMON /SSOLN/ BO(LP1,LP2,LP3),BW(LP1,LP2,LP3),BG(LP1,LP2,LP3),
     & QO(LP1,LP2,LP3),QW(LP1,LP2,LP3),QG(LP1,LP2,LP3),
     & GOWT(LP1,LP2,LP3),GWWT(LP1,LP2,LP3),GGWT(LP1,LP2,LP3),
     & OW(LP4,LP2,LP3),OE(LP4,LP2,LP3),WW(LP4,LP2,LP3),WE(LP4,LP2,LP3),
     & OS(LP1,LP5,LP3),ON(LP1,LP5,LP3),WS(LP1,LP5,LP3),WN(LP1,LP5,LP3),
     & OT(LP1,LP2,LP6),OB(LP1,LP2,LP6),WT(LP1,LP2,LP6),WB(LP1,LP2,LP6),
     & QOWG(LP1,LP2,LP3),VP(LP1,LP2,LP3),CT(LP1,LP2,LP3)
      DIMENSION IHED(150)
      DO 15  I=1,100
   15 IHED(I)=I
      PPM=0.
      SOM=0.
      SWM=0.
      SGM=0.
      IF(NLOOP.EQ.1) GO TO 300
      DO 240 K=1,KK
      DO 240 J=1,JJ
      DO 240 I=1,II
      DPO=P(I,J,K)-PN(I,J,K)
      DSO=SO(I,J,K)-SON(I,J,K)
      DSW=SW(I,J,K)-SWN(I,J,K)
      DSG=SG(I,J,K)-SGN(I,J,K)
      IF(ABS(DPO).LE.ABS(PPM))GO TO 210
      PPM=DPO
      IPM=I
      JPM=J
      KPM=K
  210 IF(ABS(DSO).LE.ABS(SOM))GO TO 220
      SOM=DSO
      IOM=I
      JOM=J
      KOM=K
  220 IF(ABS(DSW).LE.ABS(SWM))GO TO 230
      SWM=DSW
      IWM=I
      JWM=J
      KWM=K
  230 IF(ABS(DSG).LE.ABS(SGM))GO TO 240
      SGM=DSG
      IGM=I
      JGM=J
      KGM=K
  240 CONTINUE
      WRITE(IOCODE,5)
      WRITE(IOCODE,105)
      WRITE(IOCODE,6)
      NLM=NLOOP-1
      GORM=1000.*GOR
      WRITE(IOCODE,110)ETI,NLM,DELT0,PAVG,PAVG0,IPM,JPM,KPM,PPM,
     & IOM,JOM,KOM,SOM,IGM,JGM,KGM,SGM,IWM,JWM,KWM,SWM,
     & MBEO,MBEG,MBEW,CMBEO,CMBEG,CMBEW,OPR,COP,GPR,CGP,WPR
        WRITE(IOCODE,1109)CWP,GIR,CGI,WIR,CWI,WOR,CWOR,GORM,CGOR
  110 FORMAT(/,1X,'ELAPSED TIME (DAYS)         =',F9.2,3X,
     & 'TIME STEP NUMBER             =',I5,6X,
     & 'TIME STEP SIZE (DAYS)         =',F9.2,//,1X,
     & 'CURRENT AVG RES PRESSURE    =',F9.1,3X,
     & 'PREVIOUS AVG RES PRESSURE    =',F9.1,2X,
     & 'PRESSURE DPMAX(',I3,',',I3,',',I3,')   =',F9.1,/,1X,
     & 'OIL DSMAX(',I3,',',I3,',',I3,')      =',F9.5,3X,
     & 'GAS DSMAX(',I3,',',I3,',',I3,')       =',F9.5,2X,
     & 'WATER DSMAX(',I3,',',I3,',',I3,')      =',F9.5,/,1X,
     & 'OIL MATERIAL BALANCE (%)    =',F9.6,3X,
     & 'GAS MATERIAL BALANCE (%)     =',F9.6,2X,
     & 'WATER MATERIAL BALANCE (%)    =',F9.6,/,1X,
     & 'CUM. OIL MATERIAL BALANCE(%)=',F9.6,3X,
     & 'CUM. GAS MATERIAL BALANCE(%) =',F9.6,2X,
     & 'CUM. WATER MATERIAL BALANCE(%)=',F9.6,//,1X,
     & 'OIL PRODUCTION RATE (STB/D) =',F9.1,3X,
     & 'CUM. OIL PRODUCTION (STB)    =',E10.4,/,1X,
     & 'GAS PRODUCTION RATE (MSCF/D)=',F9.1,3X,
     & 'CUM. GAS PRODUCTION (MSCF)   =',E10.4,/,1X,
     & 'WATER PRODUCTION RATE(STB/D)=',F9.1)
 1109 FORMAT(1X,T42,'CUM. WATER PRODUCTION (STB)  =',E10.4,//,1X,
     & 'GAS INJECTION RATE (MSCF/D) =',F9.1,3X,
     & 'CUM. GAS INJECTION (MSCF)    =',E10.4,/,1X,
     & 'WATER INJECTION RATE (STB/D)=',F9.1,3X,
     & 'CUM. WATER INJECTION (STB)   =',E10.4,//,1X,
     & 'PRODUCING WOR (STB/STB)     =',F9.3,3X,
     & 'CUM. WOR (STB/STB)           =',F9.3,/,1X,
     & 'PRODUCING GOR (SCF/STB)     =',F9.1,3X,
     & 'CUM. GOR (SCF/STB)           =',F9.1,//)
C      AQUIFER PRINT
      CALL AQPRNT
  300 WRITE(IOCODE,302)
  302 FORMAT(1H1)
      IF(NLOOP.EQ.1) WRITE(IOCODE,304)
  304 FORMAT(/,T15,7('*'),' INITIAL ARRAYS ',7('*')//)
      IF(IPMAP.EQ.0.AND.NLOOP.NE.1)GO TO 315
C      PRESSURE ARRAY
      WRITE(IOCODE,61)
      ICNT=0
      INTRVL=15
      ICHOP=II/INTRVL
      IEXTRA=II-(ICHOP*INTRVL)
      IR2=0
  308 ICNT=ICNT+1
      IR1=IR2+1
      IR2=INTRVL+IR2
      IF(IR2.GT.ICHOP*INTRVL) IR2=II
      DO 310 K=1,KK
      WRITE(IOCODE,51) K,(IHED(IT),IT=IR1,IR2)
      WRITE(IOCODE,53)
      DO 310 J=1,JJ
      WRITE(IOCODE,41) J, (P(I,J,K),I=IR1,IR2)
310   CONTINUE
      IF(ICNT.LE.ICHOP.AND.IR2.LT.II) GO TO 308
      IF(GRAD.LE.0.0) GO TO 311
      DO 312 K=1,KK
      DO 312 J=1,JJ
      DO 312 I=1,II
      IF(VP(I,J,K).LE.0.0) GO TO 312
      PDAT(I,J,K)=P(I,J,K)+(PDATUM-EL(I,J,K))*GRAD
312   CONTINUE
      WRITE(IOCODE,62) PDATUM
      ICNT=0
      INTRVL=15
      ICHOP=II/INTRVL
      IEXTRA=II-(ICHOP*INTRVL)
      IR2=0
  313 ICNT=ICNT+1
      IR1=IR2+1
      IR2=INTRVL+IR2
      IF(IR2.GT.ICHOP*INTRVL) IR2=II
      DO 314 K=1,KK
      WRITE(IOCODE,51) K,(IHED(IT),IT=IR1,IR2)
      WRITE(IOCODE,53)
      DO 314 J=1,JJ
      WRITE(IOCODE,41) J, (PDAT(I,J,K),I=IR1,IR2)
314   CONTINUE
      IF(ICNT.LE.ICHOP.AND.IR2.LT.II) GO TO 313
  311 IF(IPMAP.EQ.1.OR.NLOOP.EQ.1) GO TO 315
      CALL PLOT(P,II,JJ,KK,IOCODE,1)
  315 IF(ISOMAP.EQ.0.AND.NLOOP.NE.1)GO TO 422
C      OIL SAT ARRAY
      WRITE(IOCODE,71)
      ICNT=0
      INTRVL=15
      ICHOP=II/INTRVL
      IEXTRA=II-(ICHOP*INTRVL)
      IR2=0
  418 ICNT=ICNT+1
      IR1=IR2+1
      IR2=INTRVL+IR2
      IF(IR2.GT.ICHOP*INTRVL) IR2=II
      DO 420 K=1,KK
      WRITE(IOCODE,51) K,(IHED(IT),IT=IR1,IR2)
      WRITE(IOCODE,53)
      DO 420 J=1,JJ
      WRITE(IOCODE,101) J,(SO(I,J,K),I=IR1,IR2)
420   CONTINUE
      IF(ICNT.LE.ICHOP.AND.IR2.LT.II) GO TO 418
      IF(ISOMAP.EQ.1.OR.NLOOP.EQ.1) GO TO 422
      CALL PLOT(SO,II,JJ,KK,IOCODE,2)
  422 IF(ISWMAP.EQ.0.AND.NLOOP.NE.1)GO TO 432
C      WATER SAT ARRAY
      WRITE(IOCODE,81)
      ICNT=0
      INTRVL=15
      ICHOP=II/INTRVL
      IEXTRA=II-(ICHOP*INTRVL)
      IR2=0
  428 ICNT=ICNT+1
      IR1=IR2+1
      IR2=INTRVL+IR2
      IF(IR2.GT.ICHOP*INTRVL) IR2=II
      DO 430 K=1,KK
      WRITE(IOCODE,51) K,(IHED(IT),IT=IR1,IR2)
      WRITE(IOCODE,53)
      DO 430 J=1,JJ
      WRITE(IOCODE,101) J,(SW(I,J,K),I=IR1,IR2)
430   CONTINUE
      IF(ICNT.LE.ICHOP.AND.IR2.LT.II) GO TO 428
      IF(ISWMAP.EQ.1.OR.NLOOP.EQ.1) GO TO 432
      CALL PLOT(SW,II,JJ,KK,IOCODE,3)
  432 IF(ISGMAP.EQ.0.AND.NLOOP.NE.1)GO TO 442
C      GAS SAT ARRAY
      WRITE(IOCODE,91)
      ICNT=0
      INTRVL=15
      ICHOP=II/INTRVL
      IEXTRA=II-(ICHOP*INTRVL)
      IR2=0
  438 ICNT=ICNT+1
      IR1=IR2+1
      IR2=INTRVL+IR2
      IF(IR2.GT.ICHOP*INTRVL) IR2=II
      DO 440 K=1,KK
      WRITE(IOCODE,51) K,(IHED(IT),IT=IR1,IR2)
      WRITE(IOCODE,53)
      DO 440 J=1,JJ
      WRITE(IOCODE,101) J,(SG(I,J,K),I=IR1,IR2)
  440 CONTINUE
      IF(ICNT.LE.ICHOP.AND.IR2.LT.II) GO TO 438
      IF(ISGMAP.EQ.1.OR.NLOOP.EQ.1) GO TO 442
      CALL PLOT(SG,II,JJ,KK,IOCODE,4)
  442 IF(IPBMAP.EQ.0.AND.NLOOP.NE.1)GO TO 452
C      BUBBLE POINT PRESSURE ARRAY
      WRITE(IOCODE,102)
  102 FORMAT(///,T15,'***** BUBBLE POINT PRESSURE DISTRIBUTION *****'/)
      ICNT=0
      INTRVL=15
      ICHOP=II/INTRVL
      IEXTRA=II-(ICHOP*INTRVL)
      IR2=0
  448 ICNT=ICNT+1
      IR1=IR2+1
      IR2=INTRVL+IR2
      IF(IR2.GT.ICHOP*INTRVL) IR2=II
      DO 450 K=1,KK
      WRITE(IOCODE,51) K,(IHED(IT),IT=IR1,IR2)
      WRITE(IOCODE,53)
      DO 450 J=1,JJ
      WRITE(IOCODE,41) J,(PBOT(I,J,K),I=IR1,IR2)
  450 CONTINUE
      IF(ICNT.LE.ICHOP.AND.IR2.LT.II) GO TO 448
      IF(IPBMAP.EQ.1.OR.NLOOP.EQ.1) GO TO 452
      CALL PLOT(PBOT,II,JJ,KK,IOCODE,5)
  452 IF(IAQOPT.LE.0) GO TO 462
      IF(IAQMAP.EQ.0.AND.NLOOP.NE.1) GO TO 462
C      CUM AQ INFLUX ARRAY
      WRITE(IOCODE,104)
  104 FORMAT(///,T15,'***** CUM. AQ INFLUX (STB) DISTRIBUTION *****',/)
      ICNT=0
      INTRVL=10
      ICHOP=II/INTRVL
      IEXTRA=II-(ICHOP*INTRVL)
      IR2=0
  458 ICNT=ICNT+1
      IR1=IR2+1
      IR2=INTRVL+IR2
      IF(IR2.GT.ICHOP*INTRVL) IR2=II
      DO 460 K=1,KK
      WRITE(IOCODE,52) K,(IHED(IT),IT=IR1,IR2)
      WRITE(IOCODE,53)
      DO 460 J=1,JJ
      WRITE(IOCODE,42) J,(CUMAQW(I,J,K),I=IR1,IR2)
   42 FORMAT(1X,I3,1X,10E10.4)
  460 CONTINUE
      IF(ICNT.LE.ICHOP.AND.IR2.LT.II) GO TO 458
      IF(IAQMAP.EQ.1.OR.NLOOP.EQ.1) GO TO 462
      CALL PLOT(CUMAQW,II,JJ,KK,IOCODE,6)
  462 IF(NLOOP.NE.1)WRITE(IOCODE,7)
      IF(NLOOP.EQ.1) WRITE(IOCODE,8)
5     FORMAT(//T30,69('*'),/T30,'*',T98,'*'/T30,'*',T98,'*')
6     FORMAT(T30,'*',T98,'*'/T30,'*',T98,'*'/T30,69('*'),///)
7     FORMAT(///T4,49('*'),'  END OF SUMMARY REPORT  ',49('*'),6(/))
8     FORMAT(///T4,49('*'),'  END OF INITIALIZATION  ',49('*'),6(/))
105   FORMAT(T30,'*',T45,'SUMMARY REPORT: BOAST II (RELEASE 1.1)  '
     &,T98,'*')
41    FORMAT(1X,I3,1X,15F8.0)
51    FORMAT(/1X,'K =',I2/,5X,15(2X,I4,2X))
52    FORMAT(/1X,'K =',I2/,5X,10(4X,I4,2X))
53     FORMAT(/)
61    FORMAT(///,T15,'***** RESERVOIR PRESSURE DISTRIBUTION *****'/)
62    FORMAT(///,T15,'****** RESERVOIR PRESSURE DISTRIBUTION ******'/,
     & T15,'(CORRECTED TO REFERENCE DEPTH OF ',F6.0,' FEET)'/)
71    FORMAT(///,T15,'*********  OIL SATURATION  *********'/)
81    FORMAT(///,T15,'******** WATER SATURATION *********'/)
91    FORMAT(///,T15,'*********  GAS SATURATION  *********'/)
101   FORMAT(1X,I3,1X,15F8.3)
      RETURN
      END
