summaryrefslogtreecommitdiff
path: root/CakeModel.R
diff options
context:
space:
mode:
Diffstat (limited to 'CakeModel.R')
-rw-r--r--CakeModel.R42
1 files changed, 24 insertions, 18 deletions
diff --git a/CakeModel.R b/CakeModel.R
index 3a32779..116ef6b 100644
--- a/CakeModel.R
+++ b/CakeModel.R
@@ -4,8 +4,8 @@
# Portions Johannes Ranke, 2010
# Contact: mkin-devel@lists.berlios.de
-# Modifications developed by Tessella for Syngenta: Copyright (C) 2011-2016 Syngenta
-# Tessella Project Reference: 6245, 7247, 8361, 7414
+# Modifications developed by Tessella for Syngenta: Copyright (C) 2011-2020 Syngenta
+# Tessella Project Reference: 6245, 7247, 8361, 7414, 10091
# The CAKE R modules are free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
@@ -22,6 +22,8 @@
CakeModel <- function(..., use_of_ff = "max")
{
+ # While spec is modified throughout this function, topology is added as-is to the returned model
+ topology <- list(...)
spec <- list(...)
obs_vars <- names(spec)
@@ -33,7 +35,7 @@ CakeModel <- function(..., use_of_ff = "max")
parms <- vector()
diffs <- vector()
map <- list()
- nlt = list()
+ nlt <- list()
# Establish list of differential equations
for (varname in obs_vars)
@@ -74,7 +76,7 @@ CakeModel <- function(..., use_of_ff = "max")
ff <- vector()
decline_term <- paste(nonlinear_term, "*", new_boxes[[1]])
} else { # otherwise no decline term needed here
- decline_term = "0"
+ decline_term <- "0"
}
} else {
k_term <- paste("k", new_boxes[[1]], sep="_")
@@ -102,9 +104,9 @@ CakeModel <- function(..., use_of_ff = "max")
# Construct and add DFOP term and add DFOP parameters if needed
if(spec[[varname]]$type == "DFOP") {
- k1_term = paste("k1", varname, sep="_")
- k2_term = paste("k2", varname, sep="_")
- g_term = paste("g", varname, sep="_")
+ k1_term <- paste("k1", varname, sep="_")
+ k2_term <- paste("k2", varname, sep="_")
+ g_term <- paste("g", varname, sep="_")
new_parms <- c(k1_term, k2_term, g_term)
ff <- vector()
@@ -121,7 +123,8 @@ CakeModel <- function(..., use_of_ff = "max")
first_nonlinear_term <- paste(k1_term, new_boxes[[1]], sep=" * ")
second_nonlinear_term <- paste(k2_term, new_boxes[[2]], sep=" * ")
- overall_term_for_formation <- paste("(", g_term, " * ", first_nonlinear_term, " + (1 - ", g_term, ") *", second_nonlinear_term, ")")
+ # CU-150: formation has already been accounted for on the formation into the two sub-compartments; it does not need to be factored in again on the way out
+ overall_term_for_formation <- paste("(", first_nonlinear_term, " + ", second_nonlinear_term, ")")
spec[[varname]]$nlt <- overall_term_for_formation
new_diffs[[1]] <- paste(new_diffs[[1]], "-", first_nonlinear_term)
@@ -177,23 +180,23 @@ CakeModel <- function(..., use_of_ff = "max")
# There is only one output, so no need for any flow fractions. Just add the whole flow from the parent
formation_term <- spec[[varname]]$nlt
} else {
- fraction_to_target = paste("f", varname, "to", target, sep="_")
- fraction_not_to_target = paste("(1 - ", fraction_to_target, ")", sep="")
+ fraction_to_target <- paste("f", varname, "to", target, sep="_")
+ fraction_not_to_target <- paste("(1 - ", fraction_to_target, ")", sep="")
if(is.null(fraction_left)) {
- fraction_really_to_target = fraction_to_target
- fraction_left = fraction_not_to_target
+ fraction_really_to_target <- fraction_to_target
+ fraction_left <- fraction_not_to_target
} else {
# If this is the last output and there is no sink, it gets what's left
if ( target==tail(to,1) && !spec[[varname]]$sink ) {
- fraction_really_to_target = fraction_left
+ fraction_really_to_target <- fraction_left
} else {
- fraction_really_to_target = fraction_to_target
- fraction_left = paste(fraction_left, " - ", fraction_to_target, sep="")
+ fraction_really_to_target <- fraction_to_target
+ fraction_left <- paste(fraction_left, " - ", fraction_to_target, sep="")
}
}
- ff[target] = fraction_really_to_target
+ ff[target] <- fraction_really_to_target
formation_term <- paste(ff[target], "*", spec[[varname]]$nlt)
# Add the flow fraction parameter (if it exists)
@@ -218,9 +221,12 @@ CakeModel <- function(..., use_of_ff = "max")
}
}
- model <- list(diffs = diffs, parms = parms, map = map, use_of_ff = use_of_ff)
+ model <- list(diffs = diffs, parms = parms, map = map, use_of_ff = use_of_ff, topology = topology)
- if (exists("ff")) model$ff = ff
+ if (exists("ff")) {
+ model$ff <- ff
+ }
+
class(model) <- "mkinmod"
invisible(model)
}

Contact - Imprint