Learn R Programming

spsh (version 1.1.0)

shypFun: Wrapper Function for all Supported Soil Hydraulic Property Models

Description

This function allows to select soil hydraulic property models.

Usage

shypFun(p, h, shpmodel = "01110", ivap.query = NULL)

Arguments

p

Vector of the model parameters, order is sensitve cf respective model documentation.

h

Pressure heads [cm] for which the corresponding retention and conductivity values are calculated.

shpmodel

character

01110 unimodel van Genuchten-Mualem model, with the contraint of m = 1-1/n vanGenuchten.1980spsh 01210
bimodel van Genuchten-Mualem model, with the contraint of m_i = 1-1/n_i Durner.1994spsh 01310 trimodal van Genuchten-Mualem model, with the contraint of m_i = 1-1/n_i Durner.1994spsh
02110 unimodel Kosugi 2 parametric-Mualem model Kosugi.1996spsh 03110
unimodel Fredlund-Xing-Mualem model, with the contraint of m = 1-1/n Fredlund.1994spsh 01110 unimodel van Genuchten-Mualem model, with the contraint of m = 1-1/n vanGenuchten.1980spsh
ivap.query
NULL no isothermal vapour conductivity will be calculated with Kvap
Model type for isothermal vapour conductivity, see Details of function KvapFun for model codes NULL no isothermal vapour conductivity will be calculated with Kvap

Value

a list with calculated soil hydraulic properties at specified h:

theta

calculated volumetric moisture content

Se

calculated saturation

Scap

effective saturation (of the capillary part if FM is specified

cap

specific water capacity function (of the capillary part if FM is specified

psd

pore size distribution (of the capillary part if FM is specified

Kh

total hydraulic conductivity

if FM specified, additionally:
thetacap

calculated volumetric moisture content of the capillary part

thetanc

calculated volumetric moisture content of the non-capillary part

Snc

effective saturation of the non-capillary part

Kcap

hydraulic conductivity of the capillary

Knc

hydraulic conductivity of the non-capillary

Kvap

isothermal vapour conductivity

Krcap

relative hydraulic conductivity of the capillary

Krnc

relative hydraulic conductivity of the non-capillary

References

Durner.1994spsh Fredlund.1994spsh Kosugi.1996spsh vanGenuchten.1980spsh Weber.2019spsh

Examples

Run this code
# NOT RUN {
 data("shpdata1")
 retdata <- shpdata1$LFH1$wrc[!is.na(shpdata1$LFH1$wrc[,1]),]
 condata <- shpdata1$LFH1$hcc
 
 # assign auxiliary variables
 pF <- seq(-3, 6.8, length = 501)
 h <- 10^pF
 
 # assign list of parameters for the van Genuchten-Mualem model
 parL <- list("p" = c("thr"= 0.05, "ths" = 0.45, "alf1" = 0.01, "n" = 2, "Ks" = 100, "tau" = .5),
              "psel" = c(1, 1, 0, 1, 1, 1),
              "plo" = c(0.001 , 0.2, 0.001, 1.1, 1, -2),
              "pup" = c(0.3, 0.95, 1, 10, 1e4, 10))
 
 # calculate soil hydraulic property function values
 
 shyp.L <- shypFun(parL$p, h, shpmodel = "01110", ivap.query = NULL)
 wrc <- shyp.L$theta
 hcc <- log10(shyp.L$Kh)
 
 # # PLOT THE MEASURED WATER RETENTION CURVE
 ticksatmin <- -2
 tcllen <- 0.4
 ticksat <- seq(ticksatmin,5,1)
 pow <- ticksatmin:6
 
 par(mfrow = c(1,2), tcl = tcllen)
 plot(retdata, ylim = c(.0,.50), xlim = c(0, 6.8), ylab = "", xlab = "",
      col = "darkgrey", axes = FALSE, main = "Water Retention Curve", cex = 2)
 lines(log10(h), wrc, col = "darkblue", lwd = 2)
 legend("topright", c("observed", "simulated"),pch = c(1,NA),
        lty = c(NA,1), lwd = 2, bty = "n", cex = 1.3,col = c("darkgrey", "darkblue"))
 axis(1, at = pow, labels = parse(text = paste('10^',(pow), sep = "")), tcl = tcllen)
 axis(2, tcl = tcllen)
 axis(4, labels = NA)
 axis(3, labels = NA)
 mtext("pressure head |h| [cm]", 1, cex = 1.2, line = 2.8)
 mtext("vol. water content [ - ]", 2, cex = 1.2, line = 2.8)
 box()
 
 # PLOT THE MEASURED HYDRAULIC CONDUCTIVITY CURVE
 plot(condata, ylim = c(-8,2), xlim = c(0, 6.8), ylab = "", xlab = "", col = "darkgrey",
      axes = FALSE, main = "Hydraulic Conductivity Curve", cex = 2)
 lines(log10(h), hcc, col = "darkblue", lwd = 2)
 legend("topright", c("observed", "simulated"), pch = c(1,NA),
        lty = c(NA,1), lwd = 2, bty = "n", cex = 1.3, col = c("darkgrey","darkblue"))
 axis(1, at = pow, labels = parse(text = paste('10^',(pow), sep = "")), tcl = tcllen)
 axis(2)
 axis(4, labels = NA)
 axis(3, labels = NA)
 mtext("log10 K [cm/d]", 2, cex = 1.2, line = 2.8)
 mtext("pressure head |h| [cm]",1 , cex = 1.2, line = 2.8)
 box()
 par(mfrow = c(1,1))
 
 
# }
# NOT RUN {
 # HOW TO WRITE A MATER.IN FOR HYDRUS-1D
 
 mater_out <- cbind(shyp.L[['theta']], h, shyp.L[['Kh']], abs(shyp.L[['cap']]))
 
 materWriteFun <- function(mater_out.L, path = getwd(), sample) {
       
       # Function to write a Mater.in
       
       # ARGUMENTS
       
       # mater_outdata frame of 4 columns of calculated SHP values at h and length n. 
       # 1. Column: THETA
       # 2. Column: H(negative pressure heads)
       # 3. Column: K
       # 4. Column: C(positive)
       # path character specifying the path where the MATER.IN should be saved
       # sample optional chr for sample name: NULL = no name given
       
       n <- dim(mater_out)[1]
       sink(file.path(path, paste(sample, "MATER.IN", sep = "")))
       cat(c("iCap", "\n", "1", "\n", "NTab", "\n", n, "\n"))
       cat(c("\t","THETA", "\t\t\t","H","\t\t\t","K","\t\t\t","C"))
       cat("\n")
       
       write.table(format(mater_out, justify = "right"),
                   row.names = FALSE, col.names = FALSE, quote = FALSE)
       sink()
 }
 
# }

Run the code above in your browser using DataLab