SUBROUTINE RELP(SG,REPL,REPG,NMAT,K,NLOC,SG0) C C-----THIS ROUTINE COMPUTES RELATIVE PERMEABILITIES FOR LIQUID C AND GASEOUS PHASES. C COMMON/P3/DELX(1) COMMON/RPCAP/IRP(27),RP(7,27),ICP(27),CP(7,27),IRPD,RPD(7), XICPD,CPD(7) C SAVE ICALL DATA ICALL/0/ ICALL=ICALL+1 IF(ICALL.EQ.1) WRITE(11,899) c 899 FORMAT(6X,'RELP 1.0 25 JANUARY 1990',6X, c 899 FORMAT(6X,'RELP 1.0 23 November 1994',6X, 899 FORMAT(6X,'RELP 1.0 26 July 1995',6X, X'LIQUID AND GAS PHASE RELATIVE PERMEABILITIES AS FUNCTIONS', X' OF SATURATION'/ x47X,'for IRP=7, use Corey-krg when RP(4).ne.0, with Sgr', x' = RP(4)') C SL=1.-SG GOTO(10,11,12,12,13,14,15,16),IRP(NMAT) 10 CONTINUE C-----LINEAR FUNCTIONS. C C CHECK IF INCREMENT NEEDS TO BE ADJUSTED AT LOWER LIQUID CUTOFF. IF(K.NE.3) GOTO 20 IF((SL-RP(1,NMAT))*(1.-SG0-RP(1,NMAT)).GE.0.) GOTO 20 C ADJUST INCREMENT. DELX(NLOC+2)=-DELX(NLOC+2) SG=SG0+DELX(NLOC+2) SL=1.-SG 20 CONTINUE C REPL=(SL-RP(1,NMAT))/(RP(3,NMAT)-RP(1,NMAT)) IF(SL.GE.RP(3,NMAT)) REPL=1. IF(SL.LE.RP(1,NMAT)) REPL=0. REPG=(SG-RP(2,NMAT))/(RP(4,NMAT)-RP(2,NMAT)) IF(SG.GE.RP(4,NMAT)) REPG=1. IF(SG.LE.RP(2,NMAT)) REPG=0. C RETURN C 11 CONTINUE C-----RELATIVE PERMEABILITY OF PICKENS ET AL. C REPG=1. REPL=(1.-SG)**RP(1,NMAT) C RETURN C 12 CONTINUE C-----COREY@S OR GRANT@S CURVES. C SSTAR=(SL-RP(1,NMAT))/(1.-RP(1,NMAT)-RP(2,NMAT)) REPL=SSTAR**4 REPG=(1.-SSTAR**2)*(1.-SSTAR)**2 IF(SG.GE.RP(2,NMAT)) GOTO 50 REPG=0. REPL=1. GOTO 102 50 IF(SG.LT.(1.-RP(1,NMAT))) GOTO 102 REPL=0. REPG=1. 102 CONTINUE IF(IRP(NMAT).EQ.4) REPG=1.-REPL RETURN C 13 CONTINUE C-----BOTH PHASES ARE PERFECTLY MOBILE. C REPL=1. REPG=1. C RETURN 14 CONTINUE C-----RELATIVE PERMEABILITIES OF FATT AND KLIKOFF (1959), AS REPORTED C BY K. UDELL (BERKELEY, 1982). C SS=0. IF(SL.GT.RP(1,NMAT)) SS=(SL-RP(1,NMAT))/(1.-RP(1,NMAT)) REPL=SS**3 REPG=(1.-SS)**3 RETURN C 15 CONTINUE C-----RELATIVE PERMEABILITY OF VAN GENUCHTEN, SOIL SCI. SOC. AM. J. 44, C PP. 892-898, 1980. C IF(SL.GE.RP(3,NMAT)) GOTO 150 SS=(SL-RP(2,NMAT))/(RP(3,NMAT)-RP(2,NMAT)) REPL=0. IF(SS.GT.0.) XREPL=SQRT(SS)*(1.-(1.-SS**(1./RP(1,NMAT)))**RP(1,NMAT))**2 c 11-23-94: for RP(4).ne.0, take Sgr=RP(4) and use Corey krg. if(rp(4,nmat).le.0.) then REPG=1.-REPL else c.....7-26-95 if(1.-sl.le.rp(4,nmat)) then repg=0. else SSTAR=(SL-RP(2,NMAT))/(1.-RP(2,NMAT)-RP(4,NMAT)) sstar=max(0.,sstar) sstar=min(1.,sstar) REPG=(1.-SSTAR**2)*(1.-SSTAR)**2 endif endif RETURN C 150 REPL=1. REPG=0. RETURN C 16 CONTINUE C RELATIVE PERMEABILITIES AS MEASURED BY VERMA ET AL. IN C LABORATORY FLOW EXPERIMENTS FOR STEAM-WATER MIXTURES C SS=(SL-RP(1,NMAT))/(RP(2,NMAT)-RP(1,NMAT)) IF(SS.GT.1.) SS=1. IF(SS.LT.0.) SS=0. REPL=SS**3 REPG=RP(3,NMAT)+RP(4,NMAT)*SS+RP(5,NMAT)*SS*SS IF(REPG.GT.1.) REPG=1. IF(REPG.LT.0.) REPG=0. RETURN C END SUBROUTINE PCAP(SL,T,PC,NMAT) C C-----THIS ROUTINE COMPUTES CAPILLARY PRESSURE AS FUNCTION OF LIQUID C SATURATION SL AND TEMPERATURE T. C COMMON/RPCAP/IRP(27),RP(7,27),ICP(27),CP(7,27),IRPD,RPD(7), AICPD,CPD(7) C SAVE ICALL DATA ICALL/0/ ICALL=ICALL+1 IF(ICALL.EQ.1) WRITE(11,899) c 899 FORMAT(6X,'PCAP 1.0 4 MARCH 1991',6X, 899 FORMAT(6X,'PCAP 1.0 9 November 1999',6X, X'CAPILLARY PRESSURE AS FUNCTION OF SATURATION') C GOTO(10,11,12,13,14,15,16,17),ICP(NMAT) C 10 CONTINUE C-----LINEAR FUNCTION. PC=-CP(1,NMAT)*(CP(3,NMAT)-SL)/(CP(3,NMAT)-CP(2,NMAT)) IF(SL.GE.CP(3,NMAT)) PC=0. IF(SL.LE.CP(2,NMAT)) PC=-CP(1,NMAT) RETURN 11 CONTINUE C-----CAPILLARY PRESSURE FUNCTION OF PICKENS ET AL, AS GIVEN IN C J. HYDROLOGY 40, 243-264, 1979. C SLX=MAX(SL,1.001*CP(2,NMAT)) IF(SLX.GT..999*CP(3,NMAT)) SLX=.999*CP(3,NMAT) A=(1.+SLX/CP(3,NMAT))*(CP(3,NMAT)-CP(2,NMAT))/ A(CP(3,NMAT)+CP(2,NMAT)) B=(1.-SLX/CP(3,NMAT)) PC=-CP(1,NMAT)*LOG(A*(1.+SQRT(1.-B*B/(A*A)))/B)** A(1./CP(4,NMAT)) IF(SL.GT..999*CP(3,NMAT)) PC=PC*(1.-SL)/.001 RETURN C C 12 CONTINUE C-----CAPILLARY PRESSURE FUNCTION AS USED IN THE TRUST-PROGRAM, WHICH C WAS DEVELOPED BY T.N. NARASIMHAN AT LAWRENCE BERKELEY LABORATORY. C IF(SL.NE.1) GOTO 120 PC=0. RETURN C 120 SLX=SL IF(CP(5,NMAT).EQ.0.)SLX=MAX(SL,1.001*CP(2,NMAT)) PC=-ABS(CP(5,NMAT)) IF(SLX.GT.CP(2,NMAT)) APC=-CP(4,NMAT)-CP(1,NMAT)*((1.-SLX)/(SLX-CP(2,NMAT))) B**(1./CP(3,NMAT)) IF(CP(5,NMAT).NE.0.)PC=MAX(PC,-ABS(CP(5,NMAT))) IF(SL.GT..999) PC=PC*(1.-SL)/.001 RETURN C 13 CONTINUE C-----CAPILLARY PRESSURE OF YOLO CLAY AFTER CHRIS MILLY, C WATER RES. RES., VOL. 18 NO.3 (JUNE 1982), PP. 489-498. C IF(SL-CP(1,NMAT).GE..371) GOTO 130 SLX=MAX(SL,1.001*CP(1,NMAT)) EX=(0.371/(SLX-CP(1,NMAT))-1.)**.25 EX=2.26*EX-2. PC=-9.7783E3*10.**EX RETURN C 130 PC=-97.783 RETURN 14 CONTINUE 15 CONTINUE C-----LEVERETT@S J-FUNCTION. SS=0. IF(SL.GT.CP(2,NMAT)) SS=(SL-CP(2,NMAT))/(1.-CP(2,NMAT)) OSS=1.-SS F=1.417*OSS-2.120*OSS**2+1.263*OSS**3 CALL SIGMA(T,ST) PC=-CP(1,NMAT)*ST*F RETURN 16 CONTINUE C-----CAPILLARY FUNCTION OF VAN GENUCHTEN, SOIL SCI. SOC. AM. J. 44, C PP.892-898, 1980. C IF(SL.NE.1.)GO TO 160 PC=0. RETURN C 160 SLX=SL IF(SLX.GE.CP(5,NMAT)) GOTO 161 IF(CP(4,NMAT).EQ.0.)SLX=MAX(SL,1.001*CP(2,NMAT)) PC=-ABS(CP(4,NMAT)) IF(SLX.GT.CP(2,NMAT)) APC=-1./ABS(CP(3,NMAT))*(((SL-CP(2,NMAT))/(CP(5,NMAT)-CP(2,NMAT))) B**(-1./CP(1,NMAT))-1.)**(1.-CP(1,NMAT)) IF(CP(4,NMAT).NE.0.) PC=MAX(PC,-ABS(CP(4,NMAT))) IF(SL.GT..999) PC=PC*(1.-SL)/.001 RETURN 161 PC=0. RETURN c 17 continue pc=0. return C END