From noreply at r-forge.r-project.org Thu Nov 1 08:25:20 2018 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 1 Nov 2018 08:25:20 +0100 (CET) Subject: [CHNOSZ-commits] r338 - in pkg/CHNOSZ: . R demo inst man man/macros Message-ID: <20181101072520.9DD8C188EDC@r-forge.r-project.org> Author: jedick Date: 2018-11-01 08:25:18 +0100 (Thu, 01 Nov 2018) New Revision: 338 Added: pkg/CHNOSZ/demo/gold.R Modified: pkg/CHNOSZ/DESCRIPTION pkg/CHNOSZ/R/examples.R pkg/CHNOSZ/R/solubility.R pkg/CHNOSZ/R/util.expression.R pkg/CHNOSZ/R/util.plot.R pkg/CHNOSZ/demo/00Index pkg/CHNOSZ/inst/NEWS pkg/CHNOSZ/man/examples.Rd pkg/CHNOSZ/man/macros/macros.Rd pkg/CHNOSZ/man/solubility.Rd pkg/CHNOSZ/man/util.expression.Rd Log: add demo/gold.R Modified: pkg/CHNOSZ/DESCRIPTION =================================================================== --- pkg/CHNOSZ/DESCRIPTION 2018-10-31 06:25:35 UTC (rev 337) +++ pkg/CHNOSZ/DESCRIPTION 2018-11-01 07:25:18 UTC (rev 338) @@ -1,6 +1,6 @@ -Date: 2018-10-31 +Date: 2018-11-01 Package: CHNOSZ -Version: 1.1.3-45 +Version: 1.1.3-46 Title: Thermodynamic Calculations and Diagrams for Geo(bio)chemistry Authors at R: c( person("Jeffrey", "Dick", , "j3ffdick at gmail.com", role = c("aut", "cre"), Modified: pkg/CHNOSZ/R/examples.R =================================================================== --- pkg/CHNOSZ/R/examples.R 2018-10-31 06:25:35 UTC (rev 337) +++ pkg/CHNOSZ/R/examples.R 2018-11-01 07:25:18 UTC (rev 338) @@ -28,7 +28,7 @@ demos <- function(which=c("sources", "protein.equil", "affinity", "NaCl", "density", "ORP", "revisit", "findit", "ionize", "buffer", "protbuff", "yeastgfp", "mosaic", - "copper", "oldsolub", "solubility", "wjd", "bugstab", "Shh", "activity_ratios", + "copper", "oldsolub", "solubility", "gold", "wjd", "bugstab", "Shh", "activity_ratios", "adenine", "DEW", "lambda", "TCA", "go-IU", "bison"), save.png=FALSE) { # run one or more demos from CHNOSZ with ask=FALSE, and return the value of the last one for(i in 1:length(which)) { Modified: pkg/CHNOSZ/R/solubility.R =================================================================== --- pkg/CHNOSZ/R/solubility.R 2018-10-31 06:25:35 UTC (rev 337) +++ pkg/CHNOSZ/R/solubility.R 2018-11-01 07:25:18 UTC (rev 338) @@ -3,7 +3,7 @@ solubility <- function(eout, exp = 1) { # exp = 1: e.g. dissolution of CO2 - # exp = 2: e.g. dissolution (dissociation) of CaCO3 + # exp = 2: e.g. dissolution (and dissociation) of CaCO3 # bookkeeping: track any single species itrack <- 1 @@ -19,14 +19,12 @@ A.whatif <- loga.species.track + A.track - loga.equil.track # predictive: assuming the species distribution doesn't change, - # what is the total loga that would give zero affinity? + # what is the total loga that gives zero affinity? # TODO: modify this according to stoichiometry (species with > 1 of the balanced basis species) loga.total <- (eout$loga.balance + A.whatif) / exp - message("solubility: calculated logarithm of total activity of ", eout$balance) # use the predicted loga.total to re-calculate activities of species aout <- eout[1:which(names(eout)=="values")] equilibrate(aout, loga.balance = loga.total) } - Modified: pkg/CHNOSZ/R/util.expression.R =================================================================== --- pkg/CHNOSZ/R/util.expression.R 2018-10-31 06:25:35 UTC (rev 337) +++ pkg/CHNOSZ/R/util.expression.R 2018-11-01 07:25:18 UTC (rev 338) @@ -2,6 +2,9 @@ # write descriptions of chemical species, properties, reactions, conditions # modified from describe(), axis.label() 20120121 jmd +## if this file is interactively sourced, the following are also needed to provide unexported functions: +#source("util.character.R") + expr.species <- function(species, state="", log="", value=NULL, use.makeup=FALSE, use.molality=FALSE) { # make plotting expressions for chemical formulas # that include subscripts, superscripts (if charged) @@ -38,16 +41,16 @@ if(coeff==-1) coeff <- "-" else if(coeff==1) coeff <- "+" else if(coeff > 0) coeff <- paste("+", as.character(coeff), sep="") - # append the coefficient (as a superscript if we're not in a log expression) - if(log != "") expr <- substitute(a*b, list(a=expr, b=coeff)) - else expr <- substitute(a^b, list(a=expr, b=coeff)) + # append the coefficient as a superscript + expr <- substitute(a^b, list(a=expr, b=coeff)) } } } # write a designation of physical state - # use the state given in log if it's a gas or neutral aqueous species - if(log %in% c("g", "gas")) state <- "g" - else if(!"Z" %in% names(elements) & !missing(log)) state <- log + ## deprecated 20181101 + ## use the state given in log if it's a gas or neutral aqueous species + #if(log %in% c("g", "gas")) state <- "g" + #else if(!"Z" %in% names(elements) & !missing(log)) state <- log if(state != "") { # subscript it if we're not in a log expression if(log != "") expr <- substitute(a*group('(',italic(b),')'),list(a=expr, b=state)) @@ -89,7 +92,7 @@ if(property=="Eh") return("Eh") if(property=="pH") return("pH") if(property=="pe") return("pe") - if(property=="IS") return("IS") + if(property=="IS") return(quote(italic(I))) if(property=="ZC") return(quote(italic(Z)[C])) # process each character in the property abbreviation prevchar <- character() @@ -182,15 +185,24 @@ return(desc) } -describe.basis <- function(basis=get("thermo")$basis, ibasis=1:nrow(basis), digits=1, oneline=FALSE) { +describe.basis <- function(basis = get("thermo")$basis, ibasis = 1:nrow(basis), + digits = 1, oneline = FALSE, use.molality = FALSE, use.pH = TRUE) { # make expressions for the chemical activities/fugacities of the basis species propexpr <- valexpr <- character() for(i in ibasis) { # propexpr is logarithm of activity or fugacity - propexpr <- c(propexpr, expr.species(rownames(basis)[i], log=basis$state[i])) - # we have an as.numeric here in case the basis$logact is character - # (by inclusion of a buffer for one of the other basis species) - valexpr <- c(valexpr, format(round(as.numeric(basis$logact[i]), digits), nsmall=digits)) + if(rownames(basis)[i]=="H+" & use.pH) thispropexpr <- "pH" + else thispropexpr <- expr.species(rownames(basis)[i], log=basis$state[i], use.molality = use.molality) + propexpr <- c(propexpr, thispropexpr) + if(can.be.numeric(basis$logact[i])) { + # we have an as.numeric here in case the basis$logact is character + # (by inclusion of a buffer for one of the other basis species) + if(thispropexpr=="pH") valexpr <- c(valexpr, format(round(-as.numeric(basis$logact[i]), digits), nsmall=digits)) + else valexpr <- c(valexpr, format(round(as.numeric(basis$logact[i]), digits), nsmall=digits)) + } else { + # a non-numeric value is the name of a buffer + valexpr <- c(valexpr, basis$logact[i]) + } } # write an equals sign between the property and value desc <- character() Modified: pkg/CHNOSZ/R/util.plot.R =================================================================== --- pkg/CHNOSZ/R/util.plot.R 2018-10-31 06:25:35 UTC (rev 337) +++ pkg/CHNOSZ/R/util.plot.R 2018-11-01 07:25:18 UTC (rev 338) @@ -104,7 +104,7 @@ if(eout$vars[1]=="P") P <- envert(xpoints, "bar") # logaH2O is 0 unless given in eout$basis iH2O <- match("H2O", rownames(eout$basis)) - if(is.na(iH2O)) logaH2O <- 0 else logaH2O <- eout$basis$logact[iH2O] + if(is.na(iH2O)) logaH2O <- 0 else logaH2O <- as.numeric(eout$basis$logact[iH2O]) # pH is 7 unless given in eout$basis or plotted on one of the axes iHplus <- match("H+", rownames(eout$basis)) if(eout$vars[1]=="pH") pH <- xpoints Modified: pkg/CHNOSZ/demo/00Index =================================================================== --- pkg/CHNOSZ/demo/00Index 2018-10-31 06:25:35 UTC (rev 337) +++ pkg/CHNOSZ/demo/00Index 2018-11-01 07:25:18 UTC (rev 338) @@ -14,6 +14,7 @@ copper Another example of mosaic(): complexation of copper with glycine species oldsolub Old solubility calculations using uniroot() solubility Solubility of calcite and CO2(gas) as a function of pH +gold Solubility of gold wjd Gibbs energy minimization: prebiological atmospheres and cell periphery of yeast dehydration log K of dehydration reactions; SVG file contains tooltips and links bugstab Formation potential of microbial proteins in colorectal cancer Added: pkg/CHNOSZ/demo/gold.R =================================================================== --- pkg/CHNOSZ/demo/gold.R (rev 0) +++ pkg/CHNOSZ/demo/gold.R 2018-11-01 07:25:18 UTC (rev 338) @@ -0,0 +1,195 @@ +# CHNOSZ/demo/gold.R: Au solubility calculations +# 20181101 jmd first version + +## additions to OBIGT: +# Au(HS) from Akinfiev and Zotov, 2010 +# (doi:10.1134/S0016702910070074) +# corrected H taken from Pokrovski et al., 2014 +# (doi:10.1144/SP402.4) +mod.obigt("Au(HS)", formula = "Au(HS)", state = "aq", ref1 = "AZ10", date = today(), + G = 8344, H = 13193, S = 50.86, Cp = 1.8, V = 56.5, + a1 = 9.4965, a2 = 15.4057, a3 = -0.3052, a4 = -3.1459, + c1 = -38.1356, c2 = 19.6524, omega = 0, z = 0) +# AuOH from Pokrovski et al., 2014 +mod.obigt("AuOH", formula = "AuOH", state = "aq", ref1 = "PAB+14", date = today(), + G = -32716, H = -41533, S = 21.89, Cp = -11.1, V = 32.4, + a1 = 6.1937, a2 = 7.3415, a3 = 2.8644, a4 = -3.0825, + c1 = -3.0370, c2 = -3.9635, omega = 0, z = 0) + +## modifications to OBIGT: +# AuCl2- from Akinfiev and Zotov, 2001 (reported in AZ10) +# (http://pleiades.online/cgi-perl/search.pl/?type=abstract&name=geochem&number=10&year=1&page=990) +mod.obigt("AuCl2-", formula = "AuCl2-", state = "aq", ref1 = "AZ01", date = today(), + G = -36795, H = -46664, S = 47.16, Cp = -26.4, V = 68.6, + a1 = 11.4774, a2 = 20.2425, a3 = -2.2063, a4 = -3.6158, + c1 = 27.0677, c2 = -22.240, omega = 0.8623, z = -1) +# Au(HS)2- from Pokrovski et al., 2014 +mod.obigt("Au(HS)2-", G = 3487, H = 4703, S = 77.46, Cp = 3.3, V = 75.1, + a1 = 12.3373, a2 = 22.3421, a3 = 3.0317, a4 = -3.7026, + c1 = -53.6010, c2 = 31.4030, omega = 0.7673, z = -1) + +# set up system +# use H2S here: it's the predominant species at the pH of the QMK buffer -- see sulfur() +basis(c("Al2O3", "SiO2", "Fe", "Au", "K+", "Cl-", "H2S", "H2O", "oxygen", "H+")) + +# create a pH buffer +mod.buffer("QMK", c("quartz", "muscovite", "K-feldspar"), "cr", 0) + +# define colors for Au(HS)2-, Au(HS), AuOH, AuCl2- +# after Williams-Jones et al., 2009 +# (doi:10.2113/gselements.5.5.281) +col <- c("#ED4037", "#F58645", "#0F9DE2", "#22CC88") + +# sulfur logfO2-pH diagrams showing redox and pH buffers at four temperatures 20181031 +sulfur <- function() { + species(delete = TRUE) + species(c("H2S", "HS-", "HSO4-", "SO4-2")) + T <- c(200, 300, 400, 500) + P <- 1000 + O2min <- c(-50, -40, -30, -25) + O2max <- c(-30, -20, -20, -10) + par(mfrow=c(2, 2)) + for(i in 1:4) { + a <- affinity(pH = c(0, 14), O2 = c(O2min[i], O2max[i]), T = T[i], P = 1000) + diagram(a) + basis("H+", "QMK") + pH_QMK <- -affinity(T = T[i], P = P, return.buffer = TRUE)$`H+` + abline(v = pH_QMK, lty = 2) + basis("O2", "HM") + O2_HM <- affinity(T = T[i], P = P, return.buffer = TRUE)$O2 + abline(h = O2_HM, lty = 2, col = "blue") + text(12, O2_HM, "HM", adj = c(0, -0.5), col = "blue") + basis("O2", "PPM") + O2_PPM <- affinity(T = T[i], P = P, return.buffer = TRUE)$O2 + abline(h = O2_PPM, lty = 2, col = "blue") + text(12, O2_PPM, "PPM", adj = c(0, -0.5), col = "blue") + # remove the buffers for next plot + basis("O2", 0) + basis("pH", 0) + } +} + +# log(m_Au)-pH diagram like Fig. 7 of Akinfiev and Zotov, 2001 +# (http://pleiades.online/cgi-perl/search.pl/?type=abstract&name=geochem&number=10&year=1&page=990) +Au_pH1 <- function() { + species(c("Au(HS)2-", "Au(HS)", "AuOH")) + # apply PPM buffer for fO2 and aH2S + basis("O2", "PPM") + basis("H2S", "PPM") + # calculate affinity, equilibrate, solubility + # (set IS = 0 for diagram to show "log m" instead of "log a") + a <- affinity(pH = c(3, 8), T = 300, P = 1000, IS = 0) + e <- equilibrate(a) + s <- solubility(e) + # make diagram and show total log molality + diagram(s, ylim = c(-10, -5), col = col, lwd = 2, lty = 1) + diagram(s, add = TRUE, type = "loga.balance", lwd = 3, lty = 2) + # add neutral pH line + pH <- -subcrt(c("H2O", "H+", "OH-"), c(-1, 1, 1), T = 300, P = 1000)$out$logK/2 + abline(v = pH, lty = 3) + # make legend and title + dprop <- describe.property(c("T", "P", "IS"), c(300, 1000, 0)) + legend("topleft", dprop, bty = "n") + dbasis <- describe.basis(ibasis = c(9, 7)) + legend("bottomright", dbasis, bty = "n") + title(main=("After Akinfiev and Zotov, 2001, Fig. 7"), font.main = 1) +} + +# log(m_Au)-pH diagram similar to Fig. 12b of Stefansson and Seward, 2004 +# (doi:10.1016/j.gca.2004.04.006) +Au_pH2 <- function() { + species(c("Au(HS)2-", "Au(HS)", "AuOH", "AuCl2-")) + # apply PPM buffer for fO2 and aH2S + basis("O2", "PPM") + basis("H2S", "PPM") + # calculate affinity, equilibrate, solubility + # (set IS = 0 for diagram to show "log m" instead of "log a") + a <- affinity(pH = c(3, 8), T = 450, P = 1000, IS = 0) + e <- equilibrate(a) + s <- solubility(e) + # make diagram and show total log molality + diagram(s, ylim = c(-8, -3), col = col, lwd = 2, lty = 1) + diagram(s, add = TRUE, type = "loga.balance", lwd = 3, lty = 2) + # add neutral pH line + pH <- -subcrt(c("H2O", "H+", "OH-"), c(-1, 1, 1), T = 450, P = 1000)$out$logK/2 + abline(v = pH, lty = 3) + # make legend and title + dprop <- describe.property(c("T", "P", "IS"), c(450, 1000, 0)) + legend("topleft", dprop, bty = "n") + dbasis <- describe.basis(ibasis = c(6, 9, 7)) + legend("topright", dbasis, bty = "n") + title(main=("After Stef\u00e1nsson and Seward, 2004, Fig. 12b"), font.main = 1, cex.main = 1.1) +} + +# log(m_Au)-T diagram like Fig. 2B of Williams-Jones et al., 2009 +# (doi:10.2113/gselements.5.5.281) +Au_T1 <- function() { + species(c("Au(HS)2-", "Au(HS)", "AuOH", "AuCl2-")) + # apply PPM buffer for fO2 and aH2S + basis("O2", "PPM") + basis("H2S", "PPM") + # apply QMK buffer for pH + basis("H+", "QMK") + # at 400 degC, 1000 bar, and IS=2, the logarithm of the activity coefficient of Cl- is -0.66: + loggam <- subcrt("Cl-", T=400, P=1000, IS=2)$out[[1]]$loggam + # for a total molality of 2 m (1.5 m NaCl and 0.5 m KCl), the activity of Cl- is about 10: + actCl <- 2/10^loggam + basis("Cl-", log10(actCl)) + # calculate affinity, equilibrate, solubility + a <- affinity(T = c(150, 550), P = 1000, IS = 2) + e <- equilibrate(a) + s <- solubility(e) + # make diagram and show total log molality + diagram(s, ylim = c(-10, -4), col = col, lwd = 2, lty = 1) + diagram(s, add = TRUE, type = "loga.balance", lwd = 3, lty = 2) + # make legend and title + dprop <- describe.property(c("P", "IS"), c(1000, 2)) + legend("topleft", dprop, bty = "n") + dbasis <- describe.basis(ibasis = c(6, 9, 7, 10)) + legend("bottomright", dbasis, bty = "n") + title(main=("After Williams-Jones et al., 2009, Fig. 2B"), font.main = 1) +} + +# log(m_Au)-T diagram like Fig. 2A of Williams-Jones et al., 2009 and Fig. 8a of Pokrovski et al., 2014 +# (doi:10.2113/gselements.5.5.281) +# (doi:10.1144/SP402.4) +Au_T2 <- function() { + species(c("Au(HS)2-", "Au(HS)", "AuOH", "AuCl2-")) + # set total activity of H2S + # TODO: the paper says total S = 0.01 m, + # but a higher activity makes the diagram here closer to + # that of Williams-Jones et al., 2009 + basis("H2S", -1) + # apply HM buffer for fO2 + basis("O2", "HM") + # apply QMK buffer for pH + basis("H+", "QMK") + # calculate activity coefficient of Cl- at IS=2 + loggam <- subcrt("Cl-", T = seq(150, 550, 10), P = 1000, IS = 2)$out[[1]]$loggam + # calculate activity of Cl- given a total molality of 2 m (1.5 m NaCl and 0.5 m KCl) + actCl <- 2/10^loggam + # TODO: adjust Cl- activity for increasing logK(T) of Na+ + Cl- = NaCl + # calculate affinity, equilibrate, solubility + a <- affinity(T = seq(150, 550, 10), `Cl-` = log10(actCl), P = 1000, IS = 2) + e <- equilibrate(a) + s <- solubility(e) + # make diagram and show total log molality + diagram(s, ylim = c(-10, -2), col = col, lwd = 2, lty = 1) + diagram(s, add = TRUE, type = "loga.balance", lwd = 3, lty = 2) + # make legend and title + dprop <- describe.property(c("P", "IS"), c(1000, 2)) + legend("topleft", dprop, bty = "n") + # show the log molality of Cl- + basis("Cl-", log10(2)) + dbasis1 <- describe.basis(ibasis = 6, use.molality = TRUE) + dbasis2 <- describe.basis(ibasis = c(9, 7, 10)) + legend("bottomright", c(dbasis1, dbasis2), bty = "n") + title(main=("After Williams-Jones et al., 2009, Fig. 2B"), font.main = 1) +} + +# make plots +par(mfrow=c(2, 2)) +Au_pH1() +Au_pH2() +Au_T1() +Au_T2() Modified: pkg/CHNOSZ/inst/NEWS =================================================================== --- pkg/CHNOSZ/inst/NEWS 2018-10-31 06:25:35 UTC (rev 337) +++ pkg/CHNOSZ/inst/NEWS 2018-11-01 07:25:18 UTC (rev 338) @@ -1,4 +1,4 @@ -CHANGES IN CHNOSZ 1.1.3-45 (2018-10-31) +CHANGES IN CHNOSZ 1.1.3-46 (2018-11-01) --------------------------------------- NEW FEATURES @@ -6,6 +6,10 @@ - Add solubility(). Run this after equilibrate() to calculate the solubility (loga.balance) of the balanced basis species. +- Add demo/gold.R for calculations of Au solubility (based on diagrams + from Akinfiev and Zotov, 2001, Stef?nsson and Seward, 2004, and + Williams-Jones et al., 2009). + - Revise demo/solubility.R to show solubility calculations for CO2(gas) and calcite as a function of T and pH. Modified: pkg/CHNOSZ/man/examples.Rd =================================================================== --- pkg/CHNOSZ/man/examples.Rd 2018-10-31 06:25:35 UTC (rev 337) +++ pkg/CHNOSZ/man/examples.Rd 2018-11-01 07:25:18 UTC (rev 338) @@ -16,7 +16,7 @@ demos(which = c("sources", "protein.equil", "affinity", "NaCl", "density", "ORP", "revisit", "findit", "ionize", "buffer", "protbuff", "yeastgfp", "mosaic", "copper", "oldsolub", - "solubility", "wjd", "bugstab", "Shh", "activity_ratios", + "solubility", "gold", "wjd", "bugstab", "Shh", "activity_ratios", "adenine", "DEW", "lambda", "TCA", "go-IU", "bison"), save.png=FALSE) } @@ -47,6 +47,7 @@ \code{copper} \tab * Another example of \code{\link{mosaic}}: complexation of Cu with glycine (Aksu and Doyle, 2001) \cr \code{oldsolub} \tab Old solubility calculations using \code{\link{uniroot}} \cr \code{solubility} \tab * Solubility of calcite (cf. Manning et al., 2013) and \CO2 (cf. Stumm and Morgan, 1996) \cr + \code{gold} \tab * Solubility of gold (Akinfiev and Zotov; 2001; Stef{\aacute}nsson and Seward, 2004; Williams-Jones et al., 2009) \cr \code{wjd} \tab * \eqn{G}{G} minimization: prebiological atmospheres (Dayhoff et al., 1964) and cell periphery of yeast \cr \code{dehydration} \tab * \logK of dehydration reactions; SVG file contains tooltips and links \cr \code{bugstab} \tab * Formation potential of microbial proteins in colorectal cancer (Dick, 2016) \cr @@ -80,6 +81,8 @@ } \references{ +Akinfiev, N. N. and Zotov, A. V. (2001) Thermodynamic description of chloride, hydrosulfide, and hydroxo complexes of Ag(I), Cu(I), and Au(I) at temperatures of 25-500\degC and pressures of 1-2000 bar. \emph{Geochem. Int.} \bold{39}, 990--1006. \url{http://pleiades.online/cgi-perl/search.pl/?type=abstract&name=geochem&number=10&year=1&page=990} + Aksu, S. and Doyle, F. M. (2001) Electrochemistry of copper in aqueous glycine solutions. \emph{J. Electrochem. Soc.} \bold{148}, B51--B57. \url{https://doi.org/10.1149/1.1344532} Amend, J. P. and Shock, E. L. (1998) Energetics of amino acid synthesis in hydrothermal ecosystems. \emph{Science} \bold{281}, 1659--1662. \url{https://doi.org/10.1126/science.281.5383.1659} @@ -114,12 +117,16 @@ Shock, E. L., Oelkers, E. H., Johnson, J. W., Sverjensky, D. A. and Helgeson, H. C. (1992) Calculation of the thermodynamic properties of aqueous species at high pressures and temperatures: Effective electrostatic radii, dissociation constants and standard partial molal properties to 1000 \degC and 5 kbar. \emph{J. Chem. Soc. Faraday Trans.} \bold{88}, 803--826. \url{https://doi.org/10.1039/FT9928800803} +Stef{\aacute}nsson, A. and Seward, T. M. (2004) Gold(I) complexing in aqueous sulphide solutions to 500\degC at 500 bar. \emph{Geochim. Cosmochim. Acta} \bold{68}, 4121--4143. \url{https://doi.org/10.1016/j.gca.2004.04.006} + Stumm, W. and Morgan, J. J. (1996) \emph{Aquatic Chemistry: Chemical Equilibria and Rates in Natural Waters}, John Wiley & Sons, New York, 1040 p. \url{http://www.worldcat.org/oclc/31754493} Sverjensky, D. A., Harrison, B. and Azzolini, D. (2014a) Water in the deep Earth: The dielectric constant and the solubilities of quartz and corundum to 60 kb and 1,200 \degC. \emph{Geochim. Cosmochim. Acta} \bold{129}, 125--145. \url{https://doi.org/10.1016/j.gca.2013.12.019} Sverjensky, D. A., Stagno, V. and Huang, F. (2014b) Important role for organic carbon in subduction-zone fluids in the deep carbon cycle. \emph{Nat. Geosci.} \bold{7}, 909--913. \url{https://doi.org/10.1038/ngeo2291} +Williams-Jones, A. E., Bowell, R. J. and Migdisov, A. A. (2009) Gold in solution. \emph{Elements} \bold{5}, 281--287. \url{https://doi.org/10.2113/gselements.5.5.281} + Zimmer, K., Zhang, Y., Lu, P., Chen, Y., Zhang, G., Dalkilic, M. and Zhu, C. (2016) SUPCRTBL: A revised and extended thermodynamic dataset and software package of SUPCRT92. \emph{Comp. Geosci.} \bold{90}, 97--111. \url{https://doi.org/10.1016/j.cageo.2016.02.013} } Modified: pkg/CHNOSZ/man/macros/macros.Rd =================================================================== --- pkg/CHNOSZ/man/macros/macros.Rd 2018-10-31 06:25:35 UTC (rev 337) +++ pkg/CHNOSZ/man/macros/macros.Rd 2018-11-01 07:25:18 UTC (rev 338) @@ -45,3 +45,4 @@ \newcommand{\ge}{\ifelse{latex}{\eqn{\ge}}{\ifelse{html}{\out{≥}}{?}}} \newcommand{\Psat}{\ifelse{latex}{\eqn{P_{\mathrm{SAT}}}}{\ifelse{html}{\out{PSAT}}{Psat}}} \newcommand{\Delta}{\ifelse{latex}{\eqn{\Delta}}{\ifelse{html}{\out{Δ}}{?}}} +\newcommand{\aacute}{\ifelse{latex}{\out{\'{a}}}{\ifelse{html}{\out{á}}{?}}} Modified: pkg/CHNOSZ/man/solubility.Rd =================================================================== --- pkg/CHNOSZ/man/solubility.Rd 2018-10-31 06:25:35 UTC (rev 337) +++ pkg/CHNOSZ/man/solubility.Rd 2018-11-01 07:25:18 UTC (rev 338) @@ -31,6 +31,17 @@ The output of \code{solubility} has the same format as that of \code{equilibrate}, and can be used by \code{\link{diagram}} with \code{type = "loga.balance"}. } +\section{Warning}{ +This function has not been tested for systems that may form dimers or higher-order complexes (such as Au\s{2}S\s{2}\S{2-}). +The lower figures in \code{demo("gold")} are incomplete, as they do not account for other possible reactions not involving Au, particularly the decrease of Cl\S{-} concentration owing to the rising stability of the NaCl\s{(aq)} complex at high temperature. +Except for relatively simple systems, even after careful refinement, the results from CHNOSZ, which considers chemical activities as the independent variables, will not match the results from speciation-solubility (or Gibbs energy minimization) codes, where the system is defined by its bulk composition. +} + +\seealso{ +\code{demo("solubility")} adds pH-\T diagrams to the CO\s{2} and calcite example here. +\code{demo("gold")} shows solubility calculations for Au in aqueous solutions with hydroxide, chloride, and hydrosulfide complexes. +} + \examples{\dontshow{data(thermo)} # solubility of CO2 and calcite as a function of pH par(mfrow = c(1, 2)) Modified: pkg/CHNOSZ/man/util.expression.Rd =================================================================== --- pkg/CHNOSZ/man/util.expression.Rd 2018-10-31 06:25:35 UTC (rev 337) +++ pkg/CHNOSZ/man/util.expression.Rd 2018-11-01 07:25:18 UTC (rev 338) @@ -21,7 +21,7 @@ axis.label(label, units = NULL, basis = get("thermo")$basis, prefix = "", use.molality = FALSE) describe.basis(basis = get("thermo")$basis, ibasis = 1:nrow(basis), - digits = 1, oneline = FALSE) + digits = 1, oneline = FALSE, use.molality = FALSE, use.pH = TRUE) describe.property(property, value, digits = 0, oneline = FALSE, ret.val = FALSE) describe.reaction(reaction, iname = numeric(), states = NULL) @@ -36,6 +36,7 @@ \item{value}{numeric, logarithm of activity or fugacity of species, or value of other property} \item{use.makeup}{logical, use \code{\link{makeup}} to count the elements?} \item{use.molality}{logical, use molality (m) instead of activity (a) for aqueous species?} + \item{use.pH}{logical, use pH instead of log activity of H+?} \item{property}{character, description of chemical property} \item{prefix}{character, prefix for units} \item{per}{character, denominator in units} From noreply at r-forge.r-project.org Sun Nov 4 15:44:14 2018 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 4 Nov 2018 15:44:14 +0100 (CET) Subject: [CHNOSZ-commits] r339 - in pkg/CHNOSZ: . R demo inst man Message-ID: <20181104144414.4F1F718B075@r-forge.r-project.org> Author: jedick Date: 2018-11-04 15:44:13 +0100 (Sun, 04 Nov 2018) New Revision: 339 Added: pkg/CHNOSZ/R/NaCl.R pkg/CHNOSZ/man/NaCl.Rd Modified: pkg/CHNOSZ/DESCRIPTION pkg/CHNOSZ/NAMESPACE pkg/CHNOSZ/demo/gold.R pkg/CHNOSZ/inst/NEWS pkg/CHNOSZ/man/solubility.Rd Log: add NaCl() for first-order estimate of H2O + NaCl solutions Modified: pkg/CHNOSZ/DESCRIPTION =================================================================== --- pkg/CHNOSZ/DESCRIPTION 2018-11-01 07:25:18 UTC (rev 338) +++ pkg/CHNOSZ/DESCRIPTION 2018-11-04 14:44:13 UTC (rev 339) @@ -1,6 +1,6 @@ -Date: 2018-11-01 +Date: 2018-11-04 Package: CHNOSZ -Version: 1.1.3-46 +Version: 1.1.3-47 Title: Thermodynamic Calculations and Diagrams for Geo(bio)chemistry Authors at R: c( person("Jeffrey", "Dick", , "j3ffdick at gmail.com", role = c("aut", "cre"), Modified: pkg/CHNOSZ/NAMESPACE =================================================================== --- pkg/CHNOSZ/NAMESPACE 2018-11-01 07:25:18 UTC (rev 338) +++ pkg/CHNOSZ/NAMESPACE 2018-11-04 14:44:13 UTC (rev 339) @@ -56,7 +56,7 @@ "calculateEpsilon", "calculateQ", "water.DEW", "berman", "maxdiff", "expect_maxdiff", "Bdot", # added 20171121 or later - "dumpdata", "thermo.axis", "solubility" + "dumpdata", "thermo.axis", "solubility", "NaCl" ) # Load shared objects Added: pkg/CHNOSZ/R/NaCl.R =================================================================== --- pkg/CHNOSZ/R/NaCl.R (rev 0) +++ pkg/CHNOSZ/R/NaCl.R 2018-11-04 14:44:13 UTC (rev 339) @@ -0,0 +1,48 @@ +# NaCl.R +# calculate ion activities and ionic strength +# given a total molality of NaCl +# taking account of ion association: Na+ + Cl- = NaCl(aq) +# 20181102 jmd first version + +NaCl <- function(T=seq(100, 500, 100), P=1000, m_tot=2) { + # define a function for the reaction quotient + logQ <- function(m_Cl, gamma) { + # starting with Q = a_NaCl / (a_Na+ * a_Cl-), + # substitute gam_NaCl = 0, m_NaCl + m_Cl = m_tot, m_Cl = m_Na, gam_Cl = gam_Na = gamma + # to write: + log10( (m_tot - m_Cl) / (m_Cl * gamma) ^ 2 ) + } + # define a function for affinity = log(K / Q) + A <- function(m_Cl, gamma, logK) logK - logQ(m_Cl, gamma) + # calculate equilibrium constant at all temperatures (standard conditions: IS = 0) + logK <- subcrt(c("Na+", "Cl-", "NaCl"), c(-1, -1, 1), T = T, P = P)$out$logK + # calculate Debye-Huckel parameters at all temperatures + wout <- water(c("A_DH", "B_DH"), T = convert(T, "K"), P = P) + # initialize output variables + N <- length(T) + ISout <- a_Cl <- numeric(N) + # initial guess for m_Cl and ionic strength assuming complete dissociation of NaCl + IS <- m_Cl <- rep(m_tot, N) + # the species index for Cl- + iCl <- info("Cl-") + # we start by doing calculations for all temperatures + doit <- !logical(N) + while(any(doit)) { + # calculate activity coefficient at given ionic strength + gamma <- suppressMessages(10^nonideal(iCl, list(data.frame(G=numeric(N))), IS=IS, T=convert(T, "K"), P=P, A_DH=wout$A_DH, B_DH=wout$B_DH)[[1]]$loggam) + # solve for m_Cl + for(i in which(doit)) m_Cl[i] <- uniroot(A, c(0, m_tot), gamma=gamma[i], logK=logK[i])$root + # calculate new ionic strength and deviation + ISnew <- m_Cl + dIS <- ISnew - IS + # set net ionic strength + IS <- ISnew + # keep going until the deviation in ionic strength at any temperature is less than 0.01 + doit <- abs(dIS) > 0.01 + } + # assemble final gamma and activity of Cl- + gamma <- suppressMessages(10^nonideal(iCl, list(data.frame(G=numeric(N))), IS=IS, T=convert(T, "K"), P=P, A_DH=wout$A_DH, B_DH=wout$B_DH)[[1]]$loggam) + a_Cl <- m_Cl * gamma + # return the calculated values + list(IS=IS, gamma=gamma, a_Cl=a_Cl) +} Modified: pkg/CHNOSZ/demo/gold.R =================================================================== --- pkg/CHNOSZ/demo/gold.R 2018-11-01 07:25:18 UTC (rev 338) +++ pkg/CHNOSZ/demo/gold.R 2018-11-04 14:44:13 UTC (rev 339) @@ -31,6 +31,8 @@ # set up system # use H2S here: it's the predominant species at the pH of the QMK buffer -- see sulfur() basis(c("Al2O3", "SiO2", "Fe", "Au", "K+", "Cl-", "H2S", "H2O", "oxygen", "H+")) +# set activity of K+ for 0.5 molal KCl assuming complete dissociation +basis("K+", log10(0.5)) # create a pH buffer mod.buffer("QMK", c("quartz", "muscovite", "K-feldspar"), "cr", 0) @@ -130,23 +132,22 @@ basis("H2S", "PPM") # apply QMK buffer for pH basis("H+", "QMK") - # at 400 degC, 1000 bar, and IS=2, the logarithm of the activity coefficient of Cl- is -0.66: - loggam <- subcrt("Cl-", T=400, P=1000, IS=2)$out[[1]]$loggam - # for a total molality of 2 m (1.5 m NaCl and 0.5 m KCl), the activity of Cl- is about 10: - actCl <- 2/10^loggam - basis("Cl-", log10(actCl)) + # calculate solution composition for 2 mol/kg NaCl + NaCl <- NaCl(T = seq(150, 550, 10), P = 1000, m_tot=2) # calculate affinity, equilibrate, solubility - a <- affinity(T = c(150, 550), P = 1000, IS = 2) + a <- affinity(T = seq(150, 550, 10), `Cl-` = log10(NaCl$a_Cl), P = 1000, IS = NaCl$IS) e <- equilibrate(a) s <- solubility(e) # make diagram and show total log molality diagram(s, ylim = c(-10, -4), col = col, lwd = 2, lty = 1) diagram(s, add = TRUE, type = "loga.balance", lwd = 3, lty = 2) # make legend and title - dprop <- describe.property(c("P", "IS"), c(1000, 2)) - legend("topleft", dprop, bty = "n") - dbasis <- describe.basis(ibasis = c(6, 9, 7, 10)) - legend("bottomright", dbasis, bty = "n") + dP <- describe.property("P", 1000) + dNaCl <- expression(NaCl == 2~mol~kg^-1) + dK <- describe.basis(ibasis=5) + legend("topleft", c(dP, dNaCl, dK), bty = "n") + dbasis <- describe.basis(ibasis = c(9, 7, 10)) + legend("topright", dbasis, bty = "n") title(main=("After Williams-Jones et al., 2009, Fig. 2B"), font.main = 1) } @@ -155,36 +156,29 @@ # (doi:10.1144/SP402.4) Au_T2 <- function() { species(c("Au(HS)2-", "Au(HS)", "AuOH", "AuCl2-")) - # set total activity of H2S - # TODO: the paper says total S = 0.01 m, - # but a higher activity makes the diagram here closer to - # that of Williams-Jones et al., 2009 - basis("H2S", -1) + # approximate activity of H2S for total S = 0.01 m + basis("H2S", -2) # apply HM buffer for fO2 basis("O2", "HM") # apply QMK buffer for pH basis("H+", "QMK") - # calculate activity coefficient of Cl- at IS=2 - loggam <- subcrt("Cl-", T = seq(150, 550, 10), P = 1000, IS = 2)$out[[1]]$loggam - # calculate activity of Cl- given a total molality of 2 m (1.5 m NaCl and 0.5 m KCl) - actCl <- 2/10^loggam - # TODO: adjust Cl- activity for increasing logK(T) of Na+ + Cl- = NaCl + # calculate solution composition for 2 mol/kg NaCl + NaCl <- NaCl(T = seq(150, 550, 10), P = 1000, m_tot=2) # calculate affinity, equilibrate, solubility - a <- affinity(T = seq(150, 550, 10), `Cl-` = log10(actCl), P = 1000, IS = 2) + a <- affinity(T = seq(150, 550, 10), `Cl-` = log10(NaCl$a_Cl), P = 1000, IS = NaCl$IS) e <- equilibrate(a) s <- solubility(e) # make diagram and show total log molality diagram(s, ylim = c(-10, -2), col = col, lwd = 2, lty = 1) diagram(s, add = TRUE, type = "loga.balance", lwd = 3, lty = 2) # make legend and title - dprop <- describe.property(c("P", "IS"), c(1000, 2)) - legend("topleft", dprop, bty = "n") - # show the log molality of Cl- - basis("Cl-", log10(2)) - dbasis1 <- describe.basis(ibasis = 6, use.molality = TRUE) - dbasis2 <- describe.basis(ibasis = c(9, 7, 10)) - legend("bottomright", c(dbasis1, dbasis2), bty = "n") - title(main=("After Williams-Jones et al., 2009, Fig. 2B"), font.main = 1) + dP <- describe.property("P", 1000) + dNaCl <- expression(NaCl == 2~mol~kg^-1) + dK <- describe.basis(ibasis=5) + legend("topleft", c(dP, dNaCl, dK), bty = "n") + dbasis <- describe.basis(ibasis = c(9, 7, 10)) + legend("topright", dbasis, bty = "n") + title(main=("After Williams-Jones et al., 2009, Fig. 2A"), font.main = 1) } # make plots Modified: pkg/CHNOSZ/inst/NEWS =================================================================== --- pkg/CHNOSZ/inst/NEWS 2018-11-01 07:25:18 UTC (rev 338) +++ pkg/CHNOSZ/inst/NEWS 2018-11-04 14:44:13 UTC (rev 339) @@ -1,4 +1,4 @@ -CHANGES IN CHNOSZ 1.1.3-46 (2018-11-01) +CHANGES IN CHNOSZ 1.1.3-47 (2018-11-01) --------------------------------------- NEW FEATURES @@ -6,10 +6,15 @@ - Add solubility(). Run this after equilibrate() to calculate the solubility (loga.balance) of the balanced basis species. -- Add demo/gold.R for calculations of Au solubility (based on diagrams - from Akinfiev and Zotov, 2001, Stef?nsson and Seward, 2004, and - Williams-Jones et al., 2009). +- Add NaCl(), implementing a first-order calculation of the speciation + of NaCl in water, taking account of activity coefficients and the + reaction Na+ + Cl- = NaCl(aq). +- Add demo/gold.R for calculations of Au solubility in hydrothermal + chloride and sulfide solutions (based on diagrams from Akinfiev and + Zotov, 2001, Stef?nsson and Seward, 2004, and Williams-Jones et al., + 2009). + - Revise demo/solubility.R to show solubility calculations for CO2(gas) and calcite as a function of T and pH. Added: pkg/CHNOSZ/man/NaCl.Rd =================================================================== --- pkg/CHNOSZ/man/NaCl.Rd (rev 0) +++ pkg/CHNOSZ/man/NaCl.Rd 2018-11-04 14:44:13 UTC (rev 339) @@ -0,0 +1,92 @@ +\encoding{UTF-8} +\name{NaCl} +\alias{NaCl} +\title{Simple NaCl-Water Solution} +\description{ +Calculate speciation and ionic strength of aqueous solutions with a given molality of NaCl. +} + +\usage{ + NaCl(T = seq(100, 500, 100), P = 1000, m_tot = 2) +} + +\arguments{ + \item{T}{numeric, temperature in \degC} + \item{P}{numeric, pressure in bar (single value)} + \item{m_tot}{numeric, total molality of NaCl (single value)} +} + +\details{ +This function calculates speciation (ion activities) and ionic strength in aqueous solutions given a total amount (\code{m_tot}, in mol/kg) of NaCl. +The function is written for quick calculations along a temperature range (\code{T}) at constant pressure (\code{P}). +The only reaction considered is Na\S{+} + Cl\S{-} = NaCl(aq). +The algorithm starts by calculating the equilibrium constant (\emph{K}) of the reaction and assuming complete dissociation of NaCl(aq). +This also permits calculating the ionic strength from the molalities of Na\S{+} and Cl\S{-}. +Then, \code{\link{uniroot}} is used to find the equilibrium molality of Cl\S{-}; that is, where the affinity of the reaction (log(\emph{K}/\emph{Q})) becomes zero. +The activity quotient (\emph{Q}) is evaluated taking account of activity coefficients calculated for the nominal ionic strength (see \code{\link{nonideal}}). +The calculated molality of Cl\S{-} yields a new estimate of the ionic strength of the system. +The calculations are iterated until the deviation in ionic strength at all temperatures is less than 0.01. +} + +\section{Warning}{ +This function provides only a first-order estimate of the solution composition, and is intended for solubility calculations of relatively insoluble metals in NaCl-dominated solutions. +The formation of other species such as HCl or NaOH is not accounted for. +} + +\value{ +A list with components \samp{IS} (\dQuote{true} ionic strength from concentrations of unpaired ions), \samp{gamma} (activity coefficient of Cl\S{-}), \samp{a_Cl} (activity of Cl\S{-}). +} + +\seealso{ +\code{demo("gold")} for an application of this function. +} + +\examples{\dontshow{data(thermo)} +# ionic strength and activity coefficient of Cl- +# from HCh (Shvarov and Bastrakov, 1999) at 1000 bar, +# 100, 200, and 300 degress C, and 1 to 6 molal NaCl +m.HCh <- 1:6 +IS.HCh <- list(`100`=c(0.992, 1.969, 2.926, 3.858, 4.758, 5.619), + `300`=c(0.807, 1.499, 2.136, 2.739, 3.317, 3.875), + `500`=c(0.311, 0.590, 0.861, 1.125, 1.385, 1.642)) +gam.HCh <- list(`100`=c(0.565, 0.545, 0.551, 0.567, 0.589, 0.615), + `300`=c(0.366, 0.307, 0.275, 0.254, 0.238, 0.224), + `500`=c(0.19, 0.137, 0.111, 0.096, 0.085, 0.077)) +# total molality in the calculation with NaCl() +m_tot <- seq(1, 6, 0.5) +N <- length(m_tot) +# where we'll put the calculated values +IS.calc <- data.frame(`100`=numeric(N), `300`=numeric(N), `500`=numeric(N)) +gam.calc <- data.frame(`100`=numeric(N), `300`=numeric(N), `500`=numeric(N)) +# NaCl() is *not* vectorized over m_tot, so we use a loop here +for(i in 1:length(m_tot)) { + NaCl.out <- NaCl(c(100, 300, 500), m_tot=m_tot[i]) + IS.calc[i, ] <- NaCl.out$IS + gam.calc[i, ] <- NaCl.out$gamma +} +# plot ionic strength from HCh and NaCl() as points and lines +par(mfrow=c(2, 1)) +col <- c("black", "red", "orange") +plot(c(1,6), c(0,6), xlab="NaCl (mol/kg)", ylab="I (mol/kg)", type="n") +for(i in 1:3) { + points(m.HCh, IS.HCh[[i]], col=col[i]) + lines(m_tot, IS.calc[, i], col=col[i]) +} +# add 1:1 line, legend, and title +abline(0, 1, lty=3) +dprop <- describe.property(rep("T", 3), c(100, 300, 500)) +legend("topleft", dprop, lty=1, pch=1, col=col) +title(main="H2O + NaCl; HCh (points) and 'NaCl()' (lines)") +# plot activity coefficient (gamma) +plot(c(1,6), c(0,1), xlab="NaCl (mol/kg)", ylab="gamma", type="n") +for(i in 1:3) { + points(m.HCh, gam.HCh[[i]], col=col[i]) + lines(m_tot, gam.calc[, i], col=col[i]) +} +} + +\references{ +Shvarov, Y. and Bastrakov, E. (1999) HCh: A software package for geochemical equilibrium modelling. User's Guide. \emph{Australian Geological Survey Organisation} \bold{1999/25}. +} + +\concept{Extended workflow} Modified: pkg/CHNOSZ/man/solubility.Rd =================================================================== --- pkg/CHNOSZ/man/solubility.Rd 2018-11-01 07:25:18 UTC (rev 338) +++ pkg/CHNOSZ/man/solubility.Rd 2018-11-04 14:44:13 UTC (rev 339) @@ -38,7 +38,7 @@ } \seealso{ -\code{demo("solubility")} adds pH-\T diagrams to the CO\s{2} and calcite example here. +\code{demo("solubility")} adds \T-pH diagrams to the CO\s{2} and calcite example here. \code{demo("gold")} shows solubility calculations for Au in aqueous solutions with hydroxide, chloride, and hydrosulfide complexes. } From noreply at r-forge.r-project.org Mon Nov 5 08:08:13 2018 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 5 Nov 2018 08:08:13 +0100 (CET) Subject: [CHNOSZ-commits] r340 - in pkg/CHNOSZ: . R inst man tests/testthat Message-ID: <20181105070813.6F58518144B@r-forge.r-project.org> Author: jedick Date: 2018-11-05 08:08:12 +0100 (Mon, 05 Nov 2018) New Revision: 340 Modified: pkg/CHNOSZ/DESCRIPTION pkg/CHNOSZ/R/nonideal.R pkg/CHNOSZ/inst/NEWS pkg/CHNOSZ/man/NaCl.Rd pkg/CHNOSZ/man/nonideal.Rd pkg/CHNOSZ/tests/testthat/test-logmolality.R pkg/CHNOSZ/tests/testthat/test-nonideal.R Log: nonideal(): use ion-size parameters for different species Modified: pkg/CHNOSZ/DESCRIPTION =================================================================== --- pkg/CHNOSZ/DESCRIPTION 2018-11-04 14:44:13 UTC (rev 339) +++ pkg/CHNOSZ/DESCRIPTION 2018-11-05 07:08:12 UTC (rev 340) @@ -1,6 +1,6 @@ -Date: 2018-11-04 +Date: 2018-11-05 Package: CHNOSZ -Version: 1.1.3-47 +Version: 1.1.3-48 Title: Thermodynamic Calculations and Diagrams for Geo(bio)chemistry Authors at R: c( person("Jeffrey", "Dick", , "j3ffdick at gmail.com", role = c("aut", "cre"), Modified: pkg/CHNOSZ/R/nonideal.R =================================================================== --- pkg/CHNOSZ/R/nonideal.R 2018-11-04 14:44:13 UTC (rev 339) +++ pkg/CHNOSZ/R/nonideal.R 2018-11-05 07:08:12 UTC (rev 340) @@ -54,9 +54,9 @@ } # function for Debye-Huckel equation with B-dot extended term parameter (Helgeson, 1969) - Helgeson <- function(Z, I, T, P, A_DH, B_DH, prop = "loggamma") { - # "distance of closest approach" of ions in NaCl solutions (HKF81 Table 2) - acirc <- 3.72e-8 # cm + Helgeson <- function(Z, I, T, P, A_DH, B_DH, prop = "loggamma", acirc) { + ## "distance of closest approach" of ions in NaCl solutions (HKF81 Table 2) + #acirc <- 3.72e-8 # cm if(method=="Helgeson") loggamma <- - A_DH * Z^2 * I^0.5 / (1 + acirc * B_DH * I^0.5) + Bdot * I else if(method=="Helgeson0") loggamma <- - A_DH * Z^2 * I^0.5 / (1 + acirc * B_DH * I^0.5) R <- 1.9872 # gas constant, cal K^-1 mol^-1 @@ -70,39 +70,69 @@ # get species indices if(!is.numeric(species[[1]])) species <- info(species, "aq") + # loop over species #1: get the charge + Z <- numeric(length(species)) + for(i in 1:length(species)) { + # force a charge count even if it's zero + mkp <- makeup(c("Z0", species[i]), sum=TRUE) + thisZ <- mkp[match("Z", names(mkp))] + # don't do anything for neutral species (Z absent from formula or equal to zero) + if(is.na(thisZ)) next + if(thisZ==0) next + Z[i] <- thisZ + } + # get species formulas to assign acirc 20181105 + if(grepl("Helgeson", method)) { + formula <- get("thermo")$obigt$formula[species] + # "ion size paramter" taken from UT_SIZES.REF of HCh package (Shvarov and Bastrakov, 1999), + # based on Table 2.7 of Garrels and Christ, 1965 + acircdat <- c("Rb+"=2.5, "Cs+"=2.5, "NH4+"=2.5, "Tl+"=2.5, "Ag+"=2.5, + "K+"=3, "Cl-"=3, "Br-"=3, "I-"=3, "NO3-"=3, + "OH-"=3.5, "F-"=3.5, "HS-"=3.5, "BrO3-"=3.5, "IO3-"=3.5, "MnO4-"=3.5, + "Na+"=4, "HCO3-"=4, "H2PO4-"=4, "HSO3-"=4, "Hg2+2"=4, "SO4-2"=4, "SeO4-2"=4, "CrO4-2"=4, "HPO4-2"=4, "PO4-3"=4, + "Pb+2"=4.5, "CO3-2"=4.5, "SO4-2"=4.5, "MoO4-2"=4.5, + "Sr+2"=5, "Ba+2"=5, "Ra+2"=5, "Cd+2"=5, "Hg+2"=5, "S-2"=5, "WO4-2"=5, + "Li+"=6, "Ca+2"=6, "Cu+2"=6, "Zn+2"=6, "Sn+2"=6, "Mn+2"=6, "Fe+2"=6, "Ni+2"=6, "Co+2"=6, + "Mg+2"=8, "Be+2"=8, + "H+"=9, "Al+3"=9, "Cr+3"=9, "La+3"=9, "Ce+3"=9, "Y+3"=9, "Eu+3"=9, + "Th+4"=11, "Zr+4"=11, "Ce+4"=11, "Sn+4"=11) + acirc <- as.numeric(acircdat[formula]) + acirc[is.na(acirc)] <- 4.5 + # make a message + nZ <- sum(Z!=0) + if(nZ > 1) message("nonideal: using ", paste(acirc[Z!=0], collapse=" "), " for ion size parameters of ", paste(formula[Z!=0], collapse=" ")) + else if(nZ==1) message("nonideal: using ", acirc[Z!=0], " for ion size parameter of ", formula[Z!=0]) + # use correct units for ion size paramter + acirc <- acirc * 10^-8 + } + # loop over species #2: activity coefficient calculations iH <- info("H+") ie <- info("e-") speciesprops <- as.list(speciesprops) ndid <- 0 - # loop over species for(i in 1:length(species)) { myprops <- speciesprops[[i]] - # get the charge from the chemical formula - # force a charge count even if it's zero - mkp <- makeup(c("Z0", species[i]), sum=TRUE) - Z <- mkp[match("Z", names(mkp))] - # don't do anything for neutral species (Z absent from formula or equal to zero) - if(is.na(Z)) next - if(Z==0) next # to keep unit activity coefficients of the proton and electron if(species[i] == iH & get("thermo")$opt$ideal.H) next if(species[i] == ie & get("thermo")$opt$ideal.e) next + # skip neutral species + if(Z[i]==0) next didit <- FALSE for(j in 1:ncol(myprops)) { pname <- colnames(myprops)[j] if(method=="Alberty" & pname %in% c("G", "H", "S", "Cp")) { - myprops[, j] <- myprops[, j] + Alberty(Z, IS, T, pname) + myprops[, j] <- myprops[, j] + Alberty(Z[i], IS, T, pname) didit <- TRUE } else if(grepl("Helgeson", method) & pname %in% c("G", "H", "S", "Cp")) { - myprops[, j] <- myprops[, j] + Helgeson(Z, IS, T, P, A_DH, B_DH, pname) + myprops[, j] <- myprops[, j] + Helgeson(Z[i], IS, T, P, A_DH, B_DH, pname, acirc[i]) didit <- TRUE } } # append a loggam column if we did any nonideal calculations of thermodynamic properties if(didit) { - if(method=="Alberty") myprops <- cbind(myprops, loggam = Alberty(Z, IS, T)) + if(method=="Alberty") myprops <- cbind(myprops, loggam = Alberty(Z[i], IS, T)) else if(grepl("Helgeson", method)) { - myprops <- cbind(myprops, loggam = Helgeson(Z, IS, T, P, A_DH, B_DH)) + myprops <- cbind(myprops, loggam = Helgeson(Z[i], IS, T, P, A_DH, B_DH, "loggamma", acirc[i])) } } speciesprops[[i]] <- myprops Modified: pkg/CHNOSZ/inst/NEWS =================================================================== --- pkg/CHNOSZ/inst/NEWS 2018-11-04 14:44:13 UTC (rev 339) +++ pkg/CHNOSZ/inst/NEWS 2018-11-05 07:08:12 UTC (rev 340) @@ -1,4 +1,4 @@ -CHANGES IN CHNOSZ 1.1.3-47 (2018-11-01) +CHANGES IN CHNOSZ 1.1.3-48 (2018-11-05) --------------------------------------- NEW FEATURES @@ -10,6 +10,10 @@ of NaCl in water, taking account of activity coefficients and the reaction Na+ + Cl- = NaCl(aq). +- nonideal() now uses specific ion-size parameters for different ions, + in accord with the HCh package (Shvarov and Bastrakov, 1999). + Parameters are from Table 2.7 of Garrels and Christ, 1965. + - Add demo/gold.R for calculations of Au solubility in hydrothermal chloride and sulfide solutions (based on diagrams from Akinfiev and Zotov, 2001, Stef?nsson and Seward, 2004, and Williams-Jones et al., Modified: pkg/CHNOSZ/man/NaCl.Rd =================================================================== --- pkg/CHNOSZ/man/NaCl.Rd 2018-11-04 14:44:13 UTC (rev 339) +++ pkg/CHNOSZ/man/NaCl.Rd 2018-11-05 07:08:12 UTC (rev 340) @@ -42,7 +42,7 @@ } \examples{\dontshow{data(thermo)} -# ionic strength and activity coefficient of Cl- +# ionic strength of solution and activity coefficient of Cl- # from HCh (Shvarov and Bastrakov, 1999) at 1000 bar, # 100, 200, and 300 degress C, and 1 to 6 molal NaCl m.HCh <- 1:6 @@ -60,7 +60,7 @@ gam.calc <- data.frame(`100`=numeric(N), `300`=numeric(N), `500`=numeric(N)) # NaCl() is *not* vectorized over m_tot, so we use a loop here for(i in 1:length(m_tot)) { - NaCl.out <- NaCl(c(100, 300, 500), m_tot=m_tot[i]) + NaCl.out <- NaCl(c(100, 300, 500), P=1000, m_tot=m_tot[i]) IS.calc[i, ] <- NaCl.out$IS gam.calc[i, ] <- NaCl.out$gamma } Modified: pkg/CHNOSZ/man/nonideal.Rd =================================================================== --- pkg/CHNOSZ/man/nonideal.Rd 2018-11-04 14:44:13 UTC (rev 339) +++ pkg/CHNOSZ/man/nonideal.Rd 2018-11-05 07:08:12 UTC (rev 340) @@ -39,7 +39,7 @@ If \code{method} is \samp{Helgeson}, the \dQuote{B-dot} equation is used. This equation seems to have been originally proposed by Huckel, 1925; parameters were derived for use at high temperature and pressure by Helgeson, 1969; Helgeson et al., 1981; Manning, 2013. -The distance of closest approach (the \dQuote{ion size parameter}) is set to 3.72 Angstrom, which is appropriate for NaCl-dominated solutions (Helgeson et al., 1981 Table 2). +The distance of closest approach (the \dQuote{ion size parameter}) is taken from the UT_SIZES.REF file of the HCh package (Shvarov and Bastrakov, 1992), which is based on Table 2.7 of Garrels and Christ, 1965. In addition to \code{IS} and \code{T}, this method depends on values of \code{P}, \code{A_DH}, and \code{B_DH} given in the arguments. The calculation of \dQuote{B-dot}, also used in the equations, is made within \code{nonideal} by calling the \code{Bdot} function. For some uses, it is desirable to set the \dQuote{B-dot} parameter to zero; this can be done by setting the method to \code{Helgeson0}. @@ -138,7 +138,7 @@ nonideal(oldnon) # same as nonideal("Helgeson") ## activity coefficients for monovalent ions at 700 degC, 10 kbar -# after Manning, 2010, Fig. 7 +# after Manning, 2013, Fig. 7 IS <- c(0.001, 0.01, 0.1, 1, 2, 2.79) # we're above 5000 bar, so need to use IAPWS-95 or DEW oldwat <- water("DEW") @@ -153,10 +153,9 @@ # the activity coefficient; check values of the latter Manning_gamma <- c(0.93, 0.82, 0.65, 0.76, 1.28, 2) gamma <- 10^nonidealprops[[1]]$loggam -# we're getting progressively further from his values with -# higher IS; not sure why +# the error is larger at higher IS stopifnot(maxdiff(gamma[1], Manning_gamma[1]) < 0.01) -stopifnot(maxdiff(gamma, Manning_gamma) < 0.23) +stopifnot(maxdiff(gamma, Manning_gamma) < 0.36) ## data and splines used for calculating B-dot ## (extended term parameter) @@ -167,6 +166,8 @@ \references{ Alberty, R. A. (2003) \emph{Thermodynamics of Biochemical Reactions}, John Wiley & Sons, Hoboken, New Jersey, 397 p. \url{http://www.worldcat.org/oclc/51242181} +Garrels, R. M. and Christ, C. L. (1965) \emph{Solutions, Minerals, and Equilibria}, Harper & Row, New York, 450 p. \url{http://www.worldcat.org/oclc/517586} + Helgeson, H. C. (1969) Thermodynamics of hydrothermal systems at elevated temperatures and pressures. \emph{Am. J. Sci.} \bold{267}, 729--804. \url{https://doi.org/10.2475/ajs.267.7.729} Helgeson, H. C., Kirkham, D. H. and Flowers, G. C. (1981) Theoretical prediction of the thermodynamic behavior of aqueous electrolytes at high pressures and temperatures. IV. Calculation of activity coefficients, osmotic coefficients, and apparent molal and standard and relative partial molal properties to 600\degC and 5 Kb. \emph{Am. J. Sci.} \bold{281}, 1249--1516. \url{https://doi.org/10.2475/ajs.281.10.1249} @@ -176,6 +177,8 @@ Manning, C. E. (2013) Thermodynamic modeling of fluid-rock interaction at mid-crustal to upper-mantle conditions. \emph{Rev. Mineral. Geochem.} \bold{76}, 135--164. \url{https://doi.org/10.2138/rmg.2013.76.5} Manning, C. E., Shock, E. L. and Sverjensky, D. A. (2013) The chemistry of carbon in aqueous fluids at crustal and upper-mantle conditions: Experimental and theoretical constraints. \emph{Rev. Mineral. Geochem.} \bold{75}, 109--148. \url{https://doi.org/10.2138/rmg.2013.75.5} + +Shvarov, Y. and Bastrakov, E. (1999) HCh: A software package for geochemical equilibrium modelling. User's Guide. \emph{Australian Geological Survey Organisation} \bold{1999/25}. } \concept{Thermodynamic calculations} Modified: pkg/CHNOSZ/tests/testthat/test-logmolality.R =================================================================== --- pkg/CHNOSZ/tests/testthat/test-logmolality.R 2018-11-04 14:44:13 UTC (rev 339) +++ pkg/CHNOSZ/tests/testthat/test-logmolality.R 2018-11-05 07:08:12 UTC (rev 340) @@ -10,10 +10,10 @@ wprop <- water(c("A_DH", "B_DH"), P=1) nonid <- nonideal(c("H+", "HCO3-"), subcrt(c("H+", "HCO3-"), T=25)$out, IS=1, T=298.15, P=1, A_DH=wprop$A_DH, B_DH=wprop$B_DH) # here we have a small difference due to rounding of the expected value: - expect_maxdiff(nonid[[2]]$loggam, -0.1890084, 1e-7) + expect_maxdiff(nonid[[2]]$loggam, -0.1798625, 1e-7) # the short way... loggam <- subcrt(c("H+", "HCO3-"), T=25, IS=1)$out[[2]]$loggam - # we get that loggam(H+)=0 and loggam(HCO3-)=-0.189 + # we get that loggam(H+)=0 and loggam(HCO3-)=-0.180 expect_equal(nonid[[2]]$loggam, loggam) ## take-home message -1: with default settings, the activity coefficient of H+ is always 1 Modified: pkg/CHNOSZ/tests/testthat/test-nonideal.R =================================================================== --- pkg/CHNOSZ/tests/testthat/test-nonideal.R 2018-11-04 14:44:13 UTC (rev 339) +++ pkg/CHNOSZ/tests/testthat/test-nonideal.R 2018-11-05 07:08:12 UTC (rev 340) @@ -75,3 +75,35 @@ expect_type(subcrt(c("Zn+2", "Cl-", "ZnCl+"), c(-1, -1, 1), T=200, P=16, IS=0.05), "list") }) + +# 20181105 +test_that("activity coefficients are similar to those from HCh", { + # ionic strength of solution and activity coefficients of Na+ and Cl- + # from HCh (Shvarov and Bastrakov, 1999) at 1000 bar, + # 100, 200, and 300 degress C, and 1 to 6 molal NaCl + # using the default "B-dot" activity coefficient model (Helgeson, 1969) + IS.HCh <- list(`100`=c(0.992, 1.969, 2.926, 3.858, 4.758, 5.619), + `300`=c(0.807, 1.499, 2.136, 2.739, 3.317, 3.875), + `500`=c(0.311, 0.590, 0.861, 1.125, 1.385, 1.642)) + gamCl.HCh <- list(`100`=c(0.565, 0.545, 0.551, 0.567, 0.589, 0.615), + `300`=c(0.366, 0.307, 0.275, 0.254, 0.238, 0.224), + `500`=c(0.19, 0.137, 0.111, 0.096, 0.085, 0.077)) + gamNa.HCh <- list(`100`=c(0.620, 0.616, 0.635, 0.662, 0.695, 0.730), + `300`=c(0.421, 0.368, 0.339, 0.318, 0.302, 0.288), + `500`=c(0.233, 0.180, 0.155, 0.138, 0.126, 0.117)) + # calculate activity coefficent of Cl- at each temperature + gamCl.100 <- 10^subcrt("Cl-", T=100, P=1000, IS=IS.HCh$`100`)$out$`Cl-`$loggam + gamCl.300 <- 10^subcrt("Cl-", T=300, P=1000, IS=IS.HCh$`300`)$out$`Cl-`$loggam + gamCl.500 <- 10^subcrt("Cl-", T=500, P=1000, IS=IS.HCh$`500`)$out$`Cl-`$loggam + # TODO: get lower differences by adjusting the activity coefficient model in CHNOSZ + expect_maxdiff(gamCl.100, gamCl.HCh$`100`, 0.73) + expect_maxdiff(gamCl.300, gamCl.HCh$`300`, 0.22) + expect_maxdiff(gamCl.500, gamCl.HCh$`500`, 0.04) + # calculate activity coefficent of Cl- at each temperature + gamNa.100 <- 10^subcrt("Na+", T=100, P=1000, IS=IS.HCh$`100`)$out$`Na+`$loggam + gamNa.300 <- 10^subcrt("Na+", T=300, P=1000, IS=IS.HCh$`300`)$out$`Na+`$loggam + gamNa.500 <- 10^subcrt("Na+", T=500, P=1000, IS=IS.HCh$`500`)$out$`Na+`$loggam + expect_maxdiff(gamNa.100, gamNa.HCh$`100`, 0.67) + expect_maxdiff(gamNa.300, gamNa.HCh$`300`, 0.18) + expect_maxdiff(gamNa.500, gamNa.HCh$`500`, 0.06) +}) From noreply at r-forge.r-project.org Mon Nov 5 10:27:01 2018 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 5 Nov 2018 10:27:01 +0100 (CET) Subject: [CHNOSZ-commits] r341 - in pkg/CHNOSZ: . R data demo inst man tests/testthat Message-ID: <20181105092701.D9AD418A93A@r-forge.r-project.org> Author: jedick Date: 2018-11-05 10:27:01 +0100 (Mon, 05 Nov 2018) New Revision: 341 Removed: pkg/CHNOSZ/demo/oldsolub.R Modified: pkg/CHNOSZ/DESCRIPTION pkg/CHNOSZ/NAMESPACE pkg/CHNOSZ/R/examples.R pkg/CHNOSZ/R/nonideal.R pkg/CHNOSZ/R/subcrt.R pkg/CHNOSZ/data/opt.csv pkg/CHNOSZ/demo/00Index pkg/CHNOSZ/demo/DEW.R pkg/CHNOSZ/demo/solubility.R pkg/CHNOSZ/inst/NEWS pkg/CHNOSZ/man/examples.Rd pkg/CHNOSZ/man/nonideal.Rd pkg/CHNOSZ/tests/testthat/test-logmolality.R pkg/CHNOSZ/tests/testthat/test-nonideal.R Log: nonideal(): reorganize options for activity coefficient calculations Modified: pkg/CHNOSZ/DESCRIPTION =================================================================== --- pkg/CHNOSZ/DESCRIPTION 2018-11-05 07:08:12 UTC (rev 340) +++ pkg/CHNOSZ/DESCRIPTION 2018-11-05 09:27:01 UTC (rev 341) @@ -1,6 +1,6 @@ Date: 2018-11-05 Package: CHNOSZ -Version: 1.1.3-48 +Version: 1.1.3-49 Title: Thermodynamic Calculations and Diagrams for Geo(bio)chemistry Authors at R: c( person("Jeffrey", "Dick", , "j3ffdick at gmail.com", role = c("aut", "cre"), Modified: pkg/CHNOSZ/NAMESPACE =================================================================== --- pkg/CHNOSZ/NAMESPACE 2018-11-05 07:08:12 UTC (rev 340) +++ pkg/CHNOSZ/NAMESPACE 2018-11-05 09:27:01 UTC (rev 341) @@ -54,7 +54,7 @@ # added 20170301 or later "GHS_Tr", "calculateDensity", "calculateGibbsOfWater", "calculateEpsilon", "calculateQ", "water.DEW", "berman", - "maxdiff", "expect_maxdiff", "Bdot", + "maxdiff", "expect_maxdiff", "bgamma", # added 20171121 or later "dumpdata", "thermo.axis", "solubility", "NaCl" ) Modified: pkg/CHNOSZ/R/examples.R =================================================================== --- pkg/CHNOSZ/R/examples.R 2018-11-05 07:08:12 UTC (rev 340) +++ pkg/CHNOSZ/R/examples.R 2018-11-05 09:27:01 UTC (rev 341) @@ -28,7 +28,7 @@ demos <- function(which=c("sources", "protein.equil", "affinity", "NaCl", "density", "ORP", "revisit", "findit", "ionize", "buffer", "protbuff", "yeastgfp", "mosaic", - "copper", "oldsolub", "solubility", "gold", "wjd", "bugstab", "Shh", "activity_ratios", + "copper", "solubility", "gold", "wjd", "bugstab", "Shh", "activity_ratios", "adenine", "DEW", "lambda", "TCA", "go-IU", "bison"), save.png=FALSE) { # run one or more demos from CHNOSZ with ask=FALSE, and return the value of the last one for(i in 1:length(which)) { Modified: pkg/CHNOSZ/R/nonideal.R =================================================================== --- pkg/CHNOSZ/R/nonideal.R 2018-11-05 07:08:12 UTC (rev 340) +++ pkg/CHNOSZ/R/nonideal.R 2018-11-05 09:27:01 UTC (rev 341) @@ -7,26 +7,32 @@ # generate nonideal contributions to thermodynamic properties # number of species, same length as speciesprops list # T in Kelvin, same length as nrows of speciespropss - # arguments P, A_DH, B_DH are needed for Helgeson/Helgeson0 methods only + # arguments A_DH and B_DH are needed for all methods other than "Alberty", and P is needed for "bgamma" mettext <- function(method) { - mettext <- paste(method, "method") - if(method=="Helgeson0") mettext <- "Helgeson method with B-dot = 0" + mettext <- paste(method, "equation") + if(method=="Bdot0") mettext <- "B-dot equation (B-dot = 0)" mettext } # we can use this function to change the nonideal method option - if(identical(species, "Helgeson") | identical(species, "Helgeson0") | identical(species, "Alberty")) { - thermo <- get("thermo") - oldnon <- thermo$opt$nonideal - thermo$opt$nonideal <- species - assign("thermo", thermo, "CHNOSZ") - message("nonideal: setting nonideal option to use ", mettext(species)) - return(invisible(oldnon)) + if(missing(speciesprops)) { + if(species[1] %in% c("Bdot", "Bdot0", "bgamma", "bgamma0", "Alberty")) { + thermo <- get("thermo") + oldnon <- thermo$opt$nonideal + thermo$opt$nonideal <- species[1] + assign("thermo", thermo, "CHNOSZ") + message("nonideal: setting nonideal option to use ", mettext(species)) + return(invisible(oldnon)) + } else stop(species[1], " is not a valid nonideality setting (Bdot, Bdot0, bgamma, bgamma0, or Alberty)") } + # check if we have a valid method setting + thermo <- get("thermo") + if(!thermo$opt$nonideal %in% c("Alberty", "Bdot", "Bdot0", "bgamma", "bgamma0")) stop("invalid setting (", thermo$opt$nonideal, ") in thermo$opt$nonideal") + # function to calculate extended Debye-Huckel equation and derivatives using Alberty's parameters - Alberty <- function(Z, I, T, prop = "loggamma") { + Alberty <- function(prop = "loggamma", Z, I, T) { # extended Debye-Huckel equation ("log") # and its partial derivatives ("G","H","S","Cp") # T in Kelvin @@ -54,20 +60,14 @@ } # function for Debye-Huckel equation with B-dot extended term parameter (Helgeson, 1969) - Helgeson <- function(Z, I, T, P, A_DH, B_DH, prop = "loggamma", acirc) { - ## "distance of closest approach" of ions in NaCl solutions (HKF81 Table 2) - #acirc <- 3.72e-8 # cm - if(method=="Helgeson") loggamma <- - A_DH * Z^2 * I^0.5 / (1 + acirc * B_DH * I^0.5) + Bdot * I - else if(method=="Helgeson0") loggamma <- - A_DH * Z^2 * I^0.5 / (1 + acirc * B_DH * I^0.5) + Helgeson <- function(prop = "loggamma", Z, I, T, A_DH, B_DH, acirc, bgamma) { + loggamma <- - A_DH * Z^2 * I^0.5 / (1 + acirc * B_DH * I^0.5) + bgamma * I R <- 1.9872 # gas constant, cal K^-1 mol^-1 if(prop=="loggamma") return(loggamma) else if(prop=="G") return(R * T * log(10) * loggamma) # note the log(10) (=2.303) ... use natural logarithm to calculate G } - # get B-dot if we're using the Helgeson method - if(method=="Helgeson") Bdot <- Bdot(convert(T, "C"), P) - # get species indices if(!is.numeric(species[[1]])) species <- info(species, "aq") # loop over species #1: get the charge @@ -82,7 +82,7 @@ Z[i] <- thisZ } # get species formulas to assign acirc 20181105 - if(grepl("Helgeson", method)) { + if(grepl("Bdot", method)) { formula <- get("thermo")$obigt$formula[species] # "ion size paramter" taken from UT_SIZES.REF of HCh package (Shvarov and Bastrakov, 1999), # based on Table 2.7 of Garrels and Christ, 1965 @@ -102,9 +102,16 @@ nZ <- sum(Z!=0) if(nZ > 1) message("nonideal: using ", paste(acirc[Z!=0], collapse=" "), " for ion size parameters of ", paste(formula[Z!=0], collapse=" ")) else if(nZ==1) message("nonideal: using ", acirc[Z!=0], " for ion size parameter of ", formula[Z!=0]) - # use correct units for ion size paramter + # use correct units (cm) for ion size parameter acirc <- acirc * 10^-8 + } else if(grepl("bgamma", method)) { + # "distance of closest approach" of ions in NaCl solutions (HKF81 Table 2) + acirc <- rep(3.72e-8, length(species)) } + # get b_gamma (or Bdot) + if(method=="bgamma") bgamma <- bgamma(convert(T, "C"), P) + else if(method=="Bdot") bgamma <- Bdot(convert(T, "C")) + else if(method %in% c("Bdot0", "bgamma0")) bgamma <- 0 # loop over species #2: activity coefficient calculations iH <- info("H+") ie <- info("e-") @@ -120,20 +127,19 @@ didit <- FALSE for(j in 1:ncol(myprops)) { pname <- colnames(myprops)[j] - if(method=="Alberty" & pname %in% c("G", "H", "S", "Cp")) { - myprops[, j] <- myprops[, j] + Alberty(Z[i], IS, T, pname) + if(!pname %in% c("G", "H", "S", "Cp")) next + if(method=="Alberty") { + myprops[, j] <- myprops[, j] + Alberty(pname, Z[i], IS, T) didit <- TRUE - } else if(grepl("Helgeson", method) & pname %in% c("G", "H", "S", "Cp")) { - myprops[, j] <- myprops[, j] + Helgeson(Z[i], IS, T, P, A_DH, B_DH, pname, acirc[i]) + } else { + myprops[, j] <- myprops[, j] + Helgeson(pname, Z[i], IS, T, A_DH, B_DH, acirc[i], bgamma) didit <- TRUE } } # append a loggam column if we did any nonideal calculations of thermodynamic properties if(didit) { - if(method=="Alberty") myprops <- cbind(myprops, loggam = Alberty(Z[i], IS, T)) - else if(grepl("Helgeson", method)) { - myprops <- cbind(myprops, loggam = Helgeson(Z[i], IS, T, P, A_DH, B_DH, "loggamma", acirc[i])) - } + if(method=="Alberty") myprops <- cbind(myprops, loggam = Alberty("loggamma", Z[i], IS, T)) + else myprops <- cbind(myprops, loggam = Helgeson("loggamma", Z[i], IS, T, A_DH, B_DH, acirc[i], bgamma)) } speciesprops[[i]] <- myprops if(didit) ndid <- ndid + 1 @@ -142,8 +148,8 @@ return(speciesprops) } -Bdot <- function(TC = 25, P = 1, showsplines = "") { - # 20171012 calculate B-dot (bgamma) using P, T, points from: +bgamma <- function(TC = 25, P = 1, showsplines = "") { + # 20171012 calculate b_gamma using P, T, points from: # Helgeson, 1969 (doi:10.2475/ajs.267.7.729) # Helgeson et al., 1981 (doi:10.2475/ajs.281.10.1249) # Manning et al., 2013 (doi:10.2138/rmg.2013.75.5) @@ -292,7 +298,7 @@ legend=c("Helgeson, 1969", "Helgeson et al., 1981", "Manning et al., 2013", "spline control point", "high-P extrapolation")) legend("bottomright", col=c(NA, rev(col)), lty=1, legend=c("kbar", "60", "50", "40", "30", "20", "10", "5", "4", "3", "2", "1", "0.5", "Psat")) - title(main=expression("Deybe-H\u00FCckel "*italic(b)[gamma]*" ('B-dot') parameter")) + title(main=expression("Deybe-H\u00FCckel extended term ("*italic(b)[gamma]*") parameter")) } else if(showsplines=="P") { thermo.plot.new(c(0, 5), c(-.2, .7), xlab=expression(log~italic(P)*"(bar)"), ylab=expression(italic(b)[gamma])) # pressures that are used to make the isothermal splines (see below) @@ -308,44 +314,44 @@ P900 <- c(10000, 20000, 30000, 40000, 50000, 60000) P1000 <- c(10000, 20000, 30000, 40000, 50000, 60000) # plot the pressure and B-dot values used to make the isothermal splines - points(log10(P25), Bdot(25, P25)) - points(log10(P100), Bdot(100, P100)) - points(log10(P200), Bdot(200, P200)) - points(log10(P300), Bdot(300, P300)) - points(log10(P400), Bdot(400, P400)) - points(log10(P500), Bdot(500, P500)) - points(log10(P600), Bdot(600, P600)) - points(log10(P700), Bdot(700, P700)) - points(log10(P800), Bdot(800, P800)) - points(log10(P900), Bdot(900, P900)) - points(log10(P1000), Bdot(1000, P1000)) + points(log10(P25), bgamma(25, P25)) + points(log10(P100), bgamma(100, P100)) + points(log10(P200), bgamma(200, P200)) + points(log10(P300), bgamma(300, P300)) + points(log10(P400), bgamma(400, P400)) + points(log10(P500), bgamma(500, P500)) + points(log10(P600), bgamma(600, P600)) + points(log10(P700), bgamma(700, P700)) + points(log10(P800), bgamma(800, P800)) + points(log10(P900), bgamma(900, P900)) + points(log10(P1000), bgamma(1000, P1000)) # plot the isothermal spline functions col <- tail(rev(rainbow(12)), -1) - P <- c(1, seq(50, 5000, 50)); lines(log10(P), Bdot(25, P), col=col[1]) - P <- c(1, seq(50, 20000, 50)); lines(log10(P), Bdot(100, P), col=col[2]) - P <- c(1, seq(50, 40000, 50)); lines(log10(P), Bdot(200, P), col=col[3]) - P <- c(1, seq(50, 60000, 50)); lines(log10(P), Bdot(300, P), col=col[4]) - P <- seq(500, 60000, 50); lines(log10(P), Bdot(400, P), col=col[5]) - P <- seq(1000, 60000, 50); lines(log10(P), Bdot(500, P), col=col[6]) - P <- seq(2000, 60000, 50); lines(log10(P), Bdot(600, P), col=col[7]) - P <- seq(10000, 60000, 50); lines(log10(P), Bdot(700, P), col=col[8]) - P <- seq(10000, 60000, 50); lines(log10(P), Bdot(800, P), col=col[9]) - P <- seq(10000, 60000, 50); lines(log10(P), Bdot(900, P), col=col[10]) - P <- seq(10000, 60000, 50); lines(log10(P), Bdot(1000, P), col=col[11]) + P <- c(1, seq(50, 5000, 50)); lines(log10(P), bgamma(25, P), col=col[1]) + P <- c(1, seq(50, 20000, 50)); lines(log10(P), bgamma(100, P), col=col[2]) + P <- c(1, seq(50, 40000, 50)); lines(log10(P), bgamma(200, P), col=col[3]) + P <- c(1, seq(50, 60000, 50)); lines(log10(P), bgamma(300, P), col=col[4]) + P <- seq(500, 60000, 50); lines(log10(P), bgamma(400, P), col=col[5]) + P <- seq(1000, 60000, 50); lines(log10(P), bgamma(500, P), col=col[6]) + P <- seq(2000, 60000, 50); lines(log10(P), bgamma(600, P), col=col[7]) + P <- seq(10000, 60000, 50); lines(log10(P), bgamma(700, P), col=col[8]) + P <- seq(10000, 60000, 50); lines(log10(P), bgamma(800, P), col=col[9]) + P <- seq(10000, 60000, 50); lines(log10(P), bgamma(900, P), col=col[10]) + P <- seq(10000, 60000, 50); lines(log10(P), bgamma(1000, P), col=col[11]) legend("topleft", col=c(NA, col), lty=1, legend=c("degrees C", 25, 100, 200, 300, 400, 500, 600, 700, 800, 900, 1000)) legend("bottomright", pch=1, legend="points from iso-P splines") - title(main=expression("Deybe-H\u00FCckel "*italic(b)[gamma]*" ('B-dot') parameter")) + title(main=expression("Deybe-H\u00FCckel extended term ("*italic(b)[gamma]*") parameter")) } else { # make T and P the same length ncond <- max(length(T), length(P)) T <- rep(T, length.out=ncond) P <- rep(P, length.out=ncond) # loop over P, T conditions - Bdot <- numeric() + bgamma <- numeric() lastT <- NULL for(i in 1:length(T)) { # make it fast: skip splines at 25 degC and 1 bar - if(T[i]==25 & P[i]==1) Bdot <- c(Bdot, 0.041) + if(T[i]==25 & P[i]==1) bgamma <- c(bgamma, 0.041) else { if(!identical(T[i], lastT)) { # get the spline fits from particular pressures for each T @@ -381,9 +387,17 @@ # remember this T; if it's the same as the next one, we won't re-make the spline lastT <- T[i] } - Bdot <- c(Bdot, ST(P[i])) + bgamma <- c(bgamma, ST(P[i])) } } - return(Bdot) + return(bgamma) } } + +### unexported functions ### + +Bdot <- function(TC) { + Bdot <- splinefun(c(25, 50, 100, 150, 200, 250, 300), c(0.0418, 0.0439, 0.0468, 0.0479, 0.0456, 0.0348, 0))(TC) + Bdot[TC > 300] <- 0 + return(Bdot) +} Modified: pkg/CHNOSZ/R/subcrt.R =================================================================== --- pkg/CHNOSZ/R/subcrt.R 2018-11-05 07:08:12 UTC (rev 340) +++ pkg/CHNOSZ/R/subcrt.R 2018-11-05 09:27:01 UTC (rev 341) @@ -280,7 +280,7 @@ # always get density H2O.props <- "rho" # calculate A_DH and B_DH if we're using the B-dot (Helgeson) equation - if(any(IS != 0) & grepl("Helgeson", thermo$opt$nonideal)) H2O.props <- c(H2O.props, "A_DH", "B_DH") + if(any(IS != 0) & thermo$opt$nonideal %in% c("Bdot", "Bdot0", "bgamma", "bgamma0")) H2O.props <- c(H2O.props, "A_DH", "B_DH") # get other properties for H2O only if it's in the reaction if(any(isH2O)) H2O.props <- c(H2O.props, eosprop) hkfstuff <- hkf(eosprop, parameters = param, T = T, P = P, H2O.props=H2O.props) @@ -298,7 +298,7 @@ } # calculate activity coefficients if ionic strength is not zero if(any(IS != 0)) { - if(grepl("Helgeson", thermo$opt$nonideal)) p.aq <- nonideal(iphases[isaq], p.aq, newIS, T, P, H2O.PT$A_DH, H2O.PT$B_DH) + if(thermo$opt$nonideal %in% c("Bdot", "Bdot0", "bgamma", "bgamma0")) p.aq <- nonideal(iphases[isaq], p.aq, newIS, T, P, H2O.PT$A_DH, H2O.PT$B_DH) else if(thermo$opt$nonideal=="Alberty") p.aq <- nonideal(iphases[isaq], p.aq, newIS, T) } outprops <- c(outprops, p.aq) Modified: pkg/CHNOSZ/data/opt.csv =================================================================== --- pkg/CHNOSZ/data/opt.csv 2018-11-05 07:08:12 UTC (rev 340) +++ pkg/CHNOSZ/data/opt.csv 2018-11-05 09:27:01 UTC (rev 341) @@ -1,2 +1,2 @@ cutoff,E.units,T.units,P.units,state,water,G.tol,Cp.tol,V.tol,varP,IAPWS.sat,paramin,ideal.H,ideal.e,nonideal,Berman,maxcores -1E-10,cal,C,bar,aq,SUPCRT92,100,1,1,FALSE,liquid,1000,TRUE,TRUE,Helgeson,NA,2 +1E-10,cal,C,bar,aq,SUPCRT92,100,1,1,FALSE,liquid,1000,TRUE,TRUE,Bdot,NA,2 Modified: pkg/CHNOSZ/demo/00Index =================================================================== --- pkg/CHNOSZ/demo/00Index 2018-11-05 07:08:12 UTC (rev 340) +++ pkg/CHNOSZ/demo/00Index 2018-11-05 09:27:01 UTC (rev 341) @@ -12,7 +12,6 @@ yeastgfp Subcellular locations: log fO2 - log aH2O and log a - log fO2 diagrams mosaic Eh-pH diagram for iron oxides, sulfides and carbonate with two sets of changing basis species copper Another example of mosaic(): complexation of copper with glycine species -oldsolub Old solubility calculations using uniroot() solubility Solubility of calcite and CO2(gas) as a function of pH gold Solubility of gold wjd Gibbs energy minimization: prebiological atmospheres and cell periphery of yeast Modified: pkg/CHNOSZ/demo/DEW.R =================================================================== --- pkg/CHNOSZ/demo/DEW.R 2018-11-05 07:08:12 UTC (rev 340) +++ pkg/CHNOSZ/demo/DEW.R 2018-11-05 09:27:01 UTC (rev 341) @@ -155,8 +155,8 @@ IS <- c(0.39, 0.57, 0.88, 1.45, 2.49) pH <- c(3.80, 3.99, 4.14, 4.25, 4.33) molC <- c(0.03, 0.2, 1, 4, 20) -## use Debye-Huckel equation with B-dot set to zero -nonideal("Helgeson0") +## use extended Debye-Huckel equation with b_gamma set to zero +nonideal("bgamma0") ## calculate affinities on the T-logfO2-pH-IS transect a <- affinity(T = T, O2 = buf$O2 - 2, IS = IS, pH = pH, P = 50000) ## calculate metastable equilibrium activities using the total Deleted: pkg/CHNOSZ/demo/oldsolub.R =================================================================== --- pkg/CHNOSZ/demo/oldsolub.R 2018-11-05 07:08:12 UTC (rev 340) +++ pkg/CHNOSZ/demo/oldsolub.R 2018-11-05 09:27:01 UTC (rev 341) @@ -1,87 +0,0 @@ -# CHNOSZ/demo/oldsolub.R -# 20150306 added to CHNOSZ as solubility.R -# 20181030 renamed to oldsolub.R - -# demo showing how to calculate CO2(gas) or calcite solubility and aqueous carbonate speciation -# the affinity() ... equilibrate() sequence in CHNOSZ gives *metastable equilibrium activities* -# (activities for a total activity of the balanced component given in loga.balance) ... -# here we are interested in finding the value of loga.balance itself -# (the total activity of [CO2, HCO3-, CO3-2] species in the aqueous phase). -# this total activity is the solubility of CO2(gas) or calcite if the affinities of the -# aqueous species as formed from CO2(gas) or calcite are all equal to zero. -# note that the affinities for species in metastable equilibrium are all equal. -# Afun() calculates the metastable equilibrium affinities for a given loga.balance -# and uniroot() finds the loga.balance where they are zero -# additionally, if we are reacting calcite, the activity of Ca+2 should be set equal to loga.balance - -# for comparison with published calcite solubility plot, see Fig. 4A in -# Manning et al., 2013, Reviews in Mineralogy & Geochemistry, v. 75, pp. 109-148 -# (doi: 10.2138/rmg.2013.75.5) - -# for comparison with published CO2 solubility plot, see Fig. 4.5 in -# Stumm and Morgan, 1996, Aquatic Chemistry: Chemical Equilibria and Rates in Natural Waters -# (New York: John Wiley & Sons), 3rd edition - -# set this to CO2 or calcite -what <- "calcite" -#what <- "CO2" - -# function to return the affinity of the metastable equilibrium species -Afun <- function(loga.balance=-3, T=25) { - if(what=="calcite") basis("Ca+2", loga.balance) - a <- affinity(T=T) - e <- equilibrate(a, loga.balance=loga.balance) - # set metastable activities and re-calculate the affinity - species(1:3, unlist(e$loga.equil)) - a <- affinity(T=T) - # check they're actually equal - stopifnot(all(abs(unlist(a$values) - as.vector(a$values[[1]])) < 1e-10)) - return(a$values[[1]]) -} - -# set up system -if(what=="CO2") { - basis("CHNOS+") - basis("CO2", "gas") - # ca. atmospheric PCO2 - basis("CO2", -3.5) -} else if(what=="calcite") { - basis(c("calcite", "Ca+2", "H2O", "O2", "H+")) -} -species(c("CO2", "HCO3-", "CO3-2")) -T <- 25 -# decrease this for higher resolution -pHstep <- 1 - -# where we'll store the results -loga.tot <- numeric() -loga.CO2 <- loga.HCO3 <- loga.CO3 <- numeric() - -# loop over pH range -pHs <- seq(0, 14, pHstep) -for(pH in pHs) { - print(paste("pH =", pH)) - basis("pH", pH) - # this is for the solubility - loga.balance <- suppressMessages(uniroot(Afun, c(-10, 10), T=T)$root) - loga.tot <- c(loga.tot, loga.balance) - # this is for the speciation - if(what=="calcite") basis("Ca+2", loga.balance) - a <- affinity(T=T) - e <- equilibrate(a, loga.balance=loga.balance) - loga <- unlist(e$loga.equil) - loga.CO2 <- c(loga.CO2, loga[1]) - loga.HCO3 <- c(loga.HCO3, loga[2]) - loga.CO3 <- c(loga.CO3, loga[3]) -} - -# make plot -ylim <- c(-10, 4) -thermo.plot.new(xlim=range(pHs), ylim=ylim, xlab="pH", ylab="log a") -lines(pHs, loga.tot, lwd=4, col="green2") -lines(pHs, loga.CO2, lwd=2) -lines(pHs, loga.HCO3, lty=2, lwd=2) -lines(pHs, loga.CO3, lty=3, lwd=2) -legend(ifelse(what=="calcite", "topright", "topleft"), lty=c(1, 1:3), lwd=c(4, 2, 2, 2), col=c("green2", rep("black", 3)), - legend=as.expression(c("total", expr.species("CO2", state="aq"), expr.species("HCO3-"), expr.species("CO3-2")))) -title(main=substitute("Solubility of"~what~"at"~T~degree*"C", list(what=what, T=T))) Modified: pkg/CHNOSZ/demo/solubility.R =================================================================== --- pkg/CHNOSZ/demo/solubility.R 2018-11-05 07:08:12 UTC (rev 340) +++ pkg/CHNOSZ/demo/solubility.R 2018-11-05 09:27:01 UTC (rev 341) @@ -1,6 +1,6 @@ -# CHNOSZ/demo/solubility.R: vectorized solubility without uniroot -# 20181030 adapted from CHNOSZ/demo/oldsolub.R -# 20181031 use new solubility(); add T-pH plots +# CHNOSZ/demo/solubility.R: solubility of CO2 and calcite +# 20150306 jmd first version; used uniroot() to find zero affinity +# 20181031 use new vectorized, non-uniroot solubility(); add T-pH plots # for comparison with published CO2 solubility plot, see Fig. 4.5 in # Stumm and Morgan, 1996, Aquatic Chemistry: Chemical Equilibria and Rates in Natural Waters Modified: pkg/CHNOSZ/inst/NEWS =================================================================== --- pkg/CHNOSZ/inst/NEWS 2018-11-05 07:08:12 UTC (rev 340) +++ pkg/CHNOSZ/inst/NEWS 2018-11-05 09:27:01 UTC (rev 341) @@ -1,30 +1,35 @@ -CHANGES IN CHNOSZ 1.1.3-48 (2018-11-05) +CHANGES IN CHNOSZ 1.1.3-49 (2018-11-05) --------------------------------------- NEW FEATURES -- Add solubility(). Run this after equilibrate() to calculate the - solubility (loga.balance) of the balanced basis species. +- Reorganize and expand options for activity coefficient calculations + (set in thermo$opt$nonideal: Bdot, Bdot0, bgamma, bgamma0, or Alberty). + The previous default, which corresponds to 'bgamma' (T- and + P-dependent extended term parameter with single ion-size parameter), + has been replaced by 'Bdot' (T-dependent extended term parameter and + species-dependent ion-size parameter; see below). +- nonideal() with the 'Bdot' or 'Bdot0' equation uses specific + ion-size parameters for different ions, in accord with the HCh package + (Shvarov and Bastrakov, 1999). Parameters are from Table 2.7 of + Garrels and Christ, 1965. + - Add NaCl(), implementing a first-order calculation of the speciation of NaCl in water, taking account of activity coefficients and the reaction Na+ + Cl- = NaCl(aq). -- nonideal() now uses specific ion-size parameters for different ions, - in accord with the HCh package (Shvarov and Bastrakov, 1999). - Parameters are from Table 2.7 of Garrels and Christ, 1965. +- Add solubility(). Run this after equilibrate() to calculate the + solubility (loga.balance) of the balanced basis species. +- Revise demo/solubility.R to show solubility calculations for CO2(gas) + and calcite as a function of T and pH. + - Add demo/gold.R for calculations of Au solubility in hydrothermal chloride and sulfide solutions (based on diagrams from Akinfiev and Zotov, 2001, Stef?nsson and Seward, 2004, and Williams-Jones et al., 2009). -- Revise demo/solubility.R to show solubility calculations for CO2(gas) - and calcite as a function of T and pH. - -- The old solubility demo, which uses uniroot() instead of the - vectorized calculations in solubility(), has been renamed oldsolub.R. - THERMODYNAMIC DATA - The Berman data (Berman, 1988 and later additions) have replaced the Modified: pkg/CHNOSZ/man/examples.Rd =================================================================== --- pkg/CHNOSZ/man/examples.Rd 2018-11-05 07:08:12 UTC (rev 340) +++ pkg/CHNOSZ/man/examples.Rd 2018-11-05 09:27:01 UTC (rev 341) @@ -15,9 +15,9 @@ examples(save.png = FALSE) demos(which = c("sources", "protein.equil", "affinity", "NaCl", "density", "ORP", "revisit", "findit", "ionize", "buffer", - "protbuff", "yeastgfp", "mosaic", "copper", "oldsolub", - "solubility", "gold", "wjd", "bugstab", "Shh", "activity_ratios", - "adenine", "DEW", "lambda", "TCA", "go-IU", "bison"), + "protbuff", "yeastgfp", "mosaic", "copper", "solubility", + "gold", "wjd", "bugstab", "Shh", "activity_ratios", "adenine", + "DEW", "lambda", "TCA", "go-IU", "bison"), save.png=FALSE) } @@ -45,7 +45,6 @@ \code{yeastgfp} \tab * Subcellular locations: \logfO2 - \logaH2O and \loga - \logfO2 diagrams (Dick, 2009) \cr \code{mosaic} \tab * Eh-pH diagram with two sets of changing basis species (Garrels and Christ, 1965) \cr \code{copper} \tab * Another example of \code{\link{mosaic}}: complexation of Cu with glycine (Aksu and Doyle, 2001) \cr - \code{oldsolub} \tab Old solubility calculations using \code{\link{uniroot}} \cr \code{solubility} \tab * Solubility of calcite (cf. Manning et al., 2013) and \CO2 (cf. Stumm and Morgan, 1996) \cr \code{gold} \tab * Solubility of gold (Akinfiev and Zotov; 2001; Stef{\aacute}nsson and Seward, 2004; Williams-Jones et al., 2009) \cr \code{wjd} \tab * \eqn{G}{G} minimization: prebiological atmospheres (Dayhoff et al., 1964) and cell periphery of yeast \cr Modified: pkg/CHNOSZ/man/nonideal.Rd =================================================================== --- pkg/CHNOSZ/man/nonideal.Rd 2018-11-05 07:08:12 UTC (rev 340) +++ pkg/CHNOSZ/man/nonideal.Rd 2018-11-05 09:27:01 UTC (rev 341) @@ -1,7 +1,7 @@ \encoding{UTF-8} \name{nonideal} \alias{nonideal} -\alias{Bdot} +\alias{bgamma} \title{Activity coefficients of aqueous species} \description{ Calculate activity coefficients and adjusted (non-ideal) molal properties of aqueous species. @@ -10,7 +10,7 @@ \usage{ nonideal(species, speciesprops, IS, T, P, A_DH, B_DH, method=get("thermo")$opt$nonideal) - Bdot(TC, P, showsplines = "") + bgamma(TC, P, showsplines = "") } \arguments{ @@ -18,34 +18,39 @@ \item{speciesprops}{list of dataframes of species properties} \item{IS}{numeric, ionic strength(s) used in nonideal calculations, mol kg\eqn{^{-1}}{^-1}} \item{T}{numeric, temperature (K)} - \item{P}{numeric, pressure (bar); required for Helgeson method} - \item{A_DH}{numeric, A Debye-Huckel coefficient; required for Helgeson method} - \item{B_DH}{numeric, B Debye-Huckel coefficient; required for Helgeson method} - \item{method}{character, \samp{Alberty}, \samp{Helgeson}, or \samp{Helgeson0}} + \item{P}{numeric, pressure (bar); required for B-dot or b_gamma equation} + \item{A_DH}{numeric, A Debye-Huckel coefficient; required for B-dot or b_gamma equation} + \item{B_DH}{numeric, B Debye-Huckel coefficient; required for B-dot or b_gamma equation} + \item{method}{character, \samp{Alberty}, \samp{Bdot}, \samp{Bdot0}, or \samp{bgamma}} \item{TC}{numeric, temperature (\degC)} \item{showsplines}{character, show isobaric (\samp{T}) or isothermal (\samp{P}) splines} } \details{ \code{nonideal} takes a list of dataframes (in \code{speciesprops}) containing the standard molal properties of the identified \code{species}. -The function calculates the *adjusted* properties for given ionic strength (\code{IS}); they are equal to the *standard* values at IS=0. +The function calculates the *adjusted* properties for given ionic strength (\code{IS}); they are equal to the *standard* values only at IS=0. The function bypasses (leaves unchanged) properties of all species whose charge (determined by the number of Z in their \code{\link{makeup}}) is equal to zero. The proton (\Hplus) and electron (\eminus) are also bypassed by default; this makes sense if you are setting the pH, i.e. activity of \Hplus, to some value. To apply the calculations to H+ and/or e-, change \code{\link{thermo}$opt$ideal.H} or \code{ideal.e} to FALSE. The lengths of \code{IS} and \code{T} supplied in the arguments should be equal to the number of rows of each dataframe in \code{speciesprops}, or length one to use single values throughout. -If \code{method} is \samp{Alberty}, the values of \code{IS} are combined with Alberty's (2003) equation 3.6-1 (extended Debye-H?ckel equation) and its derivatives, to calculate adjusted molal properties at the specified ionic strength(s) and temperature(s). +If \code{method} is \samp{Alberty}, the values of \code{IS} are combined with Alberty's (2003) equation 3.6-1 (extended Debye-H?ckel equation; H?ckel, 1925) and its derivatives, to calculate adjusted molal properties at the specified ionic strength(s) and temperature(s). The adjusted molal properties that can be calculated include \samp{G}, \samp{H}, \samp{S} and \samp{Cp}; any columns in the dataframes of \code{speciesprops} with other names are left untouched. -If \code{method} is \samp{Helgeson}, the \dQuote{B-dot} equation is used. -This equation seems to have been originally proposed by Huckel, 1925; parameters were derived for use at high temperature and pressure by Helgeson, 1969; Helgeson et al., 1981; Manning, 2013. +In addition to \code{IS} and \code{T}, the following two methods depend on values of \code{P}, \code{A_DH}, and \code{B_DH} given in the arguments. +For these methods, \samp{G} is currently the only adjusted molal property that is calculated (but this can be used by \code{\link{subcrt}} to calculate adjusted equilibrium constants). + +If \code{method} is \samp{Bdot} (the default setting in CHNOSZ), the \dQuote{B-dot} form of the extended Debye-H?ckel equation equation is used. The distance of closest approach (the \dQuote{ion size parameter}) is taken from the UT_SIZES.REF file of the HCh package (Shvarov and Bastrakov, 1992), which is based on Table 2.7 of Garrels and Christ, 1965. -In addition to \code{IS} and \code{T}, this method depends on values of \code{P}, \code{A_DH}, and \code{B_DH} given in the arguments. -The calculation of \dQuote{B-dot}, also used in the equations, is made within \code{nonideal} by calling the \code{Bdot} function. -For some uses, it is desirable to set the \dQuote{B-dot} parameter to zero; this can be done by setting the method to \code{Helgeson0}. -Currently, \samp{G} is the only adjusted molal property that is calculated (but this can be used by \code{\link{subcrt}} to calculate adjusted equilibrium constants). +The extended term parameter is expressed as \dQuote{B-dot}, which is a function only of temperature (Helgeson, 1969). +For some uses, it is desirable to set the extended term parameter to zero; this can be done by setting the method to \samp{Bdot0}. -\code{Bdot} calculates the \dQuote{B-dot} deviation function (Helgeson, 1969) a.k.a. extended term parameter (written as b_gamma; Helgeson et al., 1981) for activity coefficients in NaCl solutions at high temperature and pressure. +If \code{method} is \samp{bgamma}, the \dQuote{b_gamma} equation is used. +The distance of closest approach is set to a constant (3.72e-8 cm) (e.g., Manning et al., 2013). +The extended term parameter is calculated by calling the \code{bgamma} function. +Alternatively, set the extended term parameter to zero with \samp{bgamma0}. + +\code{bgamma} calculates the extended term parameter (written as b_gamma; Helgeson et al., 1981) for activity coefficients in NaCl-dominated solutions at high temperature and pressure. Data at \Psat and 0.5 to 5 kb are taken from Helgeson (1969, Table 2 and Figure 3) and Helgeson et al. (1981, Table 27) and extrapolated values at 10 to 30 kb from Manning et al. (2013, Figure 11). Furthermore, the 10 to 30 kb data were used to generate super-extrapolated values at 40, 50, and 60 kb, which may be encountered using the \code{\link{water.DEW}} calculations. If all \code{P} correspond to one of the isobaric conditions, the values of \code{Bdot} at \code{T} are calculated by spline fits to the isobaric data. @@ -63,7 +68,7 @@ ### Examples following Alberty, 2003 ### (page numbers given below) -## the default method setting is Helgeson; +## the default method setting is Bdot; ## change it to Alberty oldnon <- nonideal("Alberty") @@ -132,10 +137,8 @@ par(opar) -### finished with Alberty equation, let's look at Helgeson -# this is the default setting, but is needed here because -# we set "Alberty" above -nonideal(oldnon) # same as nonideal("Helgeson") +### finished with Alberty equation, let's look at b_gamma +nonideal("bgamma") ## activity coefficients for monovalent ions at 700 degC, 10 kbar # after Manning, 2013, Fig. 7 @@ -155,12 +158,15 @@ gamma <- 10^nonidealprops[[1]]$loggam # the error is larger at higher IS stopifnot(maxdiff(gamma[1], Manning_gamma[1]) < 0.01) -stopifnot(maxdiff(gamma, Manning_gamma) < 0.36) +stopifnot(maxdiff(gamma, Manning_gamma) < 0.23) -## data and splines used for calculating B-dot +## data and splines used for calculating b_gamma ## (extended term parameter) -Bdot(showsplines = "T") -Bdot(showsplines = "P") +bgamma(showsplines = "T") +bgamma(showsplines = "P") + +# done with examples, restore default setting +nonideal(oldnon) # == nonideal("Bdot") } \references{ Modified: pkg/CHNOSZ/tests/testthat/test-logmolality.R [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/chnosz -r 341 From noreply at r-forge.r-project.org Mon Nov 5 12:32:04 2018 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 5 Nov 2018 12:32:04 +0100 (CET) Subject: [CHNOSZ-commits] r342 - in pkg/CHNOSZ: . R demo man tests/testthat Message-ID: <20181105113204.7BE0D18B145@r-forge.r-project.org> Author: jedick Date: 2018-11-05 12:32:04 +0100 (Mon, 05 Nov 2018) New Revision: 342 Modified: pkg/CHNOSZ/DESCRIPTION pkg/CHNOSZ/R/NaCl.R pkg/CHNOSZ/R/nonideal.R pkg/CHNOSZ/demo/DEW.R pkg/CHNOSZ/demo/gold.R pkg/CHNOSZ/man/NaCl.Rd pkg/CHNOSZ/man/nonideal.Rd pkg/CHNOSZ/tests/testthat/test-logmolality.R pkg/CHNOSZ/tests/testthat/test-nonideal.R Log: NaCl(): also consider activity coefficient of Na+ Modified: pkg/CHNOSZ/DESCRIPTION =================================================================== --- pkg/CHNOSZ/DESCRIPTION 2018-11-05 09:27:01 UTC (rev 341) +++ pkg/CHNOSZ/DESCRIPTION 2018-11-05 11:32:04 UTC (rev 342) @@ -1,6 +1,6 @@ Date: 2018-11-05 Package: CHNOSZ -Version: 1.1.3-49 +Version: 1.1.3-50 Title: Thermodynamic Calculations and Diagrams for Geo(bio)chemistry Authors at R: c( person("Jeffrey", "Dick", , "j3ffdick at gmail.com", role = c("aut", "cre"), Modified: pkg/CHNOSZ/R/NaCl.R =================================================================== --- pkg/CHNOSZ/R/NaCl.R 2018-11-05 09:27:01 UTC (rev 341) +++ pkg/CHNOSZ/R/NaCl.R 2018-11-05 11:32:04 UTC (rev 342) @@ -3,17 +3,18 @@ # given a total molality of NaCl # taking account of ion association: Na+ + Cl- = NaCl(aq) # 20181102 jmd first version +# 20181105 add activity coefficients of Na+ NaCl <- function(T=seq(100, 500, 100), P=1000, m_tot=2) { # define a function for the reaction quotient - logQ <- function(m_Cl, gamma) { + logQ <- function(m_Cl, gam_NaCl, gam_Na, gam_Cl) { # starting with Q = a_NaCl / (a_Na+ * a_Cl-), - # substitute gam_NaCl = 0, m_NaCl + m_Cl = m_tot, m_Cl = m_Na, gam_Cl = gam_Na = gamma + # substitute m_tot = m_NaCl + m_Cl and m_Cl = m_Na # to write: - log10( (m_tot - m_Cl) / (m_Cl * gamma) ^ 2 ) + log10( (m_tot - m_Cl) * gam_NaCl / (m_Cl ^ 2 * gam_Na * gam_Cl) ) } # define a function for affinity = log(K / Q) - A <- function(m_Cl, gamma, logK) logK - logQ(m_Cl, gamma) + A <- function(m_Cl, gam_NaCl, gam_Na, gam_Cl, logK) logK - logQ(m_Cl, gam_NaCl, gam_Na, gam_Cl) # calculate equilibrium constant at all temperatures (standard conditions: IS = 0) logK <- subcrt(c("Na+", "Cl-", "NaCl"), c(-1, -1, 1), T = T, P = P)$out$logK # calculate Debye-Huckel parameters at all temperatures @@ -23,15 +24,18 @@ ISout <- a_Cl <- numeric(N) # initial guess for m_Cl and ionic strength assuming complete dissociation of NaCl IS <- m_Cl <- rep(m_tot, N) - # the species index for Cl- - iCl <- info("Cl-") + # the species indices for Cl- and Na+ + ispecies <- info(c("Na+", "Cl-")) # we start by doing calculations for all temperatures doit <- !logical(N) while(any(doit)) { # calculate activity coefficient at given ionic strength - gamma <- suppressMessages(10^nonideal(iCl, list(data.frame(G=numeric(N))), IS=IS, T=convert(T, "K"), P=P, A_DH=wout$A_DH, B_DH=wout$B_DH)[[1]]$loggam) + speciesprops <- rep(list(data.frame(G=numeric(N))), length(ispecies)) + gammas <- suppressMessages(nonideal(ispecies, speciesprops, IS=IS, T=convert(T, "K"), P=P, A_DH=wout$A_DH, B_DH=wout$B_DH)) + gam_Na <- 10^gammas[[1]]$loggam + gam_Cl <- 10^gammas[[2]]$loggam # solve for m_Cl - for(i in which(doit)) m_Cl[i] <- uniroot(A, c(0, m_tot), gamma=gamma[i], logK=logK[i])$root + for(i in which(doit)) m_Cl[i] <- uniroot(A, c(0, m_tot), gam_NaCl=1, gam_Na=gam_Na[i], gam_Cl=gam_Cl[i], logK=logK[i])$root # calculate new ionic strength and deviation ISnew <- m_Cl dIS <- ISnew - IS @@ -40,9 +44,10 @@ # keep going until the deviation in ionic strength at any temperature is less than 0.01 doit <- abs(dIS) > 0.01 } - # assemble final gamma and activity of Cl- - gamma <- suppressMessages(10^nonideal(iCl, list(data.frame(G=numeric(N))), IS=IS, T=convert(T, "K"), P=P, A_DH=wout$A_DH, B_DH=wout$B_DH)[[1]]$loggam) - a_Cl <- m_Cl * gamma + # assemble final molality of Cl- and gammas + gammas <- suppressMessages(nonideal(ispecies, speciesprops, IS=IS, T=convert(T, "K"), P=P, A_DH=wout$A_DH, B_DH=wout$B_DH)) + gam_Na <- 10^gammas[[1]]$loggam + gam_Cl <- 10^gammas[[2]]$loggam # return the calculated values - list(IS=IS, gamma=gamma, a_Cl=a_Cl) + list(IS=IS, m_Cl=m_Cl, gam_Na=gam_Na, gam_Cl=gam_Cl) } Modified: pkg/CHNOSZ/R/nonideal.R =================================================================== --- pkg/CHNOSZ/R/nonideal.R 2018-11-05 09:27:01 UTC (rev 341) +++ pkg/CHNOSZ/R/nonideal.R 2018-11-05 11:32:04 UTC (rev 342) @@ -3,11 +3,12 @@ # moved to nonideal.R from util.misc.R 20151107 # added Helgeson method 20171012 -nonideal <- function(species, speciesprops, IS, T, P, A_DH, B_DH, method=get("thermo")$opt$nonideal) { +nonideal <- function(species, speciesprops, IS, T, P, A_DH, B_DH, m_star=NULL, method=get("thermo")$opt$nonideal) { # generate nonideal contributions to thermodynamic properties # number of species, same length as speciesprops list # T in Kelvin, same length as nrows of speciespropss # arguments A_DH and B_DH are needed for all methods other than "Alberty", and P is needed for "bgamma" + # m_start is the total molality of all dissolved species; if not given, it is taken to be equal to ionic strength mettext <- function(method) { mettext <- paste(method, "equation") @@ -28,8 +29,10 @@ } # check if we have a valid method setting - thermo <- get("thermo") - if(!thermo$opt$nonideal %in% c("Alberty", "Bdot", "Bdot0", "bgamma", "bgamma0")) stop("invalid setting (", thermo$opt$nonideal, ") in thermo$opt$nonideal") + if(!method %in% c("Alberty", "Bdot", "Bdot0", "bgamma", "bgamma0")) { + if(missing(method)) stop("invalid setting (", thermo$opt$nonideal, ") in thermo$opt$nonideal") + else stop("invalid method (", thermo$opt$nonideal, ")") + } # function to calculate extended Debye-Huckel equation and derivatives using Alberty's parameters Alberty <- function(prop = "loggamma", Z, I, T) { @@ -60,8 +63,8 @@ } # function for Debye-Huckel equation with B-dot extended term parameter (Helgeson, 1969) - Helgeson <- function(prop = "loggamma", Z, I, T, A_DH, B_DH, acirc, bgamma) { - loggamma <- - A_DH * Z^2 * I^0.5 / (1 + acirc * B_DH * I^0.5) + bgamma * I + Helgeson <- function(prop = "loggamma", Z, I, T, A_DH, B_DH, acirc, m_star, bgamma) { + loggamma <- - A_DH * Z^2 * I^0.5 / (1 + acirc * B_DH * I^0.5) - log10(1 + 0.0180153 * m_star) + bgamma * I R <- 1.9872 # gas constant, cal K^-1 mol^-1 if(prop=="loggamma") return(loggamma) else if(prop=="G") return(R * T * log(10) * loggamma) @@ -113,6 +116,7 @@ else if(method=="Bdot") bgamma <- Bdot(convert(T, "C")) else if(method %in% c("Bdot0", "bgamma0")) bgamma <- 0 # loop over species #2: activity coefficient calculations + if(is.null(m_star)) m_star <- IS iH <- info("H+") ie <- info("e-") speciesprops <- as.list(speciesprops) @@ -132,14 +136,14 @@ myprops[, j] <- myprops[, j] + Alberty(pname, Z[i], IS, T) didit <- TRUE } else { - myprops[, j] <- myprops[, j] + Helgeson(pname, Z[i], IS, T, A_DH, B_DH, acirc[i], bgamma) + myprops[, j] <- myprops[, j] + Helgeson(pname, Z[i], IS, T, A_DH, B_DH, acirc[i], m_star, bgamma) didit <- TRUE } } # append a loggam column if we did any nonideal calculations of thermodynamic properties if(didit) { if(method=="Alberty") myprops <- cbind(myprops, loggam = Alberty("loggamma", Z[i], IS, T)) - else myprops <- cbind(myprops, loggam = Helgeson("loggamma", Z[i], IS, T, A_DH, B_DH, acirc[i], bgamma)) + else myprops <- cbind(myprops, loggam = Helgeson("loggamma", Z[i], IS, T, A_DH, B_DH, acirc[i], m_star, bgamma)) } speciesprops[[i]] <- myprops if(didit) ndid <- ndid + 1 Modified: pkg/CHNOSZ/demo/DEW.R =================================================================== --- pkg/CHNOSZ/demo/DEW.R 2018-11-05 09:27:01 UTC (rev 341) +++ pkg/CHNOSZ/demo/DEW.R 2018-11-05 11:32:04 UTC (rev 342) @@ -203,7 +203,9 @@ loggamma <- c(-0.15, -0.18, -0.22, -0.26, -0.31) # activity coefficients calculated in CHNOSZ sres <- subcrt("propanoate", T = seq(600, 1000, 100), P = 50000, IS = c(0.39, 0.57, 0.88, 1.45, 2.49)) -stopifnot(maxdiff(sres$out[[1]]$loggam, loggamma) < 0.004) +stopifnot(maxdiff(sres$out[[1]]$loggam, loggamma) < 0.023) +# if m_star in nonideal() was zero, we could decrease the tolerance here +#stopifnot(maxdiff(sres$out[[1]]$loggam, loggamma) < 0.004) ########### ### all done! Modified: pkg/CHNOSZ/demo/gold.R =================================================================== --- pkg/CHNOSZ/demo/gold.R 2018-11-05 09:27:01 UTC (rev 341) +++ pkg/CHNOSZ/demo/gold.R 2018-11-05 11:32:04 UTC (rev 342) @@ -134,8 +134,9 @@ basis("H+", "QMK") # calculate solution composition for 2 mol/kg NaCl NaCl <- NaCl(T = seq(150, 550, 10), P = 1000, m_tot=2) + a_Cl <- NaCl$m_Cl * NaCl$gam_Cl # calculate affinity, equilibrate, solubility - a <- affinity(T = seq(150, 550, 10), `Cl-` = log10(NaCl$a_Cl), P = 1000, IS = NaCl$IS) + a <- affinity(T = seq(150, 550, 10), `Cl-` = log10(a_Cl), P = 1000, IS = NaCl$IS) e <- equilibrate(a) s <- solubility(e) # make diagram and show total log molality @@ -164,8 +165,9 @@ basis("H+", "QMK") # calculate solution composition for 2 mol/kg NaCl NaCl <- NaCl(T = seq(150, 550, 10), P = 1000, m_tot=2) + a_Cl <- NaCl$m_Cl * NaCl$gam_Cl # calculate affinity, equilibrate, solubility - a <- affinity(T = seq(150, 550, 10), `Cl-` = log10(NaCl$a_Cl), P = 1000, IS = NaCl$IS) + a <- affinity(T = seq(150, 550, 10), `Cl-` = log10(a_Cl), P = 1000, IS = NaCl$IS) e <- equilibrate(a) s <- solubility(e) # make diagram and show total log molality Modified: pkg/CHNOSZ/man/NaCl.Rd =================================================================== --- pkg/CHNOSZ/man/NaCl.Rd 2018-11-05 09:27:01 UTC (rev 341) +++ pkg/CHNOSZ/man/NaCl.Rd 2018-11-05 11:32:04 UTC (rev 342) @@ -23,7 +23,7 @@ The algorithm starts by calculating the equilibrium constant (\emph{K}) of the reaction and assuming complete dissociation of NaCl(aq). This also permits calculating the ionic strength from the molalities of Na\S{+} and Cl\S{-}. Then, \code{\link{uniroot}} is used to find the equilibrium molality of Cl\S{-}; that is, where the affinity of the reaction (log(\emph{K}/\emph{Q})) becomes zero. -The activity quotient (\emph{Q}) is evaluated taking account of activity coefficients calculated for the nominal ionic strength (see \code{\link{nonideal}}). +The activity quotient (\emph{Q}) is evaluated taking account of activity coefficients of Na\S{+} and Cl\S{-} calculated for the nominal ionic strength (see \code{\link{nonideal}}). The calculated molality of Cl\S{-} yields a new estimate of the ionic strength of the system. The calculations are iterated until the deviation in ionic strength at all temperatures is less than 0.01. } @@ -34,7 +34,7 @@ } \value{ -A list with components \samp{IS} (\dQuote{true} ionic strength from concentrations of unpaired ions), \samp{gamma} (activity coefficient of Cl\S{-}), \samp{a_Cl} (activity of Cl\S{-}). +A list with components \samp{IS} (\dQuote{true} ionic strength from concentrations of unpaired ions), \samp{m_Cl} (molality of Cl\S{-}), \samp{gam_Na}, and \samp{gam_Cl} (activity coefficients of Na\S{+} and Cl\S{-}). } \seealso{ @@ -49,20 +49,20 @@ IS.HCh <- list(`100`=c(0.992, 1.969, 2.926, 3.858, 4.758, 5.619), `300`=c(0.807, 1.499, 2.136, 2.739, 3.317, 3.875), `500`=c(0.311, 0.590, 0.861, 1.125, 1.385, 1.642)) -gam.HCh <- list(`100`=c(0.565, 0.545, 0.551, 0.567, 0.589, 0.615), - `300`=c(0.366, 0.307, 0.275, 0.254, 0.238, 0.224), - `500`=c(0.19, 0.137, 0.111, 0.096, 0.085, 0.077)) +gam_Cl.HCh <- list(`100`=c(0.565, 0.545, 0.551, 0.567, 0.589, 0.615), + `300`=c(0.366, 0.307, 0.275, 0.254, 0.238, 0.224), + `500`=c(0.19, 0.137, 0.111, 0.096, 0.085, 0.077)) # total molality in the calculation with NaCl() m_tot <- seq(1, 6, 0.5) N <- length(m_tot) # where we'll put the calculated values IS.calc <- data.frame(`100`=numeric(N), `300`=numeric(N), `500`=numeric(N)) -gam.calc <- data.frame(`100`=numeric(N), `300`=numeric(N), `500`=numeric(N)) +gam_Cl.calc <- data.frame(`100`=numeric(N), `300`=numeric(N), `500`=numeric(N)) # NaCl() is *not* vectorized over m_tot, so we use a loop here for(i in 1:length(m_tot)) { NaCl.out <- NaCl(c(100, 300, 500), P=1000, m_tot=m_tot[i]) IS.calc[i, ] <- NaCl.out$IS - gam.calc[i, ] <- NaCl.out$gamma + gam_Cl.calc[i, ] <- NaCl.out$gam_Cl } # plot ionic strength from HCh and NaCl() as points and lines par(mfrow=c(2, 1)) @@ -78,11 +78,13 @@ legend("topleft", dprop, lty=1, pch=1, col=col) title(main="H2O + NaCl; HCh (points) and 'NaCl()' (lines)") # plot activity coefficient (gamma) -plot(c(1,6), c(0,1), xlab="NaCl (mol/kg)", ylab="gamma", type="n") +plot(c(1,6), c(0,1), xlab="NaCl (mol/kg)", ylab=expression(gamma[Cl^"-"]), type="n") for(i in 1:3) { - points(m.HCh, gam.HCh[[i]], col=col[i]) - lines(m_tot, gam.calc[, i], col=col[i]) + points(m.HCh, gam_Cl.HCh[[i]], col=col[i]) + lines(m_tot, gam_Cl.calc[, i], col=col[i]) } +# we should be fairly close +stopifnot(maxdiff(unlist(gam_Cl.calc[seq(1,11,2), ]), unlist(gam_Cl.HCh)) < 0.034) } \references{ Modified: pkg/CHNOSZ/man/nonideal.Rd =================================================================== --- pkg/CHNOSZ/man/nonideal.Rd 2018-11-05 09:27:01 UTC (rev 341) +++ pkg/CHNOSZ/man/nonideal.Rd 2018-11-05 11:32:04 UTC (rev 342) @@ -9,7 +9,7 @@ \usage{ nonideal(species, speciesprops, IS, T, P, A_DH, B_DH, - method=get("thermo")$opt$nonideal) + m_star=NULL, method=get("thermo")$opt$nonideal) bgamma(TC, P, showsplines = "") } @@ -21,6 +21,7 @@ \item{P}{numeric, pressure (bar); required for B-dot or b_gamma equation} \item{A_DH}{numeric, A Debye-Huckel coefficient; required for B-dot or b_gamma equation} \item{B_DH}{numeric, B Debye-Huckel coefficient; required for B-dot or b_gamma equation} + \item{m_star}{numeric, total molality of all dissolved species} \item{method}{character, \samp{Alberty}, \samp{Bdot}, \samp{Bdot0}, or \samp{bgamma}} \item{TC}{numeric, temperature (\degC)} \item{showsplines}{character, show isobaric (\samp{T}) or isothermal (\samp{P}) splines} @@ -37,7 +38,9 @@ If \code{method} is \samp{Alberty}, the values of \code{IS} are combined with Alberty's (2003) equation 3.6-1 (extended Debye-H?ckel equation; H?ckel, 1925) and its derivatives, to calculate adjusted molal properties at the specified ionic strength(s) and temperature(s). The adjusted molal properties that can be calculated include \samp{G}, \samp{H}, \samp{S} and \samp{Cp}; any columns in the dataframes of \code{speciesprops} with other names are left untouched. -In addition to \code{IS} and \code{T}, the following two methods depend on values of \code{P}, \code{A_DH}, and \code{B_DH} given in the arguments. +In addition to \code{IS} and \code{T}, the following two methods depend on values of \code{P}, \code{A_DH}, \code{B_DH}, and \code{m_star} given in the arguments. +\code{m_star}, the total molality of all dissolved species, is used to compute the mole fraction to molality conversion factor. +If \code{m_star} is NULL, it is taken to be equal to \code{IS}, which is an underestimate. For these methods, \samp{G} is currently the only adjusted molal property that is calculated (but this can be used by \code{\link{subcrt}} to calculate adjusted equilibrium constants). If \code{method} is \samp{Bdot} (the default setting in CHNOSZ), the \dQuote{B-dot} form of the extended Debye-H?ckel equation equation is used. Modified: pkg/CHNOSZ/tests/testthat/test-logmolality.R =================================================================== --- pkg/CHNOSZ/tests/testthat/test-logmolality.R 2018-11-05 09:27:01 UTC (rev 341) +++ pkg/CHNOSZ/tests/testthat/test-logmolality.R 2018-11-05 11:32:04 UTC (rev 342) @@ -9,11 +9,10 @@ # the long way... wprop <- water(c("A_DH", "B_DH"), P=1) nonid <- nonideal(c("H+", "HCO3-"), subcrt(c("H+", "HCO3-"), T=25)$out, IS=1, T=298.15, P=1, A_DH=wprop$A_DH, B_DH=wprop$B_DH) - # here we have a small difference due to rounding of the expected value: - expect_maxdiff(nonid[[2]]$loggam, -0.1790625, 1e-7) + # compare with a precalculated value: + expect_maxdiff(nonid[[2]]$loggam, -0.1868168, 1e-7) # the short way... loggam <- subcrt(c("H+", "HCO3-"), T=25, IS=1)$out[[2]]$loggam - # we get that loggam(H+)=0 and loggam(HCO3-)=-0.179 expect_equal(nonid[[2]]$loggam, loggam) ## take-home message -1: with default settings, the activity coefficient of H+ is always 1 Modified: pkg/CHNOSZ/tests/testthat/test-nonideal.R =================================================================== --- pkg/CHNOSZ/tests/testthat/test-nonideal.R 2018-11-05 09:27:01 UTC (rev 341) +++ pkg/CHNOSZ/tests/testthat/test-nonideal.R 2018-11-05 11:32:04 UTC (rev 342) @@ -96,14 +96,14 @@ gamCl.300 <- 10^subcrt("Cl-", T=300, P=1000, IS=IS.HCh$`300`)$out$`Cl-`$loggam gamCl.500 <- 10^subcrt("Cl-", T=500, P=1000, IS=IS.HCh$`500`)$out$`Cl-`$loggam # TODO: get lower differences by adjusting the activity coefficient model in CHNOSZ - expect_maxdiff(gamCl.100, gamCl.HCh$`100`, 0.13) - expect_maxdiff(gamCl.300, gamCl.HCh$`300`, 0.05) - expect_maxdiff(gamCl.500, gamCl.HCh$`500`, 0.02) + expect_maxdiff(gamCl.100, gamCl.HCh$`100`, 0.07) + expect_maxdiff(gamCl.300, gamCl.HCh$`300`, 0.03) + expect_maxdiff(gamCl.500, gamCl.HCh$`500`, 0.009) # calculate activity coefficent of Cl- at each temperature gamNa.100 <- 10^subcrt("Na+", T=100, P=1000, IS=IS.HCh$`100`)$out$`Na+`$loggam gamNa.300 <- 10^subcrt("Na+", T=300, P=1000, IS=IS.HCh$`300`)$out$`Na+`$loggam gamNa.500 <- 10^subcrt("Na+", T=500, P=1000, IS=IS.HCh$`500`)$out$`Na+`$loggam - expect_maxdiff(gamNa.100, gamNa.HCh$`100`, 0.16) - expect_maxdiff(gamNa.300, gamNa.HCh$`300`, 0.06) - expect_maxdiff(gamNa.500, gamNa.HCh$`500`, 0.02) + expect_maxdiff(gamNa.100, gamNa.HCh$`100`, 0.08) + expect_maxdiff(gamNa.300, gamNa.HCh$`300`, 0.03) + expect_maxdiff(gamNa.500, gamNa.HCh$`500`, 0.013) }) From noreply at r-forge.r-project.org Tue Nov 6 06:24:28 2018 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 6 Nov 2018 06:24:28 +0100 (CET) Subject: [CHNOSZ-commits] r343 - in pkg/CHNOSZ: . R data demo inst man man/macros tests/testthat Message-ID: <20181106052428.7CEAA18B630@r-forge.r-project.org> Author: jedick Date: 2018-11-06 06:24:26 +0100 (Tue, 06 Nov 2018) New Revision: 343 Modified: pkg/CHNOSZ/DESCRIPTION pkg/CHNOSZ/R/NaCl.R pkg/CHNOSZ/R/nonideal.R pkg/CHNOSZ/data/opt.csv pkg/CHNOSZ/demo/gold.R pkg/CHNOSZ/inst/NEWS pkg/CHNOSZ/man/NaCl.Rd pkg/CHNOSZ/man/data.Rd pkg/CHNOSZ/man/macros/macros.Rd pkg/CHNOSZ/man/nonideal.Rd pkg/CHNOSZ/tests/testthat/test-logmolality.R pkg/CHNOSZ/tests/testthat/test-nonideal.R Log: nonideal(): add calculations for neutral species (Setch?\195?\169now equation) Modified: pkg/CHNOSZ/DESCRIPTION =================================================================== --- pkg/CHNOSZ/DESCRIPTION 2018-11-05 11:32:04 UTC (rev 342) +++ pkg/CHNOSZ/DESCRIPTION 2018-11-06 05:24:26 UTC (rev 343) @@ -1,6 +1,6 @@ -Date: 2018-11-05 +Date: 2018-11-06 Package: CHNOSZ -Version: 1.1.3-50 +Version: 1.1.3-51 Title: Thermodynamic Calculations and Diagrams for Geo(bio)chemistry Authors at R: c( person("Jeffrey", "Dick", , "j3ffdick at gmail.com", role = c("aut", "cre"), Modified: pkg/CHNOSZ/R/NaCl.R =================================================================== --- pkg/CHNOSZ/R/NaCl.R 2018-11-05 11:32:04 UTC (rev 342) +++ pkg/CHNOSZ/R/NaCl.R 2018-11-06 05:24:26 UTC (rev 343) @@ -3,7 +3,8 @@ # given a total molality of NaCl # taking account of ion association: Na+ + Cl- = NaCl(aq) # 20181102 jmd first version -# 20181105 add activity coefficients of Na+ +# 20181105 use activity coefficient of Na+ +# 20181106 use activity coefficient of NaCl NaCl <- function(T=seq(100, 500, 100), P=1000, m_tot=2) { # define a function for the reaction quotient @@ -24,22 +25,27 @@ ISout <- a_Cl <- numeric(N) # initial guess for m_Cl and ionic strength assuming complete dissociation of NaCl IS <- m_Cl <- rep(m_tot, N) - # the species indices for Cl- and Na+ - ispecies <- info(c("Na+", "Cl-")) + # the corresponding total molality of dissolved species (NaCl + Cl- + Na+) + m_star <- (m_tot - m_Cl) + 2*m_Cl + # the species indices for Na+, Cl-, and NaCl(aq) + ispecies <- info(c("Na+", "Cl-", "NaCl")) # we start by doing calculations for all temperatures doit <- !logical(N) while(any(doit)) { # calculate activity coefficient at given ionic strength speciesprops <- rep(list(data.frame(G=numeric(N))), length(ispecies)) - gammas <- suppressMessages(nonideal(ispecies, speciesprops, IS=IS, T=convert(T, "K"), P=P, A_DH=wout$A_DH, B_DH=wout$B_DH)) + gammas <- suppressMessages(nonideal(ispecies, speciesprops, IS=IS, T=convert(T, "K"), P=P, A_DH=wout$A_DH, B_DH=wout$B_DH, m_star=m_star)) gam_Na <- 10^gammas[[1]]$loggam gam_Cl <- 10^gammas[[2]]$loggam + gam_NaCl <- 10^gammas[[3]]$loggam # solve for m_Cl - for(i in which(doit)) m_Cl[i] <- uniroot(A, c(0, m_tot), gam_NaCl=1, gam_Na=gam_Na[i], gam_Cl=gam_Cl[i], logK=logK[i])$root + for(i in which(doit)) m_Cl[i] <- uniroot(A, c(0, m_tot), gam_NaCl=gam_NaCl[i], gam_Na=gam_Na[i], gam_Cl=gam_Cl[i], logK=logK[i])$root + # calculate new total molality + m_star <- (m_tot - m_Cl) + 2*m_Cl # calculate new ionic strength and deviation ISnew <- m_Cl dIS <- ISnew - IS - # set net ionic strength + # set new ionic strength IS <- ISnew # keep going until the deviation in ionic strength at any temperature is less than 0.01 doit <- abs(dIS) > 0.01 @@ -49,5 +55,5 @@ gam_Na <- 10^gammas[[1]]$loggam gam_Cl <- 10^gammas[[2]]$loggam # return the calculated values - list(IS=IS, m_Cl=m_Cl, gam_Na=gam_Na, gam_Cl=gam_Cl) + list(IS=IS, m_Cl=m_Cl, gam_Na=gam_Na, gam_Cl=gam_Cl, gam_NaCl=gam_NaCl) } Modified: pkg/CHNOSZ/R/nonideal.R =================================================================== --- pkg/CHNOSZ/R/nonideal.R 2018-11-05 11:32:04 UTC (rev 342) +++ pkg/CHNOSZ/R/nonideal.R 2018-11-06 05:24:26 UTC (rev 343) @@ -62,7 +62,7 @@ else if(prop=="Cp") return(R * T^2 *loggamma(eval(DD(A, "T", 2)), Z, I, B)) } - # function for Debye-Huckel equation with B-dot extended term parameter (Helgeson, 1969) + # function for Debye-Huckel equation with b_gamma or B-dot extended term parameter (Helgeson, 1969) Helgeson <- function(prop = "loggamma", Z, I, T, A_DH, B_DH, acirc, m_star, bgamma) { loggamma <- - A_DH * Z^2 * I^0.5 / (1 + acirc * B_DH * I^0.5) - log10(1 + 0.0180153 * m_star) + bgamma * I R <- 1.9872 # gas constant, cal K^-1 mol^-1 @@ -71,6 +71,14 @@ # note the log(10) (=2.303) ... use natural logarithm to calculate G } + # function for Setchenow equation with b_gamma or B-dot extended term parameter (Shvarov and Bastrakov, 1999) 20181106 + Setchenow <- function(prop = "loggamma", I, T, m_star, bgamma) { + loggamma <- - log10(1 + 0.0180153 * m_star) + bgamma * I + R <- 1.9872 # gas constant, cal K^-1 mol^-1 + if(prop=="loggamma") return(loggamma) + else if(prop=="G") return(R * T * log(10) * loggamma) + } + # get species indices if(!is.numeric(species[[1]])) species <- info(species, "aq") # loop over species #1: get the charge @@ -79,7 +87,7 @@ # force a charge count even if it's zero mkp <- makeup(c("Z0", species[i]), sum=TRUE) thisZ <- mkp[match("Z", names(mkp))] - # don't do anything for neutral species (Z absent from formula or equal to zero) + # no charge if Z is absent from the formula or equal to zero if(is.na(thisZ)) next if(thisZ==0) next Z[i] <- thisZ @@ -111,7 +119,7 @@ # "distance of closest approach" of ions in NaCl solutions (HKF81 Table 2) acirc <- rep(3.72e-8, length(species)) } - # get b_gamma (or Bdot) + # get b_gamma or B-dot if(method=="bgamma") bgamma <- bgamma(convert(T, "C"), P) else if(method=="Bdot") bgamma <- Bdot(convert(T, "C")) else if(method %in% c("Bdot0", "bgamma0")) bgamma <- 0 @@ -120,35 +128,55 @@ iH <- info("H+") ie <- info("e-") speciesprops <- as.list(speciesprops) - ndid <- 0 + ncharged <- nneutral <- 0 for(i in 1:length(species)) { myprops <- speciesprops[[i]] # to keep unit activity coefficients of the proton and electron if(species[i] == iH & get("thermo")$opt$ideal.H) next if(species[i] == ie & get("thermo")$opt$ideal.e) next - # skip neutral species - if(Z[i]==0) next - didit <- FALSE - for(j in 1:ncol(myprops)) { - pname <- colnames(myprops)[j] - if(!pname %in% c("G", "H", "S", "Cp")) next - if(method=="Alberty") { - myprops[, j] <- myprops[, j] + Alberty(pname, Z[i], IS, T) - didit <- TRUE - } else { - myprops[, j] <- myprops[, j] + Helgeson(pname, Z[i], IS, T, A_DH, B_DH, acirc[i], m_star, bgamma) - didit <- TRUE + didcharged <- didneutral <- FALSE + # logic for neutral and charged species 20181106 + if(Z[i]==0) { + for(j in 1:ncol(myprops)) { + pname <- colnames(myprops)[j] + if(!pname %in% c("G", "H", "S", "Cp")) next + if(get("thermo")$opt$Setchenow == "bgamma") { + myprops[, j] <- myprops[, j] + Setchenow(pname, IS, T, m_star, bgamma) + didneutral <- TRUE + } else if(get("thermo")$opt$Setchenow == "bgamma0") { + myprops[, j] <- myprops[, j] + Setchenow(pname, IS, T, m_star, bgamma = 0) + didneutral <- TRUE + } } + } else { + for(j in 1:ncol(myprops)) { + pname <- colnames(myprops)[j] + if(!pname %in% c("G", "H", "S", "Cp")) next + if(method=="Alberty") { + myprops[, j] <- myprops[, j] + Alberty(pname, Z[i], IS, T) + didcharged <- TRUE + } else { + myprops[, j] <- myprops[, j] + Helgeson(pname, Z[i], IS, T, A_DH, B_DH, acirc[i], m_star, bgamma) + didcharged <- TRUE + } + } } - # append a loggam column if we did any nonideal calculations of thermodynamic properties - if(didit) { + # append a loggam column if we did any calculations of adjusted thermodynamic properties + if(didcharged) { if(method=="Alberty") myprops <- cbind(myprops, loggam = Alberty("loggamma", Z[i], IS, T)) else myprops <- cbind(myprops, loggam = Helgeson("loggamma", Z[i], IS, T, A_DH, B_DH, acirc[i], m_star, bgamma)) } + if(didneutral) { + if(get("thermo")$opt$Setchenow == "bgamma") myprops <- cbind(myprops, loggam = Setchenow("loggamma", IS, T, m_star, bgamma)) + else if(get("thermo")$opt$Setchenow == "bgamma0") myprops <- cbind(myprops, loggam = Setchenow("loggamma", IS, T, m_star, bgamma = 0)) + } + # save the calculated properties and increment progress counters speciesprops[[i]] <- myprops - if(didit) ndid <- ndid + 1 + ncharged <- ncharged + sum(didcharged) + nneutral <- nneutral + sum(didneutral) } - if(ndid > 0) message("nonideal: calculated activity coefficients for ", ndid, " species (", mettext(method), ")") + if(ncharged > 0) message("nonideal: calculations for ", ncharged, " charged species (", mettext(method), ")") + if(nneutral > 0) message("nonideal: calculations for ", nneutral, " neutral species (Setchenow equation)") return(speciesprops) } Modified: pkg/CHNOSZ/data/opt.csv =================================================================== --- pkg/CHNOSZ/data/opt.csv 2018-11-05 11:32:04 UTC (rev 342) +++ pkg/CHNOSZ/data/opt.csv 2018-11-06 05:24:26 UTC (rev 343) @@ -1,2 +1,2 @@ -cutoff,E.units,T.units,P.units,state,water,G.tol,Cp.tol,V.tol,varP,IAPWS.sat,paramin,ideal.H,ideal.e,nonideal,Berman,maxcores -1E-10,cal,C,bar,aq,SUPCRT92,100,1,1,FALSE,liquid,1000,TRUE,TRUE,Bdot,NA,2 +cutoff,E.units,T.units,P.units,state,water,G.tol,Cp.tol,V.tol,varP,IAPWS.sat,paramin,ideal.H,ideal.e,nonideal,Setchenow,Berman,maxcores +1E-10,cal,C,bar,aq,SUPCRT92,100,1,1,FALSE,liquid,1000,TRUE,TRUE,Bdot,bgamma0,NA,2 Modified: pkg/CHNOSZ/demo/gold.R =================================================================== --- pkg/CHNOSZ/demo/gold.R 2018-11-05 11:32:04 UTC (rev 342) +++ pkg/CHNOSZ/demo/gold.R 2018-11-06 05:24:26 UTC (rev 343) @@ -30,8 +30,10 @@ # set up system # use H2S here: it's the predominant species at the pH of the QMK buffer -- see sulfur() -basis(c("Al2O3", "SiO2", "Fe", "Au", "K+", "Cl-", "H2S", "H2O", "oxygen", "H+")) -# set activity of K+ for 0.5 molal KCl assuming complete dissociation +basis(c("Al2O3", "quartz", "Fe", "Au", "K+", "Cl-", "H2S", "H2O", "oxygen", "H+")) +# set molality of K+ in completely dissociated 0.5 molal KCl +# NOTE: This value is used only for making the legend; +# activities corrected for ionic strength are computed below basis("K+", log10(0.5)) # create a pH buffer @@ -135,8 +137,12 @@ # calculate solution composition for 2 mol/kg NaCl NaCl <- NaCl(T = seq(150, 550, 10), P = 1000, m_tot=2) a_Cl <- NaCl$m_Cl * NaCl$gam_Cl + # using this ionic strength, calculate the activity of K+ + # assuming complete dissociation of 0.5 mol/kg KCl + gam_K <- 10^subcrt("K+", T = seq(150, 550, 10), P = 1000, IS=NaCl$IS)$out$`K+`$loggam + a_K <- 0.5 * gam_K # calculate affinity, equilibrate, solubility - a <- affinity(T = seq(150, 550, 10), `Cl-` = log10(a_Cl), P = 1000, IS = NaCl$IS) + a <- affinity(T = seq(150, 550, 10), `Cl-` = log10(a_Cl), `K+` = log10(a_K), P = 1000, IS = NaCl$IS) e <- equilibrate(a) s <- solubility(e) # make diagram and show total log molality @@ -145,7 +151,7 @@ # make legend and title dP <- describe.property("P", 1000) dNaCl <- expression(NaCl == 2~mol~kg^-1) - dK <- describe.basis(ibasis=5) + dK <- describe.basis(ibasis=5, use.molality=TRUE) legend("topleft", c(dP, dNaCl, dK), bty = "n") dbasis <- describe.basis(ibasis = c(9, 7, 10)) legend("topright", dbasis, bty = "n") @@ -166,8 +172,12 @@ # calculate solution composition for 2 mol/kg NaCl NaCl <- NaCl(T = seq(150, 550, 10), P = 1000, m_tot=2) a_Cl <- NaCl$m_Cl * NaCl$gam_Cl + # using this ionic strength, calculate the activity of K+ + # assuming complete dissociation of 0.5 mol/kg KCl + gam_K <- 10^subcrt("K+", T = seq(150, 550, 10), P = 1000, IS=NaCl$IS)$out$`K+`$loggam + a_K <- 0.5 * gam_K # calculate affinity, equilibrate, solubility - a <- affinity(T = seq(150, 550, 10), `Cl-` = log10(a_Cl), P = 1000, IS = NaCl$IS) + a <- affinity(T = seq(150, 550, 10), `Cl-` = log10(a_Cl), `K+` = log10(a_K), P = 1000, IS = NaCl$IS) e <- equilibrate(a) s <- solubility(e) # make diagram and show total log molality @@ -176,7 +186,7 @@ # make legend and title dP <- describe.property("P", 1000) dNaCl <- expression(NaCl == 2~mol~kg^-1) - dK <- describe.basis(ibasis=5) + dK <- describe.basis(ibasis=5, use.molality=TRUE) legend("topleft", c(dP, dNaCl, dK), bty = "n") dbasis <- describe.basis(ibasis = c(9, 7, 10)) legend("topright", dbasis, bty = "n") Modified: pkg/CHNOSZ/inst/NEWS =================================================================== --- pkg/CHNOSZ/inst/NEWS 2018-11-05 11:32:04 UTC (rev 342) +++ pkg/CHNOSZ/inst/NEWS 2018-11-06 05:24:26 UTC (rev 343) @@ -1,8 +1,20 @@ -CHANGES IN CHNOSZ 1.1.3-49 (2018-11-05) +CHANGES IN CHNOSZ 1.1.3-51 (2018-11-06) --------------------------------------- NEW FEATURES +- Add solubility(). Run this after equilibrate() to calculate the + solubility (loga.balance) of the balanced basis species. + +- Revise demo/solubility.R to show solubility calculations for CO2(gas) + and calcite as a function of T and pH. + +- Add demo/gold.R for calculations of Au solubility in hydrothermal + chloride and sulfide solutions (based on diagrams from Akinfiev and + Zotov, 2001, Stef?nsson and Seward, 2004, and Williams-Jones et al., + 2009). This depends on the revised nonideal() and new NaCl() functions + described next. + - Reorganize and expand options for activity coefficient calculations (set in thermo$opt$nonideal: Bdot, Bdot0, bgamma, bgamma0, or Alberty). The previous default, which corresponds to 'bgamma' (T- and @@ -15,21 +27,16 @@ (Shvarov and Bastrakov, 1999). Parameters are from Table 2.7 of Garrels and Christ, 1965. +- nonideal() now calulates activity coefficients of neutral species, + using the Setch?now equation. Whether the extended-term parameter in + this equation is taken to be zero or is taken from the value for + charged species (see above) is controlled by setting + 'thermo$opt$Setchenow' to bgamma0 (default) or bgamma. + - Add NaCl(), implementing a first-order calculation of the speciation of NaCl in water, taking account of activity coefficients and the reaction Na+ + Cl- = NaCl(aq). -- Add solubility(). Run this after equilibrate() to calculate the - solubility (loga.balance) of the balanced basis species. - -- Revise demo/solubility.R to show solubility calculations for CO2(gas) - and calcite as a function of T and pH. - -- Add demo/gold.R for calculations of Au solubility in hydrothermal - chloride and sulfide solutions (based on diagrams from Akinfiev and - Zotov, 2001, Stef?nsson and Seward, 2004, and Williams-Jones et al., - 2009). - THERMODYNAMIC DATA - The Berman data (Berman, 1988 and later additions) have replaced the Modified: pkg/CHNOSZ/man/NaCl.Rd =================================================================== --- pkg/CHNOSZ/man/NaCl.Rd 2018-11-05 11:32:04 UTC (rev 342) +++ pkg/CHNOSZ/man/NaCl.Rd 2018-11-06 05:24:26 UTC (rev 343) @@ -23,7 +23,7 @@ The algorithm starts by calculating the equilibrium constant (\emph{K}) of the reaction and assuming complete dissociation of NaCl(aq). This also permits calculating the ionic strength from the molalities of Na\S{+} and Cl\S{-}. Then, \code{\link{uniroot}} is used to find the equilibrium molality of Cl\S{-}; that is, where the affinity of the reaction (log(\emph{K}/\emph{Q})) becomes zero. -The activity quotient (\emph{Q}) is evaluated taking account of activity coefficients of Na\S{+} and Cl\S{-} calculated for the nominal ionic strength (see \code{\link{nonideal}}). +The activity quotient (\emph{Q}) is evaluated taking account of activity coefficients of Na\S{+}, Cl\S{-}, and NaCl(aq) calculated for the nominal ionic strength (see \code{\link{nonideal}}). The calculated molality of Cl\S{-} yields a new estimate of the ionic strength of the system. The calculations are iterated until the deviation in ionic strength at all temperatures is less than 0.01. } @@ -43,7 +43,7 @@ \examples{\dontshow{data(thermo)} # ionic strength of solution and activity coefficient of Cl- -# from HCh (Shvarov and Bastrakov, 1999) at 1000 bar, +# from HCh version 3.7 (Shvarov and Bastrakov, 1999) at 1000 bar, # 100, 200, and 300 degress C, and 1 to 6 molal NaCl m.HCh <- 1:6 IS.HCh <- list(`100`=c(0.992, 1.969, 2.926, 3.858, 4.758, 5.619), @@ -67,8 +67,11 @@ # plot ionic strength from HCh and NaCl() as points and lines par(mfrow=c(2, 1)) col <- c("black", "red", "orange") -plot(c(1,6), c(0,6), xlab="NaCl (mol/kg)", ylab="I (mol/kg)", type="n") +plot(c(1,6), c(0,6), xlab="NaCl (mol/kg)", ylab=axis.label("IS"), type="n") for(i in 1:3) { + # NOTE: the differences are probably mostly due to different models + # for the properties of NaCl(aq) (HCh: B.Ryhzenko model; + # CHONSZ: revised HKF with parameters from Shock et al., 1997) points(m.HCh, IS.HCh[[i]], col=col[i]) lines(m_tot, IS.calc[, i], col=col[i]) } @@ -77,14 +80,14 @@ dprop <- describe.property(rep("T", 3), c(100, 300, 500)) legend("topleft", dprop, lty=1, pch=1, col=col) title(main="H2O + NaCl; HCh (points) and 'NaCl()' (lines)") +plot(c(1,6), c(0,0.8), xlab="NaCl (mol/kg)", ylab=expression(gamma[Cl^"-"]), type="n") # plot activity coefficient (gamma) -plot(c(1,6), c(0,1), xlab="NaCl (mol/kg)", ylab=expression(gamma[Cl^"-"]), type="n") for(i in 1:3) { points(m.HCh, gam_Cl.HCh[[i]], col=col[i]) lines(m_tot, gam_Cl.calc[, i], col=col[i]) } # we should be fairly close -stopifnot(maxdiff(unlist(gam_Cl.calc[seq(1,11,2), ]), unlist(gam_Cl.HCh)) < 0.034) +stopifnot(maxdiff(unlist(gam_Cl.calc[seq(1,11,2), ]), unlist(gam_Cl.HCh)) < 0.033) } \references{ Modified: pkg/CHNOSZ/man/data.Rd =================================================================== --- pkg/CHNOSZ/man/data.Rd 2018-11-05 11:32:04 UTC (rev 342) +++ pkg/CHNOSZ/man/data.Rd 2018-11-06 05:24:26 UTC (rev 343) @@ -58,7 +58,8 @@ \code{paramin} \tab integer \tab Minimum number of calculations to launch parallel processes [1000] (see \code{\link{palply}}) \cr \code{ideal.H} \tab logical \tab Should \code{\link{nonideal}} ignore the proton? [\code{TRUE}] \cr \code{ideal.e} \tab logical \tab Should \code{\link{nonideal}} ignore the electron? [\code{TRUE}] \cr - \code{nonideal} \tab character \tab Method for \code{\link{nonideal}} [\code{Helgeson}] \cr + \code{nonideal} \tab character \tab Option for charged species in \code{\link{nonideal}} [\code{Bdot}] \cr + \code{Setchenow} \tab character \tab Option for neutral species in \code{\link{nonideal}} [\code{bgamma0}] \cr \code{Berman} \tab character \tab User data file for mineral parameters in the Berman equations [\code{NA}] \cr \code{maxcores} \tab numeric \tab Maximum number of cores for parallel calculations with \code{\link{palply}} [\code{2}] } Modified: pkg/CHNOSZ/man/macros/macros.Rd =================================================================== --- pkg/CHNOSZ/man/macros/macros.Rd 2018-11-05 11:32:04 UTC (rev 342) +++ pkg/CHNOSZ/man/macros/macros.Rd 2018-11-06 05:24:26 UTC (rev 343) @@ -46,3 +46,4 @@ \newcommand{\Psat}{\ifelse{latex}{\eqn{P_{\mathrm{SAT}}}}{\ifelse{html}{\out{PSAT}}{Psat}}} \newcommand{\Delta}{\ifelse{latex}{\eqn{\Delta}}{\ifelse{html}{\out{Δ}}{?}}} \newcommand{\aacute}{\ifelse{latex}{\out{\'{a}}}{\ifelse{html}{\out{á}}{?}}} +\newcommand{\eacute}{\ifelse{latex}{\out{\'{e}}}{\ifelse{html}{\out{é}}{?}}} Modified: pkg/CHNOSZ/man/nonideal.Rd =================================================================== --- pkg/CHNOSZ/man/nonideal.Rd 2018-11-05 11:32:04 UTC (rev 342) +++ pkg/CHNOSZ/man/nonideal.Rd 2018-11-06 05:24:26 UTC (rev 343) @@ -4,7 +4,7 @@ \alias{bgamma} \title{Activity coefficients of aqueous species} \description{ -Calculate activity coefficients and adjusted (non-ideal) molal properties of aqueous species. +Calculate activity coefficients and adjusted (transformed) molal properties of aqueous species. } \usage{ @@ -28,13 +28,17 @@ } \details{ -\code{nonideal} takes a list of dataframes (in \code{speciesprops}) containing the standard molal properties of the identified \code{species}. +This function calculates activity coefficients and adjusted thermodynamic proeprties (i.e. transformed standard Gibbs energy) for charged and neutral aqueous species. +The species are identified by name or species index in \code{species}. +\code{speciesprops} is a list of dataframes containing the input standard molal properties; normally, at least one column is \samp{G} for Gibbs energy. The function calculates the *adjusted* properties for given ionic strength (\code{IS}); they are equal to the *standard* values only at IS=0. -The function bypasses (leaves unchanged) properties of all species whose charge (determined by the number of Z in their \code{\link{makeup}}) is equal to zero. -The proton (\Hplus) and electron (\eminus) are also bypassed by default; this makes sense if you are setting the pH, i.e. activity of \Hplus, to some value. -To apply the calculations to H+ and/or e-, change \code{\link{thermo}$opt$ideal.H} or \code{ideal.e} to FALSE. The lengths of \code{IS} and \code{T} supplied in the arguments should be equal to the number of rows of each dataframe in \code{speciesprops}, or length one to use single values throughout. +} +\section{Charged Species}{ +Calculations for the proton (\Hplus) and electron (\eminus) are skipped by default; this makes sense if you are setting the pH, i.e. activity of \Hplus, to some value. +To apply the calculations to H+ and/or e-, change \code{\link{thermo}$opt$ideal.H} or \code{ideal.e} to FALSE. + If \code{method} is \samp{Alberty}, the values of \code{IS} are combined with Alberty's (2003) equation 3.6-1 (extended Debye-H?ckel equation; H?ckel, 1925) and its derivatives, to calculate adjusted molal properties at the specified ionic strength(s) and temperature(s). The adjusted molal properties that can be calculated include \samp{G}, \samp{H}, \samp{S} and \samp{Cp}; any columns in the dataframes of \code{speciesprops} with other names are left untouched. @@ -52,7 +56,16 @@ The distance of closest approach is set to a constant (3.72e-8 cm) (e.g., Manning et al., 2013). The extended term parameter is calculated by calling the \code{bgamma} function. Alternatively, set the extended term parameter to zero with \samp{bgamma0}. +} +\section{Neutral Species}{ +For neutral species, the Setch{\eacute}now equation is used, as described in Shvarov and Bastrakov, 1999. +If \code{\link{thermo}$opt$Setchenow} is \samp{bgamma0} (the default), the extended term parameter is set to zero and the only non-zero term is the mole fraction to molality conversion factor (using the value of \code{m_star}). +If \code{thermo$opt$Setchenow} is \samp{bgamma}, the extended term paramter is taken from the setting for the charged species (which can be either \samp{Bdot} or \samp{bgamma}). +Set \code{thermo$opt$Setchenow} to any other value to disable the calculations for neutral species. +} + +\section{b_gamma}{ \code{bgamma} calculates the extended term parameter (written as b_gamma; Helgeson et al., 1981) for activity coefficients in NaCl-dominated solutions at high temperature and pressure. Data at \Psat and 0.5 to 5 kb are taken from Helgeson (1969, Table 2 and Figure 3) and Helgeson et al. (1981, Table 27) and extrapolated values at 10 to 30 kb from Manning et al. (2013, Figure 11). Furthermore, the 10 to 30 kb data were used to generate super-extrapolated values at 40, 50, and 60 kb, which may be encountered using the \code{\link{water.DEW}} calculations. Modified: pkg/CHNOSZ/tests/testthat/test-logmolality.R =================================================================== --- pkg/CHNOSZ/tests/testthat/test-logmolality.R 2018-11-05 11:32:04 UTC (rev 342) +++ pkg/CHNOSZ/tests/testthat/test-logmolality.R 2018-11-06 05:24:26 UTC (rev 343) @@ -3,39 +3,40 @@ test_that("non-zero ionic strength transforms variables from activity to molality", { # what happens with activity coefficients when using subcrt() to calculate affinity, # and in the rest of the main workflow of CHNOSZ? - # 20171025 + # 20171025 first version + # 20181106 include non-zero activity coefficient of CO2(aq) - # first get the activity coefficients of H+ and HCO3- - # the long way... + ### first get the activity coefficients of H+ and HCO3- + ## the long way... wprop <- water(c("A_DH", "B_DH"), P=1) - nonid <- nonideal(c("H+", "HCO3-"), subcrt(c("H+", "HCO3-"), T=25)$out, IS=1, T=298.15, P=1, A_DH=wprop$A_DH, B_DH=wprop$B_DH) + speciesprops <- subcrt(c("H+", "HCO3-", "CO2"), T=25)$out + nonid <- nonideal(c("H+", "HCO3-", "CO2"), speciesprops, IS=1, T=298.15, P=1, A_DH=wprop$A_DH, B_DH=wprop$B_DH) # compare with a precalculated value: expect_maxdiff(nonid[[2]]$loggam, -0.1868168, 1e-7) - # the short way... - loggam <- subcrt(c("H+", "HCO3-"), T=25, IS=1)$out[[2]]$loggam - expect_equal(nonid[[2]]$loggam, loggam) - + ## the short way... + out1 <- subcrt(c("H+", "HCO3-", "CO2"), T=25, IS=1)$out + loggam_HCO3 <- out1[[2]]$loggam + loggam_CO2 <- out1[[3]]$loggam + expect_equal(nonid[[2]]$loggam, loggam_HCO3) + expect_equal(nonid[[3]]$loggam, loggam_CO2) ## take-home message -1: with default settings, the activity coefficient of H+ is always 1 - # how do activity coefficient affect the value of G? + ### how do activity coefficient affect the value of G? # let's step back and look at the *standard Gibbs energy* at IS = 0 - out0 <- subcrt(c("H+", "HCO3-"), T=25)$out - # and at IS = 1 - out1 <- subcrt(c("H+", "HCO3-"), T=25, IS=1)$out + out0 <- subcrt(c("H+", "HCO3-", "CO2"), T=25)$out # the adjusted standard Gibbs energy is less than the standard Gibbs energy # by an amount determined by the activity coefficient - expect_equal(out1[[2]]$G - out0[[2]]$G, -convert(loggam, "G")) - + expect_equal(out1[[2]]$G - out0[[2]]$G, -convert(loggam_HCO3, "G")) + expect_equal(out1[[3]]$G - out0[[3]]$G, -convert(loggam_CO2, "G")) ## take-home message 0: setting IS in subcrt() gives adjusted standard Gibbs energy - # now, what is the equilibrium constant for the reaction CO2 + H2O = H+ + HCO3-? + # what is the equilibrium constant for the reaction CO2 + H2O = H+ + HCO3-? # (this is the standard state property at IS=0) logK <- subcrt(c("CO2", "H2O", "H+", "HCO3-"), c(-1, -1, 1, 1), T=25)$out$logK # we get logK = -6.344694 (rounded) expect_maxdiff(logK, -6.344694, 1e-6) - # now, what is the affinity of the reaction at pH=7 and molalities of HCO3- and CO2 = 10^-3? - + ### what is the affinity of the reaction at pH=7 and molalities of HCO3- and CO2 = 10^-3? ## case 1: ionic strength = 0, so gamma = 0 and activity = molality # first calculate it by hand from 2.303RTlog(K/Q) # logQ = (logaH+ + logaHCO3-) - (logaH2O + logaCO2) @@ -47,37 +48,33 @@ A0subcrt <- subcrt(c("CO2", "H2O", "H+", "HCO3-"), c(-1, -1, 1, 1), T=25, logact=c(-3, 0, -7, -3))$out$A # we get the same affinity! expect_equal(A0subcrt, A0manual) - - ## case 1: ionic strength = 0, so activity = molality * gamma - logaHCO3 = -3 + loggam - logQ1 <- (-7 + logaHCO3) - (0 + -3) + ## case 2: ionic strength = 1, so activity = molality * gamma + logaHCO3 <- -3 + loggam_HCO3 + logaCO2 <- -3 + loggam_CO2 + logQ1 <- (-7 + logaHCO3) - (0 + logaCO2) A1manual <- -convert(logK - logQ1, "G") A1subcrt <- subcrt(c("CO2", "H2O", "H+", "HCO3-"), c(-1, -1, 1, 1), T=25, logact=c(-3, 0, -7, -3), IS=1)$out$A expect_equal(A1subcrt, A1manual) - ## take-home message 1: using subcrt with IS not equal to zero, the "logact" ## argument is logmolal in affinity calculations for charged aqueous species - # now, calculate the affinities using affinity() + ### now calculate the affinities using affinity() basis("CHNOS+") # pH=7, logaCO2 = -3 species(c("CO2", "HCO3-")) # logactivities = -3 - ## case 1: IS = 0 a0 <- affinity() # that gives us values in log units; convert to energy # (HCO3- is species #2) A0affinity <- -convert(a0$values[[2]], "G") expect_equal(A0affinity[[1]], A0subcrt) - ## case 2: IS = 1 a1 <- affinity(IS=1) A1affinity <- -convert(a1$values[[2]], "G") expect_equal(A1affinity[[1]], A1subcrt) - ## take-home message 2: using affinity() with IS not equal to zero, the "logact" ## set by species() is logmolal in affinity calculations for charged aqueous species - # now, swap HCO3- for CO2 in the basis + ### now, swap HCO3- for CO2 in the basis swap.basis("CO2", "HCO3-") basis("HCO3-", -3) a0 <- affinity() @@ -99,24 +96,26 @@ ACO2_1manual <- -convert(logKrev - logQrev1, "G") expect_equal(ACO2_0manual, ACO2_0affinity[[1]]) expect_equal(ACO2_1manual, ACO2_1affinity[[1]]) - ## take-home message 3: using affinity() with IS not equal to zero, the "logact" ## set by basis() is logmolal in affinity calculations for charged aqueous species - # now look at equilibrate() + ### now look at equilibrate() e0 <- equilibrate(a0) e1 <- equilibrate(a1) # using the equilibrated values, calculate affinity of the reaction CO2 + H2O = H+ + HCO3- # case 1: IS = 0 - logQeq0 <- (-7 + e0$loga.equil[[2]]) - (e0$loga.equil[[1]] + 0) + logact_HCO3 <- e0$loga.equil[[2]] + logact_CO2 <- e0$loga.equil[[1]] + logQeq0 <- (-7 + logact_HCO3) - (logact_CO2 + 0) Aeq0 <- -convert(logK - logQeq0, "G") # zero! expect_equal(Aeq0[[1]], 0) # case 2: IS = 1 + logact_HCO3 <- e1$loga.equil[[2]] + logact_CO2 <- e1$loga.equil[[1]] # here, loga.equil is the *molality*, so we must multiply by loggam - logQeq1 <- (-7 + e1$loga.equil[[2]] + loggam) - (e1$loga.equil[[1]] + 0) + logQeq1 <- (-7 + logact_HCO3 + loggam_HCO3) - (logact_CO2 + loggam_CO2 + 0) Aeq1 <- -convert(logK - logQeq1, "G") # zero! expect_equal(Aeq1[[1]], 0) - ## take-home message 4: using affinity() with IS not equal to zero, the "loga.equil" ## returned by equilibrate() is logmolal for speciation calculations with charged aqueous species @@ -124,7 +123,6 @@ a.balance <- 10^e1$loga.balance m.total <- sum(10^unlist(e1$loga.equil)) expect_equal(a.balance, m.total) - ## take-home message 5: using affinity() with IS not equal to zero, the "loga.balance" ## used by equilibrate() is the logarithm of total molality of the balancing basis species }) Modified: pkg/CHNOSZ/tests/testthat/test-nonideal.R =================================================================== --- pkg/CHNOSZ/tests/testthat/test-nonideal.R 2018-11-05 11:32:04 UTC (rev 342) +++ pkg/CHNOSZ/tests/testthat/test-nonideal.R 2018-11-06 05:24:26 UTC (rev 343) @@ -79,9 +79,11 @@ # 20181105 test_that("activity coefficients are similar to those from HCh", { # ionic strength of solution and activity coefficients of Na+ and Cl- - # from HCh (Shvarov and Bastrakov, 1999) at 1000 bar, - # 100, 200, and 300 degress C, and 1 to 6 molal NaCl + # calculated with HCh version 3.7 (Shvarov and Bastrakov, 1999) at 1000 bar, + # 100, 200, and 300 degress C, and 1 to 6 molal NaCl, # using the default "B-dot" activity coefficient model (Helgeson, 1969) + # and the default setting for the Setchenow equation, + # for which the only non-zero term is the mole fraction to molality conversion factor IS.HCh <- list(`100`=c(0.992, 1.969, 2.926, 3.858, 4.758, 5.619), `300`=c(0.807, 1.499, 2.136, 2.739, 3.317, 3.875), `500`=c(0.311, 0.590, 0.861, 1.125, 1.385, 1.642)) @@ -91,19 +93,28 @@ gamNa.HCh <- list(`100`=c(0.620, 0.616, 0.635, 0.662, 0.695, 0.730), `300`=c(0.421, 0.368, 0.339, 0.318, 0.302, 0.288), `500`=c(0.233, 0.180, 0.155, 0.138, 0.126, 0.117)) + gamNaCl.HCh <- list(`100`=c(0.965, 0.933, 0.904, 0.876, 0.850, 0.827), + `300`=c(0.968, 0.941, 0.915, 0.892, 0.870, 0.849), + `500`=c(0.977, 0.955, 0.935, 0.915, 0.897, 0.879)) # calculate activity coefficent of Cl- at each temperature gamCl.100 <- 10^subcrt("Cl-", T=100, P=1000, IS=IS.HCh$`100`)$out$`Cl-`$loggam gamCl.300 <- 10^subcrt("Cl-", T=300, P=1000, IS=IS.HCh$`300`)$out$`Cl-`$loggam gamCl.500 <- 10^subcrt("Cl-", T=500, P=1000, IS=IS.HCh$`500`)$out$`Cl-`$loggam - # TODO: get lower differences by adjusting the activity coefficient model in CHNOSZ expect_maxdiff(gamCl.100, gamCl.HCh$`100`, 0.07) expect_maxdiff(gamCl.300, gamCl.HCh$`300`, 0.03) expect_maxdiff(gamCl.500, gamCl.HCh$`500`, 0.009) - # calculate activity coefficent of Cl- at each temperature + # calculate activity coefficent of Na+ at each temperature gamNa.100 <- 10^subcrt("Na+", T=100, P=1000, IS=IS.HCh$`100`)$out$`Na+`$loggam gamNa.300 <- 10^subcrt("Na+", T=300, P=1000, IS=IS.HCh$`300`)$out$`Na+`$loggam gamNa.500 <- 10^subcrt("Na+", T=500, P=1000, IS=IS.HCh$`500`)$out$`Na+`$loggam expect_maxdiff(gamNa.100, gamNa.HCh$`100`, 0.08) expect_maxdiff(gamNa.300, gamNa.HCh$`300`, 0.03) expect_maxdiff(gamNa.500, gamNa.HCh$`500`, 0.013) + # calculate activity coefficent of NaCl at each temperature + gamNaCl.100 <- 10^subcrt("NaCl", T=100, P=1000, IS=IS.HCh$`100`)$out$`NaCl`$loggam + gamNaCl.300 <- 10^subcrt("NaCl", T=300, P=1000, IS=IS.HCh$`300`)$out$`NaCl`$loggam + gamNaCl.500 <- 10^subcrt("NaCl", T=500, P=1000, IS=IS.HCh$`500`)$out$`NaCl`$loggam + expect_maxdiff(gamNaCl.100, gamNaCl.HCh$`100`, 0.09) + expect_maxdiff(gamNaCl.300, gamNaCl.HCh$`300`, 0.09) + expect_maxdiff(gamNaCl.500, gamNaCl.HCh$`500`, 0.10) }) From noreply at r-forge.r-project.org Wed Nov 7 03:18:54 2018 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 7 Nov 2018 03:18:54 +0100 (CET) Subject: [CHNOSZ-commits] r344 - in pkg/CHNOSZ: . R demo inst man tests/testthat Message-ID: <20181107021854.BC3FA18AD5B@r-forge.r-project.org> Author: jedick Date: 2018-11-07 03:18:53 +0100 (Wed, 07 Nov 2018) New Revision: 344 Modified: pkg/CHNOSZ/DESCRIPTION pkg/CHNOSZ/R/examples.R pkg/CHNOSZ/R/solubility.R pkg/CHNOSZ/demo/gold.R pkg/CHNOSZ/demo/solubility.R pkg/CHNOSZ/inst/NEWS pkg/CHNOSZ/man/NaCl.Rd pkg/CHNOSZ/man/equilibrate.Rd pkg/CHNOSZ/man/nonideal.Rd pkg/CHNOSZ/man/solubility.Rd pkg/CHNOSZ/tests/testthat/test-solubility.R Log: solubility(): calculate activity directly from affinity (no equilibrate step) Modified: pkg/CHNOSZ/DESCRIPTION =================================================================== --- pkg/CHNOSZ/DESCRIPTION 2018-11-06 05:24:26 UTC (rev 343) +++ pkg/CHNOSZ/DESCRIPTION 2018-11-07 02:18:53 UTC (rev 344) @@ -1,6 +1,6 @@ Date: 2018-11-06 Package: CHNOSZ -Version: 1.1.3-51 +Version: 1.1.3-52 Title: Thermodynamic Calculations and Diagrams for Geo(bio)chemistry Authors at R: c( person("Jeffrey", "Dick", , "j3ffdick at gmail.com", role = c("aut", "cre"), Modified: pkg/CHNOSZ/R/examples.R =================================================================== --- pkg/CHNOSZ/R/examples.R 2018-11-06 05:24:26 UTC (rev 343) +++ pkg/CHNOSZ/R/examples.R 2018-11-07 02:18:53 UTC (rev 344) @@ -9,8 +9,8 @@ "util.array", "util.blast", "util.data", "util.expression", "util.fasta", "util.formula", "util.matrix", "util.misc", "util.seq", "util.units", "util.water", "taxonomy", "info", "protein.info", "hkf", "water", "IAPWS95", "subcrt", - "makeup", "basis", "swap.basis", "species", "affinity", "equil.boltzmann", - "diagram", "buffer", "nonideal", "add.protein", "protein", "ionize.aa", "yeast.aa", + "makeup", "basis", "swap.basis", "species", "affinity", "solubility", "equilibrate", + "diagram", "buffer", "nonideal", "NaCl", "add.protein", "protein", "ionize.aa", "yeast.aa", "objective", "revisit", "EOSregress", "wjd") plot.it <- FALSE if(is.character(save.png)) Modified: pkg/CHNOSZ/R/solubility.R =================================================================== --- pkg/CHNOSZ/R/solubility.R 2018-11-06 05:24:26 UTC (rev 343) +++ pkg/CHNOSZ/R/solubility.R 2018-11-07 02:18:53 UTC (rev 344) @@ -1,30 +1,55 @@ # solubility.R: vectorized solubility calculations without uniroot # 20181031 jmd +# 20181106 work on the output from affinity(); no "equilibrate()" needed! -solubility <- function(eout, exp = 1) { - # exp = 1: e.g. dissolution of CO2 - # exp = 2: e.g. dissolution (and dissociation) of CaCO3 +## if this file is interactively sourced, the following are also needed to provide unexported functions: +#source("equilibrate.R") +#source("util.misc.R") - # bookkeeping: track any single species - itrack <- 1 - # the log activity used to calculate the affinity - loga.species.track <- eout$species$logact[itrack] - # the affinities at the starting loga.balance - A.track <- eout$values[[itrack]] - # the loga.equil at the starting loga.balance - loga.equil.track <- eout$loga.equil[[itrack]] +solubility <- function(aout, balance=NULL, split=FALSE) { + ## concept: the logarithms of activities of species at equilibrium are equal to + ## Astar, the affinities calculated for unit activities of species + + ## however, the values in aout can be calculated for other than + ## unit activities of species, so we have to take away the activites + Astar <- function(i) aout$values[[i]] + aout$species$logact[i] + loga.equil <- lapply(1:length(aout$values), Astar) + ## for a dissociation (split) on a *per reaction* (not system) basis, + ## apply the divisor here and skip the if(split){} part below + ## (can be used to reproduce Fig. 4 of Manning et al., 2013) + if(is.numeric(split)) loga.equil <- lapply(loga.equil, "/", split) - # subjunctive: what would the affinities be if the - # activity of the tracked species was set to loga.equil? - A.whatif <- loga.species.track + A.track - loga.equil.track + # get the balancing coefficients + bout <- balance(aout, balance) + n.balance <- bout$n.balance + balance <- bout$balance - # predictive: assuming the species distribution doesn't change, - # what is the total loga that gives zero affinity? - # TODO: modify this according to stoichiometry (species with > 1 of the balanced basis species) - loga.total <- (eout$loga.balance + A.whatif) / exp - message("solubility: calculated logarithm of total activity of ", eout$balance) + # get logarithm of total activity of the balancing basis species + logabfun <- function(loga.equil, n.balance) { + # exponentiate, multiply by n.balance, sum, logarithm + a.equil <- mapply("^", 10, loga.equil, SIMPLIFY = FALSE) + a.balance <- mapply("*", a.equil, n.balance, SIMPLIFY=FALSE) + a.balance <- Reduce("+", a.balance) + log10(a.balance) + } + loga.balance <- logabfun(loga.equil, bout$n.balance) - # use the predicted loga.total to re-calculate activities of species - aout <- eout[1:which(names(eout)=="values")] - equilibrate(aout, loga.balance = loga.total) + # recalculate things for a 1:1 split species (like CaCO3 = Ca+2 + CO3+2) + if(isTRUE(split)) { + # the multiplicity becomes the exponent in the reaction quotient + loga.split <- loga.balance / 2 + # the contribution to affinity + Asplit <- lapply(n.balance, "*", loga.split) + # adjust the affinity and get new equilibrium activities + aout$values <- mapply("-", aout$values, Asplit, SIMPLIFY=FALSE) + loga.equil <- lapply(1:length(aout$values), Astar) + # check that the new loga.balance == loga.split; this might not work for non-1:1 species + loga.balance <- logabfun(loga.equil, n.balance) + stopifnot(all.equal(loga.balance, loga.split)) + } + + # make the output + # (we don't deal with normalized formulas yet, so for now m.balance==n.balance) + c(aout, list(balance=bout$balance, m.balance=bout$n.balance, n.balance=bout$n.balance, + loga.balance=loga.balance, Astar=loga.equil, loga.equil=loga.equil)) } Modified: pkg/CHNOSZ/demo/gold.R =================================================================== --- pkg/CHNOSZ/demo/gold.R 2018-11-06 05:24:26 UTC (rev 343) +++ pkg/CHNOSZ/demo/gold.R 2018-11-07 02:18:53 UTC (rev 344) @@ -80,11 +80,10 @@ # apply PPM buffer for fO2 and aH2S basis("O2", "PPM") basis("H2S", "PPM") - # calculate affinity, equilibrate, solubility + # calculate affinity and solubility # (set IS = 0 for diagram to show "log m" instead of "log a") a <- affinity(pH = c(3, 8), T = 300, P = 1000, IS = 0) - e <- equilibrate(a) - s <- solubility(e) + s <- solubility(a) # make diagram and show total log molality diagram(s, ylim = c(-10, -5), col = col, lwd = 2, lty = 1) diagram(s, add = TRUE, type = "loga.balance", lwd = 3, lty = 2) @@ -106,11 +105,10 @@ # apply PPM buffer for fO2 and aH2S basis("O2", "PPM") basis("H2S", "PPM") - # calculate affinity, equilibrate, solubility + # calculate affinity and solubility # (set IS = 0 for diagram to show "log m" instead of "log a") a <- affinity(pH = c(3, 8), T = 450, P = 1000, IS = 0) - e <- equilibrate(a) - s <- solubility(e) + s <- solubility(a) # make diagram and show total log molality diagram(s, ylim = c(-8, -3), col = col, lwd = 2, lty = 1) diagram(s, add = TRUE, type = "loga.balance", lwd = 3, lty = 2) @@ -141,10 +139,9 @@ # assuming complete dissociation of 0.5 mol/kg KCl gam_K <- 10^subcrt("K+", T = seq(150, 550, 10), P = 1000, IS=NaCl$IS)$out$`K+`$loggam a_K <- 0.5 * gam_K - # calculate affinity, equilibrate, solubility + # calculate affinity and solubility a <- affinity(T = seq(150, 550, 10), `Cl-` = log10(a_Cl), `K+` = log10(a_K), P = 1000, IS = NaCl$IS) - e <- equilibrate(a) - s <- solubility(e) + s <- solubility(a) # make diagram and show total log molality diagram(s, ylim = c(-10, -4), col = col, lwd = 2, lty = 1) diagram(s, add = TRUE, type = "loga.balance", lwd = 3, lty = 2) @@ -176,10 +173,9 @@ # assuming complete dissociation of 0.5 mol/kg KCl gam_K <- 10^subcrt("K+", T = seq(150, 550, 10), P = 1000, IS=NaCl$IS)$out$`K+`$loggam a_K <- 0.5 * gam_K - # calculate affinity, equilibrate, solubility + # calculate affinity and solubility a <- affinity(T = seq(150, 550, 10), `Cl-` = log10(a_Cl), `K+` = log10(a_K), P = 1000, IS = NaCl$IS) - e <- equilibrate(a) - s <- solubility(e) + s <- solubility(a) # make diagram and show total log molality diagram(s, ylim = c(-10, -2), col = col, lwd = 2, lty = 1) diagram(s, add = TRUE, type = "loga.balance", lwd = 3, lty = 2) Modified: pkg/CHNOSZ/demo/solubility.R =================================================================== --- pkg/CHNOSZ/demo/solubility.R 2018-11-06 05:24:26 UTC (rev 343) +++ pkg/CHNOSZ/demo/solubility.R 2018-11-07 02:18:53 UTC (rev 344) @@ -25,8 +25,7 @@ basis("CO2", -3.5) species(c("CO2", "HCO3-", "CO3-2")) a <- affinity(pH = c(pH, res), T = T1, IS = IS) -e <- equilibrate(a) -s <- solubility(e) +s <- solubility(a) # first plot total activity line diagram(s, ylim = c(-10, 4), type = "loga.balance", lwd = 4, col = "green2") # add activities of species @@ -39,11 +38,12 @@ title(main = substitute("Solubility of"~what~"at"~T~degree*"C", list(what = expr.species("CO2"), T = T1)), line = 1.6) mtext("cf. Fig. 4.5 of Stumm and Morgan, 1996") +# check the endpoints +stopifnot(round(s$loga.balance[c(1, res)])==c(-5, 6)) # CO2 T-pH plot a <- affinity(pH = c(pH, res), T = c(T, res), IS = IS) -e <- equilibrate(a) -s <- solubility(e) +s <- solubility(a) diagram(s, type = "loga.balance") title(main = substitute("Solubility of"~what, list(what = expr.species("CO2")))) @@ -51,8 +51,7 @@ basis(c("calcite", "Ca+2", "H2O", "O2", "H+")) species(c("CO2", "HCO3-", "CO3-2")) a <- affinity(pH = c(pH, res), T = T1, IS = IS) -e <- equilibrate(a) -s <- solubility(e, exp = 2) +s <- solubility(a, split = TRUE) diagram(s, ylim = c(-10, 4), type = "loga.balance", lwd = 4, col = "green2") diagram(s, add = TRUE, dy = 1) legend("topright", lty = c(1, 1:3), lwd = c(4, 2, 2, 2), @@ -60,10 +59,11 @@ title(main = substitute("Solubility of"~what~"at"~T~degree*"C", list(what = "calcite", T = T1)), line = 1.6) mtext("cf. Fig. 4A of Manning et al., 2013") +# check the endpoints +stopifnot(round(s$loga.balance[c(1, res)])==c(4, -4)) # calcite T-pH plot a <- affinity(pH = c(pH, res), T = c(T, res), IS = IS) -e <- equilibrate(a) -s <- solubility(e, exp = 2) +s <- solubility(a, split = TRUE) diagram(s, type = "loga.balance") title(main = "Solubility of calcite", font.main = 1) Modified: pkg/CHNOSZ/inst/NEWS =================================================================== --- pkg/CHNOSZ/inst/NEWS 2018-11-06 05:24:26 UTC (rev 343) +++ pkg/CHNOSZ/inst/NEWS 2018-11-07 02:18:53 UTC (rev 344) @@ -1,10 +1,10 @@ -CHANGES IN CHNOSZ 1.1.3-51 (2018-11-06) +CHANGES IN CHNOSZ 1.1.3-52 (2018-11-07) --------------------------------------- NEW FEATURES -- Add solubility(). Run this after equilibrate() to calculate the - solubility (loga.balance) of the balanced basis species. +- Add solubility(). Run this after affinity() to calculate the + solubility of the conserved basis species. - Revise demo/solubility.R to show solubility calculations for CO2(gas) and calcite as a function of T and pH. Modified: pkg/CHNOSZ/man/NaCl.Rd =================================================================== --- pkg/CHNOSZ/man/NaCl.Rd 2018-11-06 05:24:26 UTC (rev 343) +++ pkg/CHNOSZ/man/NaCl.Rd 2018-11-07 02:18:53 UTC (rev 344) @@ -65,7 +65,7 @@ gam_Cl.calc[i, ] <- NaCl.out$gam_Cl } # plot ionic strength from HCh and NaCl() as points and lines -par(mfrow=c(2, 1)) +opar <- par(mfrow=c(2, 1)) col <- c("black", "red", "orange") plot(c(1,6), c(0,6), xlab="NaCl (mol/kg)", ylab=axis.label("IS"), type="n") for(i in 1:3) { @@ -88,10 +88,11 @@ } # we should be fairly close stopifnot(maxdiff(unlist(gam_Cl.calc[seq(1,11,2), ]), unlist(gam_Cl.HCh)) < 0.033) +par(opar) } \references{ -Shvarov, Y. and Bastrakov, E. (1999) HCh: A software package for geochemical equilibrium modelling. User's Guide. \emph{Australian Geological Survey Organisation} \bold{1999/25}. +Shvarov, Y. and Bastrakov, E. (1999) HCh: A software package for geochemical equilibrium modelling. User's Guide. \emph{Australian Geological Survey Organisation} \bold{1999/25}. \url{http://pid.geoscience.gov.au/dataset/ga/25473} } \concept{Extended workflow} Modified: pkg/CHNOSZ/man/equilibrate.Rd =================================================================== --- pkg/CHNOSZ/man/equilibrate.Rd 2018-11-06 05:24:26 UTC (rev 343) +++ pkg/CHNOSZ/man/equilibrate.Rd 2018-11-07 02:18:53 UTC (rev 344) @@ -83,6 +83,13 @@ } +\section{Warning}{ +Despite its name, this function does not generally produce a complete equilibrium. +It returns activities of species such that the affinities of formation reactions are equal to each other (and transformations between species have zero affinity); this is a type of metastable equilibrium. +Although they are equal to each other, the affinities are not necessarily equal to zero. +Use \code{solubility} to find complete equilibrium, where the affinities of the formation reactions become zero. +} + \seealso{ \code{\link{diagram}} has examples of using \code{equilibrate} to make equilibrium activity diagrams. \code{\link{revisit}} can be used to perform further analysis of the equilibrium activities. \code{\link{palply}} is used by both \code{equil.reaction} and \code{equil.boltzmann} to parallelize intensive parts of the calculations. Modified: pkg/CHNOSZ/man/nonideal.Rd =================================================================== --- pkg/CHNOSZ/man/nonideal.Rd 2018-11-06 05:24:26 UTC (rev 343) +++ pkg/CHNOSZ/man/nonideal.Rd 2018-11-07 02:18:53 UTC (rev 344) @@ -2,7 +2,7 @@ \name{nonideal} \alias{nonideal} \alias{bgamma} -\title{Activity coefficients of aqueous species} +\title{Activity Coefficients of Aqueous Species} \description{ Calculate activity coefficients and adjusted (transformed) molal properties of aqueous species. } @@ -39,7 +39,7 @@ Calculations for the proton (\Hplus) and electron (\eminus) are skipped by default; this makes sense if you are setting the pH, i.e. activity of \Hplus, to some value. To apply the calculations to H+ and/or e-, change \code{\link{thermo}$opt$ideal.H} or \code{ideal.e} to FALSE. -If \code{method} is \samp{Alberty}, the values of \code{IS} are combined with Alberty's (2003) equation 3.6-1 (extended Debye-H?ckel equation; H?ckel, 1925) and its derivatives, to calculate adjusted molal properties at the specified ionic strength(s) and temperature(s). +If \code{method} is \samp{Alberty}, the values of \code{IS} are combined with Alberty's (2003) equation 3.6-1 (extended Debye-H?ckel equation) and its derivatives, to calculate adjusted molal properties at the specified ionic strength(s) and temperature(s). The adjusted molal properties that can be calculated include \samp{G}, \samp{H}, \samp{S} and \samp{Cp}; any columns in the dataframes of \code{speciesprops} with other names are left untouched. In addition to \code{IS} and \code{T}, the following two methods depend on values of \code{P}, \code{A_DH}, \code{B_DH}, and \code{m_star} given in the arguments. @@ -194,13 +194,11 @@ Helgeson, H. C., Kirkham, D. H. and Flowers, G. C. (1981) Theoretical prediction of the thermodynamic behavior of aqueous electrolytes at high pressures and temperatures. IV. Calculation of activity coefficients, osmotic coefficients, and apparent molal and standard and relative partial molal properties to 600\degC and 5 Kb. \emph{Am. J. Sci.} \bold{281}, 1249--1516. \url{https://doi.org/10.2475/ajs.281.10.1249} -H?ckel, E. (1925). The theory of concentrated, aqueous solutions of strong electrolytes. \emph{Physikalische Zeitschrift} \bold{26}, 93--147. - Manning, C. E. (2013) Thermodynamic modeling of fluid-rock interaction at mid-crustal to upper-mantle conditions. \emph{Rev. Mineral. Geochem.} \bold{76}, 135--164. \url{https://doi.org/10.2138/rmg.2013.76.5} Manning, C. E., Shock, E. L. and Sverjensky, D. A. (2013) The chemistry of carbon in aqueous fluids at crustal and upper-mantle conditions: Experimental and theoretical constraints. \emph{Rev. Mineral. Geochem.} \bold{75}, 109--148. \url{https://doi.org/10.2138/rmg.2013.75.5} -Shvarov, Y. and Bastrakov, E. (1999) HCh: A software package for geochemical equilibrium modelling. User's Guide. \emph{Australian Geological Survey Organisation} \bold{1999/25}. +Shvarov, Y. and Bastrakov, E. (1999) HCh: A software package for geochemical equilibrium modelling. User's Guide. \emph{Australian Geological Survey Organisation} \bold{1999/25}. \url{http://pid.geoscience.gov.au/dataset/ga/25473} } \concept{Thermodynamic calculations} Modified: pkg/CHNOSZ/man/solubility.Rd =================================================================== --- pkg/CHNOSZ/man/solubility.Rd 2018-11-06 05:24:26 UTC (rev 343) +++ pkg/CHNOSZ/man/solubility.Rd 2018-11-07 02:18:53 UTC (rev 344) @@ -7,44 +7,46 @@ } \usage{ - solubility(eout, exp = 1) + solubility(aout, balance = NULL, split = FALSE) } \arguments{ - \item{eout}{list, output from \code{\link{equilibrate}}} - \item{exp}{numeric, exponent characterizing the stoichiometry of the dissociation reaction} + \item{aout}{list, output from \code{\link{affinity}}} + \item{balance}{character, basis species to conserve in reactions} + \item{split}{logical, does the mineral undergo a dissociation reaction?} } \details{ -Use this function to calculate solubilities of minerals (such as CaCO\s3) or gases (such as CO\s2). -Start by using \code{\link{equilibrate}} to calculate equilibrium chemical activities of species given a constant value of \code{loga.balance} (the logarithm of total activity of the balanced basis species). -Note that this produces affinities of formation reactions of species that are equal to each other, but are generally not equal to zero. -\code{solubility} adjusts \code{loga.balance} such that the affinities of the formation reaction become zero. -This corresponds to \dQuote{true} equilibrium for a solution in contact with the balanced basis species - i.e. the solubility of that species. +This function performs a simple task: from the values of \code{\link{affinity}} of formation reactions of species at given activity, it works backward to find the activities of species that make the affinities zero. +This corresponds to complete equilibrium with all of the basis species. +For solubility calculations, the basis species should be set up so that formation reactions of species are balanced on the thing being dissolved (a mineral such as CaCO\s3 or gas such as CO\s2). +This is usually identified as the first basis species, but if there is any ambiguity, use \code{balance} to indicate the conserved basis species. -Normally, the balance is automatically identified as the first basis species that is present in all of the species. -If that is not adequate, it can be explicitly set via the \samp{balance} setting in \code{equilibrate}. +\code{split} should be set when calculating the solubility of something that dissociates (not just dissolves). +For example, to calculate the solubility of calcite (CaCO\s3), each form of carbonate is represented by a different reaction, but all of these reactions also release calcium ions. +The equilibrium calculation must take account of the \emph{total} activity of the shared ion (Ca\S{+2}); naturally, that value was unknown for the calculation of \code{\link{affinity}}. +The solution is accomplished by setting \code{split} to TRUE to recalculate the affinities (working backward, as if the split didn't occur). +Then, the resulting activities correspond to equilibrium considering the system-wide activity of Ca\S{+2}. +A \emph{not recommended} alternative is to set \code{split} to a numeric value (probably 2) to calculate activities on a per-reaction basis, where each reaction has its own activity of Ca\S{+2}. +That does not give a complete equilibrium, but may be required to reproduce some published diagrams. -The value of \code{exp} should be changed when calculating solubility of species that dissociate (not just dissolve). -For example, set \code{exp} to 2 for calculating the solubility of calcite (CaCO\s3). - -The output of \code{solubility} has the same format as that of \code{equilibrate}, and can be used by \code{\link{diagram}} with \code{type = "loga.balance"}. +The output of \code{solubility} has the same format as that of \code{equilibrate}, and can be used by \code{\link{diagram}} with \code{type = "loga.balance"} to plot the solubilities, or with \code{type = NULL} to plot the activities of species. } \section{Warning}{ This function has not been tested for systems that may form dimers or higher-order complexes (such as Au\s{2}S\s{2}\S{2-}). -The lower figures in \code{demo("gold")} are incomplete, as they do not account for other possible reactions not involving Au, particularly the decrease of Cl\S{-} concentration owing to the rising stability of the NaCl\s{(aq)} complex at high temperature. Except for relatively simple systems, even after careful refinement, the results from CHNOSZ, which considers chemical activities as the independent variables, will not match the results from speciation-solubility (or Gibbs energy minimization) codes, where the system is defined by its bulk composition. } \seealso{ \code{demo("solubility")} adds \T-pH diagrams to the CO\s{2} and calcite example here. \code{demo("gold")} shows solubility calculations for Au in aqueous solutions with hydroxide, chloride, and hydrosulfide complexes. +\code{\link{equilibrate}} calculates equilibrium chemical activities of species given a constant value of \code{loga.balance} (the logarithm of total activity of the conserved basis species). } \examples{\dontshow{data(thermo)} # solubility of CO2 and calcite as a function of pH -par(mfrow = c(1, 2)) +opar <- par(mfrow = c(1, 2)) # set pH range and resolution, constant temperature and ionic strength pH <- c(0, 14) @@ -58,8 +60,7 @@ basis("CO2", -3.5) species(c("CO2", "HCO3-", "CO3-2")) a <- affinity(pH = c(pH, res), T = T, IS = IS) -e <- equilibrate(a) -s <- solubility(e) +s <- solubility(a) # first plot total activity line diagram(s, ylim = c(-10, 4), type = "loga.balance", lwd = 4, col = "green2") # add activities of species @@ -77,8 +78,7 @@ basis(c("calcite", "Ca+2", "H2O", "O2", "H+")) species(c("CO2", "HCO3-", "CO3-2")) a <- affinity(pH = c(pH, res), T = T, IS = IS) -e <- equilibrate(a) -s <- solubility(e, exp = 2) +s <- solubility(a, split = TRUE) diagram(s, ylim = c(-10, 4), type = "loga.balance", lwd = 4, col = "green2") diagram(s, add = TRUE, dy = 1) legend("topright", lty = c(1, 1:3), lwd = c(4, 2, 2, 2), @@ -86,6 +86,8 @@ title(main = substitute("Solubility of"~what~"at"~T~degree*"C", list(what = "calcite", T = T))) mtext("cf. Fig. 4A of Manning et al., 2013") + +par(opar) } \references{ Modified: pkg/CHNOSZ/tests/testthat/test-solubility.R =================================================================== --- pkg/CHNOSZ/tests/testthat/test-solubility.R 2018-11-06 05:24:26 UTC (rev 343) +++ pkg/CHNOSZ/tests/testthat/test-solubility.R 2018-11-07 02:18:53 UTC (rev 344) @@ -7,29 +7,38 @@ T <- 25 IS <- 0 - # start with CO2 + ## start with CO2 basis(c("carbon dioxide", "H2O", "O2", "H+")) # ca. atmospheric PCO2 basis("CO2", -3.5) species(c("CO2", "HCO3-", "CO3-2")) a <- affinity(pH = c(pH, res), T = T, IS = IS) - e <- equilibrate(a) - s <- solubility(e) + s <- solubility(a) + # a function to check for stable conditions (affinity = 0) + # do this by setting activities in species() then calculating the affintiy + checkfun <- function(i) { + logact <- sapply(s$loga.equil, "[", i) + species(1:3, logact) + basis("pH", s$vals[[1]][i]) + affinity(T = T, IS = IS) + } + # check any 'i' here - let's just take two + expect_equal(max(abs(unlist(checkfun(33)$values))), 0) + expect_equal(max(abs(unlist(checkfun(99)$values))), 0) - # check for stable conditions (affinity = 0) - species(1:3, 0) - atest <- affinity(pH = s$vals[[1]], T = T, IS = IS) - expect_true(all(sapply(unlist(atest$values) - unlist(s$loga.equil), all.equal, 0))) - # now do calcite basis(c("calcite", "Ca+2", "H2O", "O2", "H+")) species(c("CO2", "HCO3-", "CO3-2")) a <- affinity(pH = c(pH, res), T = T, IS = IS) - e <- equilibrate(a) - s <- solubility(e, exp = 2) - - # check for stable conditions (affinity = 0) - species(1:3, 0) - atest <- affinity(pH = s$vals[[1]], `Ca+2` = s$loga.balance, T = T, IS = IS) - expect_true(all(sapply(unlist(atest$values) - unlist(s$loga.equil), all.equal, 0))) + s <- solubility(a, split = TRUE) + # here we need to also set the activity of Ca+2 + checkfun <- function(i) { + logact <- sapply(s$loga.equil, "[", i) + species(1:3, logact) + basis("pH", s$vals[[1]][i]) + basis("Ca+2", s$loga.balance[i]) + affinity(T = T, IS = IS) + } + expect_equal(max(abs(unlist(checkfun(33)$values))), 0) + expect_equal(max(abs(unlist(checkfun(99)$values))), 0) }) From noreply at r-forge.r-project.org Wed Nov 7 14:14:21 2018 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 7 Nov 2018 14:14:21 +0100 (CET) Subject: [CHNOSZ-commits] r345 - in pkg/CHNOSZ: . R man tests/testthat Message-ID: <20181107131421.B7BA61888A0@r-forge.r-project.org> Author: jedick Date: 2018-11-07 14:14:21 +0100 (Wed, 07 Nov 2018) New Revision: 345 Modified: pkg/CHNOSZ/DESCRIPTION pkg/CHNOSZ/R/NaCl.R pkg/CHNOSZ/R/examples.R pkg/CHNOSZ/R/solubility.R pkg/CHNOSZ/R/subcrt.R pkg/CHNOSZ/R/util.misc.R pkg/CHNOSZ/man/NaCl.Rd pkg/CHNOSZ/man/util.misc.Rd pkg/CHNOSZ/tests/testthat/test-subcrt.R Log: subcrt(): fix some phase transition bugs Modified: pkg/CHNOSZ/DESCRIPTION =================================================================== --- pkg/CHNOSZ/DESCRIPTION 2018-11-07 02:18:53 UTC (rev 344) +++ pkg/CHNOSZ/DESCRIPTION 2018-11-07 13:14:21 UTC (rev 345) @@ -1,6 +1,6 @@ Date: 2018-11-06 Package: CHNOSZ -Version: 1.1.3-52 +Version: 1.1.3-53 Title: Thermodynamic Calculations and Diagrams for Geo(bio)chemistry Authors at R: c( person("Jeffrey", "Dick", , "j3ffdick at gmail.com", role = c("aut", "cre"), Modified: pkg/CHNOSZ/R/NaCl.R =================================================================== --- pkg/CHNOSZ/R/NaCl.R 2018-11-07 02:18:53 UTC (rev 344) +++ pkg/CHNOSZ/R/NaCl.R 2018-11-07 13:14:21 UTC (rev 345) @@ -6,7 +6,7 @@ # 20181105 use activity coefficient of Na+ # 20181106 use activity coefficient of NaCl -NaCl <- function(T=seq(100, 500, 100), P=1000, m_tot=2) { +NaCl <- function(T=seq(100, 500, 100), P=1000, m_tot=2, ...) { # define a function for the reaction quotient logQ <- function(m_Cl, gam_NaCl, gam_Na, gam_Cl) { # starting with Q = a_NaCl / (a_Na+ * a_Cl-), @@ -17,7 +17,7 @@ # define a function for affinity = log(K / Q) A <- function(m_Cl, gam_NaCl, gam_Na, gam_Cl, logK) logK - logQ(m_Cl, gam_NaCl, gam_Na, gam_Cl) # calculate equilibrium constant at all temperatures (standard conditions: IS = 0) - logK <- subcrt(c("Na+", "Cl-", "NaCl"), c(-1, -1, 1), T = T, P = P)$out$logK + logK <- subcrt(c("Na+", "Cl-", "NaCl"), c(-1, -1, 1), T = T, P = P, ...)$out$logK # calculate Debye-Huckel parameters at all temperatures wout <- water(c("A_DH", "B_DH"), T = convert(T, "K"), P = P) # initialize output variables Modified: pkg/CHNOSZ/R/examples.R =================================================================== --- pkg/CHNOSZ/R/examples.R 2018-11-07 02:18:53 UTC (rev 344) +++ pkg/CHNOSZ/R/examples.R 2018-11-07 13:14:21 UTC (rev 345) @@ -8,7 +8,7 @@ topics <- c("thermo", "examples", "util.array", "util.blast", "util.data", "util.expression", "util.fasta", "util.formula", "util.matrix", "util.misc", "util.seq", "util.units", - "util.water", "taxonomy", "info", "protein.info", "hkf", "water", "IAPWS95", "subcrt", + "util.water", "taxonomy", "info", "protein.info", "hkf", "water", "IAPWS95", "subcrt", "berman", "makeup", "basis", "swap.basis", "species", "affinity", "solubility", "equilibrate", "diagram", "buffer", "nonideal", "NaCl", "add.protein", "protein", "ionize.aa", "yeast.aa", "objective", "revisit", "EOSregress", "wjd") Modified: pkg/CHNOSZ/R/solubility.R =================================================================== --- pkg/CHNOSZ/R/solubility.R 2018-11-07 02:18:53 UTC (rev 344) +++ pkg/CHNOSZ/R/solubility.R 2018-11-07 13:14:21 UTC (rev 345) @@ -14,16 +14,16 @@ ## unit activities of species, so we have to take away the activites Astar <- function(i) aout$values[[i]] + aout$species$logact[i] loga.equil <- lapply(1:length(aout$values), Astar) + ## for a dissociation (split) on a *per reaction* (not system) basis, ## apply the divisor here and skip the if(split){} part below ## (can be used to reproduce Fig. 4 of Manning et al., 2013) if(is.numeric(split)) loga.equil <- lapply(loga.equil, "/", split) - # get the balancing coefficients + ## to output loga.balance we need the balancing coefficients bout <- balance(aout, balance) n.balance <- bout$n.balance balance <- bout$balance - # get logarithm of total activity of the balancing basis species logabfun <- function(loga.equil, n.balance) { # exponentiate, multiply by n.balance, sum, logarithm Modified: pkg/CHNOSZ/R/subcrt.R =================================================================== --- pkg/CHNOSZ/R/subcrt.R 2018-11-07 02:18:53 UTC (rev 344) +++ pkg/CHNOSZ/R/subcrt.R 2018-11-07 13:14:21 UTC (rev 345) @@ -328,20 +328,22 @@ # name and state myname <- reaction$name[i] mystate <- reaction$state[i] -# # don't proceed if the state is cr_Berman -# if(mystate=="cr_Berman") next - # if this phase is cr2 or higher, check if we're below the transition temperature - if(!(reaction$state[i] %in% c('liq','cr','gas'))) { - Ttr <- Ttr(iphases[i]-1,P=P,dPdT=dPdTtr(iphases[i]-1)) - if(all(is.na(Ttr))) next - if(any(T < Ttr)) { - status.Ttr <- "(extrapolating G)" - if(!exceed.Ttr) { - # put NA into the value of G - p.cgl[[ncgl[i]]]$G[T length(ispecies) & i > 1) { + if(!(reaction$state[i] %in% c('liq','cr','gas')) & reaction$name[i-1] == reaction$name[i]) { + # after add.obigt("SUPCRT92"), quartz cr and cr2 are not next to each other in thermo$obigt, + # so use iphases[i-1] here, not iphases[i]-1 20181107 + Ttr <- Ttr(iphases[i-1], iphases[i], P=P, dPdT = dPdTtr(iphases[i-1], iphases[i])) + if(all(is.na(Ttr))) next + if(any(T < Ttr)) { + status.Ttr <- "(extrapolating G)" + if(!exceed.Ttr) { + # put NA into the value of G + p.cgl[[ncgl[i]]]$G[T= Ttr)) { + if(!all(Ttr == 0) & any(T >= Ttr)) { status.Ttr <- "(extrapolating G)" if(!exceed.Ttr) { - p.cgl[[ncgl[i]]]$G[T>=Ttr] <- NA + p.cgl[[ncgl[i]]]$G[T >= Ttr] <- NA status.Ttr <- "(using NA for G)" } - if(warn.above) message(paste('subcrt: some points above temperature limit for',myname, mystate, status.Ttr)) + Tmax <- min(T[T >= Ttr]) + if(warn.above) message(paste("subcrt: temperature(s) of", Tmax, "K and above exceed limit for", myname, mystate, status.Ttr)) } } } @@ -430,7 +434,7 @@ } # find the minimum-energy phase at each T-P point phasestate <- numeric() - out.new.entry <- outprops[[1]] + out.new.entry <- outprops[[arephases[1]]] for(j in 1:nrow(G)) { ps <- which.min(as.numeric(G[j,])) if(length(ps)==0) { @@ -458,7 +462,7 @@ up <- unique(phasestate) if(length(up)>1) { word <- 'are'; p.word <- 'phases' } else { word <- 'is'; p.word <- 'phase' } - message(paste(p.word,c2s(unique(phasestate)),word,'stable')) + message(paste(p.word,paste(unique(phasestate), collapse=","),word,'stable')) } else { # multiple phases aren't involved ... things stay the same out.new[[i]] <- outprops[[arephases]] @@ -469,6 +473,7 @@ isH2O.new <- c(isH2O.new,isH2O[arephases]) } } + outprops <- out.new # remove the rows that were added to keep track of phase transitions reaction <- reaction.new[1:length(ispecies),] Modified: pkg/CHNOSZ/R/util.misc.R =================================================================== --- pkg/CHNOSZ/R/util.misc.R 2018-11-07 02:18:53 UTC (rev 344) +++ pkg/CHNOSZ/R/util.misc.R 2018-11-07 13:14:21 UTC (rev 345) @@ -2,14 +2,14 @@ # some utility functions for the CHNOSZ package # speciate/thermo.R 20051021 jmd -dPdTtr <- function(ispecies) { +dPdTtr <- function(ispecies, ispecies2 = NULL) { # calculate dP/dT for a phase transition # (argument is index of the lower-T phase) thermo <- get("thermo") - pars <- info(c(ispecies, ispecies+1), check.it=FALSE) - # if these aren't the same mineral all we can say is zero - # actually, should be infinity ... the volume change is zero - if(as.character(pars$name[1]) != as.character(pars$name[2])) return(Inf) + if(is.null(ispecies2)) ispecies2 <- ispecies + 1 + pars <- info(c(ispecies, ispecies2), check.it=FALSE) + # if these aren't the same mineral, we shouldn't be here + if(as.character(pars$name[1]) != as.character(pars$name[2])) stop("different names for species ", ispecies, " and ", ispecies2) # the special handling for quartz and coesite interfere with this function, # so we convert to uppercase names to prevent cgl() from calling quartz_coesite() pars$name <- toupper(pars$name) @@ -20,11 +20,11 @@ return(dP.dT) } -Ttr <- function(ispecies,P=1,dPdT=NULL) { +Ttr <- function(ispecies, ispecies2 = NULL, P = 1, dPdT = NULL) { # calculate a phase transition temperature for given P TtrPr <- get("thermo")$obigt$z.T[ispecies] # the constant slope, dP/dT - if(is.null(dPdT)) dPdT <- dPdTtr(ispecies) + if(is.null(dPdT)) dPdT <- dPdTtr(ispecies, ispecies2) Pr <- 1 TtrPr + (P - Pr) / dPdT } Modified: pkg/CHNOSZ/man/NaCl.Rd =================================================================== --- pkg/CHNOSZ/man/NaCl.Rd 2018-11-07 02:18:53 UTC (rev 344) +++ pkg/CHNOSZ/man/NaCl.Rd 2018-11-07 13:14:21 UTC (rev 345) @@ -7,13 +7,14 @@ } \usage{ - NaCl(T = seq(100, 500, 100), P = 1000, m_tot = 2) + NaCl(T = seq(100, 500, 100), P = 1000, m_tot = 2, ...) } \arguments{ \item{T}{numeric, temperature in \degC} \item{P}{numeric, pressure in bar (single value)} \item{m_tot}{numeric, total molality of NaCl (single value)} + \item{...}{additional arguments for \code{\link{subcrt}}} } \details{ Modified: pkg/CHNOSZ/man/util.misc.Rd =================================================================== --- pkg/CHNOSZ/man/util.misc.Rd 2018-11-07 02:18:53 UTC (rev 344) +++ pkg/CHNOSZ/man/util.misc.Rd 2018-11-07 13:14:21 UTC (rev 345) @@ -11,14 +11,15 @@ } \usage{ - dPdTtr(ispecies) - Ttr(ispecies, P = 1, dPdT = NULL) + dPdTtr(ispecies, ispecies2 = NULL) + Ttr(ispecies, ispecies2 = NULL, P = 1, dPdT = NULL) GHS_Tr(ispecies, Htr) unitize(logact = NULL, length = NULL, logact.tot = 0) } \arguments{ \item{ispecies}{numeric, species index of a mineral phase} + \item{ispecies2}{numeric, species index of next mineral phase (the default is ispecies + 1)} \item{P}{numeric, pressure (bar)} \item{dPdT}{numeric, values of (\eqn{dP/dT}{dP/dT}) of phase transitions (\code{Ttr})} \item{Htr}{numeric, enthalpy(ies) of transition (cal/mol)} @@ -28,7 +29,7 @@ } \details{ -\code{dPdTtr} returns values of \eqn{(dP/dT)_{Ttr}}{(dP/dT)Ttr}, where \eqn{Ttr}{Ttr} represents the transition temperature, of the phase transition at the high-\eqn{T}{T} stability limit of the \code{ispecies} in \code{thermo$obigt} (no checking is done to verify that the species represents in fact one phase of a mineral with phase transitions). +\code{dPdTtr} returns values of \eqn{(dP/dT)_{Ttr}}{(dP/dT)Ttr}, where \eqn{Ttr}{Ttr} represents the transition temperature, of the phase transition at the high-\eqn{T}{T} stability limit of the \code{ispecies} in \code{thermo$obigt} (other than checking that the names match, the function does not check that the species in fact represent different phases of the same mineral). \code{dPdTtr} takes account of the Clapeyron equation, \eqn{(dP/dT)_{Ttr}}{(dP/dT)Ttr}=\eqn{{\Delta}S/{\Delta}V}{DS/DV}, where \eqn{{\Delta}S}{DS} and \eqn{{\Delta}V}{DV} represent the changes in entropy and volume of phase transition, and are calculated using \code{subcrt} at Ttr from the standard molal entropies and volumes of the two phases involved. Using values of \code{dPdT} calculated using \code{dPdTtr} or supplied in the arguments, \code{Ttr} returns as a function of \code{P} values of the upper transition temperature of the mineral phase represented by \code{ispecies}. @@ -42,17 +43,21 @@ } \examples{\dontshow{data(thermo)} -### the first example is commented because after removing most of the -### Helgeson et al. minerals, we don't have a suitable mineral in the -### database to demonstrate this calculation (but ice might work) -## properties of phase transitions -#si <- info("enstatite") -## (dP/dT) of transitions -#dPdTtr(si) # first transition -#dPdTtr(si+1) # second transition -## temperature of transitions (Ttr) as a function of P -#Ttr(si,P=c(1,10,100,1000)) -#Ttr(si,P=c(1,10,100,1000)) +# we need the Helgeson et al., 1978 minerals for this example +add.obigt("SUPCRT92") +# that replaces the existing enstatite with the first phase; +# the other phases are appended to the end of thermo$obigt +i1 <- info("enstatite") +i2 <- info("enstatite", "cr2") +i3 <- info("enstatite", "cr3") +# (dP/dT) of transitions +dPdTtr(i1, i2) # first transition +dPdTtr(i2, i3) # second transition +# temperature of transitions (Ttr) as a function of P +Ttr(i1, i2, P=c(1,10,100,1000)) +Ttr(i2, i3, P=c(1,10,100,1000)) +# restore default database +data(OBIGT) # calculate the GHS at Tr for the high-temperature phases of iron # using transition enthalpies from the SUPCRT92 database (sprons92.dat) Modified: pkg/CHNOSZ/tests/testthat/test-subcrt.R =================================================================== --- pkg/CHNOSZ/tests/testthat/test-subcrt.R 2018-11-07 02:18:53 UTC (rev 344) +++ pkg/CHNOSZ/tests/testthat/test-subcrt.R 2018-11-07 13:14:21 UTC (rev 345) @@ -62,8 +62,7 @@ test_that("phase transitions of minerals give expected messages and results", { iacanthite <- info("acanthite", "cr2") - #expect_message(subcrt(iacanthite), "subcrt: some points below transition temperature for acanthite cr2 \\(using NA for G\\)") - expect_message(subcrt(iacanthite), "subcrt: some points above temperature limit for acanthite cr2 \\(using NA for G\\)") + expect_message(subcrt(iacanthite), "subcrt: temperature\\(s\\) of 623.15 K and above exceed limit for acanthite cr2 \\(using NA for G\\)") expect_equal(subcrt("acanthite")$out$acanthite$polymorph, c(1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3)) # the reaction coefficients in the output should be unchanged 20171214 expect_equal(subcrt(c("bunsenite", "nickel", "oxygen"), c(-1, 1, 0.5))$reaction$coeff, c(-1, 1, 0.5)) @@ -89,8 +88,6 @@ }) test_that("calculations for quartz are nearly consistent with SUPCRT92", { - # remove existing quartz so that SUPCRT92 quartz gets added with cr and cr2 next to each other - thermo$obigt <<- thermo$obigt[thermo$obigt$name!="quartz", ] add.obigt("SUPCRT92") # using SUPCRT's equations, the alpha-beta transition occurs at # 705 degC at 5000 bar and 1874 degC at 50000 bar, @@ -119,8 +116,6 @@ }) test_that("more calculations for quartz are nearly consistent with SUPCRT92", { - # remove existing quartz so that SUPCRT92 quartz gets added with cr and cr2 next to each other - thermo$obigt <<- thermo$obigt[thermo$obigt$name!="quartz", ] add.obigt("SUPCRT92") # output from SUPCRT92 for reaction specified as "1 QUARTZ" run at 1 bar # (SUPCRT shows phase transition at 574.850 deg C, and does not give Cp values around the transition) @@ -194,6 +189,20 @@ expect_equal(sum(is.na(s2$out$`Na+`$logK)), 0) }) +test_that("combining minerals with phase transitions and aqueous species with IS > 0 does not mangle output", { + # s2 was giving quartz an extraneous loggam column and incorrect G and logK 20181107 + add.obigt("SUPCRT92") + s1 <- subcrt(c("quartz", "K+"), T=25, IS=1) + s2 <- subcrt(c("K+", "quartz"), T=25, IS=1) + expect_true(identical(colnames(s1$out[[1]]), c("T", "P", "rho", "logK", "G", "H", "S", "V", "Cp", "polymorph"))) + expect_true(identical(colnames(s2$out[[2]]), c("T", "P", "rho", "logK", "G", "H", "S", "V", "Cp", "polymorph"))) + expect_true(identical(colnames(s1$out[[2]]), c("T", "P", "rho", "logK", "G", "H", "S", "V", "Cp", "loggam", "IS"))) + expect_true(identical(colnames(s2$out[[1]]), c("T", "P", "rho", "logK", "G", "H", "S", "V", "Cp", "loggam", "IS"))) + # another one ... pyrrhotite was getting a loggam + expect_true(identical(colnames(subcrt(c("iron", "Na+", "Cl-", "OH-", "pyrrhotite"), T=25, IS=1)$out$pyrrhotite), + c("T", "P", "rho", "logK", "G", "H", "S", "V", "Cp", "polymorph"))) +}) + # references # Amend, J. P. and Shock, E. L. (2001) From noreply at r-forge.r-project.org Wed Nov 7 16:50:34 2018 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 7 Nov 2018 16:50:34 +0100 (CET) Subject: [CHNOSZ-commits] r346 - in pkg/CHNOSZ: . R inst man man/macros tests/testthat Message-ID: <20181107155034.DB6131880C0@r-forge.r-project.org> Author: jedick Date: 2018-11-07 16:50:34 +0100 (Wed, 07 Nov 2018) New Revision: 346 Modified: pkg/CHNOSZ/DESCRIPTION pkg/CHNOSZ/R/nonideal.R pkg/CHNOSZ/R/subcrt.R pkg/CHNOSZ/R/util.affinity.R pkg/CHNOSZ/inst/NEWS pkg/CHNOSZ/man/macros/macros.Rd pkg/CHNOSZ/man/nonideal.Rd pkg/CHNOSZ/man/subcrt.Rd pkg/CHNOSZ/tests/testthat/test-logmolality.R Log: nonideal(): add 'is.basis' argument to handle transformed Gibbs energies for basis species Modified: pkg/CHNOSZ/DESCRIPTION =================================================================== --- pkg/CHNOSZ/DESCRIPTION 2018-11-07 13:14:21 UTC (rev 345) +++ pkg/CHNOSZ/DESCRIPTION 2018-11-07 15:50:34 UTC (rev 346) @@ -1,6 +1,6 @@ -Date: 2018-11-06 +Date: 2018-11-07 Package: CHNOSZ -Version: 1.1.3-53 +Version: 1.1.3-54 Title: Thermodynamic Calculations and Diagrams for Geo(bio)chemistry Authors at R: c( person("Jeffrey", "Dick", , "j3ffdick at gmail.com", role = c("aut", "cre"), Modified: pkg/CHNOSZ/R/nonideal.R =================================================================== --- pkg/CHNOSZ/R/nonideal.R 2018-11-07 13:14:21 UTC (rev 345) +++ pkg/CHNOSZ/R/nonideal.R 2018-11-07 15:50:34 UTC (rev 346) @@ -3,7 +3,7 @@ # moved to nonideal.R from util.misc.R 20151107 # added Helgeson method 20171012 -nonideal <- function(species, speciesprops, IS, T, P, A_DH, B_DH, m_star=NULL, method=get("thermo")$opt$nonideal) { +nonideal <- function(species, speciesprops, IS, T, P, A_DH, B_DH, m_star=NULL, method=get("thermo")$opt$nonideal, is.basis=FALSE) { # generate nonideal contributions to thermodynamic properties # number of species, same length as speciesprops list # T in Kelvin, same length as nrows of speciespropss @@ -123,6 +123,9 @@ if(method=="bgamma") bgamma <- bgamma(convert(T, "C"), P) else if(method=="Bdot") bgamma <- Bdot(convert(T, "C")) else if(method %in% c("Bdot0", "bgamma0")) bgamma <- 0 + # different signs for basis species and species of interest 20181107 + species.sign <- ifelse(is.basis, -1, 1) + species.sign <- rep(species.sign, length.out=length(species)) # loop over species #2: activity coefficient calculations if(is.null(m_star)) m_star <- IS iH <- info("H+") @@ -141,10 +144,10 @@ pname <- colnames(myprops)[j] if(!pname %in% c("G", "H", "S", "Cp")) next if(get("thermo")$opt$Setchenow == "bgamma") { - myprops[, j] <- myprops[, j] + Setchenow(pname, IS, T, m_star, bgamma) + myprops[, j] <- myprops[, j] + species.sign[i] * Setchenow(pname, IS, T, m_star, bgamma) didneutral <- TRUE } else if(get("thermo")$opt$Setchenow == "bgamma0") { - myprops[, j] <- myprops[, j] + Setchenow(pname, IS, T, m_star, bgamma = 0) + myprops[, j] <- myprops[, j] + species.sign[i] * Setchenow(pname, IS, T, m_star, bgamma = 0) didneutral <- TRUE } } @@ -153,10 +156,10 @@ pname <- colnames(myprops)[j] if(!pname %in% c("G", "H", "S", "Cp")) next if(method=="Alberty") { - myprops[, j] <- myprops[, j] + Alberty(pname, Z[i], IS, T) + myprops[, j] <- myprops[, j] + species.sign[i] * Alberty(pname, Z[i], IS, T) didcharged <- TRUE } else { - myprops[, j] <- myprops[, j] + Helgeson(pname, Z[i], IS, T, A_DH, B_DH, acirc[i], m_star, bgamma) + myprops[, j] <- myprops[, j] + species.sign[i] * Helgeson(pname, Z[i], IS, T, A_DH, B_DH, acirc[i], m_star, bgamma) didcharged <- TRUE } } Modified: pkg/CHNOSZ/R/subcrt.R =================================================================== --- pkg/CHNOSZ/R/subcrt.R 2018-11-07 13:14:21 UTC (rev 345) +++ pkg/CHNOSZ/R/subcrt.R 2018-11-07 15:50:34 UTC (rev 346) @@ -12,7 +12,7 @@ subcrt <- function(species, coeff = 1, state = NULL, property = c("logK", "G", "H", "S", "V", "Cp"), T = seq(273.15, 623.15, 25), P = "Psat", grid = NULL, convert = TRUE, exceed.Ttr = FALSE, - exceed.rhomin = FALSE, logact = NULL, action.unbalanced = "warn", IS = 0) { + exceed.rhomin = FALSE, logact = NULL, action.unbalanced = "warn", IS = 0, is.basis = FALSE) { # revise the call if the states have # come as the second argument @@ -45,6 +45,8 @@ if(length(species) > length(state)) state <- rep(state,length.out=length(species)) state <- state.args(state) } + # make is.basis the same length as species + is.basis <- rep(is.basis, length.out=length(species)) # allowed properties properties <- c("rho", "logK", "G", "H", "S", "Cp", "V", "kT", "E") @@ -298,8 +300,11 @@ } # calculate activity coefficients if ionic strength is not zero if(any(IS != 0)) { - if(thermo$opt$nonideal %in% c("Bdot", "Bdot0", "bgamma", "bgamma0")) p.aq <- nonideal(iphases[isaq], p.aq, newIS, T, P, H2O.PT$A_DH, H2O.PT$B_DH) - else if(thermo$opt$nonideal=="Alberty") p.aq <- nonideal(iphases[isaq], p.aq, newIS, T) + # work out whether the species are basis species (from the is.basis argument) 20181107 + isb <- is.basis[match(iphases[isaq], ispecies)] + if(thermo$opt$nonideal %in% c("Bdot", "Bdot0", "bgamma", "bgamma0")) + p.aq <- nonideal(iphases[isaq], p.aq, newIS, T, P, H2O.PT$A_DH, H2O.PT$B_DH, is.basis=isb) + else if(thermo$opt$nonideal=="Alberty") p.aq <- nonideal(iphases[isaq], p.aq, newIS, T, is.basis=isb) } outprops <- c(outprops, p.aq) } else if(any(isH2O)) { Modified: pkg/CHNOSZ/R/util.affinity.R =================================================================== --- pkg/CHNOSZ/R/util.affinity.R 2018-11-07 13:14:21 UTC (rev 345) +++ pkg/CHNOSZ/R/util.affinity.R 2018-11-07 15:50:34 UTC (rev 346) @@ -133,10 +133,12 @@ if(!is.null(sout)) return(sout) else { ## subcrt arguments species <- c(mybasis$ispecies,myspecies$ispecies) + is.basis <- c(rep(TRUE, length(mybasis$ispecies)), rep(FALSE, length(myspecies$ispecies))) if("T" %in% vars) T <- vals[[which(vars=="T")]] if("P" %in% vars) P <- vals[[which(vars=="P")]] if("IS" %in% vars) IS <- vals[[which(vars=="IS")]] - s.args <- list(species=species,property=property,T=T,P=P,IS=IS,grid=grid,convert=FALSE,exceed.Ttr=exceed.Ttr,exceed.rhomin=exceed.rhomin) + s.args <- list(species = species, property = property, T = T, P = P, IS = IS, grid = grid, + convert = FALSE, exceed.Ttr = exceed.Ttr, exceed.rhomin = exceed.rhomin, is.basis = is.basis) return(do.call("subcrt",s.args)) } } Modified: pkg/CHNOSZ/inst/NEWS =================================================================== --- pkg/CHNOSZ/inst/NEWS 2018-11-07 13:14:21 UTC (rev 345) +++ pkg/CHNOSZ/inst/NEWS 2018-11-07 15:50:34 UTC (rev 346) @@ -1,6 +1,20 @@ -CHANGES IN CHNOSZ 1.1.3-52 (2018-11-07) +CHANGES IN CHNOSZ 1.1.3-54 (2018-11-07) --------------------------------------- +MAJOR BUG FIXED + +- Previously, the virtual conversion of activities to molalities was + done incorrectly; the Gibbs energies of basis species and formed + species were transformed in the same direction. They should have + opposite transformations. This has been fixed by adding the 'is.basis' + argument to nonideal(), which is used by affinity() to transform the + Gibbs energies in the right direction. + +- For more information, see the new section of ?nonideal: 'is.basis and + the CHNOSZ workflow'. + +- Two new demos depend on the corrected behavior: gold.R and QtzMsKfs.R. + NEW FEATURES - Add solubility(). Run this after affinity() to calculate the Modified: pkg/CHNOSZ/man/macros/macros.Rd =================================================================== --- pkg/CHNOSZ/man/macros/macros.Rd 2018-11-07 13:14:21 UTC (rev 345) +++ pkg/CHNOSZ/man/macros/macros.Rd 2018-11-07 15:50:34 UTC (rev 346) @@ -47,3 +47,4 @@ \newcommand{\Delta}{\ifelse{latex}{\eqn{\Delta}}{\ifelse{html}{\out{Δ}}{?}}} \newcommand{\aacute}{\ifelse{latex}{\out{\'{a}}}{\ifelse{html}{\out{á}}{?}}} \newcommand{\eacute}{\ifelse{latex}{\out{\'{e}}}{\ifelse{html}{\out{é}}{?}}} +\newcommand{\gamma}{\ifelse{latex}{\eqn{\gamma}}{\ifelse{html}{\out{γ}}{?}}} Modified: pkg/CHNOSZ/man/nonideal.Rd =================================================================== --- pkg/CHNOSZ/man/nonideal.Rd 2018-11-07 13:14:21 UTC (rev 345) +++ pkg/CHNOSZ/man/nonideal.Rd 2018-11-07 15:50:34 UTC (rev 346) @@ -9,7 +9,7 @@ \usage{ nonideal(species, speciesprops, IS, T, P, A_DH, B_DH, - m_star=NULL, method=get("thermo")$opt$nonideal) + m_star=NULL, method=get("thermo")$opt$nonideal, is.basis=FALSE) bgamma(TC, P, showsplines = "") } @@ -23,6 +23,7 @@ \item{B_DH}{numeric, B Debye-Huckel coefficient; required for B-dot or b_gamma equation} \item{m_star}{numeric, total molality of all dissolved species} \item{method}{character, \samp{Alberty}, \samp{Bdot}, \samp{Bdot0}, or \samp{bgamma}} + \item{is.basis}{logical, is (are) the specie basis species?} \item{TC}{numeric, temperature (\degC)} \item{showsplines}{character, show isobaric (\samp{T}) or isothermal (\samp{P}) splines} } @@ -75,6 +76,23 @@ This is a crude method of kriging the data, but produces fairly smooth interpolations without adding any external dependencies. } +\section{is.basis and the CHNOSZ workflow}{ +The main workflow in CHNOSZ (\code{\link{basis}} - \code{\link{species}} - \code{\link{affinity}} - ( \code{\link{solubility}} or \code{\link{equilibrate}} ) - \code{\link{diagram}}) is written in terms of chemical activities, not concentrations (i.e. molalities for aqueous species). +To output molalities for the \emph{species of interest}, which are formed from the basis species, we would multiply CHNOSZ's activities by activity coefficients. +But to obtain activities for the \emph{basis species}, we should divide the molalities that are desired in the input by activity coefficients. +That is, to convert the entire workflow from activity to molality space requires opposite treatments for the basis species and the species being formed. +To simplify the problem, CHNOSZ does not compute molalities by actually multiplying activities by activity coefficients (or vice versa) -- this would require complex calculations of activity coefficients at the input and output stages, considering the many possible dimensions of system variables -- a true mess! +Instead, the same effect is obtained at the core of the workflow by using standard Gibbs energies adjusted for given ionic strength (i.e. transformed Gibbs energies). +The transformation is very simple: by adding \emph{RT}\gamma (\gamma is the activity coefficient calculated at the appropriate \emph{T}, \emph{P}, and ionic strength) to the standard Gibbs energy, all expressions for activity of that species are converted to molality. +That transformation is consistent with the requirements for the species of interest. +The reverse transformation, subtracting \emph{RT}\gamma from the standard Gibbs energy, is needed for the basis species. + +The \code{is.basis} argument controls the direction of the transformation. +In general, it should not be needed by the user, but is used by \code{affinity} to obtain the correctly transformed Gibbs energies. +Thus, by activating nonideality calculations in \code{affinity} (with a non-zero \code{IS} argument), the activity variables, such as \code{logact} in the \code{basis} and \code{species} definitions, and \code{loga.equil} and \code{loga.balance} in the downstream calculations, are converted to molalities. +Actually renaming the variables in the code is not possible, but \code{\link{diagram}} changes the plot labels to molalities if it is provided results from a calculation with non-zero \code{IS} set in \code{affinity}. +} + \value{ One (\samp{G}) or more (\samp{H}, \samp{S}, \samp{Cp}; currently only with the Alberty method) standard thermodynamic properties (at IS=0) in \code{speciesprops} are replaced by the corresponding adjusted thermodynamic properties (at higher IS). For all affected species, a column named \code{loggam} (common (base-10) logarithm of gamma, the activity coefficient) is appended to the output dataframe of species properties. Modified: pkg/CHNOSZ/man/subcrt.Rd =================================================================== --- pkg/CHNOSZ/man/subcrt.Rd 2018-11-07 13:14:21 UTC (rev 345) +++ pkg/CHNOSZ/man/subcrt.Rd 2018-11-07 15:50:34 UTC (rev 346) @@ -11,7 +11,7 @@ property = c("logK","G","H","S","V","Cp"), T = seq(273.15,623.15,25), P = "Psat", grid = NULL, convert = TRUE, exceed.Ttr = FALSE, exceed.rhomin = FALSE, - logact = NULL, action.unbalanced = "warn", IS = 0) + logact = NULL, action.unbalanced = "warn", IS = 0, is.basis = FALSE) } \arguments{ @@ -28,6 +28,7 @@ \item{convert}{logical, are input and output units of T and P those of the user (\code{TRUE}) (see \code{\link{T.units}}), or are they Kelvin and bar (\code{FALSE})?} \item{action.unbalanced}{character \samp{warn} or NULL, what action to take if unbalanced reaction is provided} \item{IS}{numeric, ionic strength(s) at which to calculate adjusted molal properties, mol kg\eqn{^{-1}}{^-1}} + \item{is.basis}{logical, is (are) the species basis species? See \code{\link{nonideal}}} } \details{ Modified: pkg/CHNOSZ/tests/testthat/test-logmolality.R =================================================================== --- pkg/CHNOSZ/tests/testthat/test-logmolality.R 2018-11-07 13:14:21 UTC (rev 345) +++ pkg/CHNOSZ/tests/testthat/test-logmolality.R 2018-11-07 15:50:34 UTC (rev 346) @@ -5,6 +5,7 @@ # and in the rest of the main workflow of CHNOSZ? # 20171025 first version # 20181106 include non-zero activity coefficient of CO2(aq) + # 20181107 include 'is.basis' and opposite transformations for basis species and formed species ### first get the activity coefficients of H+ and HCO3- ## the long way... @@ -70,7 +71,9 @@ ## case 2: IS = 1 a1 <- affinity(IS=1) A1affinity <- -convert(a1$values[[2]], "G") - expect_equal(A1affinity[[1]], A1subcrt) + # we had better use is.basis here, which indicates the direction of transformation of Gibbs energy 20181107 + A1subcrt.trans <- subcrt(c("CO2", "H2O", "H+", "HCO3-"), c(-1, -1, 1, 1), T=25, logact=c(-3, 0, -7, -3), IS=1, is.basis=c(TRUE, TRUE, TRUE, FALSE))$out$A + expect_equal(A1affinity[[1]], A1subcrt.trans) ## take-home message 2: using affinity() with IS not equal to zero, the "logact" ## set by species() is logmolal in affinity calculations for charged aqueous species @@ -91,7 +94,10 @@ # so, logK = 6.345 logKrev <- -logK logQrev0 <- -logQ0 - logQrev1 <- -logQ1 + # note the minus sign here, because HCO3 is now a basis species + # and has the opposite Gibbs energy transformation 20181107 + logaHCO3 <- -3 - loggam_HCO3 + logQrev1 <- (0 + logaCO2) - (-7 + logaHCO3) ACO2_0manual <- -convert(logKrev - logQrev0, "G") ACO2_1manual <- -convert(logKrev - logQrev1, "G") expect_equal(ACO2_0manual, ACO2_0affinity[[1]]) @@ -112,8 +118,9 @@ # case 2: IS = 1 logact_HCO3 <- e1$loga.equil[[2]] logact_CO2 <- e1$loga.equil[[1]] - # here, loga.equil is the *molality*, so we must multiply by loggam - logQeq1 <- (-7 + logact_HCO3 + loggam_HCO3) - (logact_CO2 + loggam_CO2 + 0) + # CO2 (formed species): convert log activity to log molality (multiply by loggam) + # HCO3- (basis species): convert log molality to log activity (divide by loggam) + logQeq1 <- (-7 + logact_HCO3 - loggam_HCO3) - (logact_CO2 + loggam_CO2 + 0) Aeq1 <- -convert(logK - logQeq1, "G") # zero! expect_equal(Aeq1[[1]], 0) ## take-home message 4: using affinity() with IS not equal to zero, the "loga.equil" From noreply at r-forge.r-project.org Thu Nov 8 07:50:23 2018 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 8 Nov 2018 07:50:23 +0100 (CET) Subject: [CHNOSZ-commits] r347 - in pkg/CHNOSZ: . R demo inst man Message-ID: <20181108065023.3C6D618B61A@r-forge.r-project.org> Author: jedick Date: 2018-11-08 07:50:22 +0100 (Thu, 08 Nov 2018) New Revision: 347 Added: pkg/CHNOSZ/demo/QtzMsKfs.R Modified: pkg/CHNOSZ/DESCRIPTION pkg/CHNOSZ/R/examples.R pkg/CHNOSZ/R/util.expression.R pkg/CHNOSZ/demo/00Index pkg/CHNOSZ/demo/gold.R pkg/CHNOSZ/inst/NEWS pkg/CHNOSZ/man/berman.Rd pkg/CHNOSZ/man/examples.Rd pkg/CHNOSZ/man/util.expression.Rd Log: add demo/QtzMsKfs.R Modified: pkg/CHNOSZ/DESCRIPTION =================================================================== --- pkg/CHNOSZ/DESCRIPTION 2018-11-07 15:50:34 UTC (rev 346) +++ pkg/CHNOSZ/DESCRIPTION 2018-11-08 06:50:22 UTC (rev 347) @@ -1,6 +1,6 @@ -Date: 2018-11-07 +Date: 2018-11-08 Package: CHNOSZ -Version: 1.1.3-54 +Version: 1.1.3-55 Title: Thermodynamic Calculations and Diagrams for Geo(bio)chemistry Authors at R: c( person("Jeffrey", "Dick", , "j3ffdick at gmail.com", role = c("aut", "cre"), Modified: pkg/CHNOSZ/R/examples.R =================================================================== --- pkg/CHNOSZ/R/examples.R 2018-11-07 15:50:34 UTC (rev 346) +++ pkg/CHNOSZ/R/examples.R 2018-11-08 06:50:22 UTC (rev 347) @@ -28,7 +28,7 @@ demos <- function(which=c("sources", "protein.equil", "affinity", "NaCl", "density", "ORP", "revisit", "findit", "ionize", "buffer", "protbuff", "yeastgfp", "mosaic", - "copper", "solubility", "gold", "wjd", "bugstab", "Shh", "activity_ratios", + "copper", "solubility", "gold", "QtzMsKfs", "wjd", "bugstab", "Shh", "activity_ratios", "adenine", "DEW", "lambda", "TCA", "go-IU", "bison"), save.png=FALSE) { # run one or more demos from CHNOSZ with ask=FALSE, and return the value of the last one for(i in 1:length(which)) { Modified: pkg/CHNOSZ/R/util.expression.R =================================================================== --- pkg/CHNOSZ/R/util.expression.R 2018-11-07 15:50:34 UTC (rev 346) +++ pkg/CHNOSZ/R/util.expression.R 2018-11-08 06:50:22 UTC (rev 347) @@ -82,6 +82,7 @@ propchar <- s2c(property) expr <- "" # some special cases + if(is.na(property)) return("") if(property=="logK") return(quote(log~italic(K))) # grepl here b/c diagram() uses "loga.equil" and "loga.basis" if(grepl("loga", property)) { @@ -223,7 +224,8 @@ propexpr <- valexpr <- character() for(i in 1:length(property)) { propexpr <- c(propexpr, expr.property(property[i])) - if(value[i]=="Psat") thisvalexpr <- quote(italic(P)[sat]) + if(is.na(value[i])) thisvalexpr <- "" + else if(value[i]=="Psat") thisvalexpr <- quote(italic(P)[sat]) else { thisvalue <- format(round(as.numeric(value[i]), digits), nsmall=digits) thisunits <- expr.units(property[i]) @@ -236,7 +238,8 @@ # write an equals sign between the property and value desc <- character() for(i in seq_along(propexpr)) { - thisdesc <- substitute(a==b, list(a=propexpr[[i]], b=valexpr[[i]])) + if(is.na(value[i])) thisdesc <- propexpr[[i]] + else thisdesc <- substitute(a==b, list(a=propexpr[[i]], b=valexpr[[i]])) if(oneline) { # put all the property/value equations on one line, separated by commas if(i==1) desc <- substitute(a, list(a=thisdesc)) @@ -284,7 +287,7 @@ } # make formatted text for activity ratio 20170217 -ratlab <- function(ion="K+") { +ratlab <- function(ion="K+", use.molality=FALSE) { # the charge Z <- makeup(ion)["Z"] # the text for the exponent on aH+ @@ -292,9 +295,11 @@ # the expression for the ion and H+ expr.ion <- expr.species(ion) expr.H <- expr.species("H+") + # with use.molality, change a to m + a <- ifelse(use.molality, "m", "a") # the final expression - if(exp.H=="1") substitute(log~(italic(a)[expr.ion] / italic(a)[expr.H]), list(expr.ion=expr.ion, expr.H=expr.H)) - else substitute(log~(italic(a)[expr.ion] / italic(a)[expr.H]^exp.H), list(expr.ion=expr.ion, expr.H=expr.H, exp.H=exp.H)) + if(exp.H=="1") substitute(log~(italic(a)[expr.ion] / italic(a)[expr.H]), list(a=a, expr.ion=expr.ion, expr.H=expr.H)) + else substitute(log~(italic(a)[expr.ion] / italic(a)[expr.H]^exp.H), list(a=a, expr.ion=expr.ion, expr.H=expr.H, exp.H=exp.H)) } # make formatted text for thermodynamic system 20170217 Modified: pkg/CHNOSZ/demo/00Index =================================================================== --- pkg/CHNOSZ/demo/00Index 2018-11-07 15:50:34 UTC (rev 346) +++ pkg/CHNOSZ/demo/00Index 2018-11-08 06:50:22 UTC (rev 347) @@ -14,6 +14,7 @@ copper Another example of mosaic(): complexation of copper with glycine species solubility Solubility of calcite and CO2(gas) as a function of pH gold Solubility of gold +QtzMsKfs Helgeson and Berman minerals and calculations with molality wjd Gibbs energy minimization: prebiological atmospheres and cell periphery of yeast dehydration log K of dehydration reactions; SVG file contains tooltips and links bugstab Formation potential of microbial proteins in colorectal cancer Added: pkg/CHNOSZ/demo/QtzMsKfs.R =================================================================== --- pkg/CHNOSZ/demo/QtzMsKfs.R (rev 0) +++ pkg/CHNOSZ/demo/QtzMsKfs.R 2018-11-08 06:50:22 UTC (rev 347) @@ -0,0 +1,69 @@ +# CHNOSZ/demo/QtzMsKfs.R +# T - log(K+/H+) diagram, after Sverjensky et al., 1991 +# (doi:10.1016/0016-7037(91)90157-Z) +# 20171009 diagram added to berman.Rd +# 20181108 moved to demo/QtzMsKfs.R; add molality calculations + +# this demo compares diagrams made using the Berman and Helgeson datasets, +# and shows the use of nonideal calculations to set molalities in the basis species + +## set up the system: basis species +basis(c("K+", "Al+3", "quartz", "H2O", "O2", "H+")) +# use pH = 0 so that aK+ = aK+/aH+ +basis("pH", 0) +# load the species +species(c("K-feldspar", "muscovite", "kaolinite", + "pyrophyllite", "andalusite"), "cr") +## the "b_gamma" equation gets closer to the published diagram than "B-dot" +thermo$opt$nonideal <<- "bgamma" + +## start with the data from Helgeson et al., 1978 +add.obigt("SUPCRT92") +# calculate affinities in aK+ - temperature space +# exceed.Tr: we go above stated temperature limit of pyrophyllite +# (this is above its stability field on the diagram, so pyrophyllite doesn't appear in this region, +# but its properties are needed needed to calculate relative stabilities of all minerals) +res <- 400 +a <- affinity(`K+` = c(0, 5, res), T = c(200, 650, res), P = 1000, exceed.Ttr = TRUE) +# make base plot with colors and no lines +diagram(a, xlab = ratlab("K+", use.molality = TRUE), lty = 0, fill = "terrain") +# add the lines, extending into the low-density region (exceed.rhomin = TRUE) +a <- affinity(`K+` = c(0, 5, res), T = c(200, 650, res), P = 1000, exceed.Ttr = TRUE, exceed.rhomin = TRUE) +diagram(a, add = TRUE, names = NULL, col = "red", lty = 2, lwd = 1.5) +# calculate and plot the lines for 1 molal chloride +a <- affinity(`K+` = c(0, 5, res), T = c(200, 650, res), P = 1000, exceed.Ttr = TRUE, exceed.rhomin = TRUE, IS = 1) +diagram(a, add = TRUE, names = NULL, col = "red", lwd = 1.5) +# the list of references: +ref1 <- thermo.refs(species()$ispecies)$key + +## now use the (default) data from Berman, 1988 +# this resets the thermodynamic database +# without affecting the basis and species settings +data(OBIGT) +# we can check that we have Berman's quartz +# and not coesite or some other phase of SiO2 +iSiO2 <- rownames(basis()) == "SiO2" +stopifnot(info(basis()$ispecies[iSiO2])$name == "quartz") +# Berman's dataset doesn't have the upper temperature limits, so we don't need exceed.Ttr here +a <- affinity(`K+` = c(0, 5, res), T = c(200, 650, res), P = 1000, exceed.rhomin = TRUE) +diagram(a, add = TRUE, names = NULL, col = "blue", lty = 2, lwd = 1.5) +a <- affinity(`K+` = c(0, 5, res), T = c(200, 650, res), P = 1000, exceed.rhomin = TRUE, IS = 1) +diagram(a, add = TRUE, names = NULL, col = "blue", lwd = 1.5) +# the list of references: +ref2 <- thermo.refs(species()$ispecies)$key +ref2 <- paste(ref2, collapse = ", ") + +# add experimental points for 1000 bar (Table 1 of Sverjensky et al., 1991) +expt.T <- c(300, 400, 500, 550, # KFs-Ms-Qtz + 400, 450, 500, 550, # Ms-And-Qtz + 300, 350, # Ms-P-Qtz + 300, 600) # Kaol-Ms-Qtz, KFs-And-Qtz +expt.KH <- c(3.50, 2.75, 1.95, 1.40, 1.60, 1.57, 1.47, 1.38, 1.94, 1.80, 1.90, 0.63) +points(expt.KH, expt.T, pch = 19, cex = 1.2) +# add legend and title +legend("top", "low-density region", text.font = 3, bty = "n") +legend("top", describe.property(c(NA, NA, "P", "IS"), c(NA, NA, 1000, 1)), bty = "n") +legend("left", c(ref1, ref2, "ion molality", "ion activity", "experiments"), + lty = c(1, 1, 1, 2, 0), lwd = 1.5, col = c(2, 4, 1, 1, 1), pch = c(NA, NA, NA, NA, 19), bty = "n") +title(main = syslab(c("K2O", "Al2O3", "SiO2", "H2O", "HCl")), line = 1.8) +title(main = "Helgeson and Berman minerals, after Sverjensky et al., 1991", line = 0.3, font.main = 1) Modified: pkg/CHNOSZ/demo/gold.R =================================================================== --- pkg/CHNOSZ/demo/gold.R 2018-11-07 15:50:34 UTC (rev 346) +++ pkg/CHNOSZ/demo/gold.R 2018-11-08 06:50:22 UTC (rev 347) @@ -132,15 +132,11 @@ basis("H2S", "PPM") # apply QMK buffer for pH basis("H+", "QMK") + basis("K+", log10(0.5)) # calculate solution composition for 2 mol/kg NaCl NaCl <- NaCl(T = seq(150, 550, 10), P = 1000, m_tot=2) - a_Cl <- NaCl$m_Cl * NaCl$gam_Cl - # using this ionic strength, calculate the activity of K+ - # assuming complete dissociation of 0.5 mol/kg KCl - gam_K <- 10^subcrt("K+", T = seq(150, 550, 10), P = 1000, IS=NaCl$IS)$out$`K+`$loggam - a_K <- 0.5 * gam_K # calculate affinity and solubility - a <- affinity(T = seq(150, 550, 10), `Cl-` = log10(a_Cl), `K+` = log10(a_K), P = 1000, IS = NaCl$IS) + a <- affinity(T = seq(150, 550, 10), `Cl-` = log10(NaCl$m_Cl), P = 1000, IS = NaCl$IS) s <- solubility(a) # make diagram and show total log molality diagram(s, ylim = c(-10, -4), col = col, lwd = 2, lty = 1) @@ -166,15 +162,11 @@ basis("O2", "HM") # apply QMK buffer for pH basis("H+", "QMK") + basis("K+", log10(0.5)) # calculate solution composition for 2 mol/kg NaCl - NaCl <- NaCl(T = seq(150, 550, 10), P = 1000, m_tot=2) - a_Cl <- NaCl$m_Cl * NaCl$gam_Cl - # using this ionic strength, calculate the activity of K+ - # assuming complete dissociation of 0.5 mol/kg KCl - gam_K <- 10^subcrt("K+", T = seq(150, 550, 10), P = 1000, IS=NaCl$IS)$out$`K+`$loggam - a_K <- 0.5 * gam_K + NaCl <- NaCl(T = seq(150, 550, 10), P = 1000, m_tot=1) # calculate affinity and solubility - a <- affinity(T = seq(150, 550, 10), `Cl-` = log10(a_Cl), `K+` = log10(a_K), P = 1000, IS = NaCl$IS) + a <- affinity(T = seq(150, 550, 10), `Cl-` = log10(NaCl$m_Cl), P = 1000, IS = NaCl$IS) s <- solubility(a) # make diagram and show total log molality diagram(s, ylim = c(-10, -2), col = col, lwd = 2, lty = 1) Modified: pkg/CHNOSZ/inst/NEWS =================================================================== --- pkg/CHNOSZ/inst/NEWS 2018-11-07 15:50:34 UTC (rev 346) +++ pkg/CHNOSZ/inst/NEWS 2018-11-08 06:50:22 UTC (rev 347) @@ -1,19 +1,22 @@ -CHANGES IN CHNOSZ 1.1.3-54 (2018-11-07) +CHANGES IN CHNOSZ 1.1.3-55 (2018-11-08) --------------------------------------- MAJOR BUG FIXED -- Previously, the virtual conversion of activities to molalities was - done incorrectly; the Gibbs energies of basis species and formed - species were transformed in the same direction. They should have - opposite transformations. This has been fixed by adding the 'is.basis' - argument to nonideal(), which is used by affinity() to transform the - Gibbs energies in the right direction. +- Previously, with calculations using nonideal(), the Gibbs energies of + basis species and formed species were transformed in the same + direction, causing an incorrct conversion of activities to molalities. + This has been fixed by adding the 'is.basis' argument to nonideal(), + which is used by affinity() to transform the Gibbs energies in opposite + directions for basis species and formed species. - For more information, see the new section of ?nonideal: 'is.basis and the CHNOSZ workflow'. - Two new demos depend on the corrected behavior: gold.R and QtzMsKfs.R. + The latter demo also provides a comparison of the superseded Helgeson + (SUPCRT92) and newer Berman datasets for minerals. See below for more + information on demo/gold.R. NEW FEATURES Modified: pkg/CHNOSZ/man/berman.Rd =================================================================== --- pkg/CHNOSZ/man/berman.Rd 2018-11-07 15:50:34 UTC (rev 346) +++ pkg/CHNOSZ/man/berman.Rd 2018-11-08 06:50:22 UTC (rev 347) @@ -100,36 +100,6 @@ a <- affinity(T=c(200, 1700, 200), P=c(0, 50000, 200)) diagram(a) -## a longer example, comparing diagrams made using the -## Berman and Helgeson datasets, after Sverjensky et al., 1991 -res <- 200 -# using the Helgeson data -add.obigt("SUPCRT92") -# set up basis species -basis(c("K+", "Al+3", "quartz", "H2O", "O2", "H+")) -# use pH = 0 so that aK+ = aK+/aH+ -basis("pH", 0) -# load the species -species(c("K-feldspar", "muscovite", "kaolinite", - "pyrophyllite", "andalusite"), "cr") -# calculate affinities in aK+ - temperature space -a <- affinity(`K+`=c(0, 5, res), T=c(200, 650, res), P=1000) -# note that we go just past the quartz transition, -# but it has no effect on the diagram -diagram(a, xlab=ratlab("K+")) -# now using the Berman data: this resets the thermodynamic database -# without affecting the basis and species settings -data(OBIGT) -# it might be good to check that we have Berman's quartz -# and not coesite or some other SiO2 phase -info(basis()$ispecies[3]) -a <- affinity(`K+`=c(0, 5, res), T=c(200, 650, res), P=1000) -diagram(a, add=TRUE, names="", col="blue", lwd=2) -legend("topleft", lty=c(1, 1, NA), lwd=c(1, 2, 0), col=c("black", "blue", ""), - legend=c("Helgeson et al., 1978 (unadjusted)", - "Berman, 1988", " (adjusted by Sverjensky et al., 1991)"), bty="n") -title(main="Comparison of Helgeson and Berman datasets at 1000 bar") - ## Getting data from a user-supplied file ## Ol-Opx exchange equilibrium, after Berman and Aranovich, 1996 E.units("J") @@ -161,8 +131,6 @@ Berman, R. G. (2007) winTWQ (version 2.3): A software package for performing internally-consistent thermobarometric calculations. \emph{Open File} \bold{5462}, Geological Survey of Canada, 41 p. \url{https://doi.org/10.4095/223425} Helgeson, H. C., Delany, J. M., Nesbitt, H. W. and Bird, D. K. (1978) Summary and critique of the thermodynamic properties of rock-forming minerals. \emph{Am. J. Sci.} \bold{278-A}, 1--229. \url{http://www.worldcat.org/oclc/13594862} - -Sverjensky, D. A., Hemley, J. J. and D'Angelo, W. M. (1991) Thermodynamic assessment of hydrothermal alkali feldspar-mica-aluminosilicate equilibria. \emph{Geochim. Cosmochim. Acta} \bold{55}, 989-1004. \url{https://doi.org/10.1016/0016-7037(91)90157-Z} } \concept{Thermodynamic calculations} Modified: pkg/CHNOSZ/man/examples.Rd =================================================================== --- pkg/CHNOSZ/man/examples.Rd 2018-11-07 15:50:34 UTC (rev 346) +++ pkg/CHNOSZ/man/examples.Rd 2018-11-08 06:50:22 UTC (rev 347) @@ -16,8 +16,8 @@ demos(which = c("sources", "protein.equil", "affinity", "NaCl", "density", "ORP", "revisit", "findit", "ionize", "buffer", "protbuff", "yeastgfp", "mosaic", "copper", "solubility", - "gold", "wjd", "bugstab", "Shh", "activity_ratios", "adenine", - "DEW", "lambda", "TCA", "go-IU", "bison"), + "gold", "QtzMsKfs", "wjd", "bugstab", "Shh", "activity_ratios", + "adenine", "DEW", "lambda", "TCA", "go-IU", "bison"), save.png=FALSE) } @@ -47,6 +47,7 @@ \code{copper} \tab * Another example of \code{\link{mosaic}}: complexation of Cu with glycine (Aksu and Doyle, 2001) \cr \code{solubility} \tab * Solubility of calcite (cf. Manning et al., 2013) and \CO2 (cf. Stumm and Morgan, 1996) \cr \code{gold} \tab * Solubility of gold (Akinfiev and Zotov; 2001; Stef{\aacute}nsson and Seward, 2004; Williams-Jones et al., 2009) \cr + \code{QtzMsKfs} \tab * Helgeson and Berman minerals and calculations with molality (Sverjensky et al., 1991) \cr \code{wjd} \tab * \eqn{G}{G} minimization: prebiological atmospheres (Dayhoff et al., 1964) and cell periphery of yeast \cr \code{dehydration} \tab * \logK of dehydration reactions; SVG file contains tooltips and links \cr \code{bugstab} \tab * Formation potential of microbial proteins in colorectal cancer (Dick, 2016) \cr @@ -122,6 +123,8 @@ Sverjensky, D. A., Harrison, B. and Azzolini, D. (2014a) Water in the deep Earth: The dielectric constant and the solubilities of quartz and corundum to 60 kb and 1,200 \degC. \emph{Geochim. Cosmochim. Acta} \bold{129}, 125--145. \url{https://doi.org/10.1016/j.gca.2013.12.019} +Sverjensky, D. A., Hemley, J. J. and D'Angelo, W. M. (1991) Thermodynamic assessment of hydrothermal alkali feldspar-mica-aluminosilicate equilibria. \emph{Geochim. Cosmochim. Acta} \bold{55}, 989-1004. \url{https://doi.org/10.1016/0016-7037(91)90157-Z} + Sverjensky, D. A., Stagno, V. and Huang, F. (2014b) Important role for organic carbon in subduction-zone fluids in the deep carbon cycle. \emph{Nat. Geosci.} \bold{7}, 909--913. \url{https://doi.org/10.1038/ngeo2291} Williams-Jones, A. E., Bowell, R. J. and Migdisov, A. A. (2009) Gold in solution. \emph{Elements} \bold{5}, 281--287. \url{https://doi.org/10.2113/gselements.5.5.281} Modified: pkg/CHNOSZ/man/util.expression.Rd =================================================================== --- pkg/CHNOSZ/man/util.expression.Rd 2018-11-07 15:50:34 UTC (rev 346) +++ pkg/CHNOSZ/man/util.expression.Rd 2018-11-08 06:50:22 UTC (rev 347) @@ -26,7 +26,7 @@ ret.val = FALSE) describe.reaction(reaction, iname = numeric(), states = NULL) syslab(system = c("K2O", "Al2O3", "SiO2", "H2O"), dash="\u2013") - ratlab(ion = "K+") + ratlab(ion = "K+", use.molality = FALSE) } \arguments{ From noreply at r-forge.r-project.org Thu Nov 8 14:59:57 2018 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 8 Nov 2018 14:59:57 +0100 (CET) Subject: [CHNOSZ-commits] r348 - in pkg/CHNOSZ: . R demo inst man tests/testthat Message-ID: <20181108135957.7C1B418B706@r-forge.r-project.org> Author: jedick Date: 2018-11-08 14:59:57 +0100 (Thu, 08 Nov 2018) New Revision: 348 Removed: pkg/CHNOSZ/demo/QtzMsKfs.R Modified: pkg/CHNOSZ/DESCRIPTION pkg/CHNOSZ/R/examples.R pkg/CHNOSZ/R/nonideal.R pkg/CHNOSZ/R/subcrt.R pkg/CHNOSZ/R/util.affinity.R pkg/CHNOSZ/demo/00Index pkg/CHNOSZ/demo/gold.R pkg/CHNOSZ/inst/NEWS pkg/CHNOSZ/man/berman.Rd pkg/CHNOSZ/man/examples.Rd pkg/CHNOSZ/man/nonideal.Rd pkg/CHNOSZ/man/subcrt.Rd pkg/CHNOSZ/tests/testthat/test-logmolality.R Log: revert 'is.basis' changes of revision 346; use molality of Cl- in demo/gold.R Modified: pkg/CHNOSZ/DESCRIPTION =================================================================== --- pkg/CHNOSZ/DESCRIPTION 2018-11-08 06:50:22 UTC (rev 347) +++ pkg/CHNOSZ/DESCRIPTION 2018-11-08 13:59:57 UTC (rev 348) @@ -1,6 +1,6 @@ Date: 2018-11-08 Package: CHNOSZ -Version: 1.1.3-55 +Version: 1.1.3-56 Title: Thermodynamic Calculations and Diagrams for Geo(bio)chemistry Authors at R: c( person("Jeffrey", "Dick", , "j3ffdick at gmail.com", role = c("aut", "cre"), Modified: pkg/CHNOSZ/R/examples.R =================================================================== --- pkg/CHNOSZ/R/examples.R 2018-11-08 06:50:22 UTC (rev 347) +++ pkg/CHNOSZ/R/examples.R 2018-11-08 13:59:57 UTC (rev 348) @@ -28,7 +28,7 @@ demos <- function(which=c("sources", "protein.equil", "affinity", "NaCl", "density", "ORP", "revisit", "findit", "ionize", "buffer", "protbuff", "yeastgfp", "mosaic", - "copper", "solubility", "gold", "QtzMsKfs", "wjd", "bugstab", "Shh", "activity_ratios", + "copper", "solubility", "gold", "wjd", "bugstab", "Shh", "activity_ratios", "adenine", "DEW", "lambda", "TCA", "go-IU", "bison"), save.png=FALSE) { # run one or more demos from CHNOSZ with ask=FALSE, and return the value of the last one for(i in 1:length(which)) { Modified: pkg/CHNOSZ/R/nonideal.R =================================================================== --- pkg/CHNOSZ/R/nonideal.R 2018-11-08 06:50:22 UTC (rev 347) +++ pkg/CHNOSZ/R/nonideal.R 2018-11-08 13:59:57 UTC (rev 348) @@ -3,7 +3,7 @@ # moved to nonideal.R from util.misc.R 20151107 # added Helgeson method 20171012 -nonideal <- function(species, speciesprops, IS, T, P, A_DH, B_DH, m_star=NULL, method=get("thermo")$opt$nonideal, is.basis=FALSE) { +nonideal <- function(species, speciesprops, IS, T, P, A_DH, B_DH, m_star=NULL, method=get("thermo")$opt$nonideal) { # generate nonideal contributions to thermodynamic properties # number of species, same length as speciesprops list # T in Kelvin, same length as nrows of speciespropss @@ -123,9 +123,6 @@ if(method=="bgamma") bgamma <- bgamma(convert(T, "C"), P) else if(method=="Bdot") bgamma <- Bdot(convert(T, "C")) else if(method %in% c("Bdot0", "bgamma0")) bgamma <- 0 - # different signs for basis species and species of interest 20181107 - species.sign <- ifelse(is.basis, -1, 1) - species.sign <- rep(species.sign, length.out=length(species)) # loop over species #2: activity coefficient calculations if(is.null(m_star)) m_star <- IS iH <- info("H+") @@ -144,10 +141,10 @@ pname <- colnames(myprops)[j] if(!pname %in% c("G", "H", "S", "Cp")) next if(get("thermo")$opt$Setchenow == "bgamma") { - myprops[, j] <- myprops[, j] + species.sign[i] * Setchenow(pname, IS, T, m_star, bgamma) + myprops[, j] <- myprops[, j] + Setchenow(pname, IS, T, m_star, bgamma) didneutral <- TRUE } else if(get("thermo")$opt$Setchenow == "bgamma0") { - myprops[, j] <- myprops[, j] + species.sign[i] * Setchenow(pname, IS, T, m_star, bgamma = 0) + myprops[, j] <- myprops[, j] + Setchenow(pname, IS, T, m_star, bgamma = 0) didneutral <- TRUE } } @@ -156,10 +153,10 @@ pname <- colnames(myprops)[j] if(!pname %in% c("G", "H", "S", "Cp")) next if(method=="Alberty") { - myprops[, j] <- myprops[, j] + species.sign[i] * Alberty(pname, Z[i], IS, T) + myprops[, j] <- myprops[, j] + Alberty(pname, Z[i], IS, T) didcharged <- TRUE } else { - myprops[, j] <- myprops[, j] + species.sign[i] * Helgeson(pname, Z[i], IS, T, A_DH, B_DH, acirc[i], m_star, bgamma) + myprops[, j] <- myprops[, j] + Helgeson(pname, Z[i], IS, T, A_DH, B_DH, acirc[i], m_star, bgamma) didcharged <- TRUE } } Modified: pkg/CHNOSZ/R/subcrt.R =================================================================== --- pkg/CHNOSZ/R/subcrt.R 2018-11-08 06:50:22 UTC (rev 347) +++ pkg/CHNOSZ/R/subcrt.R 2018-11-08 13:59:57 UTC (rev 348) @@ -12,7 +12,7 @@ subcrt <- function(species, coeff = 1, state = NULL, property = c("logK", "G", "H", "S", "V", "Cp"), T = seq(273.15, 623.15, 25), P = "Psat", grid = NULL, convert = TRUE, exceed.Ttr = FALSE, - exceed.rhomin = FALSE, logact = NULL, action.unbalanced = "warn", IS = 0, is.basis = FALSE) { + exceed.rhomin = FALSE, logact = NULL, action.unbalanced = "warn", IS = 0) { # revise the call if the states have # come as the second argument @@ -45,8 +45,6 @@ if(length(species) > length(state)) state <- rep(state,length.out=length(species)) state <- state.args(state) } - # make is.basis the same length as species - is.basis <- rep(is.basis, length.out=length(species)) # allowed properties properties <- c("rho", "logK", "G", "H", "S", "Cp", "V", "kT", "E") @@ -300,11 +298,8 @@ } # calculate activity coefficients if ionic strength is not zero if(any(IS != 0)) { - # work out whether the species are basis species (from the is.basis argument) 20181107 - isb <- is.basis[match(iphases[isaq], ispecies)] - if(thermo$opt$nonideal %in% c("Bdot", "Bdot0", "bgamma", "bgamma0")) - p.aq <- nonideal(iphases[isaq], p.aq, newIS, T, P, H2O.PT$A_DH, H2O.PT$B_DH, is.basis=isb) - else if(thermo$opt$nonideal=="Alberty") p.aq <- nonideal(iphases[isaq], p.aq, newIS, T, is.basis=isb) + if(thermo$opt$nonideal %in% c("Bdot", "Bdot0", "bgamma", "bgamma0")) p.aq <- nonideal(iphases[isaq], p.aq, newIS, T, P, H2O.PT$A_DH, H2O.PT$B_DH) + else if(thermo$opt$nonideal=="Alberty") p.aq <- nonideal(iphases[isaq], p.aq, newIS, T) } outprops <- c(outprops, p.aq) } else if(any(isH2O)) { Modified: pkg/CHNOSZ/R/util.affinity.R =================================================================== --- pkg/CHNOSZ/R/util.affinity.R 2018-11-08 06:50:22 UTC (rev 347) +++ pkg/CHNOSZ/R/util.affinity.R 2018-11-08 13:59:57 UTC (rev 348) @@ -133,12 +133,10 @@ if(!is.null(sout)) return(sout) else { ## subcrt arguments species <- c(mybasis$ispecies,myspecies$ispecies) - is.basis <- c(rep(TRUE, length(mybasis$ispecies)), rep(FALSE, length(myspecies$ispecies))) if("T" %in% vars) T <- vals[[which(vars=="T")]] if("P" %in% vars) P <- vals[[which(vars=="P")]] if("IS" %in% vars) IS <- vals[[which(vars=="IS")]] - s.args <- list(species = species, property = property, T = T, P = P, IS = IS, grid = grid, - convert = FALSE, exceed.Ttr = exceed.Ttr, exceed.rhomin = exceed.rhomin, is.basis = is.basis) + s.args <- list(species=species,property=property,T=T,P=P,IS=IS,grid=grid,convert=FALSE,exceed.Ttr=exceed.Ttr,exceed.rhomin=exceed.rhomin) return(do.call("subcrt",s.args)) } } Modified: pkg/CHNOSZ/demo/00Index =================================================================== --- pkg/CHNOSZ/demo/00Index 2018-11-08 06:50:22 UTC (rev 347) +++ pkg/CHNOSZ/demo/00Index 2018-11-08 13:59:57 UTC (rev 348) @@ -14,7 +14,6 @@ copper Another example of mosaic(): complexation of copper with glycine species solubility Solubility of calcite and CO2(gas) as a function of pH gold Solubility of gold -QtzMsKfs Helgeson and Berman minerals and calculations with molality wjd Gibbs energy minimization: prebiological atmospheres and cell periphery of yeast dehydration log K of dehydration reactions; SVG file contains tooltips and links bugstab Formation potential of microbial proteins in colorectal cancer Deleted: pkg/CHNOSZ/demo/QtzMsKfs.R =================================================================== --- pkg/CHNOSZ/demo/QtzMsKfs.R 2018-11-08 06:50:22 UTC (rev 347) +++ pkg/CHNOSZ/demo/QtzMsKfs.R 2018-11-08 13:59:57 UTC (rev 348) @@ -1,69 +0,0 @@ -# CHNOSZ/demo/QtzMsKfs.R -# T - log(K+/H+) diagram, after Sverjensky et al., 1991 -# (doi:10.1016/0016-7037(91)90157-Z) -# 20171009 diagram added to berman.Rd -# 20181108 moved to demo/QtzMsKfs.R; add molality calculations - -# this demo compares diagrams made using the Berman and Helgeson datasets, -# and shows the use of nonideal calculations to set molalities in the basis species - -## set up the system: basis species -basis(c("K+", "Al+3", "quartz", "H2O", "O2", "H+")) -# use pH = 0 so that aK+ = aK+/aH+ -basis("pH", 0) -# load the species -species(c("K-feldspar", "muscovite", "kaolinite", - "pyrophyllite", "andalusite"), "cr") -## the "b_gamma" equation gets closer to the published diagram than "B-dot" -thermo$opt$nonideal <<- "bgamma" - -## start with the data from Helgeson et al., 1978 -add.obigt("SUPCRT92") -# calculate affinities in aK+ - temperature space -# exceed.Tr: we go above stated temperature limit of pyrophyllite -# (this is above its stability field on the diagram, so pyrophyllite doesn't appear in this region, -# but its properties are needed needed to calculate relative stabilities of all minerals) -res <- 400 -a <- affinity(`K+` = c(0, 5, res), T = c(200, 650, res), P = 1000, exceed.Ttr = TRUE) -# make base plot with colors and no lines -diagram(a, xlab = ratlab("K+", use.molality = TRUE), lty = 0, fill = "terrain") -# add the lines, extending into the low-density region (exceed.rhomin = TRUE) -a <- affinity(`K+` = c(0, 5, res), T = c(200, 650, res), P = 1000, exceed.Ttr = TRUE, exceed.rhomin = TRUE) -diagram(a, add = TRUE, names = NULL, col = "red", lty = 2, lwd = 1.5) -# calculate and plot the lines for 1 molal chloride -a <- affinity(`K+` = c(0, 5, res), T = c(200, 650, res), P = 1000, exceed.Ttr = TRUE, exceed.rhomin = TRUE, IS = 1) -diagram(a, add = TRUE, names = NULL, col = "red", lwd = 1.5) -# the list of references: -ref1 <- thermo.refs(species()$ispecies)$key - -## now use the (default) data from Berman, 1988 -# this resets the thermodynamic database -# without affecting the basis and species settings -data(OBIGT) -# we can check that we have Berman's quartz -# and not coesite or some other phase of SiO2 -iSiO2 <- rownames(basis()) == "SiO2" -stopifnot(info(basis()$ispecies[iSiO2])$name == "quartz") -# Berman's dataset doesn't have the upper temperature limits, so we don't need exceed.Ttr here -a <- affinity(`K+` = c(0, 5, res), T = c(200, 650, res), P = 1000, exceed.rhomin = TRUE) -diagram(a, add = TRUE, names = NULL, col = "blue", lty = 2, lwd = 1.5) -a <- affinity(`K+` = c(0, 5, res), T = c(200, 650, res), P = 1000, exceed.rhomin = TRUE, IS = 1) -diagram(a, add = TRUE, names = NULL, col = "blue", lwd = 1.5) -# the list of references: -ref2 <- thermo.refs(species()$ispecies)$key -ref2 <- paste(ref2, collapse = ", ") - -# add experimental points for 1000 bar (Table 1 of Sverjensky et al., 1991) -expt.T <- c(300, 400, 500, 550, # KFs-Ms-Qtz - 400, 450, 500, 550, # Ms-And-Qtz - 300, 350, # Ms-P-Qtz - 300, 600) # Kaol-Ms-Qtz, KFs-And-Qtz -expt.KH <- c(3.50, 2.75, 1.95, 1.40, 1.60, 1.57, 1.47, 1.38, 1.94, 1.80, 1.90, 0.63) -points(expt.KH, expt.T, pch = 19, cex = 1.2) -# add legend and title -legend("top", "low-density region", text.font = 3, bty = "n") -legend("top", describe.property(c(NA, NA, "P", "IS"), c(NA, NA, 1000, 1)), bty = "n") -legend("left", c(ref1, ref2, "ion molality", "ion activity", "experiments"), - lty = c(1, 1, 1, 2, 0), lwd = 1.5, col = c(2, 4, 1, 1, 1), pch = c(NA, NA, NA, NA, 19), bty = "n") -title(main = syslab(c("K2O", "Al2O3", "SiO2", "H2O", "HCl")), line = 1.8) -title(main = "Helgeson and Berman minerals, after Sverjensky et al., 1991", line = 0.3, font.main = 1) Modified: pkg/CHNOSZ/demo/gold.R =================================================================== --- pkg/CHNOSZ/demo/gold.R 2018-11-08 06:50:22 UTC (rev 347) +++ pkg/CHNOSZ/demo/gold.R 2018-11-08 13:59:57 UTC (rev 348) @@ -147,7 +147,7 @@ dK <- describe.basis(ibasis=5, use.molality=TRUE) legend("topleft", c(dP, dNaCl, dK), bty = "n") dbasis <- describe.basis(ibasis = c(9, 7, 10)) - legend("topright", dbasis, bty = "n") + legend(320, -4, dbasis, bty = "n") title(main=("After Williams-Jones et al., 2009, Fig. 2B"), font.main = 1) } @@ -156,7 +156,7 @@ # (doi:10.1144/SP402.4) Au_T2 <- function() { species(c("Au(HS)2-", "Au(HS)", "AuOH", "AuCl2-")) - # approximate activity of H2S for total S = 0.01 m + # total S = 0.01 m basis("H2S", -2) # apply HM buffer for fO2 basis("O2", "HM") @@ -164,12 +164,12 @@ basis("H+", "QMK") basis("K+", log10(0.5)) # calculate solution composition for 2 mol/kg NaCl - NaCl <- NaCl(T = seq(150, 550, 10), P = 1000, m_tot=1) + NaCl <- NaCl(T = seq(150, 550, 10), P = 1000, m_tot=2) # calculate affinity and solubility a <- affinity(T = seq(150, 550, 10), `Cl-` = log10(NaCl$m_Cl), P = 1000, IS = NaCl$IS) s <- solubility(a) # make diagram and show total log molality - diagram(s, ylim = c(-10, -2), col = col, lwd = 2, lty = 1) + diagram(s, ylim = c(-10, -3), col = col, lwd = 2, lty = 1) diagram(s, add = TRUE, type = "loga.balance", lwd = 3, lty = 2) # make legend and title dP <- describe.property("P", 1000) @@ -177,7 +177,7 @@ dK <- describe.basis(ibasis=5, use.molality=TRUE) legend("topleft", c(dP, dNaCl, dK), bty = "n") dbasis <- describe.basis(ibasis = c(9, 7, 10)) - legend("topright", dbasis, bty = "n") + legend(320, -3, dbasis, bty = "n") title(main=("After Williams-Jones et al., 2009, Fig. 2A"), font.main = 1) } Modified: pkg/CHNOSZ/inst/NEWS =================================================================== --- pkg/CHNOSZ/inst/NEWS 2018-11-08 06:50:22 UTC (rev 347) +++ pkg/CHNOSZ/inst/NEWS 2018-11-08 13:59:57 UTC (rev 348) @@ -1,23 +1,6 @@ -CHANGES IN CHNOSZ 1.1.3-55 (2018-11-08) +CHANGES IN CHNOSZ 1.1.3-56 (2018-11-08) --------------------------------------- -MAJOR BUG FIXED - -- Previously, with calculations using nonideal(), the Gibbs energies of - basis species and formed species were transformed in the same - direction, causing an incorrct conversion of activities to molalities. - This has been fixed by adding the 'is.basis' argument to nonideal(), - which is used by affinity() to transform the Gibbs energies in opposite - directions for basis species and formed species. - -- For more information, see the new section of ?nonideal: 'is.basis and - the CHNOSZ workflow'. - -- Two new demos depend on the corrected behavior: gold.R and QtzMsKfs.R. - The latter demo also provides a comparison of the superseded Helgeson - (SUPCRT92) and newer Berman datasets for minerals. See below for more - information on demo/gold.R. - NEW FEATURES - Add solubility(). Run this after affinity() to calculate the Modified: pkg/CHNOSZ/man/berman.Rd =================================================================== --- pkg/CHNOSZ/man/berman.Rd 2018-11-08 06:50:22 UTC (rev 347) +++ pkg/CHNOSZ/man/berman.Rd 2018-11-08 13:59:57 UTC (rev 348) @@ -94,6 +94,53 @@ DGrxn <- G_Cs - G_aQz stopifnot(all(abs(DGrxn) < 100)) +### compare mineral stabilities in the Berman and Helgeson datasets +### on a T - log(K+/H+) diagram, after Sverjensky et al., 1991 +### (doi:10.1016/0016-7037(91)90157-Z) +## set up the system: basis species +basis(c("K+", "Al+3", "quartz", "H2O", "O2", "H+")) +# use pH = 0 so that aK+ = aK+/aH+ +basis("pH", 0) +# load the species +species(c("K-feldspar", "muscovite", "kaolinite", + "pyrophyllite", "andalusite"), "cr") +## start with the data from Helgeson et al., 1978 +add.obigt("SUPCRT92") +# calculate affinities in aK+ - temperature space +# exceed.Tr: enable calculations above stated temperature limit of pyrophyllite +res <- 400 +a <- affinity(`K+` = c(0, 5, res), T = c(200, 650, res), P = 1000, exceed.Ttr = TRUE) +# make base plot with colors and no lines +diagram(a, xlab = ratlab("K+", use.molality = TRUE), lty = 0, fill = "terrain") +# add the lines, extending into the low-density region (exceed.rhomin = TRUE) +a <- affinity(`K+` = c(0, 5, res), T = c(200, 650, res), P = 1000, + exceed.Ttr = TRUE, exceed.rhomin = TRUE) +diagram(a, add = TRUE, names = NULL, col = "red", lwd = 1.5) +# the list of references: +ref1 <- thermo.refs(species()$ispecies)$key +## now use the (default) data from Berman, 1988 +# this resets the thermodynamic database +# without affecting the basis and species settings +data(OBIGT) +# we can check that we have Berman's quartz +# and not coesite or some other phase of SiO2 +iSiO2 <- rownames(basis()) == "SiO2" +stopifnot(info(basis()$ispecies[iSiO2])$name == "quartz") +# Berman's dataset doesn't have the upper temperature limits, so we don't need exceed.Ttr here +a <- affinity(`K+` = c(0, 5, res), T = c(200, 650, res), P = 1000, exceed.rhomin = TRUE) +diagram(a, add = TRUE, names = NULL, col = "blue", lwd = 1.5) +# the list of references: +ref2 <- thermo.refs(species()$ispecies)$key +ref2 <- paste(ref2, collapse = ", ") +# add legend and title +legend("top", "low-density region", text.font = 3, bty = "n") +legend("topleft", describe.property(c("P", "IS"), c(1000, 1)), bty = "n") +legend("left", c(ref1, ref2), + lty = c(1, 1), lwd = 1.5, col = c(2, 4), bty = "n") +title(main = syslab(c("K2O", "Al2O3", "SiO2", "H2O", "HCl")), line = 1.8) +title(main = "Helgeson and Berman minerals, after Sverjensky et al., 1991", + line = 0.3, font.main = 1) + # make a P-T diagram for SiO2 minerals (Ber88 Fig. 4) basis(c("SiO2", "O2"), c("cr", "gas")) species(c("quartz", "quartz,beta", "coesite"), "cr") Modified: pkg/CHNOSZ/man/examples.Rd =================================================================== --- pkg/CHNOSZ/man/examples.Rd 2018-11-08 06:50:22 UTC (rev 347) +++ pkg/CHNOSZ/man/examples.Rd 2018-11-08 13:59:57 UTC (rev 348) @@ -16,7 +16,7 @@ demos(which = c("sources", "protein.equil", "affinity", "NaCl", "density", "ORP", "revisit", "findit", "ionize", "buffer", "protbuff", "yeastgfp", "mosaic", "copper", "solubility", - "gold", "QtzMsKfs", "wjd", "bugstab", "Shh", "activity_ratios", + "gold", "wjd", "bugstab", "Shh", "activity_ratios", "adenine", "DEW", "lambda", "TCA", "go-IU", "bison"), save.png=FALSE) } @@ -47,7 +47,6 @@ \code{copper} \tab * Another example of \code{\link{mosaic}}: complexation of Cu with glycine (Aksu and Doyle, 2001) \cr \code{solubility} \tab * Solubility of calcite (cf. Manning et al., 2013) and \CO2 (cf. Stumm and Morgan, 1996) \cr \code{gold} \tab * Solubility of gold (Akinfiev and Zotov; 2001; Stef{\aacute}nsson and Seward, 2004; Williams-Jones et al., 2009) \cr - \code{QtzMsKfs} \tab * Helgeson and Berman minerals and calculations with molality (Sverjensky et al., 1991) \cr \code{wjd} \tab * \eqn{G}{G} minimization: prebiological atmospheres (Dayhoff et al., 1964) and cell periphery of yeast \cr \code{dehydration} \tab * \logK of dehydration reactions; SVG file contains tooltips and links \cr \code{bugstab} \tab * Formation potential of microbial proteins in colorectal cancer (Dick, 2016) \cr Modified: pkg/CHNOSZ/man/nonideal.Rd =================================================================== --- pkg/CHNOSZ/man/nonideal.Rd 2018-11-08 06:50:22 UTC (rev 347) +++ pkg/CHNOSZ/man/nonideal.Rd 2018-11-08 13:59:57 UTC (rev 348) @@ -9,7 +9,7 @@ \usage{ nonideal(species, speciesprops, IS, T, P, A_DH, B_DH, - m_star=NULL, method=get("thermo")$opt$nonideal, is.basis=FALSE) + m_star=NULL, method=get("thermo")$opt$nonideal) bgamma(TC, P, showsplines = "") } @@ -23,7 +23,6 @@ \item{B_DH}{numeric, B Debye-Huckel coefficient; required for B-dot or b_gamma equation} \item{m_star}{numeric, total molality of all dissolved species} \item{method}{character, \samp{Alberty}, \samp{Bdot}, \samp{Bdot0}, or \samp{bgamma}} - \item{is.basis}{logical, is (are) the specie basis species?} \item{TC}{numeric, temperature (\degC)} \item{showsplines}{character, show isobaric (\samp{T}) or isothermal (\samp{P}) splines} } @@ -76,23 +75,6 @@ This is a crude method of kriging the data, but produces fairly smooth interpolations without adding any external dependencies. } -\section{is.basis and the CHNOSZ workflow}{ -The main workflow in CHNOSZ (\code{\link{basis}} - \code{\link{species}} - \code{\link{affinity}} - ( \code{\link{solubility}} or \code{\link{equilibrate}} ) - \code{\link{diagram}}) is written in terms of chemical activities, not concentrations (i.e. molalities for aqueous species). -To output molalities for the \emph{species of interest}, which are formed from the basis species, we would multiply CHNOSZ's activities by activity coefficients. -But to obtain activities for the \emph{basis species}, we should divide the molalities that are desired in the input by activity coefficients. -That is, to convert the entire workflow from activity to molality space requires opposite treatments for the basis species and the species being formed. -To simplify the problem, CHNOSZ does not compute molalities by actually multiplying activities by activity coefficients (or vice versa) -- this would require complex calculations of activity coefficients at the input and output stages, considering the many possible dimensions of system variables -- a true mess! -Instead, the same effect is obtained at the core of the workflow by using standard Gibbs energies adjusted for given ionic strength (i.e. transformed Gibbs energies). -The transformation is very simple: by adding \emph{RT}\gamma (\gamma is the activity coefficient calculated at the appropriate \emph{T}, \emph{P}, and ionic strength) to the standard Gibbs energy, all expressions for activity of that species are converted to molality. -That transformation is consistent with the requirements for the species of interest. -The reverse transformation, subtracting \emph{RT}\gamma from the standard Gibbs energy, is needed for the basis species. - -The \code{is.basis} argument controls the direction of the transformation. -In general, it should not be needed by the user, but is used by \code{affinity} to obtain the correctly transformed Gibbs energies. -Thus, by activating nonideality calculations in \code{affinity} (with a non-zero \code{IS} argument), the activity variables, such as \code{logact} in the \code{basis} and \code{species} definitions, and \code{loga.equil} and \code{loga.balance} in the downstream calculations, are converted to molalities. -Actually renaming the variables in the code is not possible, but \code{\link{diagram}} changes the plot labels to molalities if it is provided results from a calculation with non-zero \code{IS} set in \code{affinity}. -} - \value{ One (\samp{G}) or more (\samp{H}, \samp{S}, \samp{Cp}; currently only with the Alberty method) standard thermodynamic properties (at IS=0) in \code{speciesprops} are replaced by the corresponding adjusted thermodynamic properties (at higher IS). For all affected species, a column named \code{loggam} (common (base-10) logarithm of gamma, the activity coefficient) is appended to the output dataframe of species properties. Modified: pkg/CHNOSZ/man/subcrt.Rd =================================================================== --- pkg/CHNOSZ/man/subcrt.Rd 2018-11-08 06:50:22 UTC (rev 347) +++ pkg/CHNOSZ/man/subcrt.Rd 2018-11-08 13:59:57 UTC (rev 348) @@ -11,7 +11,7 @@ property = c("logK","G","H","S","V","Cp"), T = seq(273.15,623.15,25), P = "Psat", grid = NULL, convert = TRUE, exceed.Ttr = FALSE, exceed.rhomin = FALSE, - logact = NULL, action.unbalanced = "warn", IS = 0, is.basis = FALSE) + logact = NULL, action.unbalanced = "warn", IS = 0) } \arguments{ @@ -28,7 +28,6 @@ \item{convert}{logical, are input and output units of T and P those of the user (\code{TRUE}) (see \code{\link{T.units}}), or are they Kelvin and bar (\code{FALSE})?} \item{action.unbalanced}{character \samp{warn} or NULL, what action to take if unbalanced reaction is provided} \item{IS}{numeric, ionic strength(s) at which to calculate adjusted molal properties, mol kg\eqn{^{-1}}{^-1}} - \item{is.basis}{logical, is (are) the species basis species? See \code{\link{nonideal}}} } \details{ Modified: pkg/CHNOSZ/tests/testthat/test-logmolality.R =================================================================== --- pkg/CHNOSZ/tests/testthat/test-logmolality.R 2018-11-08 06:50:22 UTC (rev 347) +++ pkg/CHNOSZ/tests/testthat/test-logmolality.R 2018-11-08 13:59:57 UTC (rev 348) @@ -5,7 +5,6 @@ # and in the rest of the main workflow of CHNOSZ? # 20171025 first version # 20181106 include non-zero activity coefficient of CO2(aq) - # 20181107 include 'is.basis' and opposite transformations for basis species and formed species ### first get the activity coefficients of H+ and HCO3- ## the long way... @@ -71,9 +70,7 @@ ## case 2: IS = 1 a1 <- affinity(IS=1) A1affinity <- -convert(a1$values[[2]], "G") - # we had better use is.basis here, which indicates the direction of transformation of Gibbs energy 20181107 - A1subcrt.trans <- subcrt(c("CO2", "H2O", "H+", "HCO3-"), c(-1, -1, 1, 1), T=25, logact=c(-3, 0, -7, -3), IS=1, is.basis=c(TRUE, TRUE, TRUE, FALSE))$out$A - expect_equal(A1affinity[[1]], A1subcrt.trans) + expect_equal(A1affinity[[1]], A1subcrt) ## take-home message 2: using affinity() with IS not equal to zero, the "logact" ## set by species() is logmolal in affinity calculations for charged aqueous species @@ -94,10 +91,7 @@ # so, logK = 6.345 logKrev <- -logK logQrev0 <- -logQ0 - # note the minus sign here, because HCO3 is now a basis species - # and has the opposite Gibbs energy transformation 20181107 - logaHCO3 <- -3 - loggam_HCO3 - logQrev1 <- (0 + logaCO2) - (-7 + logaHCO3) + logQrev1 <- -logQ1 ACO2_0manual <- -convert(logKrev - logQrev0, "G") ACO2_1manual <- -convert(logKrev - logQrev1, "G") expect_equal(ACO2_0manual, ACO2_0affinity[[1]]) @@ -118,9 +112,8 @@ # case 2: IS = 1 logact_HCO3 <- e1$loga.equil[[2]] logact_CO2 <- e1$loga.equil[[1]] - # CO2 (formed species): convert log activity to log molality (multiply by loggam) - # HCO3- (basis species): convert log molality to log activity (divide by loggam) - logQeq1 <- (-7 + logact_HCO3 - loggam_HCO3) - (logact_CO2 + loggam_CO2 + 0) + # here, loga.equil is the *molality*, so we must multiply by loggam + logQeq1 <- (-7 + logact_HCO3 + loggam_HCO3) - (logact_CO2 + loggam_CO2 + 0) Aeq1 <- -convert(logK - logQeq1, "G") # zero! expect_equal(Aeq1[[1]], 0) ## take-home message 4: using affinity() with IS not equal to zero, the "loga.equil" From noreply at r-forge.r-project.org Sun Nov 11 03:22:40 2018 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 11 Nov 2018 03:22:40 +0100 (CET) Subject: [CHNOSZ-commits] r349 - in pkg/CHNOSZ: . R demo man tests/testthat Message-ID: <20181111022240.87F2118823E@r-forge.r-project.org> Author: jedick Date: 2018-11-11 03:22:09 +0100 (Sun, 11 Nov 2018) New Revision: 349 Modified: pkg/CHNOSZ/DESCRIPTION pkg/CHNOSZ/R/basis.R pkg/CHNOSZ/R/mosaic.R pkg/CHNOSZ/R/swap.basis.R pkg/CHNOSZ/demo/gold.R pkg/CHNOSZ/man/berman.Rd pkg/CHNOSZ/tests/testthat/test-swap.basis.R Log: demo/gold.R: estimate molality of Cl- Modified: pkg/CHNOSZ/DESCRIPTION =================================================================== --- pkg/CHNOSZ/DESCRIPTION 2018-11-08 13:59:57 UTC (rev 348) +++ pkg/CHNOSZ/DESCRIPTION 2018-11-11 02:22:09 UTC (rev 349) @@ -1,6 +1,6 @@ -Date: 2018-11-08 +Date: 2018-11-11 Package: CHNOSZ -Version: 1.1.3-56 +Version: 1.1.3-57 Title: Thermodynamic Calculations and Diagrams for Geo(bio)chemistry Authors at R: c( person("Jeffrey", "Dick", , "j3ffdick at gmail.com", role = c("aut", "cre"), Modified: pkg/CHNOSZ/R/basis.R =================================================================== --- pkg/CHNOSZ/R/basis.R 2018-11-08 13:59:57 UTC (rev 348) +++ pkg/CHNOSZ/R/basis.R 2018-11-11 02:22:09 UTC (rev 349) @@ -185,7 +185,11 @@ } } # then modify the logact - if(!is.null(logact)) thermo$basis$logact[ib] <- as.numeric(logact[i]) + if(!is.null(logact)) { + # allow this to be non-numeric in case we're called by swap.basis() while a buffer is active 20181109 + if(can.be.numeric(logact[i])) thermo$basis$logact[ib] <- as.numeric(logact[i]) + else thermo$basis$logact[ib] <- logact[i] + } # assign the result to the CHNOSZ environment assign("thermo", thermo, "CHNOSZ") } Modified: pkg/CHNOSZ/R/mosaic.R =================================================================== --- pkg/CHNOSZ/R/mosaic.R 2018-11-08 13:59:57 UTC (rev 348) +++ pkg/CHNOSZ/R/mosaic.R 2018-11-11 02:22:09 UTC (rev 349) @@ -33,6 +33,7 @@ A.bases2 <- mcall$A.bases } # change the basis species; restore the original at the end of the loop + if(can.be.numeric(logact.swap)) logact.swap <- as.numeric(logact.swap) if(i < length(bases)) { swap.basis(bases[i], bases[i+1]) # TODO: basis() requires the formula to identify the basis species, Modified: pkg/CHNOSZ/R/swap.basis.R =================================================================== --- pkg/CHNOSZ/R/swap.basis.R 2018-11-08 13:59:57 UTC (rev 348) +++ pkg/CHNOSZ/R/swap.basis.R 2018-11-11 02:22:09 UTC (rev 349) @@ -94,13 +94,19 @@ ispecies <- oldbasis$ispecies ispecies[ib] <- ispecies2 newbasis <- put.basis(ispecies) - # if put.basis didn't stop with an error, we're good to go! - # what were the original chemical potentials of the elements? - emu <- element.mu(oldbasis, T=T) - # the corresponding logarithms of activities of the new basis species - bl <- basis.logact(emu, newbasis, T=T) + # now deal with the activities + if(!all(can.be.numeric(oldbasis$logact))) { + # if there are any buffers, just set the old activities + bl <- oldbasis$logact + } else { + # no buffers, so we can recalculate activities to maintain the chemical potentials of the elements + # what were the original chemical potentials of the elements? + emu <- element.mu(oldbasis, T=T) + # the corresponding logarithms of activities of the new basis species + bl <- basis.logact(emu, newbasis, T=T) + } # update the basis with these logacts - mb <- mod.basis(ispecies, logact=bl) + mb <- mod.basis(ispecies, state = newbasis$state, logact = bl) # delete, then restore species if they were defined species(delete=TRUE) if(!is.null(ts)) { Modified: pkg/CHNOSZ/demo/gold.R =================================================================== --- pkg/CHNOSZ/demo/gold.R 2018-11-08 13:59:57 UTC (rev 348) +++ pkg/CHNOSZ/demo/gold.R 2018-11-11 02:22:09 UTC (rev 349) @@ -1,5 +1,6 @@ # CHNOSZ/demo/gold.R: Au solubility calculations # 20181101 jmd first version +# 20181109 add calculation of K+ molality ## additions to OBIGT: # Au(HS) from Akinfiev and Zotov, 2010 @@ -19,12 +20,13 @@ ## modifications to OBIGT: # AuCl2- from Akinfiev and Zotov, 2001 (reported in AZ10) # (http://pleiades.online/cgi-perl/search.pl/?type=abstract&name=geochem&number=10&year=1&page=990) -mod.obigt("AuCl2-", formula = "AuCl2-", state = "aq", ref1 = "AZ01", date = today(), +mod.obigt("AuCl2-", ref1 = "AZ01", date = today(), G = -36795, H = -46664, S = 47.16, Cp = -26.4, V = 68.6, a1 = 11.4774, a2 = 20.2425, a3 = -2.2063, a4 = -3.6158, c1 = 27.0677, c2 = -22.240, omega = 0.8623, z = -1) # Au(HS)2- from Pokrovski et al., 2014 -mod.obigt("Au(HS)2-", G = 3487, H = 4703, S = 77.46, Cp = 3.3, V = 75.1, +mod.obigt("Au(HS)2-", ref1 = "PAB+14", date = today(), + G = 3487, H = 4703, S = 77.46, Cp = 3.3, V = 75.1, a1 = 12.3373, a2 = 22.3421, a3 = 3.0317, a4 = -3.7026, c1 = -53.6010, c2 = 31.4030, omega = 0.7673, z = -1) @@ -123,6 +125,18 @@ title(main=("After Stef\u00e1nsson and Seward, 2004, Fig. 12b"), font.main = 1, cex.main = 1.1) } +# estimate the Cl- molality and ionic strength for a hypothetical +# NaCl solution with total chloride equal to specified NaCl + KCl solution, +# then estimate the molality of K+ in that solution 20181109 +chloride <- function(T, P, m_NaCl, m_KCl) { + NaCl <- NaCl(T = T, P = P, m_tot = m_NaCl + m_KCl) + # calculate logK of K+ + Cl- = KCl, adjusted for ionic strength + logKadj <- subcrt(c("K+", "Cl-", "KCl"), c(-1, -1, 1), T = T, P = P, IS = NaCl$IS)$out$logK + # what is the molality of K+ from 0.5 mol/kg KCl, assuming total chloride from above + m_K <- m_KCl / (10^logKadj * NaCl$m_Cl + 1) + list(IS = NaCl$IS, m_Cl = NaCl$m_Cl, m_K = m_K) +} + # log(m_Au)-T diagram like Fig. 2B of Williams-Jones et al., 2009 # (doi:10.2113/gselements.5.5.281) Au_T1 <- function() { @@ -132,14 +146,13 @@ basis("H2S", "PPM") # apply QMK buffer for pH basis("H+", "QMK") - basis("K+", log10(0.5)) - # calculate solution composition for 2 mol/kg NaCl - NaCl <- NaCl(T = seq(150, 550, 10), P = 1000, m_tot=2) + # estimate solution composition for 1.5 m NaCl and 0.5 m KCl + chl <- chloride(T = seq(150, 550, 10), P = 1000, m_NaCl = 1.5, m_KCl = 0.5) # calculate affinity and solubility - a <- affinity(T = seq(150, 550, 10), `Cl-` = log10(NaCl$m_Cl), P = 1000, IS = NaCl$IS) + a <- affinity(T = seq(150, 550, 10), `Cl-` = log10(chl$m_Cl), `K+` = log10(chl$m_K), P = 1000, IS = chl$IS) s <- solubility(a) # make diagram and show total log molality - diagram(s, ylim = c(-10, -4), col = col, lwd = 2, lty = 1) + diagram(s, ylim = c(-10, -3), col = col, lwd = 2, lty = 1) diagram(s, add = TRUE, type = "loga.balance", lwd = 3, lty = 2) # make legend and title dP <- describe.property("P", 1000) @@ -147,7 +160,7 @@ dK <- describe.basis(ibasis=5, use.molality=TRUE) legend("topleft", c(dP, dNaCl, dK), bty = "n") dbasis <- describe.basis(ibasis = c(9, 7, 10)) - legend(320, -4, dbasis, bty = "n") + legend(320, -3, dbasis, bty = "n") title(main=("After Williams-Jones et al., 2009, Fig. 2B"), font.main = 1) } @@ -162,11 +175,13 @@ basis("O2", "HM") # apply QMK buffer for pH basis("H+", "QMK") - basis("K+", log10(0.5)) - # calculate solution composition for 2 mol/kg NaCl - NaCl <- NaCl(T = seq(150, 550, 10), P = 1000, m_tot=2) - # calculate affinity and solubility - a <- affinity(T = seq(150, 550, 10), `Cl-` = log10(NaCl$m_Cl), P = 1000, IS = NaCl$IS) + # estimate solution composition for 1.5 m NaCl and 0.5 m KCl + chl <- chloride(T = seq(150, 550, 10), P = 1000, m_NaCl = 1.5, m_KCl = 0.5) +# # calculate affinity and solubility, considering speciation of sulfur +# bases <- c("H2S", "HS-", "SO4-2", "HSO4-") +# m <- mosaic(bases, T = seq(150, 550, 10), `Cl-` = log10(chl$m_Cl), `K+` = log10(chl$m_K), P = 1000, IS = chl$IS) +# s <- solubility(m$A.species) + a <- affinity(T = seq(150, 550, 10), `Cl-` = log10(chl$m_Cl), `K+` = log10(chl$m_K), P = 1000, IS = chl$IS) s <- solubility(a) # make diagram and show total log molality diagram(s, ylim = c(-10, -3), col = col, lwd = 2, lty = 1) Modified: pkg/CHNOSZ/man/berman.Rd =================================================================== --- pkg/CHNOSZ/man/berman.Rd 2018-11-08 13:59:57 UTC (rev 348) +++ pkg/CHNOSZ/man/berman.Rd 2018-11-11 02:22:09 UTC (rev 349) @@ -140,6 +140,8 @@ title(main = syslab(c("K2O", "Al2O3", "SiO2", "H2O", "HCl")), line = 1.8) title(main = "Helgeson and Berman minerals, after Sverjensky et al., 1991", line = 0.3, font.main = 1) +# cleanup for next example +data(thermo) # make a P-T diagram for SiO2 minerals (Ber88 Fig. 4) basis(c("SiO2", "O2"), c("cr", "gas")) Modified: pkg/CHNOSZ/tests/testthat/test-swap.basis.R =================================================================== --- pkg/CHNOSZ/tests/testthat/test-swap.basis.R 2018-11-08 13:59:57 UTC (rev 348) +++ pkg/CHNOSZ/tests/testthat/test-swap.basis.R 2018-11-11 02:22:09 UTC (rev 349) @@ -44,3 +44,13 @@ basis(names(bl99), bl99) expect_equal(element.mu(T=99), ep99) }) + +# 20181111 +test_that("swapping works with a buffer (no recalculation of activities)", { + basis("FeCHNOS+") + oldb <- basis("O2", "PPM") + # before version 1.1.3-57, this gave Error in value * (-log(10) * R * T) : non-numeric argument to binary operator + newb <- swap.basis("O2", "hydrogen") + # note: logact includes "PPM" for O2 (old) and H2 (new) + expect_identical(oldb$logact, newb$logact) +}) From noreply at r-forge.r-project.org Sun Nov 11 05:55:33 2018 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 11 Nov 2018 05:55:33 +0100 (CET) Subject: [CHNOSZ-commits] r350 - in pkg/CHNOSZ: . R demo inst man tests/testthat Message-ID: <20181111045533.5AAD218A6B4@r-forge.r-project.org> Author: jedick Date: 2018-11-11 05:55:31 +0100 (Sun, 11 Nov 2018) New Revision: 350 Modified: pkg/CHNOSZ/DESCRIPTION pkg/CHNOSZ/R/diagram.R pkg/CHNOSZ/R/nonideal.R pkg/CHNOSZ/R/util.expression.R pkg/CHNOSZ/demo/gold.R pkg/CHNOSZ/inst/NEWS pkg/CHNOSZ/man/berman.Rd pkg/CHNOSZ/man/buffer.Rd pkg/CHNOSZ/man/diagram.Rd pkg/CHNOSZ/man/util.expression.Rd pkg/CHNOSZ/tests/testthat/test-util.R Log: expr.species(): reorganize arguments Modified: pkg/CHNOSZ/DESCRIPTION =================================================================== --- pkg/CHNOSZ/DESCRIPTION 2018-11-11 02:22:09 UTC (rev 349) +++ pkg/CHNOSZ/DESCRIPTION 2018-11-11 04:55:31 UTC (rev 350) @@ -1,6 +1,6 @@ Date: 2018-11-11 Package: CHNOSZ -Version: 1.1.3-57 +Version: 1.1.3-58 Title: Thermodynamic Calculations and Diagrams for Geo(bio)chemistry Authors at R: c( person("Jeffrey", "Dick", , "j3ffdick at gmail.com", role = c("aut", "cre"), Modified: pkg/CHNOSZ/R/diagram.R =================================================================== --- pkg/CHNOSZ/R/diagram.R 2018-11-11 02:22:09 UTC (rev 349) +++ pkg/CHNOSZ/R/diagram.R 2018-11-11 04:55:31 UTC (rev 350) @@ -105,7 +105,7 @@ } ## use molality instead of activity if the affinity calculation include ionic strength 20171101 - use.molality <- "IS" %in% names(eout) + molality <- "IS" %in% names(eout) ## when can normalize and as.residue be used if(normalize | as.residue) { @@ -277,7 +277,7 @@ ### 0-D diagram - bar graph of properties of species or reactions # plot setup - if(missing(ylab)) ylab <- axis.label(plotvar, units="", use.molality=use.molality) + if(missing(ylab)) ylab <- axis.label(plotvar, units="", molality=molality) barplot(unlist(plotvals), names.arg=names, ylab=ylab, cex.names=cex.names, col=col, ...) if(!is.null(main)) title(main=main) @@ -288,8 +288,8 @@ if(missing(xlim)) xlim <- range(xvalues) # TODO: this is backward if the vals are not increasing # initialize the plot if(!add) { - if(missing(xlab)) xlab <- axis.label(eout$vars[1], basis=eout$basis, use.molality=use.molality) - if(missing(ylab)) ylab <- axis.label(plotvar, units="", use.molality=use.molality) + if(missing(xlab)) xlab <- axis.label(eout$vars[1], basis=eout$basis, molality=molality) + if(missing(ylab)) ylab <- axis.label(plotvar, units="", molality=molality) # to get range for y-axis, use only those points that are in the xrange if(is.null(ylim)) { isx <- xvalues >= min(xlim) & xvalues <= max(xlim) @@ -563,8 +563,8 @@ ylim <- c(ys[1], tail(ys, 1)) # initialize the plot if(!add) { - if(is.null(xlab)) xlab <- axis.label(eout$vars[1], basis=eout$basis, use.molality=use.molality) - if(is.null(ylab)) ylab <- axis.label(eout$vars[2], basis=eout$basis, use.molality=use.molality) + if(is.null(xlab)) xlab <- axis.label(eout$vars[1], basis=eout$basis, molality=molality) + if(is.null(ylab)) ylab <- axis.label(eout$vars[2], basis=eout$basis, molality=molality) if(tplot) thermo.plot.new(xlim=xlim, ylim=ylim, xlab=xlab, ylab=ylab, cex=cex, cex.axis=cex.axis, mar=mar, yline=yline, side=side, ...) else plot(0, 0, type="n", xlim=xlim, ylim=ylim, xlab=xlab, ylab=ylab, ...) Modified: pkg/CHNOSZ/R/nonideal.R =================================================================== --- pkg/CHNOSZ/R/nonideal.R 2018-11-11 02:22:09 UTC (rev 349) +++ pkg/CHNOSZ/R/nonideal.R 2018-11-11 04:55:31 UTC (rev 350) @@ -93,8 +93,8 @@ Z[i] <- thisZ } # get species formulas to assign acirc 20181105 + formula <- get("thermo")$obigt$formula[species] if(grepl("Bdot", method)) { - formula <- get("thermo")$obigt$formula[species] # "ion size paramter" taken from UT_SIZES.REF of HCh package (Shvarov and Bastrakov, 1999), # based on Table 2.7 of Garrels and Christ, 1965 acircdat <- c("Rb+"=2.5, "Cs+"=2.5, "NH4+"=2.5, "Tl+"=2.5, "Ag+"=2.5, @@ -109,10 +109,10 @@ "Th+4"=11, "Zr+4"=11, "Ce+4"=11, "Sn+4"=11) acirc <- as.numeric(acircdat[formula]) acirc[is.na(acirc)] <- 4.5 - # make a message - nZ <- sum(Z!=0) - if(nZ > 1) message("nonideal: using ", paste(acirc[Z!=0], collapse=" "), " for ion size parameters of ", paste(formula[Z!=0], collapse=" ")) - else if(nZ==1) message("nonideal: using ", acirc[Z!=0], " for ion size parameter of ", formula[Z!=0]) + ## make a message + #nZ <- sum(Z!=0) + #if(nZ > 1) message("nonideal: using ", paste(acirc[Z!=0], collapse=" "), " for ion size parameters of ", paste(formula[Z!=0], collapse=" ")) + #else if(nZ==1) message("nonideal: using ", acirc[Z!=0], " for ion size parameter of ", formula[Z!=0]) # use correct units (cm) for ion size parameter acirc <- acirc * 10^-8 } else if(grepl("bgamma", method)) { @@ -128,7 +128,7 @@ iH <- info("H+") ie <- info("e-") speciesprops <- as.list(speciesprops) - ncharged <- nneutral <- 0 + icharged <- ineutral <- logical(length(species)) for(i in 1:length(species)) { myprops <- speciesprops[[i]] # to keep unit activity coefficients of the proton and electron @@ -172,11 +172,11 @@ } # save the calculated properties and increment progress counters speciesprops[[i]] <- myprops - ncharged <- ncharged + sum(didcharged) - nneutral <- nneutral + sum(didneutral) + if(didcharged) icharged[i] <- TRUE + if(didneutral) ineutral[i] <- TRUE } - if(ncharged > 0) message("nonideal: calculations for ", ncharged, " charged species (", mettext(method), ")") - if(nneutral > 0) message("nonideal: calculations for ", nneutral, " neutral species (Setchenow equation)") + if(sum(icharged) > 0) message("nonideal: calculations for ", paste(formula[icharged], collapse=", "), " (", mettext(method), ")") + if(sum(ineutral) > 0) message("nonideal: calculations for ", paste(formula[ineutral], collapse=", "), " (Setchenow equation)") return(speciesprops) } Modified: pkg/CHNOSZ/R/util.expression.R =================================================================== --- pkg/CHNOSZ/R/util.expression.R 2018-11-11 02:22:09 UTC (rev 349) +++ pkg/CHNOSZ/R/util.expression.R 2018-11-11 04:55:31 UTC (rev 350) @@ -5,7 +5,7 @@ ## if this file is interactively sourced, the following are also needed to provide unexported functions: #source("util.character.R") -expr.species <- function(species, state="", log="", value=NULL, use.makeup=FALSE, use.molality=FALSE) { +expr.species <- function(species, state = "aq", value = NULL, log = FALSE, molality = FALSE, use.state = FALSE, use.makeup = FALSE) { # make plotting expressions for chemical formulas # that include subscripts, superscripts (if charged) # and optionally designations of states +/- loga or logf prefix @@ -31,9 +31,6 @@ # recover the coefficient if(elements[i]==1) coeff <- "" else coeff <- elements[i] # append the coefficient - ## subscripts within subscripts (log) are too small - #if(log != "") expr <- substitute(a*b, list(a=expr, b=coeff)) - #else expr <- substitute(a[b], list(a=expr, b=coeff)) expr <- substitute(a[b], list(a=expr, b=coeff)) } else { # for charged species, don't show "Z" but do show e.g. "+2" @@ -46,36 +43,30 @@ } } } - # write a designation of physical state - ## deprecated 20181101 - ## use the state given in log if it's a gas or neutral aqueous species - #if(log %in% c("g", "gas")) state <- "g" - #else if(!"Z" %in% names(elements) & !missing(log)) state <- log - if(state != "") { - # subscript it if we're not in a log expression - if(log != "") expr <- substitute(a*group('(',italic(b),')'),list(a=expr, b=state)) - else expr <- substitute(a[group('(',italic(b),')')],list(a=expr, b=state)) + # write the physical state + if(use.state) { + # subscript it if we're not giving the value + if(is.null(value)) expr <- substitute(a[group('(',italic(b),')')],list(a=expr, b=state)) + else expr <- substitute(a*group('(',italic(b),')'),list(a=expr, b=state)) } - # write logarithm of activity or fugacity - # (or molality 20171101) - if(log != "") { - if(log == "aq") { - if(use.molality) acity <- "m" - else acity <- "a" - } else if(log %in% c("cr", "liq", "cr2", "cr3", "cr4")) acity <- "a" - else if(log %in% c("g", "gas")) acity <- "f" - else stop(paste("'", log, "' is not a recognized state", sep="")) - logacity <- substitute(log~italic(a), list(a=acity)) - expr <- substitute(a[b], list(a=logacity, b=expr)) - # write a value if given + # write a variable and value if given + if(!is.null(value) | log | molality) { + # write [logarithm of] activity or fugacity (or molality 20171101) + var <- "a" + if(molality) var <- "m" + if(state %in% c("g", "gas")) var <- "f" + expr <- substitute(italic(a)[b], list(a = var, b = expr)) + # use the logarithm? + if(log) expr <- substitute(log ~ a, list(a = expr)) + # write the value if not NULL or NA if(!is.null(value)) { - expr <- substitute(a==b, list(a=expr, b=value)) + if(!is.na(value)) expr <- substitute(a == b, list(a = expr, b = value)) } } return(expr) } -expr.property <- function(property, use.molality=FALSE) { +expr.property <- function(property, molality=FALSE) { # a way to make expressions for various properties # e.g. expr.property('DG0r') for standard molal Gibbs # energy change of reaction @@ -86,7 +77,7 @@ if(property=="logK") return(quote(log~italic(K))) # grepl here b/c diagram() uses "loga.equil" and "loga.basis" if(grepl("loga", property)) { - if(use.molality) return(quote(log~italic(m))) + if(molality) return(quote(log~italic(m))) else return(quote(log~italic(a))) } if(property=="alpha") return(quote(alpha)) @@ -160,7 +151,7 @@ return(expr) } -axis.label <- function(label, units=NULL, basis=get("thermo")$basis, prefix="", use.molality=FALSE) { +axis.label <- function(label, units=NULL, basis=get("thermo")$basis, prefix="", molality=FALSE) { # make a formatted axis label from a generic description # it can be a chemical property, condition, or chemical activity in the system # if the label matches one of the basis species @@ -172,11 +163,11 @@ # 20090215: the state this basis species is in state <- basis$state[match(label, rownames(basis))] # get the formatted label - desc <- expr.species(label, log=state, use.molality=use.molality) + desc <- expr.species(label, state = state, log = TRUE, molality = molality) } else { # the label is for a chemical property or condition # make the label by putting a comma between the property and the units - property <- expr.property(label, use.molality=use.molality) + property <- expr.property(label, molality=molality) if(is.null(units)) units <- expr.units(label, prefix=prefix) # no comma needed if there are no units if(units=="") desc <- substitute(a, list(a=property)) @@ -187,22 +178,27 @@ } describe.basis <- function(basis = get("thermo")$basis, ibasis = 1:nrow(basis), - digits = 1, oneline = FALSE, use.molality = FALSE, use.pH = TRUE) { + digits = 1, oneline = FALSE, molality = FALSE, use.pH = TRUE) { # make expressions for the chemical activities/fugacities of the basis species propexpr <- valexpr <- character() for(i in ibasis) { - # propexpr is logarithm of activity or fugacity - if(rownames(basis)[i]=="H+" & use.pH) thispropexpr <- "pH" - else thispropexpr <- expr.species(rownames(basis)[i], log=basis$state[i], use.molality = use.molality) - propexpr <- c(propexpr, thispropexpr) if(can.be.numeric(basis$logact[i])) { # we have an as.numeric here in case the basis$logact is character # (by inclusion of a buffer for one of the other basis species) - if(thispropexpr=="pH") valexpr <- c(valexpr, format(round(-as.numeric(basis$logact[i]), digits), nsmall=digits)) - else valexpr <- c(valexpr, format(round(as.numeric(basis$logact[i]), digits), nsmall=digits)) + if(rownames(basis)[i]=="H+" & use.pH) { + propexpr <- c(propexpr, "pH") + valexpr <- c(valexpr, format(round(-as.numeric(basis$logact[i]), digits), nsmall=digits)) + } else { + # propexpr is logarithm of activity or fugacity + propexpr <- c(propexpr, expr.species(rownames(basis)[i], state=basis$state[i], log = TRUE, molality = molality)) + valexpr <- c(valexpr, format(round(as.numeric(basis$logact[i]), digits), nsmall=digits)) + } } else { # a non-numeric value is the name of a buffer valexpr <- c(valexpr, basis$logact[i]) + # propexpr is pH, activity or fugacity + if(rownames(basis)[i]=="H+" & use.pH) propexpr <- c(propexpr, "pH") + else propexpr <- c(propexpr, expr.species(rownames(basis)[i], state=basis$state[i], value = NA, log = FALSE, molality = molality)) } } # write an equals sign between the property and value @@ -259,8 +255,8 @@ if(i %in% iname) species <- reaction$name[i] else { # should the chemical formula have a state? - if(identical(states,"all")) species <- expr.species(reaction$formula[i], state=reaction$state[i]) - else species <- expr.species(reaction$formula[i]) + if(identical(states,"all")) species <- expr.species(reaction$formula[i], state=reaction$state[i], use.state=TRUE) + else species <- expr.species(reaction$formula[i], state=reaction$state[i]) } # get the absolute value of the reaction coefficient abscoeff <- abs(reaction$coeff[i]) @@ -287,7 +283,7 @@ } # make formatted text for activity ratio 20170217 -ratlab <- function(ion="K+", use.molality=FALSE) { +ratlab <- function(ion="K+", molality=FALSE) { # the charge Z <- makeup(ion)["Z"] # the text for the exponent on aH+ @@ -295,8 +291,8 @@ # the expression for the ion and H+ expr.ion <- expr.species(ion) expr.H <- expr.species("H+") - # with use.molality, change a to m - a <- ifelse(use.molality, "m", "a") + # with molality, change a to m + a <- ifelse(molality, "m", "a") # the final expression if(exp.H=="1") substitute(log~(italic(a)[expr.ion] / italic(a)[expr.H]), list(a=a, expr.ion=expr.ion, expr.H=expr.H)) else substitute(log~(italic(a)[expr.ion] / italic(a)[expr.H]^exp.H), list(a=a, expr.ion=expr.ion, expr.H=expr.H, exp.H=exp.H)) Modified: pkg/CHNOSZ/demo/gold.R =================================================================== --- pkg/CHNOSZ/demo/gold.R 2018-11-11 02:22:09 UTC (rev 349) +++ pkg/CHNOSZ/demo/gold.R 2018-11-11 04:55:31 UTC (rev 350) @@ -156,11 +156,13 @@ diagram(s, add = TRUE, type = "loga.balance", lwd = 3, lty = 2) # make legend and title dP <- describe.property("P", 1000) - dNaCl <- expression(NaCl == 2~mol~kg^-1) - dK <- describe.basis(ibasis=5, use.molality=TRUE) - legend("topleft", c(dP, dNaCl, dK), bty = "n") - dbasis <- describe.basis(ibasis = c(9, 7, 10)) - legend(320, -3, dbasis, bty = "n") + dNaCl <- expression(italic(m)[NaCl] == 1.5) + dKCl <- expression(italic(m)[KCl] == 0.5) + legend("topleft", c(dP, dNaCl, dKCl), bty = "n") + dH2S <- describe.basis(ibasis = 7, molality=TRUE) + dO2 <- describe.basis(ibasis = 9) + dpH <- describe.basis(ibasis = 10) + legend(300, -3, c(dH2S, dO2, dpH), bty = "n") title(main=("After Williams-Jones et al., 2009, Fig. 2B"), font.main = 1) } @@ -188,11 +190,13 @@ diagram(s, add = TRUE, type = "loga.balance", lwd = 3, lty = 2) # make legend and title dP <- describe.property("P", 1000) - dNaCl <- expression(NaCl == 2~mol~kg^-1) - dK <- describe.basis(ibasis=5, use.molality=TRUE) - legend("topleft", c(dP, dNaCl, dK), bty = "n") - dbasis <- describe.basis(ibasis = c(9, 7, 10)) - legend(320, -3, dbasis, bty = "n") + dNaCl <- expression(italic(m)[NaCl] == 1.5) + dKCl <- expression(italic(m)[KCl] == 0.5) + legend("topleft", c(dP, dNaCl, dKCl), bty = "n") + dH2S <- expr.species("H2S", value = 0.01, molality = TRUE) + dO2 <- describe.basis(ibasis = 9) + dpH <- describe.basis(ibasis = 10) + legend(300, -3, c(dH2S, dO2, dpH), bty = "n") title(main=("After Williams-Jones et al., 2009, Fig. 2A"), font.main = 1) } Modified: pkg/CHNOSZ/inst/NEWS =================================================================== --- pkg/CHNOSZ/inst/NEWS 2018-11-11 02:22:09 UTC (rev 349) +++ pkg/CHNOSZ/inst/NEWS 2018-11-11 04:55:31 UTC (rev 350) @@ -1,4 +1,4 @@ -CHANGES IN CHNOSZ 1.1.3-56 (2018-11-08) +CHANGES IN CHNOSZ 1.1.3-58 (2018-11-11) --------------------------------------- NEW FEATURES @@ -37,6 +37,12 @@ of NaCl in water, taking account of activity coefficients and the reaction Na+ + Cl- = NaCl(aq). +- Add dumpdata() for returning/writing all packaged thermodynamic data + (including default database and optional data files). + +- Add demo/bison.R (average oxidation state of carbon of metagenome- + derived proteins in different microbial phyla at Bison Pool) + THERMODYNAMIC DATA - The Berman data (Berman, 1988 and later additions) have replaced the @@ -130,47 +136,46 @@ NA where the density of H2O is less than 0.35 g/cm3, avoiding the output of bogus values in this region. Thanks to Evgeniy Bastrakov. -OTHER CHANGES +COMPUTATIONAL OPTIONS - Add 'exceed.rhomin' argument to subcrt() and affinity() to enable output of properties for species in the revised HKF model below 0.35 g/cm3. -- To provide betters diagnostics for potential web apps, warning +- In equilibrate(), accept a length > 1 'normalize' argument to + normalize the chemical formulas of only the selected species. + +- Add thermo$opt$maxcores (default 2) to specify maximum number of + cores for parallel calculations with palply(). + +- Keywords in basis(): Change 'CHNOPS+' to use O2 instead of e-, and add + 'CHNOPSe' and 'MgCHNOPSe' for sets of basis species that have e-. + +- Add 'keep.duplicates' argument to thermo.refs(). Set it to TRUE to + output a single primary reference for each species, keeping any + duplicated references (but not including any secondary references in + thermo$obigt$ref2). Thanks to Evgeniy Bastrakov for the suggestion. + +USABILITY ENHANCEMENTS + +- To provide better diagnostics for potential web apps, warning messages produced by subcrt() are now available in the output of affinity(), under 'sout$warnings'. - Change internal variable names in subcrt() for better readability (sinfo -> ispecies, inpho -> iphases, sinph -> phasespecies). -- Add dumpdata() for returning/writing all packaged thermodynamic data - (including default database and optional data files). - - TODO: fix overly long message for info("SiO2"). -- In equilibrate(), accept a length > 1 'normalize' argument to - normalize the chemical formulas of only the selected species. - - Add C implementation of counting occurrences of all letters in a string (src/count_letters.c) to speed up operation of count.aa(). - read.fasta(): add support for file connections created using archive::archive_read (https://github.com/jimhester/archive). -- Add demo/bison.R (average oxidation state of carbon of metagenome- - derived proteins in different microbial phyla at Bison Pool) +- The arguments in expr.species() have been reorganized for more + flexible and concise usage. -- Add thermo$opt$maxcores (default 2) to specify maximum number of - cores for parallel calculations with palply(). - -- Keywords in basis(): Change 'CHNOPS+' to use O2 instead of e-, and add - 'CHNOPSe' and 'MgCHNOPSe' for sets of basis species that have e-. - -- Add 'keep.duplicates' argument to thermo.refs(). Set it to TRUE to - output a single primary reference for each species, keeping any - duplicated references (but not including any secondary references in - thermo$obigt$ref2). Thanks to Evgeniy Bastrakov for the suggestion. - CHANGES IN CHNOSZ 1.1.3 (2017-11-13) ------------------------------------ Modified: pkg/CHNOSZ/man/berman.Rd =================================================================== --- pkg/CHNOSZ/man/berman.Rd 2018-11-11 02:22:09 UTC (rev 349) +++ pkg/CHNOSZ/man/berman.Rd 2018-11-11 04:55:31 UTC (rev 350) @@ -111,7 +111,7 @@ res <- 400 a <- affinity(`K+` = c(0, 5, res), T = c(200, 650, res), P = 1000, exceed.Ttr = TRUE) # make base plot with colors and no lines -diagram(a, xlab = ratlab("K+", use.molality = TRUE), lty = 0, fill = "terrain") +diagram(a, xlab = ratlab("K+", molality = TRUE), lty = 0, fill = "terrain") # add the lines, extending into the low-density region (exceed.rhomin = TRUE) a <- affinity(`K+` = c(0, 5, res), T = c(200, 650, res), P = 1000, exceed.Ttr = TRUE, exceed.rhomin = TRUE) Modified: pkg/CHNOSZ/man/buffer.Rd =================================================================== --- pkg/CHNOSZ/man/buffer.Rd 2018-11-11 02:22:09 UTC (rev 349) +++ pkg/CHNOSZ/man/buffer.Rd 2018-11-11 04:55:31 UTC (rev 350) @@ -147,7 +147,7 @@ a <- affinity(O2=c(-85, -70, 4), T=c(25, 100, 4)) d <- diagram(a, type="CO2", add=TRUE, lty=2) # add a legend -lAC <- expr.species("CH3COOH", log="aq") +lAC <- expr.species("CH3COOH", log=TRUE) ltext <- c(as.expression(lAC), -3, -10) lty <- c(NA, 1, 2) legend("topright", legend=ltext, lty=lty, bg="white") Modified: pkg/CHNOSZ/man/diagram.Rd =================================================================== --- pkg/CHNOSZ/man/diagram.Rd 2018-11-11 02:22:09 UTC (rev 349) +++ pkg/CHNOSZ/man/diagram.Rd 2018-11-11 04:55:31 UTC (rev 350) @@ -166,7 +166,7 @@ \section{Activity Coefficients}{ The wording in this page and names of variables in functions refer exclusively to \samp{activities} of aqueous species. However, if activity coefficients are calculated (using the \code{IS} argument in \code{\link{affinity}}), then these variables are effectively transformed to molalities (see \code{tests/testthat/} \code{test-logmolality.R}). -So that the labels on diagrams are adjusted accordingly, \code{\link{diagram}} sets the \code{use.molality} argument of \code{\link{axis.label}} to TRUE if \code{IS} was supplied as an argument to \code{\link{affinity}}. +So that the labels on diagrams are adjusted accordingly, \code{\link{diagram}} sets the \code{molality} argument of \code{\link{axis.label}} to TRUE if \code{IS} was supplied as an argument to \code{\link{affinity}}. The labeling as molality takes effect even if \code{IS} is set to 0; this way, by including (or not) the \code{IS = 0} argument to \code{affinity}, the user decides whether to label aqueous species variables as molality (or activity) for calculations at zero ionic strength (where molality = activity). } @@ -273,9 +273,8 @@ # at 1 bar only, so we permit calculation at higher temperatures a <- affinity(T=c(200, 900, 99), P=c(0, 9000, 101), exceed.Ttr=TRUE) d <- diagram(a, fill=NULL) -bexpr <- sapply(c("Al2O3", "SiO2", "H2O"), expr.species, simplify=FALSE) -btext <- substitute(Al2O3 - SiO2 - H2O, unlist(bexpr)) -mtitle(c(as.expression(btext), "after Helgeson et al., 1978")) +slab <- syslab(c("Al2O3", "SiO2", "H2O")) +mtitle(c(as.expression(slab), "after Helgeson et al., 1978")) # find the approximate position of the triple point tp <- find.tp(d$predominant) Ttp <- a$vals[[1]][tp[1, 2]] Modified: pkg/CHNOSZ/man/util.expression.Rd =================================================================== --- pkg/CHNOSZ/man/util.expression.Rd 2018-11-11 02:22:09 UTC (rev 349) +++ pkg/CHNOSZ/man/util.expression.Rd 2018-11-11 04:55:31 UTC (rev 350) @@ -14,28 +14,29 @@ \description{Generate expressions suitable for axis labels and plot legends describing chemical species, properties and reactions.} \usage{ - expr.species(species, state = "", log = "", value=NULL, use.makeup=FALSE, - use.molality = FALSE) - expr.property(property, use.molality = FALSE) + expr.species(species, state = "aq", value=NULL, log=FALSE, molality=FALSE, + use.state=FALSE, use.makeup=FALSE) + expr.property(property, molality = FALSE) expr.units(property, prefix = "", per = "mol") axis.label(label, units = NULL, basis = get("thermo")$basis, prefix = "", - use.molality = FALSE) + molality = FALSE) describe.basis(basis = get("thermo")$basis, ibasis = 1:nrow(basis), - digits = 1, oneline = FALSE, use.molality = FALSE, use.pH = TRUE) + digits = 1, oneline = FALSE, molality = FALSE, use.pH = TRUE) describe.property(property, value, digits = 0, oneline = FALSE, ret.val = FALSE) describe.reaction(reaction, iname = numeric(), states = NULL) syslab(system = c("K2O", "Al2O3", "SiO2", "H2O"), dash="\u2013") - ratlab(ion = "K+", use.molality = FALSE) + ratlab(ion = "K+", molality = FALSE) } \arguments{ \item{species}{character, formula of a chemical species} \item{state}{character, designation of physical state} - \item{log}{character, designation of physical state (for logarithm of activity or fugacity)} \item{value}{numeric, logarithm of activity or fugacity of species, or value of other property} + \item{log}{logical, write logarithm of activity/fugacity/molality?} + \item{molality}{logical, use molality (m) instead of activity (a) for aqueous species?} + \item{use.state}{logical, include state in expression?} \item{use.makeup}{logical, use \code{\link{makeup}} to count the elements?} - \item{use.molality}{logical, use molality (m) instead of activity (a) for aqueous species?} \item{use.pH}{logical, use pH instead of log activity of H+?} \item{property}{character, description of chemical property} \item{prefix}{character, prefix for units} @@ -59,10 +60,15 @@ The \code{expr.*} functions create \code{\link{expression}}s using the \code{\link{plotmath}} syntax to describe the names and states and logarithms of activity or fugacity of chemical species, conditions including temperature and pressure and chemical properties such as Gibbs energy and volume. -\code{expr.species} takes as input the formula of a single chemical \code{species} and constructs an expression including subscripted coefficients, and a suffixed designation of physical \code{state} (italicized, in parentheses) if provided. -If \code{log} designates a physical state (as in \code{\link{thermo}$obigt$state}), the expression includes a \samp{log} prefix, followed by \samp{f} for fugacity of gaseous species, or \samp{a} for activity of species in all other states. +\code{expr.species} constructs a formatted expression using the formula or name of a single chemical \code{species}. +With no other arguments, the formula is just formatted with the appropriate subscripts and superscripts. +Providing the physical \code{state} adds a variable to the expression (\emph{a} for aqueous species and pure phases, except \emph{f} for gases). +Set \code{molality} to TRUE to write \emph{m} instead of \emph{a} for aqueous species. +The state itself is written in the expression if \code{use.state} is TRUE. +If \code{log} is TRUE, the expression includes a \samp{log} prefix. +Finally, provide a value in \code{value} to write an equation (something like logfO2 = -70), or set it to NA to only write the variable itself (e.g. logfO2). Set \code{use.makeup} to TRUE to use \code{\link{makeup}} to parse the chemical formula. -This can have the undesirable effect of reordering and grouping all the elements, and has been replaced with a different splitting algorithm so that coefficients and charges are sub/superscripted without affecting the intervening text. +This was an older default action that had the undesirable effect of reordering and grouping all the elements, and has been replaced with a different splitting algorithm so that coefficients and charges are sub/superscripted without affecting the intervening text. \code{expr.property} accepts a description in \code{property} that indicates the chemical property of interest. Uppercase letters are italicized, and lowercase letters are italicized and subscripted. @@ -100,7 +106,7 @@ If this matches the chemical formula of one of the basis species in the \code{basis} argument, the expression for the label is generated using \code{expr.species} with \code{log} set to the physical state of the basis species. Otherwise, the expression is built by combining the output of \code{expr.property} with \code{expr.units} (or the value in \code{units}, if it is supplied), placing a comma between the two. This function is used extensively in \code{\link{diagram}} and also appears in many of the examples. -Note that \code{\link{diagram}} sets \code{use.molality} to TRUE if \code{IS} was supplied as an argument to \code{\link{affinity}}. +Note that \code{\link{diagram}} sets \code{molality} to TRUE if \code{IS} was supplied as an argument to \code{\link{affinity}}. \code{describe.basis} makes an expression summarizing the basis species definition (logarithms of activity or fugacity of the basis species) provided in \code{basis}; only the basis species identified by \code{ibasis} are included. @@ -124,10 +130,10 @@ text0 <- function(...) text(..., adj=0) # species text0(1, 1, expr.species("CO2")) -text0(1, 2, expr.species("CO2", state="aq")) -text0(1, 3, expr.species("CO2", state="aq", log="aq")) -text0(1, 4, expr.species("CO2", log="aq")) -text0(1, 5, expr.species("CO2", log="aq", value=-3)) +text0(1, 2, expr.species("CO2", use.state=TRUE)) +text0(1, 3, expr.species("CO2", log=TRUE, use.state=TRUE)) +text0(1, 4, expr.species("CO2", log=TRUE)) +text0(1, 5, expr.species("CO2", log=TRUE, value=-3)) # properties text0(2, 1, expr.property("A")) text0(2, 2, expr.property("DV")) Modified: pkg/CHNOSZ/tests/testthat/test-util.R =================================================================== --- pkg/CHNOSZ/tests/testthat/test-util.R 2018-11-11 02:22:09 UTC (rev 349) +++ pkg/CHNOSZ/tests/testthat/test-util.R 2018-11-11 04:55:31 UTC (rev 350) @@ -36,10 +36,8 @@ expect_equal(as.numeric(testGHS[1, 3]), testent[2]) }) - test_that("expr.species() produces expected errors", { expect_error(expr.species(c("H2O", "CO2")), "more than one species") - expect_error(expr.species("CO2", log = "aqq"), "'aqq' is not a recognized state") }) test_that("[P|T|E].units() do not accept invalid units", {