# 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