cgxival.htm cC File name ..... GXIVAL.HTM ..... 080910 REAL FUNCTION INTVAL(I) INCLUDE '/phoenics/d_includ/farray' INCLUDE '/phoenics/d_includ/grdloc' INCLUDE '/phoenics/d_includ/satgrd' INCLUDE '/phoenics/d_includ/satear' INCLUDE '/phoenics/d_includ/grdear' INCLUDE '/phoenics/d_includ/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.EQ.-1) THEN INTVAL=PRPRTY ELSEIF(IGRND.EQ.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.EQ.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 '/phoenics/d_includ/farray' INCLUDE '/phoenics/d_includ/grdloc' INCLUDE '/phoenics/d_includ/satgrd' INCLUDE '/phoenics/d_includ/satear' INCLUDE '/phoenics/d_includ/grdear' INCLUDE '/phoenics/d_includ/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',080602) IGR= 9 ISC= IPROP C.... Call GROUND for the user set property: IF(IPILOPT.EQ.0) THEN IF(USEGRD) THEN CALL GROUND ENDIF GO TO 800 ENDIF IF(IPILOPT.EQ.-1) GO TO 700 CALL PRPADR C.... Set constants and other auxiliary variables: C.... Interface value of the first- or second-phase variable: IF(IPHASE.EQ.1) THEN PHNHAG = PHNH1A PHNHBG = PHNH1B PHNHCG = PHNH1C ELSE PHNHAG = PHNH2A PHNHBG = PHNH2B PHNHCG = PHNH2C ENDIF IF(IPILOPT.EQ.1) THEN L0P=L0F(P1) ENDIF C.... Loop over slab to get and set cell properties: 700 IGRND=IPILOPT IF(IPRPS.EQ.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.GT.0) CALL GROUND ENDIF NAMSUB= 'slbivl' if(flag.or.dbgloc) call banner(2,namsub,0) END c