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