Skip to content
Snippets Groups Projects

Compare revisions

Changes are shown as if the source revision was being merged into the target revision. Learn more about comparing revisions.

Source

Select target project
No results found

Target

Select target project
  • delucia/RedModRphree
1 result
Show changes
Commits on Source (3)
...@@ -18,5 +18,5 @@ Depends: R (>= 4.0), doParallel, phreeqc, mgcv, graphics, methods, stats, utils, ...@@ -18,5 +18,5 @@ Depends: R (>= 4.0), doParallel, phreeqc, mgcv, graphics, methods, stats, utils,
Suggests: RcppBTCS Suggests: RcppBTCS
License: LGPL-2.1 License: LGPL-2.1
Encoding: UTF-8 Encoding: UTF-8
RoxygenNote: 7.2.0 RoxygenNote: 7.2.1
LazyData: true LazyData: true
## Functions for RT simulations using through RcppBTCS's diffusion ## Functions for RT simulations using through RcppBTCS's diffusion
### Marco De Lucia, delucia@gfz-potsdam.de, 2009-2022 ### Marco De Lucia, delucia@gfz-potsdam.de, 2009-2022
### Time-stamp: "Last modified 2022-08-09 15:15:37 delucia" ### Time-stamp: "Last modified 2022-10-04 17:24:58 delucia"
##' This function is somehow equivalent to ##' This function is somehow equivalent to
##' \code{phreeqc::phrGetSelectedOutput} but it won't call ##' \code{phreeqc::phrGetSelectedOutput} but it won't call
...@@ -60,7 +60,7 @@ DiffRT <- function(setup, init, maxtime, ...@@ -60,7 +60,7 @@ DiffRT <- function(setup, init, maxtime,
maxsim=1, ebreak=FALSE, maxsim=1, ebreak=FALSE,
scheme="FTCS") { scheme="FTCS") {
require(RcppBTCS) require(RcppTUG)
attach(setup) attach(setup)
on.exit({ on.exit({
...@@ -347,14 +347,16 @@ DiffusionScheme <- function(conc, inflow, dx, dt, alpha, scheme, transported) { ...@@ -347,14 +347,16 @@ DiffusionScheme <- function(conc, inflow, dx, dt, alpha, scheme, transported) {
cnew <- data.matrix(conc) cnew <- data.matrix(conc)
if (scheme=="FTCS") { if (scheme=="FTCS") {
for (sp in totrans) { for (sp in totrans) {
tmp <- as.numeric(c(inflow[sp], cnew[, sp])) tmp <- as.numeric(conc[, sp])
cnew[,sp] <- FTCS(tmp, dx, dt, alpha) cnew[,sp] <- FTCS(tmp, dx, dt, alpha, bc_left=inflow[sp])
} }
} else { } else {
## msg("Diffusing totrans=", paste(totrans, collapse = "; "))
for (sp in totrans) { for (sp in totrans) {
## msg("Diffusing names(inflow[sp])", names(inflow[sp])) ## msg("Diffusing names(inflow[sp])", names(inflow[sp]), "bc_left=", inflow[sp])
tmp <- as.numeric(c(inflow[sp], cnew[, sp])) ## msg("Colnames(cnew)=", paste(colnames(cnew), collapse = "; "))
cnew[,sp] <- BTCS(tmp, dx, dt, alpha) ## msg("sp=", sp)
cnew[,sp] <- as.numeric(BTCS(as.numeric(conc[, sp]), dx, dt, alpha, bc_left=inflow[sp]))
} }
} }
...@@ -365,11 +367,10 @@ DiffusionScheme <- function(conc, inflow, dx, dt, alpha, scheme, transported) { ...@@ -365,11 +367,10 @@ DiffusionScheme <- function(conc, inflow, dx, dt, alpha, scheme, transported) {
return(cnew) return(cnew)
} else { } else {
cj <- c(inflow,conc)
if (scheme=="FTCS") { if (scheme=="FTCS") {
cnew <- FTCS(cj, dx, dt, alpha) cnew <- FTCS(conc, dx, dt, alpha, bc_left=inflow)
} else { } else {
cnew <- BTCS(cj, dx, dt, alpha) cnew <- BTCS(conc, dx, dt, alpha, bc_left=inflow)
} }
if (typeof(cnew)!="double") { if (typeof(cnew)!="double") {
msg("cnew is not double") msg("cnew is not double")
...@@ -380,44 +381,48 @@ DiffusionScheme <- function(conc, inflow, dx, dt, alpha, scheme, transported) { ...@@ -380,44 +381,48 @@ DiffusionScheme <- function(conc, inflow, dx, dt, alpha, scheme, transported) {
} }
##' @title Call \code{RcppBTCS::BTCS1D()} ##' @title Call \code{RcppTUG::run1D()}
##' @param field NumericVector of length n+1 with Dirichlet boundary ##' @param field NumericVector of length n
##' conditions prepended
##' @param dx the grid spacing in m ##' @param dx the grid spacing in m
##' @param dt the required time step in s ##' @param dt the required time step in s
##' @param alpha diffusion coefficient in m^2/s (constant, ##' @param alpha diffusion coefficient in m^2/s (constant,
##' homogeneous) ##' homogeneous)
##' @param bc_left Dirichlet boundary condition at the left inlet
##' @return updated concentration vector ##' @return updated concentration vector
##' @author MDL ##' @author MDL
##' @export ##' @export
BTCS <- function(field, dx, dt, alpha) { BTCS <- function(field, dx, dt, alpha, bc_left) {
require(RcppBTCS) require(RcppTUG)
n <- length(field)-1 ## msg("length(field):", length(field))
RcppBTCS::BTCS1D(count_x=n, ## msg("dim(field):", dim(field))
grid_size_x=dx*n, n <- length(field)
field=field[-1], RcppTUG::run1D(field=field,
alpha=alpha, alpha=alpha,
dt = dt, dt=dt,
dt_divide=1, iter=1,
bc_left = field[1], dt_divide = 1,
bc_right= -1) size_x = dx*n,
left = bc_left,
right = -1,
thomas = TRUE)[[1]]
} }
##' @title Call \code{RcppBTCS::RcppFTCS()} ##' @title Call \code{RcppTUG::RcppFTCS()}
##' @param field NumericVector of length n+1 with Dirichlet boundary ##' @param field NumericVector of length n
##' conditions prepended
##' @param dx the grid spacing in m ##' @param dx the grid spacing in m
##' @param dt the required time step in s ##' @param dt the required time step in s
##' @param alpha diffusion coefficient in m^2/s (constant, ##' @param alpha diffusion coefficient in m^2/s (constant,
##' homogeneous) ##' homogeneous)
##' @param bc_left Dirichlet boundary conditions at the left inlet
##' @return updated concentration vector ##' @return updated concentration vector
##' @author MDL ##' @author MDL
##' @export ##' @export
FTCS <- function(field, dx, dt, alpha) { FTCS <- function(field, dx, dt, alpha, bc_left) {
require(RcppBTCS) require(RcppTUG)
RcppBTCS::RcppFTCS(n=length(field)-1, length=1, field_size <- length(field)*dx
field=field[-1], alpha=alpha, RcppTUG::RcppFTCS(n=length(field), length=field_size,
bc_left = field[1], timestep = dt) field=field, alpha=alpha,
bc_left = bc_left, timestep = dt)
} }
##' @title Run a PHREEQC input and retrieve the DUMP ##' @title Run a PHREEQC input and retrieve the DUMP
......
...@@ -2,13 +2,12 @@ ...@@ -2,13 +2,12 @@
% Please edit documentation in R/Rphree_Diffusion.R % Please edit documentation in R/Rphree_Diffusion.R
\name{BTCS} \name{BTCS}
\alias{BTCS} \alias{BTCS}
\title{Call \code{RcppBTCS::BTCS1D()}} \title{Call \code{RcppTUG::run1D()}}
\usage{ \usage{
BTCS(field, dx, dt, alpha) BTCS(field, dx, dt, alpha, bc_left)
} }
\arguments{ \arguments{
\item{field}{NumericVector of length n+1 with Dirichlet boundary \item{field}{NumericVector of length n}
conditions prepended}
\item{dx}{the grid spacing in m} \item{dx}{the grid spacing in m}
...@@ -16,12 +15,14 @@ conditions prepended} ...@@ -16,12 +15,14 @@ conditions prepended}
\item{alpha}{diffusion coefficient in m^2/s (constant, \item{alpha}{diffusion coefficient in m^2/s (constant,
homogeneous)} homogeneous)}
\item{bc_left}{Dirichlet boundary condition at the left inlet}
} }
\value{ \value{
updated concentration vector updated concentration vector
} }
\description{ \description{
Call \code{RcppBTCS::BTCS1D()} Call \code{RcppTUG::run1D()}
} }
\author{ \author{
MDL MDL
......
...@@ -2,13 +2,12 @@ ...@@ -2,13 +2,12 @@
% Please edit documentation in R/Rphree_Diffusion.R % Please edit documentation in R/Rphree_Diffusion.R
\name{FTCS} \name{FTCS}
\alias{FTCS} \alias{FTCS}
\title{Call \code{RcppBTCS::RcppFTCS()}} \title{Call \code{RcppTUG::RcppFTCS()}}
\usage{ \usage{
FTCS(field, dx, dt, alpha) FTCS(field, dx, dt, alpha, bc_left)
} }
\arguments{ \arguments{
\item{field}{NumericVector of length n+1 with Dirichlet boundary \item{field}{NumericVector of length n}
conditions prepended}
\item{dx}{the grid spacing in m} \item{dx}{the grid spacing in m}
...@@ -16,12 +15,14 @@ conditions prepended} ...@@ -16,12 +15,14 @@ conditions prepended}
\item{alpha}{diffusion coefficient in m^2/s (constant, \item{alpha}{diffusion coefficient in m^2/s (constant,
homogeneous)} homogeneous)}
\item{bc_left}{Dirichlet boundary conditions at the left inlet}
} }
\value{ \value{
updated concentration vector updated concentration vector
} }
\description{ \description{
Call \code{RcppBTCS::RcppFTCS()} Call \code{RcppTUG::RcppFTCS()}
} }
\author{ \author{
MDL MDL
......