c .........................................................
c Incorporating specific relative permeability fucntions
c .........................................................
c .........................................................
c MODULE_t2f
c .........................................................
c
SUBROUTINE INPUT
c
c
c-----READ ALL DATA PROVIDED THROUGH THE INPUT FILE.
c
c
c-----THIS ROUTINE COMPUTES RELATIVE PERMEABILITIES FOR LIQUID
c AND GASEOUS PHASES.
c
c
implicit real*8 (a-h,o-z)
implicit integer*8 (i-n)
INCLUDE 'flowpar_v4.inc'
c
COMMON/P3/DELX((MNK+1)*MNEL)
COMMON/RPCAP/IRP(MAXMAT),RP(7,MAXMAT),ICP(MAXMAT),CP(7,MAXMAT),
XIRPD,RPD(7),ICPD,CPD(7)
!els12/02/15 add new pcap parameters
common/rpcap2/cpsavpar(6,maxmat),rpsavpar(12,maxmat)
c Added definitions below
double precision sg,repl,repg,sg0
integer*8 nmat,k,nloc
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,
c 899 FORMAT(6X,'RELP 1.0 26 July 1995',6X,
!els11/30/15 899 FORMAT(6X,'RELP 1.1 20 March 2009',6X,
899 FORMAT(6X,'RELP 1.11 30 November 2015',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.d0-SG
c GOTO(10,11,12,12,13,14,15,16),IRP(NMAT)
c Added new option 11, from ITOUGH (S. Finsterle)
GOTO(10,11,12,12,13,14,15,16,17,18,19),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.d0-SG0-RP(1,NMAT)).GE.0.d0) GOTO 20
c ADJUST INCREMENT.
DELX(NLOC+2)=-DELX(NLOC+2)
SG=SG0+DELX(NLOC+2)
SL=1.d0-SG
20 CONTINUE
c
!els12/02/15 REPL=(SL-RP(1,NMAT))/(RP(3,NMAT)-RP(1,NMAT))
REPL=(SL-RP(1,NMAT))/rpsavpar(1,nmat)
IF(SL.GE.RP(3,NMAT)) REPL=1.d0
IF(SL.LE.RP(1,NMAT)) REPL=0.d0
!els12/02/15 REPG=(SG-RP(2,NMAT))/(RP(4,NMAT)-RP(2,NMAT))
REPG=(SG-RP(2,NMAT))/rpsavpar(2,nmat)
IF(SG.GE.RP(4,NMAT)) REPG=1.d0
IF(SG.LE.RP(2,NMAT)) REPG=0.d0
c
RETURN
c
11 CONTINUE
c-----RELATIVE PERMEABILITY OF PICKENS ET AL.
c
REPG=1.d0
REPL=(1.d0-SG)**RP(1,NMAT)
c
RETURN
c
12 CONTINUE
c-----COREY@S OR GRANT@S CURVES.
c
!els12/02/15 SSTAR=(SL-RP(1,NMAT))/(1.d0-RP(1,NMAT)-RP(2,NMAT))
SSTAR=(SL-RP(1,NMAT))/rpsavpar(1,nmat)
REPL=SSTAR**1.70E0
REPG=0.50E0*(1.d0-SSTAR**1.2)*(1.d0-SSTAR)**0.40E0
IF(SG.GE.RP(2,NMAT)) GOTO 50
REPG=0.d0
REPL=1.d0
GOTO 102
!els12/02/15 50 IF(SG.LT.(1.d0-RP(1,NMAT))) GOTO 102
50 IF(SG.LT.rpsavpar(2,nmat)) GOTO 102
REPL=0.d0
REPG=1.d0
102 CONTINUE
IF(IRP(NMAT).EQ.4) REPG=1.d0-REPL
RETURN
c
13 CONTINUE
c-----BOTH PHASES ARE PERFECTLY MOBILE.
c
REPL=1.d0
REPG=1.d0
c
RETURN
14 CONTINUE
c-----RELATIVE PERMEABILITIES OF FATT AND KLIKOFF (1959), AS REPORTED
c BY K. UDELL (BERKELEY, 1982).
c
SS=0.d0
!els12/02/15 IF(SL.GT.RP(1,NMAT)) SS=(SL-RP(1,NMAT))/(1.d0-RP(1,NMAT))
IF(SL.GT.RP(1,NMAT)) SS=(SL-RP(1,NMAT))/rpsavpar(1,nmat)
REPL=SS**3
REPG=(1.d0-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
!els12/02/15 SS=(SL-RP(2,NMAT))/(RP(3,NMAT)-RP(2,NMAT))
SS=(SL-RP(2,NMAT))/rpsavpar(1,nmat)
REPL=0.d0
c
c .........................................................
c Incorporating ideal activity model
c .........................................................
c .........................................................
c MODULE_geochem
c .........................................................
c
subroutine hkfpar(T,tk,adh,bdh,bi,bil)
c
c
c
c bhat NaCl (b NaCl = bhat/(2.303RT)) from Table 29 (bi here)
c b Na+Cl- from Table 30 (bil here)
c A and B Debye-Huckel (adh and bdh) from Table 1 (cols. 3 and 4)
c
c Polynomial regression coefficients a, b, c, d, e, and f are
c stored in data statements below to calculate parameters as:
c parameter(T) = a + b*T + c*T + d*T**2 + e*T**3 + f*T**4
c where T is temperature in C.
c
c These are good for the range 0 to 300 C, BUT(!) the data
c available to fit bi and bil did not go down to T = 0 C
c (first point at 25 C) so the extrapolation may not be too good
c below 25 C for bi and bil (A and B data cover the entire range),
c but I checked that the extrapolated bi and bil values below
c 25 C vary smoothly down to 0 C.
c
c Note the following units:
c aft yields adh in kg**0.5 mol**(-0.5)
c bft yields bdh in kg**0.5 mol**(-0.5) Anstrom**(-1)
c bift yields bihat(NaCl) in kg/mol * 1e+3
c bilft yields bil (Na+Cl-) in kg/mol * 1e+2
c
implicit double precision (a-h,o-z)
implicit integer*8 (i-n)
double precision aft(5), bft(5), bift(5), bilft(5)
double precision t,tk,adh,bdh,bi,bil,bihat
c
data aft/0.49276542d+00,0.31857945d-03,0.11628933d-04,
& -0.52038832d-07,0.12633045d-09/
data bft/0.32476341d+00,0.12018502d-03,0.79530646d-06,
& -0.30410531d-08,0.56931304d-11/
data bift/0.26538636d+01,-0.52889569d-02,-0.11009615d-03,
& 0.46820513d-06,-0.11104895d-08/
data bilft/-0.14769091d+02,0.22563951d+00,-0.10225385d-02,
& 0.30349650d-05,-0.35468531d-08/
c
func(a,b,c,d,e,T) = a+(b+(c+(d+e*T)*T)*T)*T
c
SAVE ICALL
DATA ICALL/0/
ICALL=ICALL+1
IF(ICALL.eq.1) WRITE(11,"(
& 6x,'hkfpar 2.1 12 September 2013',
& 6x,'Assigns data for calculation of Debye-Huckel parameters'
& )")
c
adh=func(aft(1),aft(2),aft(3),aft(4),aft(5),T)
bdh=func(bft(1),bft(2),bft(3),bft(4),bft(5),T)
bihat=func(bift(1),bift(2),bift(3),bift(4),bift(5),T)*1.d-3
bi=bihat/(4.57061d0*tk) ![kg cal/mol]
bil=func(bilft(1),bilft(2),bilft(3),bilft(4),bilft(5),T)*1.d-2
c
return
end
c
c-------------------------------------------------------------------------------
c
subroutine dh_hkf81(no_ch,tk2,adh,bdh,bi,bil,str,gamp,gams,
& cs,ct,u2,cpw,xh2o,gampdl,gamsdl,
& mstar,stroot)
c
C****************** Calculate activity coefficient of aqueous species ************
C idryout is for dryout without update activity coefficients 0 and 1 normal, 2, skip
CC
c This routine computes activity coefficients of aqueous species
c and the activity of water using pitzer model or an extended DH model according
c to a user-specified ionic strength threshold and a user option. The extended
c DH model uses equations and parameters given in Helgeson, Kirkham and
c Flowers, 1981, A.J.S. p.1249-1516. Also computes neutral species activities
c from Setchenov equation (Langmuir 1997, Aqueous Environmental
c Geochemistry, Prentice Hall, p. 144).
c Charged species: individual ion activity coefficients calculated from:
c equation 298 (which includes 121, 122, 129, 130, 169, 170 and 297)
c - uses true ionic strenght.
c use bhat NaCl (b NaCl = bhat/(2.303RT)) from Table 29 (bi here)
c use b Na+Cl- from Table 30 (bil here)
c use Rej from Table 3 (input in thermodynamic database as
c a0 variable, but note that values are NOT a0 values)
c use A and B Debye-Huckel (adh and bdh) from Table 1 (cols. 3 and 4)
c caclulate a0 from input Rej values and eq. 125,
c assuming other dominant anion (for cations) is Cl- (rej=1.81 A)
c and cation (for anions) is Na+ (rej=1.91 A)
c
c Activity of water calculated from:
c osmotic coefficient using equation 190 and same parameters
c as above, assuming similar simplifications as done for
c the calculation of activity coefficients, but using
c stoichiometric ionic strength.
c equation 106 relating activity of water to the osm. coef.
c
c Regression coefficients a, b, c, d, e to obtain A, B, bi abd bil
c parameter as a function of temperature were calculated using
c 4th order polynomials as follow:
c f(T) = a + b*T + c*T**2 + d*T**3 + e*T**4
c
c Neutral species: assume gamma = 1 or,
c for weak acids and dissolved gases:
c log(activity coef)=sltout*ionic strength
c where sltout is input in a0 variable as 100+sltout
c For now, no temperature dependence on sltout is assumed as
c the effect is small compared to variation of solubility (K) with temp.
c
implicit double precision (a-h,o-z)
implicit integer*8 (i-n)
include 'flowpar_v4.inc'
include 'chempar_v4.inc'
include 'common_v4.inc'
integer*8 no_ch
integer*8 nprsec,ncp,niis,iis
double precision lambda, lambd2, mstar, mchr
double precision bdhstrt,bdhstr2,bdh3str2,adhstrt
double precision cpgmdms,bistr,bistr2,gamlog
double precision cpion(maqt)
double precision adh,bdh,bi,bil,str,tk2
double precision stroot,stroo2,sum,sum2,str2,summt,capgam
double precision cpw(mpri),xh2o
double precision gamp(mpri),gams(maqx)
cels5/1/14 keep versions that don't have to be logged
double precision gampdl(mpri),gamsdl(maqx)
double precision cs(maqx),u2(mpri),ct(mtot)
!els4/5/16 double precision gamln,gsalt,sltout,cpwmax
double precision gamln,gsalt,sltout
parameter(CC=-1.0312d0,FF=0.0012806d0,GG=255.9d0,EE=0.4445d0,
+ HH=-0.001606d0)
c
c
c-22-March-2000------ salting out effect, Wolery's EQ3NR Eq. (91)
c
SAVE ICALL
cpitz SAVE gam
DATA ICALL/0/
ccc data amwh2o/18.0152d0/
ICALL=ICALL+1
IF(ICALL.EQ.1) then
WRITE(11,899)
!els4/5/16 899 FORMAT(6X,'dh_hkf81 2.2 1 May 2014',6X,
899 FORMAT(6X,'dh_hkf81 2.3 5 Apr 2016',6X,
X'Calculate activity coefficient of aqueous species')
c
endif
C
cels5/22/12 moved initialization outside of icall loop
c
c ns-jan08 Initializes gammas
cels5/1/14 initial dlog of gamma
do i=1,npri+1 !ns12/2017 add 1 to store gamma for water
gamp(i) = 1.d0
gampdl(i) = 0.d0
enddo
c
do i=1,naqx
gams(i) = 1.d0
gamsdl(i) = 0.d0
enddo
c