c

c  -- file name gxsurprp.htm   021101
C.... SURHOL is called from SLBproperty to set properties when either the
C     scalar equation method, or height of liquid method are used for
C     flows with inter-fluid boundaries.
c
      SUBROUTINE SURHOL(KPROP,IPROP,IFILEP,FL1PRP)
      INCLUDE 'farray'
      INCLUDE 'grdloc'
      INCLUDE 'satgrd'
      INCLUDE 'satear'
      COMMON /PRPCMR/CONST(6),WV0,WIDTH,GRDAV,ENT0,TABSPC,HLPC,HHPC
     1       /CELPAR/IPHASE,IPROPC,IOPT,IFILEC,KPRP0
     1       /GENI/NXNY,IFG1(54),IPRPS,IFG2(4)
      LOGICAL VAC,POR
C
      L0PRPS= L0F(IPRPS)
      CALL SUB3( IPROPC,IPROP, IFILEC,IFILEP, KPRP0,KPROP )
      DO 20 I= 1,NXNY
        IF(VAC(I) .OR. POR(I)) THEN
          F(KPROP+I)= TINY
        ELSE
          IMAT= NINT(F(L0PRPS+I))
          IF(IMAT.EQ.-1) THEN  ! i.e. use domain-material properties
            F(KPROP+I)=CELPRP(I)
          ELSEIF(IMAT.LT.0) THEN ! cell has been marked as having both materials
            F(KPROP+I)= PRPM(I,ABS(F(L0PRPS+I))) ! by setting PRPS negative
          ELSE
            INDTB= INDPRTB(IMAT,0)
            PRPVAL= F(INDTB+IFILEP)
            IF(PRPVAL.GT.-TINY) THEN
              F(KPROP+I)= PRPVAL
            ELSE
              IOPT  = NINT(ABS(PRPVAL-GRND))/10
              INDTB= INDPRTB(IMAT,IFILEP)
              DO IC= 1,NINT(F(INDTB+1))
                CONST(IC)= F(INDTB+IC+1)
              ENDDO
              CALL SETOPT
              F(KPROP+I)= CELPRP(I)
            ENDIF
          ENDIF
        ENDIF
  20  CONTINUE
      END
C!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
c
      SUBROUTINE FNPRPS(K1,K2,A,B,I1,I2)
      INCLUDE 'farray'
      COMMON      /IGE/IXF,IXL,IYF,IYL,IGFLL(21)
C
      IF(IXL.LT.0) RETURN
      CALL L0F2(K1,K2,I,I2M1,IADD,'FNPRPS')
      RLOLM=A+1.E-5
      RUPLM=B-1.E-5
      DO 1 IX=IXF,IXL
        I=I+IADD
        DO 1 IY=IYF,IYL
          I=I+1
          IF(F(I).LT.100) THEN
            IF(F(I+I2M1).LT.RLOLM) THEN
              F(I)=I1
            ELSEIF(F(I+I2M1).GT.RUPLM) THEN
              F(I)=I2
            ELSE
              F(I)=-I1*100-I2-F(I+I2M1)
            ENDIF
          ENDIF
    1 CONTINUE
      END
C!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
C.... Integer 100 below is used to decode the mixture-property indices.
C     It corresponds to the integer used in subroutine FNPRPS
c
      FUNCTION PRPM(I,PRPFLG)
      INCLUDE 'farray'
      INCLUDE 'satear'
      INCLUDE 'grdloc'
      INCLUDE 'satgrd'
      COMMON /PRPCMR/CONST(6),WV0,WIDTH,GRDAV,ENT0,TABSPC,HLPC,HHPC
     1       /CELPAR/IPHASE,IPROP,IOPT,IFILEP,KPROP
      LOGICAL FL1PRP
C.... Decode indices and pick up properties
C.... First material:
      IMAT= INT(PRPFLG/100)
      CALL SUB2( NGO,1, IMAT1,IMAT )
  10  INDTB= INDPRTB(IMAT,0)
      PRPVAL= F(INDTB+IFILEP)
      IF(PRPVAL.LT.-TINY) THEN
        IOPT  = NINT(ABS(PRPVAL-GRND))/10
        INDTB= INDPRTB(IMAT,IFILEP)
        DO IC= 1,NINT(F(INDTB+1))
          CONST(IC)= F(INDTB+IC+1)
        ENDDO
        CALL SETOPT
        PRPVAL= CELPRP(I)
      ENDIF
C.... Second material & CVOL
      IF(NGO.EQ.1) THEN
        PRP1= PRPVAL
        CVOL= PRPFLG - 100*IMAT
        IMAT= INT(CVOL)
        CALL SUB2( NGO,2, IMAT2,IMAT )
        CVOL= CVOL - IMAT
        GO TO 10
      ENDIF
      PRP2= PRPVAL
C.... Mass-average CP
      IF(IFILEP.EQ.3) THEN
        RHOL= F(INDPRTB(IPRPSA,0)+1)
        RHOG= F(INDPRTB(IPRPSB,0)+1)
        CVOL= CVOL*RHOL / (CVOL*RHOL + (1.0-CVOL)*RHOG)
      ENDIF
C.... Compute mixture properties
      CON1= (RUPLIM*PRP1-PRP2*RLOLIM)
      CON2= (PRP1-PRP2)
      PRPM= (CON1-CON2*CVOL)/(RUPLIM-RLOLIM)
      PMIN= MIN(PRP1,PRP2)
      PMAX= MAX(PRP1,PRP2)
      PRPM= MIN(PRPM,PMAX)
      PRPM= MAX(PRPM,PMIN)
      END
c