home *** CD-ROM | disk | FTP | other *** search
/ Hall of Fame / HallofFameCDROM.cdr / oilfield / spe-46-2.lzh / BLOCK8.FOR < prev    next >
Text File  |  1988-06-21  |  24KB  |  585 lines
  1. $DO66
  2. C................................................................SOLTWO
  3.       SUBROUTINE SOLTWO(II,JJ,KK,DIV1,D288,
  4.      &KSM,KSM1,N,NN,KCOFF)
  5. C      MACHINE DEPENDENT INCLUDE STATEMENT
  6. $INCLUDE:'PARAMS.FOR'
  7. C      FLOW EQ COEF WITH TWO POINT UPSTREAM REL PERMS
  8.       REAL KROT,KROGT,KRWT,KRGT,MUOT,MUWT,MUGT,KX,KY,KZ
  9.       REAL MUO4,MUW4,MUG4,MUO5,MUW5,MUG5,MUO6,MUW6,MUG6
  10.      &,KRO1,KRW1,KRG1,KRO2,KRW2,KRG2,KRO3,KRW3,KRG3
  11.      &,MUO1,MUW1,MUG1,MUO2,MUW2,MUG2,MUO3,MUW3,MUG3
  12.      &,KRO4,KRW4,KRG4,KRO5,KRW5,KRG5,KRO6,KRW6,KRG6
  13.      &,MO1,MW1,MG1,MO2,MW2,MG2,MO3,MW3,MG3
  14.      &,MO4,MW4,MG4,MO5,MW5,MG5,MO6,MW6,MG6
  15.      &,MUO,MUW,MUG
  16.       COMMON /BUBBLE/ PBO,VSLOPE(LP8),BSLOPE(LP8),RSLOPE(LP8),PMAXT,
  17.      & IREPRS,MPGT(LP8),
  18.      & RHOSCO(LP8),RHOSCW(LP8),RHOSCG(LP8),MSAT(LP7),MPOT(LP8),
  19.      & MPWT(LP8),PBOT(LP1,LP2,LP3),PBOTN(LP1,LP2,LP3)
  20.       COMMON /COEF/ AW(LP1,LP2,LP3),AE(LP1,LP2,LP3),AN(LP1,LP2,LP3),
  21.      & AS(LP1,LP2,LP3),AB(LP1,LP2,LP3),AT(LP1,LP2,LP3),E(LP1,LP2,LP3),
  22.      & B(LP1,LP2,LP3)
  23.       COMMON /SARRAY/ PN(LP1,LP2,LP3),IOCODE,IDMAX,
  24.      & SON(LP1,LP2,LP3),SWN(LP1,LP2,LP3),SGN(LP1,LP2,LP3),
  25.      & A1(LP1,LP2,LP3),A2(LP1,LP2,LP3),A3(LP1,LP2,LP3),
  26.      & SUM(LP1,LP2,LP3),GAM(LP1,LP2,LP3),QS(LP1,LP2,LP3)
  27.       COMMON /SPARM/ KX(LP1,LP2,LP3),KY(LP1,LP2,LP3),KZ(LP1,LP2,LP3),
  28.      & EL(LP1,LP2,LP3),TX(LP4,LP2,LP3),TY(LP1,LP5,LP3),TZ(LP1,LP2,LP6),
  29.      & PDAT(LP1,LP2,LP3),PDATUM,GRAD
  30.       COMMON /SPRTPS/ P(LP1,LP2,LP3),SO(LP1,LP2,LP3),SW(LP1,LP2,LP3),
  31.      & SG(LP1,LP2,LP3)
  32.       COMMON /SPVT/ SAT(LP7,LP9),KROT(LP7,LP9),KRWT(LP7,LP9),
  33.      & BGT(LP7,LP9),
  34.      & KRGT(LP7,LP9),ITHREE(LP7),RSOT(LP7,LP9),BWPT(LP7,LP9),
  35.      & PCOWT(LP7,LP9),PCGOT(LP7,LP9),KROGT(LP7,LP9),SWR(LP7),
  36.      & POT(LP7,LP9),MUOT(LP7,LP9),BOT(LP7,LP9),BOPT(LP7,LP9),
  37.      & RSOPT(LP7,LP9),PWT(LP7,LP9),MUWT(LP7,LP9),BWT(LP7,LP9),
  38.      & RSWT(LP7,LP9),RSWPT(LP7,LP9),PGT(LP7,LP9),MUGT(LP7,LP9),
  39.      & BGPT(LP7,LP9),CRT(LP7,LP9),IPVT(LP1,LP2,LP3),IROCK(LP1,LP2,LP3),
  40.      & NROCK,NPVT,PSIT(LP7,LP9),PRT(LP7,LP9),WOROCK(LP7),GOROCK(LP7)
  41.       COMMON /SSOLN/ BO(LP1,LP2,LP3),BW(LP1,LP2,LP3),BG(LP1,LP2,LP3),
  42.      & QO(LP1,LP2,LP3),QW(LP1,LP2,LP3),QG(LP1,LP2,LP3),
  43.      & GOWT(LP1,LP2,LP3),GWWT(LP1,LP2,LP3),GGWT(LP1,LP2,LP3),
  44.      & OW(LP4,LP2,LP3),OE(LP4,LP2,LP3),WW(LP4,LP2,LP3),WE(LP4,LP2,LP3),
  45.      & OS(LP1,LP5,LP3),ON(LP1,LP5,LP3),WS(LP1,LP5,LP3),WN(LP1,LP5,LP3),
  46.      & OT(LP1,LP2,LP6),OB(LP1,LP2,LP6),WT(LP1,LP2,LP6),WB(LP1,LP2,LP6),
  47.      & QOWG(LP1,LP2,LP3),VP(LP1,LP2,LP3),CT(LP1,LP2,LP3)
  48.       COMMON /VECTOR/ DX(LP1,LP2,LP3),DY(LP1,LP2,LP3),DZ(LP1,LP2,LP3),
  49.      & DZNET(LP1,LP2,LP3),IQN1(LP11),IQN2(LP11),IQN3(LP11),IHEDIN(80)
  50.       DIMENSION RPW(LP1,LP2,LP3),RPG(LP1,LP2,LP3),RPOW(LP1,LP2,LP3),
  51.      & RPO3(LP1,LP2,LP3),CAPOW(LP1,LP2,LP3),CAPGO(LP1,LP2,LP3)
  52.       EQUIVALENCE (RPW,DX), (RPG,DY), (RPOW,DZ), (RPO3,KX),
  53.      & (CAPOW,KY), (CAPGO,KZ)
  54.       DATA RSO1,RSO2,RSO3,RSO4,RSO5,RSO6/6*0.0/
  55.       DATA RSW1,RSW2,RSW3,RSW4,RSW5,RSW6/6*0.0/
  56.       DO 2000 K=1,KK
  57.       DO 2000 J=1,JJ
  58.       DO 2000 I=1,II
  59.       RPW(I,J,K)=0.
  60.       RPG(I,J,K)=0.
  61.       RPOW(I,J,K)=0.
  62.       RPO3(I,J,K)=0.
  63.       CAPOW(I,J,K)=0.
  64.       CAPGO(I,J,K)=0.
  65.       IF(VP(I,J,K).LE.0.0) GO TO 2000
  66.       SSO=SO(I,J,K)
  67.       SSW=SW(I,J,K)
  68.       SSG=SG(I,J,K)
  69.       IROCKB=IROCK(I,J,K)
  70.       CALL INTERP(IROCKB,SAT,KROT,MSAT(IROCKB),SSO,KRO1)
  71.       RPOW(I,J,K)=KRO1
  72.       CALL INTERP(IROCKB,SAT,KRWT,MSAT(IROCKB),SSW,KRW1)
  73.       RPW(I,J,K)=KRW1
  74.       CALL INTERP(IROCKB,SAT,KRGT,MSAT(IROCKB),SSG,KRG1)
  75.       RPG(I,J,K)=KRG1
  76.       CALL TRIKRO(IROCKB,SSO,SSW,KRO3)
  77.       RPO3(I,J,K)=KRO3
  78.       CALL INTERP(IROCKB,SAT,PCOWT,MSAT(IROCKB),SSW,PCOW)
  79.       CAPOW(I,J,K)=PCOW
  80.       CALL INTERP(IROCKB,SAT,PCGOT,MSAT(IROCKB),SSG,PCGO)
  81.       CAPGO(I,J,K)=PCGO
  82.  2000 CONTINUE
  83.       DO 200 K=1,KK
  84.       DO 200 J=1,JJ
  85.       DO 200 I=1,II
  86.       IF(VP(I,J,K).LE.0.0) GO TO 200
  87. C      I,J,K BLOCK
  88.       PP=P(I,J,K)
  89.       BPT=PBOT(I,J,K)
  90.       IPVTR=IPVT(I,J,K)
  91.       CALL INTPVT(IPVTR,BPT,RSLOPE(IPVTR),POT,RSOT,MPOT(IPVTR),PP,RSO)
  92.       CALL INTPVT(IPVTR,BPT,VSLOPE(IPVTR),POT,MUOT,MPOT(IPVTR),PP,MUO)
  93.       CALL INTERP(IPVTR,PWT,RSWT,MPWT(IPVTR),PP,RSW)
  94.       CALL INTERP(IPVTR,PWT,MUWT,MPWT(IPVTR),PP,MUW)
  95.       CALL INTERP(IPVTR,PGT,MUGT,MPGT(IPVTR),PP,MUG)
  96.       SSO=SO(I,J,K)
  97.       SSW=SW(I,J,K)
  98.       SSG=SG(I,J,K)
  99.       IROCKB=IROCK(I,J,K)
  100.       PCOW=CAPOW(I,J,K)
  101.       PCGO=CAPGO(I,J,K)
  102.       RO=(RHOSCO(IPVTR) + RSO*RHOSCG(IPVTR))/BO(I,J,K)
  103.       RW=(RHOSCW(IPVTR) + RSW*RHOSCG(IPVTR))/BW(I,J,K)
  104.       RG=RHOSCG(IPVTR)/BG(I,J,K)
  105.       IF(I.EQ.1)GO TO 115
  106.       IF(VP(I-1,J,K).LE.0.0) GO TO 115
  107. C      I-1,J,K BLOCK
  108.       P1=P(I-1,J,K)
  109.       BPT=PBOT(I-1,J,K)
  110.       IPVTR=IPVT(I-1,J,K)
  111.       CALL INTPVT(IPVTR,BPT,RSLOPE(IPVTR),POT,RSOT,MPOT(IPVTR),P1,RSO1)
  112.       CALL INTPVT(IPVTR,BPT,VSLOPE(IPVTR),POT,MUOT,MPOT(IPVTR),P1,MUO1)
  113.       CALL INTERP(IPVTR,PWT,RSWT,MPWT(IPVTR),P1,RSW1)
  114.       CALL INTERP(IPVTR,PWT,MUWT,MPWT(IPVTR),P1,MUW1)
  115.       CALL INTERP(IPVTR,PGT,MUGT,MPGT(IPVTR),P1,MUG1)
  116.       SO1S=SO(I-1,J,K)
  117.       SW1S=SW(I-1,J,K)
  118.       SG1S=SG(I-1,J,K)
  119.       IROCKR=IROCK(I-1,J,K)
  120.       PCOW1=CAPOW(I-1,J,K)
  121.       PCGO1=CAPGO(I-1,J,K)
  122.       RO1=(RHOSCO(IPVTR) + RSO1*RHOSCG(IPVTR))/BO(I-1,J,K)
  123.       RW1=(RHOSCW(IPVTR) + RSW1*RHOSCG(IPVTR))/BW(I-1,J,K)
  124.       RG1=RHOSCG(IPVTR)/BG(I-1,J,K)
  125.       FACT=-D288*(EL(I-1,J,K)-EL(I,J,K))
  126.       GOW1=(RO1+RO)*FACT
  127.       GWW1=(RW1+RW)*FACT + PCOW-PCOW1
  128.       GGW1=(RG1+RG)*FACT + PCGO1-PCGO
  129.       P11=P1-PP
  130.       HO1=P11+GOW1
  131.       HW1=P11+GWW1
  132.       HG1=P11+GGW1
  133.       IMM=I-2
  134.       IF(IMM.LT.1) IMM=1
  135.       IP=I+1
  136.       IF(IP.GT.II) IP=II
  137.       IF(ITHREE(IROCKB).EQ.1) GO TO 10
  138.       KRO1=RPOW(I,J,K)+0.5*(RPOW(I,J,K)-RPOW(IP,J,K))
  139.       IF(KRO1.GT.RPOW(I,J,K)) KRO1=RPOW(I,J,K)
  140.       IF(HO1.GE.0.) KRO1=RPOW(I-1,J,K)+0.5*(RPOW(I-1,J,K)-RPOW(IMM,J,K))
  141.       IF(HO1.GE.0.AND.KRO1.GT.RPOW(I-1,J,K)) KRO1=RPOW(I-1,J,K)
  142.       GO TO 15
  143.    10 KRO1=RPO3(I,J,K)+0.5*(RPO3(I,J,K)-RPO3(IP,J,K))
  144.       IF(KRO1.GT.RPO3(I,J,K)) KRO1=RPO3(I,J,K)
  145.       IF(HO1.GE.0.) KRO1=RPO3(I-1,J,K)+0.5*(RPO3(I-1,J,K)-RPO3(IMM,J,K))
  146.       IF(HO1.GE.0.AND.KRO1.GT.RPO3(I-1,J,K)) KRO1=RPO3(I-1,J,K)
  147.    15 CONTINUE
  148.       KRW1=RPW(I,J,K)+0.5*(RPW(I,J,K)-RPW(IP,J,K))
  149.       IF(KRW1.GT.RPW(I,J,K)) KRW1=RPW(I,J,K)
  150.       IF(HW1.GE.0.) KRW1=RPW(I-1,J,K)+0.5*(RPW(I-1,J,K)-RPW(IMM,J,K))
  151.       IF(HW1.GE.0.AND.KRW1.GT.RPW(I-1,J,K)) KRW1=RPW(I-1,J,K)
  152.       KRG1=RPG(I,J,K)+0.5*(RPG(I,J,K)-RPG(IP,J,K))
  153.       IF(KRG1.GT.RPG(I,J,K)) KRG1=RPG(I,J,K)
  154.       IF(HG1.GE.0.) KRG1=RPG(I-1,J,K)+0.5*(RPG(I-1,J,K)-RPG(IMM,J,K))
  155.       IF(HG1.GE.0.AND.KRG1.GT.RPG(I-1,J,K)) KRG1=RPG(I-1,J,K)
  156. C      2-POINT REL PERM MUST BE POSITIVE
  157.       IF(KRO1.LT.0.) KRO1=0.
  158.       IF(KRW1.LT.0.) KRW1=0.
  159.       IF(KRG1.LT.0.) KRG1=0.
  160.       MO1=4.0*KRO1/((BO(I-1,J,K)+BO(I,J,K)) * (MUO1+MUO))
  161.       MW1=4.0*KRW1/((BW(I-1,J,K)+BW(I,J,K)) * (MUW1+MUW))
  162.       MG1=4.0*KRG1/((BG(I-1,J,K)+BG(I,J,K)) * (MUG1+MUG))
  163. 115   AOW=TX(I,J,K)*MO1
  164.       AWW=TX(I,J,K)*MW1
  165.       AGW=TX(I,J,K)*MG1
  166.       IF(I.EQ.II)GO TO 125
  167.       IF(VP(I+1,J,K).LE.0.0) GO TO 125
  168. C      I+1,J,K BLOCK
  169.       P2=P(I+1,J,K)
  170.       BPT=PBOT(I+1,J,K)
  171.       IPVTR=IPVT(I+1,J,K)
  172.       CALL INTPVT(IPVTR,BPT,RSLOPE(IPVTR),POT,RSOT,MPOT(IPVTR),P2,RSO2)
  173.       CALL INTPVT(IPVTR,BPT,VSLOPE(IPVTR),POT,MUOT,MPOT(IPVTR),P2,MUO2)
  174.       CALL INTERP(IPVTR,PWT,RSWT,MPWT(IPVTR),P2,RSW2)
  175.       CALL INTERP(IPVTR,PWT,MUWT,MPWT(IPVTR),P2,MUW2)
  176.       CALL INTERP(IPVTR,PGT,MUGT,MPGT(IPVTR),P2,MUG2)
  177.       SO2=SO(I+1,J,K)
  178.       SW2=SW(I+1,J,K)
  179.       SG2=SG(I+1,J,K)
  180.       IROCKR=IROCK(I+1,J,K)
  181.       PCOW2=CAPOW(I+1,J,K)
  182.       PCGO2=CAPGO(I+1,J,K)
  183.       RO2=(RHOSCO(IPVTR) + RSO2*RHOSCG(IPVTR))/BO(I+1,J,K)
  184.       RW2=(RHOSCW(IPVTR) + RSW2*RHOSCG(IPVTR))/BW(I+1,J,K)
  185.       RG2=RHOSCG(IPVTR)/BG(I+1,J,K)
  186.       FACT=-D288*(EL(I+1,J,K)-EL(I,J,K))
  187.       GOW2=(RO2+RO)*FACT
  188.       GWW2=(RW2+RW)*FACT + PCOW-PCOW2
  189.       GGW2=(RG2+RG)*FACT + PCGO2-PCGO
  190.       P22=P2-PP
  191.       HO2=P22+GOW2
  192.       HW2=P22+GWW2
  193.       HG2=P22+GGW2
  194.       IPP=I+2
  195.       IF(IPP.GT.II) IPP=II
  196.       IM=I-1
  197.       IF(IM.LT.1) IM=1
  198.       IF(ITHREE(IROCKB).EQ.1) GO TO 20
  199.       KRO2=RPOW(I,J,K)+0.5*(RPOW(I,J,K)-RPOW(IM,J,K))
  200.       IF(KRO2.GT.RPOW(I,J,K)) KRO2=RPOW(I,J,K)
  201.       IF(HO2.GE.0.) KRO2=RPOW(I+1,J,K)+0.5*(RPOW(I+1,J,K)-RPOW(IPP,J,K))
  202.       IF(HO2.GE.0.AND.KRO2.GT.RPOW(I+1,J,K)) KRO2=RPOW(I+1,J,K)
  203.       GO TO 25
  204.    20 KRO2=RPO3(I,J,K)+0.5*(RPO3(I,J,K)-RPO3(IM,J,K))
  205.       IF(KRO2.GT.RPO3(I,J,K)) KRO2=RPO3(I,J,K)
  206.       IF(HO2.GE.0.) KRO2=RPO3(I+1,J,K)+0.5*(RPO3(I+1,J,K)-RPO3(IPP,J,K))
  207.       IF(HO2.GE.0.AND.KRO2.GT.RPO3(I+1,J,K)) KRO2=RPO3(I+1,J,K)
  208.    25 CONTINUE
  209.       KRW2=RPW(I,J,K)+0.5*(RPW(I,J,K)-RPW(IM,J,K))
  210.       IF(KRW2.GT.RPW(I,J,K)) KRW2=RPW(I,J,K)
  211.       IF(HW2.GE.0.) KRW2=RPW(I+1,J,K)+0.5*(RPW(I+1,J,K)-RPW(IPP,J,K))
  212.       IF(HW2.GE.0.AND.KRW2.GT.RPW(I+1,J,K)) KRW2=RPW(I+1,J,K)
  213.       KRG2=RPG(I,J,K)+0.5*(RPG(I,J,K)-RPG(IM,J,K))
  214.       IF(KRG2.GT.RPG(I,J,K)) KRG2=RPG(I,J,K)
  215.       IF(HG2.GE.0.) KRG2=RPG(I+1,J,K)+0.5*(RPG(I+1,J,K)-RPG(IPP,J,K))
  216.       IF(HG2.GE.0.AND.KRG2.GT.RPG(I+1,J,K)) KRG2=RPG(I+1,J,K)
  217. C      2-POINT REL PERM MUST BE POSITIVE
  218.       IF(KRO2.LT.0.) KRO2=0.
  219.       IF(KRW2.LT.0.) KRW2=0.
  220.       IF(KRG2.LT.0.) KRG2=0.
  221.       MO2=4.0*KRO2/((BO(I+1,J,K)+BO(I,J,K)) * (MUO2+MUO))
  222.       MW2=4.0*KRW2/((BW(I+1,J,K)+BW(I,J,K)) * (MUW2+MUW))
  223.       MG2=4.0*KRG2/((BG(I+1,J,K)+BG(I,J,K)) * (MUG2+MUG))
  224. 125   AOE=TX(I+1,J,K)*MO2
  225.       AWE=TX(I+1,J,K)*MW2
  226.       AGE=TX(I+1,J,K)*MG2
  227.       IF(J.EQ.1)GO TO 135
  228.       IF(VP(I,J-1,K).LE.0.0) GO TO 135
  229. C      I,J-1,K BLOCK
  230.       P3=P(I,J-1,K)
  231.       BPT=PBOT(I,J-1,K)
  232.       IPVTR=IPVT(I,J-1,K)
  233.       CALL INTPVT(IPVTR,BPT,RSLOPE(IPVTR),POT,RSOT,MPOT(IPVTR),P3,RSO3)
  234.       CALL INTPVT(IPVTR,BPT,VSLOPE(IPVTR),POT,MUOT,MPOT(IPVTR),P3,MUO3)
  235.       CALL INTERP(IPVTR,PWT,RSWT,MPWT(IPVTR),P3,RSW3)
  236.       CALL INTERP(IPVTR,PWT,MUWT,MPWT(IPVTR),P3,MUW3)
  237.       CALL INTERP(IPVTR,PGT,MUGT,MPGT(IPVTR),P3,MUG3)
  238.       SO3=SO(I,J-1,K)
  239.       SW3=SW(I,J-1,K)
  240.       SG3=SG(I,J-1,K)
  241.       IROCKR=IROCK(I,J-1,K)
  242.       PCOW3=CAPOW(I,J-1,K)
  243.       PCGO3=CAPGO(I,J-1,K)
  244.       RO3=(RHOSCO(IPVTR) + RSO3*RHOSCG(IPVTR))/BO(I,J-1,K)
  245.       RW3=(RHOSCW(IPVTR) + RSW3*RHOSCG(IPVTR))/BW(I,J-1,K)
  246.       RG3=RHOSCG(IPVTR)/BG(I,J-1,K)
  247.       FACT=-D288*(EL(I,J-1,K)-EL(I,J,K))
  248.       GOW3=(RO3+RO)*FACT
  249.       GWW3=(RW3+RW)*FACT + PCOW-PCOW3
  250.       GGW3=(RG3+RG)*FACT + PCGO3-PCGO
  251.       P33=P3-PP
  252.       HO3=P33+GOW3
  253.       HW3=P33+GWW3
  254.       HG3=P33+GGW3
  255.       JMM=J-2
  256.       IF(JMM.LT.1) JMM=1
  257.       JP=J+1
  258.       IF(JP.GT.JJ) JP=JJ
  259.       IF(ITHREE(IROCKB).EQ.1) GO TO 30
  260.       KRO3=RPOW(I,J,K)+0.5*(RPOW(I,J,K)-RPOW(I,JP,K))
  261.       IF(KRO3.GT.RPOW(I,J,K)) KRO3=RPOW(I,J,K)
  262.       IF(HO3.GE.0.) KRO3=RPOW(I,J-1,K)+0.5*(RPOW(I,J-1,K)-RPOW(I,JMM,K))
  263.       IF(HO3.GE.0.AND.KRO3.GT.RPOW(I,J-1,K)) KRO3=RPOW(I,J-1,K)
  264.       GO TO 35
  265.    30 KRO3=RPO3(I,J,K)+0.5*(RPO3(I,J,K)-RPO3(I,JP,K))
  266.       IF(KRO3.GT.RPO3(I,J,K)) KRO3=RPO3(I,J,K)
  267.       IF(HO3.GE.0.) KRO3=RPO3(I,J-1,K)+0.5*(RPO3(I,J-1,K)-RPO3(I,JMM,K))
  268.       IF(HO3.GE.0.AND.KRO3.GT.RPO3(I,J-1,K)) KRO3=RPO3(I,J-1,K)
  269.    35 CONTINUE
  270.       KRW3=RPW(I,J,K)+0.5*(RPW(I,J,K)-RPW(I,JP,K))
  271.       IF(KRW3.GT.RPW(I,J,K)) KRW3=RPW(I,J,K)
  272.       IF(HW3.GE.0.) KRW3=RPW(I,J-1,K)+0.5*(RPW(I,J-1,K)-RPW(I,JMM,K))
  273.       IF(HW3.GE.0.AND.KRW3.GT.RPW(I,J-1,K)) KRW3=RPW(I,J-1,K)
  274.       KRG3=RPG(I,J,K)+0.5*(RPG(I,J,K)-RPG(I,JP,K))
  275.       IF(KRG3.GT.RPG(I,J,K)) KRG3=RPG(I,J,K)
  276.       IF(HG3.GE.0.) KRG3=RPG(I,J-1,K)+0.5*(RPG(I,J-1,K)-RPG(I,JMM,K))
  277.       IF(HG3.GE.0.AND.KRG3.GT.RPG(I,J-1,K)) KRG3=RPG(I,J-1,K)
  278. C      2-POINT REL PERM MUST BE POSITIVE
  279.       IF(KRO3.LT.0.) KRO3=0.
  280.       IF(KRW3.LT.0.) KRW3=0.
  281.       IF(KRG3.LT.0.) KRG3=0.
  282.       MO3=4.0*KRO3/((BO(I,J-1,K)+BO(I,J,K)) * (MUO3+MUO))
  283.       MW3=4.0*KRW3/((BW(I,J-1,K)+BW(I,J,K)) * (MUW3+MUW))
  284.       MG3=4.0*KRG3/((BG(I,J-1,K)+BG(I,J,K)) * (MUG3+MUG))
  285. 135   AOS=TY(I,J,K)*MO3
  286.       AWS=TY(I,J,K)*MW3
  287.       AGS=TY(I,J,K)*MG3
  288.       IF(J.EQ.JJ)GO TO 140
  289.       IF(VP(I,J+1,K).LE.0.0) GO TO 140
  290. C      I,J+1,K BLOCK
  291.       P4=P(I,J+1,K)
  292.       BPT=PBOT(I,J+1,K)
  293.       IPVTR=IPVT(I,J+1,K)
  294.       CALL INTPVT(IPVTR,BPT,RSLOPE(IPVTR),POT,RSOT,MPOT(IPVTR),P4,RSO4)
  295.       CALL INTPVT(IPVTR,BPT,VSLOPE(IPVTR),POT,MUOT,MPOT(IPVTR),P4,MUO4)
  296.       CALL INTERP(IPVTR,PWT,RSWT,MPWT(IPVTR),P4,RSW4)
  297.       CALL INTERP(IPVTR,PWT,MUWT,MPWT(IPVTR),P4,MUW4)
  298.       CALL INTERP(IPVTR,PGT,MUGT,MPGT(IPVTR),P4,MUG4)
  299.       SO4=SO(I,J+1,K)
  300.       SW4=SW(I,J+1,K)
  301.       SG4=SG(I,J+1,K)
  302.       IROCKR=IROCK(I,J+1,K)
  303.       PCOW4=CAPOW(I,J+1,K)
  304.       PCGO4=CAPGO(I,J+1,K)
  305.       RO4=(RHOSCO(IPVTR) + RSO4*RHOSCG(IPVTR))/BO(I,J+1,K)
  306.       RW4=(RHOSCW(IPVTR) + RSW4*RHOSCG(IPVTR))/BW(I,J+1,K)
  307.       RG4=RHOSCG(IPVTR)/BG(I,J+1,K)
  308.       FACT=-D288*(EL(I,J+1,K)-EL(I,J,K))
  309.       GOW4=(RO4+RO)*FACT
  310.       GWW4=(RW4+RW)*FACT + PCOW-PCOW4
  311.       GGW4=(RG4+RG)*FACT + PCGO4-PCGO
  312.       P44=P4-PP
  313.       HO4=P44+GOW4
  314.       HW4=P44+GWW4
  315.       HG4=P44+GGW4
  316.       JPP=J+2
  317.       IF(JPP.GT.JJ) JPP=JJ
  318.       JM=J-1
  319.       IF(JM.LT.1) JM=1
  320.       IF(ITHREE(IROCKB).EQ.1) GO TO 40
  321.       KRO4=RPOW(I,J,K)+0.5*(RPOW(I,J,K)-RPOW(I,JM,K))
  322.       IF(KRO4.GT.RPOW(I,J,K)) KRO4=RPOW(I,J,K)
  323.       IF(HO4.GE.0.) KRO4=RPOW(I,J+1,K)+0.5*(RPOW(I,J+1,K)-RPOW(I,JPP,K))
  324.       IF(HO4.GE.0.AND.KRO4.GT.RPOW(I,J+1,K)) KRO4=RPOW(I,J+1,K)
  325.       GO TO 45
  326.    40 KRO4=RPO3(I,J,K)+0.5*(RPO3(I,J,K)-RPO3(I,JM,K))
  327.       IF(KRO4.GT.RPO3(I,J,K)) KRO4=RPO3(I,J,K)
  328.       IF(HO4.GE.0.) KRO4=RPO3(I,J+1,K)+0.5*(RPO3(I,J+1,K)-RPO3(I,JPP,K))
  329.       IF(HO4.GE.0.AND.KRO4.GT.RPO3(I,J+1,K)) KRO4=RPO3(I,J+1,K)
  330.    45 CONTINUE
  331.       KRW4=RPW(I,J,K)+0.5*(RPW(I,J,K)-RPW(I,JM,K))
  332.       IF(KRW4.GT.RPW(I,J,K)) KRW4=RPW(I,J,K)
  333.       IF(HW4.GE.0.) KRW4=RPW(I,J+1,K)+0.5*(RPW(I,J+1,K)-RPW(I,JPP,K))
  334.       IF(HW4.GE.0.AND.KRW4.GT.RPW(I,J+1,K)) KRW4=RPW(I,J+1,K)
  335.       KRG4=RPG(I,J,K)+0.5*(RPG(I,J,K)-RPG(I,JM,K))
  336.       IF(KRG4.GT.RPG(I,J,K)) KRG4=RPG(I,J,K)
  337.       IF(HG4.GE.0.) KRG4=RPG(I,J+1,K)+0.5*(RPG(I,J+1,K)-RPG(I,JPP,K))
  338.       IF(HG4.GE.0.AND.KRG4.GT.RPG(I,J+1,K)) KRG4=RPG(I,J+1,K)
  339. C      2-POINT REL PERM MUST BE POSITIVE
  340.       IF(KRO4.LT.0.) KRO4=0.
  341.       IF(KRW4.LT.0.) KRW4=0.
  342.       IF(KRG4.LT.0.) KRG4=0.
  343.       MO4=4.0*KRO4/((BO(I,J+1,K)+BO(I,J,K)) * (MUO4+MUO))
  344.       MW4=4.0*KRW4/((BW(I,J+1,K)+BW(I,J,K)) * (MUW4+MUW))
  345.       MG4=4.0*KRG4/((BG(I,J+1,K)+BG(I,J,K)) * (MUG4+MUG))
  346. 140   AON=TY(I,J+1,K)*MO4
  347.       AWN=TY(I,J+1,K)*MW4
  348.       AGN=TY(I,J+1,K)*MG4
  349.       IF(K.EQ.1)GO TO 145
  350.       IF(VP(I,J,K-1).LE.0.0) GO TO 145
  351. C      I,J,K-1 BLOCK
  352.       P5=P(I,J,K-1)
  353.       BPT=PBOT(I,J,K-1)
  354.       IPVTR=IPVT(I,J,K-1)
  355.       CALL INTPVT(IPVTR,BPT,RSLOPE(IPVTR),POT,RSOT,MPOT(IPVTR),P5,RSO5)
  356.       CALL INTPVT(IPVTR,BPT,VSLOPE(IPVTR),POT,MUOT,MPOT(IPVTR),P5,MUO5)
  357.       CALL INTERP(IPVTR,PWT,RSWT,MPWT(IPVTR),P5,RSW5)
  358.       CALL INTERP(IPVTR,PWT,MUWT,MPWT(IPVTR),P5,MUW5)
  359.       CALL INTERP(IPVTR,PGT,MUGT,MPGT(IPVTR),P5,MUG5)
  360.       SO5=SO(I,J,K-1)
  361.       SW5=SW(I,J,K-1)
  362.       SG5=SG(I,J,K-1)
  363.       IROCKR=IROCK(I,J,K-1)
  364.       PCOW5=CAPOW(I,J,K-1)
  365.       PCGO5=CAPGO(I,J,K-1)
  366.       RO5=(RHOSCO(IPVTR) + RSO5*RHOSCG(IPVTR))/BO(I,J,K-1)
  367.       RW5=(RHOSCW(IPVTR) + RSW5*RHOSCG(IPVTR))/BW(I,J,K-1)
  368.       RG5=RHOSCG(IPVTR)/BG(I,J,K-1)
  369.       FACT=-D288*(EL(I,J,K-1)-EL(I,J,K))
  370.       GOW5=(RO5+RO)*FACT
  371.       GWW5=(RW5+RW)*FACT + PCOW-PCOW5
  372.       GGW5=(RG5+RG)*FACT + PCGO5-PCGO
  373.       P55=P5-PP
  374.       HO5=P55+GOW5
  375.       HW5=P55+GWW5
  376.       HG5=P55+GGW5
  377.       KMM=K-2
  378.       IF(KMM.LT.1)KMM=1
  379.       KP=K+1
  380.       IF(KP.GT.KK) KP=KK
  381.       IF(ITHREE(IROCKB).EQ.1) GO TO 50
  382.       KRO5=RPOW(I,J,K)+0.5*(RPOW(I,J,K)-RPOW(I,J,KP))
  383.       IF(KRO5.GT.RPOW(I,J,K)) KRO5=RPOW(I,J,K)
  384.       IF(HO5.GE.0.) KRO5=RPOW(I,J,K-1)+0.5*(RPOW(I,J,K-1)-RPOW(I,J,KMM))
  385.       IF(HO5.GE.0.AND.KRO5.GT.RPOW(I,J,K-1)) KRO5=RPOW(I,J,K-1)
  386.       GO TO 55
  387.    50 KRO5=RPO3(I,J,K)+0.5*(RPO3(I,J,K)-RPO3(I,J,KP))
  388.       IF(KRO5.GT.RPO3(I,J,K)) KRO5=RPO3(I,J,K)
  389.       IF(HO5.GE.0.) KRO5=RPO3(I,J,K-1)+0.5*(RPO3(I,J,K-1)-RPO3(I,J,KMM))
  390.       IF(HO5.GE.0.AND.KRO5.GT.RPO3(I,J,K-1)) KRO5=RPO3(I,J,K-1)
  391.    55 CONTINUE
  392.       KRW5=RPW(I,J,K)+0.5*(RPW(I,J,K)-RPW(I,J,KP))
  393.       IF(KRW5.GT.RPW(I,J,K)) KRW5=RPW(I,J,K)
  394.       IF(HW5.GE.0.) KRW5=RPW(I,J,K-1)+0.5*(RPW(I,J,K-1)-RPW(I,J,KMM))
  395.       IF(HW5.GE.0.AND.KRW5.GT.RPW(I,J,K-1)) KRW5=RPW(I,J,K-1)
  396.       KRG5=RPG(I,J,K)+0.5*(RPG(I,J,K)-RPG(I,J,KP))
  397.       IF(KRG5.GT.RPG(I,J,K)) KRG5=RPG(I,J,K)
  398.       IF(HG5.GE.0.) KRG5=RPG(I,J,K-1)+0.5*(RPG(I,J,K-1)-RPG(I,J,KMM))
  399.       IF(HG5.GE.0.AND.KRG5.GT.RPG(I,J,K-1)) KRG5=RPG(I,J,K-1)
  400. C      2-POINT REL PERM MUST BE POSITIVE
  401.       IF(KRO5.LT.0.) KRO5=0.
  402.       IF(KRW5.LT.0.) KRW5=0.
  403.       IF(KRG5.LT.0.) KRG5=0.
  404.       MO5=4.0*KRO5/((BO(I,J,K-1)+BO(I,J,K)) * (MUO5+MUO))
  405.       MW5=4.0*KRW5/((BW(I,J,K-1)+BW(I,J,K)) * (MUW5+MUW))
  406.       MG5=4.0*KRG5/((BG(I,J,K-1)+BG(I,J,K)) * (MUG5+MUG))
  407. 145   AOT=TZ(I,J,K)*MO5
  408.       AWT=TZ(I,J,K)*MW5
  409.       AGT=TZ(I,J,K)*MG5
  410.       IF(K.EQ.KK)GO TO 150
  411.       IF(VP(I,J,K+1).LE.0.0) GO TO 150
  412. C      I,J,K+1 BLOCK
  413.       P6=P(I,J,K+1)
  414.       BPT=PBOT(I,J,K+1)
  415.       IPVTR=IPVT(I,J,K+1)
  416.       CALL INTPVT(IPVTR,BPT,RSLOPE(IPVTR),POT,RSOT,MPOT(IPVTR),P6,RSO6)
  417.       CALL INTPVT(IPVTR,BPT,VSLOPE(IPVTR),POT,MUOT,MPOT(IPVTR),P6,MUO6)
  418.       CALL INTERP(IPVTR,PWT,RSWT,MPWT(IPVTR),P6,RSW6)
  419.       CALL INTERP(IPVTR,PWT,MUWT,MPWT(IPVTR),P6,MUW6)
  420.       CALL INTERP(IPVTR,PGT,MUGT,MPGT(IPVTR),P6,MUG6)
  421.       SO6=SO(I,J,K+1)
  422.       SW6=SW(I,J,K+1)
  423.       SG6=SG(I,J,K+1)
  424.       IROCKR=IROCK(I,J,K+1)
  425.       PCOW6=CAPOW(I,J,K+1)
  426.       PCGO6=CAPGO(I,J,K+1)
  427.       RO6=(RHOSCO(IPVTR) + RSO6*RHOSCG(IPVTR))/BO(I,J,K+1)
  428.       RW6=(RHOSCW(IPVTR) + RSW6*RHOSCG(IPVTR))/BW(I,J,K+1)
  429.       RG6=RHOSCG(IPVTR)/BG(I,J,K+1)
  430.       FACT=-D288*(EL(I,J,K+1)-EL(I,J,K))
  431.       GOW6=(RO6+RO)*FACT
  432.       GWW6=(RW6+RW)*FACT + PCOW-PCOW6
  433.       GGW6=(RG6+RG)*FACT + PCGO6-PCGO
  434.       P66=P6-PP
  435.       HO6=P66+GOW6
  436.       HW6=P66+GWW6
  437.       HG6=P66+GGW6
  438.       KPP=K+2
  439.       IF(KPP.GT.KK) KPP=KK
  440.       KM=K-1
  441.       IF(KM.LT.1) KM=1
  442.       IF(ITHREE(IROCKB).EQ.1) GO TO 60
  443.       KRO6=RPOW(I,J,K)+0.5*(RPOW(I,J,K)-RPOW(I,J,KM))
  444.       IF(KRO6.GT.RPOW(I,J,K)) KRO6=RPOW(I,J,K)
  445.       IF(HO6.GE.0.) KRO6=RPOW(I,J,K+1)+0.5*(RPOW(I,J,K+1)-RPOW(I,J,KPP))
  446.       IF(HO6.GE.0.AND.KRO6.GT.RPOW(I,J,K+1)) KRO6=RPOW(I,J,K+1)
  447.       GO TO 65
  448.    60 KRO6=RPO3(I,J,K)+0.5*(RPO3(I,J,K)-RPO3(I,J,KM))
  449.       IF(KRO6.GT.RPO3(I,J,K)) KRO6=RPO3(I,J,K)
  450.       IF(HO6.GE.0.) KRO6=RPO3(I,J,K+1)+0.5*(RPO3(I,J,K+1)-RPO3(I,J,KPP))
  451.       IF(HO6.GE.0.AND.KRO6.GT.RPO3(I,J,K+1)) KRO6=RPO3(I,J,K+1)
  452.    65 CONTINUE
  453.       KRW6=RPW(I,J,K)+0.5*(RPW(I,J,K)-RPW(I,J,KM))
  454.       IF(KRW6.GT.RPW(I,J,K)) KRW6=RPW(I,J,K)
  455.       IF(HW6.GE.0.) KRW6=RPW(I,J,K+1)+0.5*(RPW(I,J,K+1)-RPW(I,J,KPP))
  456.       IF(HW6.GE.0.AND.KRW6.GT.RPW(I,J,K+1)) KRW6=RPW(I,J,K+1)
  457.       KRG6=RPG(I,J,K)+0.5*(RPG(I,J,K)-RPG(I,J,KM))
  458.       IF(KRG6.GT.RPG(I,J,K)) KRG6=RPG(I,J,K)
  459.       IF(HG6.GE.0.) KRG6=RPG(I,J,K+1)+0.5*(RPG(I,J,K+1)-RPG(I,J,KPP))
  460.       IF(HG6.GE.0.AND.KRG6.GT.RPG(I,J,K+1)) KRG6=RPG(I,J,K+1)
  461. C      2-POINT REL PERM MUST BE POSITIVE
  462.       IF(KRO6.LT.0.) KRO6=0.
  463.       IF(KRW6.LT.0.) KRW6=0.
  464.       IF(KRG6.LT.0.) KRG6=0.
  465.       MO6=4.0*KRO6/((BO(I,J,K+1)+BO(I,J,K)) * (MUO6+MUO))
  466.       MW6=4.0*KRW6/((BW(I,J,K+1)+BW(I,J,K)) * (MUW6+MUW))
  467.       MG6=4.0*KRG6/((BG(I,J,K+1)+BG(I,J,K)) * (MUG6+MUG))
  468. 150   AOB=TZ(I,J,K+1)*MO6
  469.       AWB=TZ(I,J,K+1)*MW6
  470.       AGB=TZ(I,J,K+1)*MG6
  471.       RSO1A=0.5*(RSO1+RSO)
  472.       RSO2A=0.5*(RSO2+RSO)
  473.       RSO3A=0.5*(RSO3+RSO)
  474.       RSO4A=0.5*(RSO4+RSO)
  475.       RSO5A=0.5*(RSO5+RSO)
  476.       RSO6A=0.5*(RSO6+RSO)
  477.       RSW1A=0.5*(RSW1+RSW)
  478.       RSW2A=0.5*(RSW2+RSW)
  479.       RSW3A=0.5*(RSW3+RSW)
  480.       RSW4A=0.5*(RSW4+RSW)
  481.       RSW5A=0.5*(RSW5+RSW)
  482.       RSW6A=0.5*(RSW6+RSW)
  483.       AO1=AOW*GOW1
  484.       AO2=AOE*GOW2
  485.       AO3=AOS*GOW3
  486.       AO4=AON*GOW4
  487.       AO5=AOT*GOW5
  488.       AO6=AOB*GOW6
  489.       AW1=AWW*GWW1
  490.       AW2=AWE*GWW2
  491.       AW3=AWS*GWW3
  492.       AW4=AWN*GWW4
  493.       AW5=AWT*GWW5
  494.       AW6=AWB*GWW6
  495.       GOWT(I,J,K)= AO1 + AO2 + AO3 + AO4 + AO5 + AO6
  496.       GWWT(I,J,K)= AW1 + AW2 + AW3 + AW4 + AW5 + AW6
  497.       GGWT(I,J,K)=AGW*GGW1+AGE*GGW2+AGS*GGW3+AGN*GGW4+AGT*GGW5+AGB*GGW6
  498.      &+RSO1A*AO1+RSO2A*AO2+RSO3A*AO3+RSO4A*AO4+RSO5A*AO5+RSO6A*AO6
  499.      &+RSW1A*AW1+RSW2A*AW2+RSW3A*AW3+RSW4A*AW4+RSW5A*AW5+RSW6A*AW6
  500.       QOWG(I,J,K)=(BO(I,J,K)-BG(I,J,K)*RSO)*(-GOWT(I,J,K)+QO(I,J,K)) +
  501.      &   (BW(I,J,K)-BG(I,J,K)*RSW)*(-GWWT(I,J,K)+QW(I,J,K)) +
  502.      &    BG(I,J,K)*(-GGWT(I,J,K)+QG(I,J,K))
  503.       AW(I,J,K)=(BO(I,J,K) + 0.5*BG(I,J,K)*(RSO1-RSO)) * AOW +
  504.      & (BW(I,J,K) + 0.5*BG(I,J,K)*(RSW1-RSW)) * AWW +
  505.      &  BG(I,J,K)*AGW
  506.       AE(I,J,K)=(BO(I,J,K) + 0.5*BG(I,J,K)*(RSO2-RSO)) * AOE +
  507.      & (BW(I,J,K) + 0.5*BG(I,J,K)*(RSW2-RSW)) * AWE +
  508.      &  BG(I,J,K)*AGE
  509.       AS(I,J,K)=(BO(I,J,K) + 0.5*BG(I,J,K)*(RSO3-RSO)) * AOS +
  510.      & (BW(I,J,K) + 0.5*BG(I,J,K)*(RSW3-RSW)) * AWS +
  511.      &  BG(I,J,K)*AGS
  512.       AN(I,J,K)=(BO(I,J,K) + 0.5*BG(I,J,K)*(RSO4-RSO)) * AON +
  513.      & (BW(I,J,K) + 0.5*BG(I,J,K)*(RSW4-RSW)) * AWN +
  514.      &  BG(I,J,K)*AGN
  515.       AT(I,J,K)=(BO(I,J,K) + 0.5*BG(I,J,K)*(RSO5-RSO)) * AOT +
  516.      & (BW(I,J,K) + 0.5*BG(I,J,K)*(RSW5-RSW)) * AWT +
  517.      &  BG(I,J,K)*AGT
  518.       AB(I,J,K)=(BO(I,J,K) + 0.5*BG(I,J,K)*(RSO6-RSO)) * AOB +
  519.      & (BW(I,J,K) + 0.5*BG(I,J,K)*(RSW6-RSW)) * AWB +
  520.      &  BG(I,J,K)*AGB
  521.       OW(I,J,K)=AOW
  522.       OE(I,J,K)=AOE
  523.       OS(I,J,K)=AOS
  524.       ON(I,J,K)=AON
  525.       OT(I,J,K)=AOT
  526.       OB(I,J,K)=AOB
  527.       WW(I,J,K)=AWW
  528.       WE(I,J,K)=AWE
  529.       WS(I,J,K)=AWS
  530.       WN(I,J,K)=AWN
  531.       WT(I,J,K)=AWT
  532.       WB(I,J,K)=AWB
  533.       IF(KCOFF.EQ.0)GO TO 200
  534.       WRITE(IOCODE,33)
  535.       WRITE(IOCODE,2) I,J,K,MO1,MO2,MO3,MO4,MO5,MO6
  536.       WRITE(IOCODE,2) I,J,K,MW1,MW2,MW3,MW4,MW5,MW6
  537.       WRITE(IOCODE,2) I,J,K,MG1,MG2,MG3,MG4,MG5,MG6
  538.       WRITE(IOCODE,2) I,J,K,AOW,AOE,AOS,AON,AOT,AOB,BO(I,J,K),RSO
  539.       WRITE(IOCODE,2) I,J,K,AWW,AWE,AWS,AWN,AWT,AWB,BW(I,J,K),RSW
  540.       WRITE(IOCODE,2) I,J,K,AGW,AGE,AGS,AGN,AGT,AGB,BG(I,J,K)
  541.       WRITE(IOCODE,2) I,J,K,GOWT(I,J,K),QO(I,J,K),GWWT(I,J,K),QW(I,J,K),
  542.      &     GGWT(I,J,K),QG(I,J,K),QOWG(I,J,K)
  543. 200   CONTINUE
  544. C**** CALCULATE MAIN DIAGONAL AND RHS VECTOR
  545.       DO 300 K=1,KK
  546.       DO 300 J=1,JJ
  547.       DO 300 I=1,II
  548.       SUM(I,J,K)=AW(I,J,K)+AE(I,J,K)+AS(I,J,K)+AN(I,J,K)+
  549.      &    AT(I,J,K)+AB(I,J,K)
  550.       GAM(I,J,K)=VP(I,J,K)*CT(I,J,K)*DIV1
  551.       E(I,J,K)=-SUM(I,J,K) - GAM(I,J,K)
  552.       B(I,J,K)= QOWG(I,J,K) - GAM(I,J,K)*PN(I,J,K)
  553. 300   CONTINUE
  554. C*** CALC. COEF. FOR 0 PV BLOCKS.
  555. C*** ASSUMES NO PRESSURE CHANGE WITH TIME.
  556.       DO 350 K=1,KK
  557.       DO 350 J=1,JJ
  558.       DO 350 I=1,II
  559.       IF(VP(I,J,K).GT.0.0) GO TO 350
  560.       E(I,J,K)=-1.0
  561.       B(I,J,K)=-PN(I,J,K)
  562.       AW(I,J,K)=0.0
  563.       AE(I,J,K)=0.0
  564.       AS(I,J,K)=0.0
  565.       AN(I,J,K)=0.0
  566.       AT(I,J,K)=0.0
  567.       AB(I,J,K)=0.0
  568.   350 CONTINUE
  569.       IF(KSM1.EQ.0)RETURN
  570.       IF(N.NE.1.AND.N.NE.NN.AND.N.NE.KSM)RETURN
  571.       WRITE(IOCODE,4)
  572.       DO 404 K=1,KK
  573.       DO 404 J=1,JJ
  574.       DO 404 I=1,II
  575.       WRITE(IOCODE,2) I,J,K,AT(I,J,K),AS(I,J,K),AW(I,J,K),E(I,J,K),
  576.      & AE(I,J,K)   ,AN(I,J,K),AB(I,J,K),B(I,J,K)
  577. 404   CONTINUE
  578. 4     FORMAT(//T3,'NODE      AT(I,J,K)     AS(I,J,K)       AW(I,J,K)',
  579.      &'      E(I,J,K)     AE(I,J,K)       AN(I,J,K)      AB(I,J,K)',
  580.      &'      B(I,J,K)'/)
  581. 2     FORMAT(1X,3I3,8E15.6)
  582. 33    FORMAT(//)
  583.       RETURN
  584.       END
  585.