cgxival.htm c c
C File name ..... GXIVAL.HTM ..... 040713
      REAL FUNCTION INTVAL(I)
      INCLUDE 'farray'
      INCLUDE 'grdloc'
      INCLUDE 'satgrd'
      INCLUDE 'satear'
      INCLUDE 'grdear'
      INCLUDE 'prpcmn'
      COMMON/GENI/IGF1(2),NXNYST,NDIR,KDUMM,IGF2(4),NFM,IGF3(39),
     1            ITEM1,ITEM2,ISPH1,ISPH2,ICON1,ICON2,IPRPS,IGF4(4)
     1      /CELPAR/IPHASE,IPROP,IGRND,IFILEP,KPROP
C
      INTVAL=-999.0
C.... Interface value of the first- or second-phase variable:
      IF(IGRND==-1) THEN
        INTVAL=PRPRTY
      ELSEIF(IGRND==1) THEN
C.... Interface value is a function of pressure:
        INTVAL= PHNHAG*AMAX1(0., F(L0P+I)+PRESS0)**PHNHBG + PHNHCG
        INTVAL= INTVAL*HUNIT
      ELSEIF(IGRND==2) THEN
C.... Interface value of a second-phase variable is linear function of
C     that for a coupled first-phase variable (based on the fact that
C     interface values share the same slab-wise storage):
        INTVAL= PHNHAG + PHNHBG*F(KPROP+I)
      ENDIF
      END
C--------------------------------------------------------------------
      SUBROUTINE SLBIVL(IPILOPT,dbgloc)
      INCLUDE 'farray'
      INCLUDE 'grdloc'
      INCLUDE 'satgrd'
      INCLUDE 'satear'
      INCLUDE 'grdear'
      INCLUDE 'prpcmn'
      COMMON/VMSCMN/FL1CON
     1      /CELPAR/IPHASE,IPROP,IGRND,IFILEP,KPROP
      COMMON/GENI/IGF1(2),NXNYST,NDIR,KDUMM,IGF2(4),NFM,IGF3(21),IPRL,
     1           IBTAU,IGF4(16),ITEM1,ITEM2,ISPH1,ISPH2,ICON1,ICON2,
     1           IPRPS,IRADX,IRADY,IRADZ,IVFOL
      COMMON/NAMFN/NAMFUN,NAMSUB
      REAL INTVAL
      LOGICAL DBGLOC,SLD,FL1CON
      CHARACTER*6 NAMFUN,NAMSUB
C
      NAMSUB= 'SLBIVL'
      if(flag.or.dbgloc) call banner(1,'SLBIVL',040713)
      IGR= 9; ISC= IPROP
C.... Call GROUND for the user set property:
      IF(IPILOPT==0) THEN
        IF(USEGRD) THEN
          CALL GROUND
        ENDIF
        GO TO 800
      ENDIF
      IF(IPILOPT==-1) GO TO 700
C.... Set constants and other auxiliary variables:
C.... Interface value of the first- or second-phase variable:
      IF(IPHASE==1) THEN
        PHNHAG = PHNH1A; PHNHBG = PHNH1B; PHNHCG = PHNH1C
      ELSE
        PHNHAG = PHNH2A; PHNHBG = PHNH2B; PHNHCG = PHNH2C
      ENDIF
      IF(IPILOPT==1) L0P=L0F(P1)
C.... Loop over slab to get and set cell properties:
 700  IGRND=IPILOPT
      IF(IPRPS==0) THEN
C.... One material only, no blockages
        DO 60 I= 1,NXNYST
  60    F(KPROP+I)= INTVAL(I)
      ELSE
C.... One material only
C.... exclude solids
        DO 70 I= 1,NXNYST
          IF(SLD(I)) THEN
            F(KPROP+I)= TINY
          ELSE
            F(KPROP+I)= INTVAL(I)
          ENDIF
  70    CONTINUE
      ENDIF
C.... Call GREX to correct a property set above
 800  IF(USEGRX) CALL GREX3
C.... Call ALTPRP for an alternative property setting
      IF(USEALT) CALL ALTPRP
C.... Call GROUND for the user to correct a property set above
      IF(USEGRD) THEN
        IF(IPILOPT>0) CALL GROUND
      ENDIF
      NAMSUB= 'slbivl'
      if(flag.or.dbgloc) call banner(2,namsub,0)
      END
c