diff --git a/R/RunModel.R b/R/RunModel.R
index 1a6104d15fcceaa8195dc3944923d7110ace56dc..eb63f41e6cd2d1f2f3812358aff9aa67e31760ea 100644
--- a/R/RunModel.R
+++ b/R/RunModel.R
@@ -1,7 +1,7 @@
RunModel <- function(InputsModel, RunOptions, Param, FUN_MOD) {
-
+
FUN_MOD <- match.fun(FUN_MOD)
-
+
if (inherits(InputsModel, "SD")) {
# Lag model take one parameter at the beginning of the vector
iFirstParamRunOffModel <- 2
@@ -9,13 +9,12 @@ RunModel <- function(InputsModel, RunOptions, Param, FUN_MOD) {
# All parameters
iFirstParamRunOffModel <- 1
}
-
+
OutputsModel <- FUN_MOD(InputsModel = InputsModel, RunOptions = RunOptions,
Param = Param[iFirstParamRunOffModel:length(Param)])
-
+
if (inherits(InputsModel, "SD")) {
- InputsModel$OutputsModel <- OutputsModel
- OutputsModel <- RunModel_Lag(InputsModel, RunOptions, Param[1])
+ OutputsModel <- RunModel_Lag(InputsModel, RunOptions, Param[1], OutputsModel)
}
return(OutputsModel)
-}
\ No newline at end of file
+}
diff --git a/R/RunModel_Lag.R b/R/RunModel_Lag.R
index f1ed6a2cd40bdd147d852b25b62a3a52f53eb01a..b7f4398897b991ff7cb54980f12aad0f930ef98f 100644
--- a/R/RunModel_Lag.R
+++ b/R/RunModel_Lag.R
@@ -1,4 +1,4 @@
-RunModel_Lag <- function(InputsModel, RunOptions, Param) {
+RunModel_Lag <- function(InputsModel, RunOptions, Param, QcontribDown) {
NParam <- 1
##Arguments_check
@@ -17,19 +17,23 @@ RunModel_Lag <- function(InputsModel, RunOptions, Param) {
if (sum(!is.na(Param)) != NParam) {
stop(paste("'Param' must be a vector of length", NParam, "and contain no NA"))
}
- if (is.null(InputsModel$OutputsModel)) {
- stop("'InputsModel' should contain an 'OutputsModel' key containing the output of the runoff of the downstream subcatchment")
- }
- if (is.null(InputsModel$OutputsModel$Qsim)) {
- stop("'InputsModel$OutputsModel' should contain a key 'Qsim' containing the output of the runoff of the downstream subcatchment")
+ if (inherits(QcontribDown, "OutputsModel")) {
+ if (is.null(QcontribDown$Qsim)) {
+ stop("'QcontribDown' should contain a key 'Qsim' containing the output of the runoff of the downstream subcatchment")
+ }
+ OutputsModel <- QcontribDown
+ OutputsModel$QsimDown <- OutputsModel$Qsim
+ } else if (is.vector(QcontribDown) && is.numeric(QcontribDown)) {
+ OutputsModel <- list()
+ class(OutputsModel) <- c("OutputsModel", class(OutputsModel))
+ OutputsModel$QsimDown <- QcontribDown
+ } else {
+ stop("'QcontribDown' must be a numeric vector or a 'OutputsModel' object")
}
- if (sum(!is.na(InputsModel$OutputsModel$Qsim)) != length(RunOptions$IndPeriod_Run)) {
- stop("'InputsModel$OutputsModel$Qim' should have the same lenght as 'RunOptions$IndPeriod_Run' and contain no NA")
+ if (length(OutputsModel$QsimDown) != length(RunOptions$IndPeriod_Run)) {
+ stop("Time series in 'QcontribDown' should have the same lenght as 'RunOptions$IndPeriod_Run'")
}
- OutputsModel <- InputsModel$OutputsModel
- OutputsModel$QsimDown <- OutputsModel$Qsim
-
if (inherits(InputsModel, "hourly")) {
TimeStep <- 60 * 60
} else if (inherits(InputsModel, "daily")) {
diff --git a/man/RunModel_Lag.Rd b/man/RunModel_Lag.Rd
index b37487679c2734efdddda7f066a4ad9133e07cff..5819f083a7c52e5ba3a6587db83c63daf64252a9 100644
--- a/man/RunModel_Lag.Rd
+++ b/man/RunModel_Lag.Rd
@@ -14,26 +14,29 @@ Function which performs a single run for the Lag model over the test period.
\usage{
-RunModel_Lag(InputsModel, RunOptions, Param)
+RunModel_Lag(InputsModel, RunOptions, Param, QcontribDown)
}
\arguments{
-\item{InputsModel}{[object of class \emph{InputsModel}] created with SD model inputs, see \code{\link{CreateInputsModel}} for details. The object should also contain a key \emph{OutputsModel} of class \code{\link{CreateInputsModel}} coming from the simulation of the downstream subcatchment runoff.}
+ \item{InputsModel}{[object of class \emph{InputsModel}] created with SD model inputs, see \code{\link{CreateInputsModel}} for details. The object should also contain a key \emph{OutputsModel} of class \code{\link{CreateInputsModel}} coming from the simulation of the downstream subcatchment runoff.}
-\item{RunOptions}{[object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details}
+ \item{RunOptions}{[object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details}
+
+ \item{Param}{[numeric] vector of 1 parameter
+ \tabular{ll}{
+ Velocity \tab Mean flow velocity [m/s]
+ }
+ }
+ \item{QcontribDown}{[numeric] vector or [OutputsModel] containing the time series of the runoff contribution of the downstream sub-basin}
-\item{Param}{[numeric] vector of 1 parameter
- \tabular{ll}{
- Velocity \tab Mean flow velocity [m/s]
- }}
}
\value{
[list] see \code{\link{RunModel_GR4J}} or \code{\link{RunModel_CemaNeigeGR4J}} for details.
-The list value contains an extra item named \code{QsimDown} which is a copy of \code{InputsModel$OutputsModel$Qsim}, a numeric series of simulated discharge [mm/time step] related to the runoff contribution of the downstream sub-catchment.
+The list value contains an extra item named \code{QsimDown} which is a copy of the runoff contribution of the downstream sub-basin contained in argument \code{QcontribDown} in [mm/time step].
}
@@ -88,12 +91,11 @@ OutputsModelDown <- RunModel_GR4J(InputsModel = InputsModel,
## with a delay of 2 days for 150 km, the flow velocity is 75 km per day
Velocity <- (LengthHydro * 1e3 / 2) / (24 * 60 * 60) ## Conversion km/day -> m/s
-## add the output of the precipitation-runoff model in the InputsModel object
-InputsModel$OutputsModel <- OutputsModelDown
-
## run the lag model which routes precipitation-runoff model and upstream flows
OutputsModel <- RunModel_Lag(InputsModel = InputsModel,
- RunOptions = RunOptions, Param = Velocity)
+ RunOptions = RunOptions,
+ Param = Velocity,
+ QcontribDown = OutputsModelDown)
## results preview of comparison between naturalised (observed) and influenced flow (simulated)
plot(OutputsModel, Qobs = OutputsModel$QsimDown)
diff --git a/tests/testthat/test-RunModel_Lag.R b/tests/testthat/test-RunModel_Lag.R
index 0432fa091351418eaa4bfeee93a906dd805183f6..924b02ac07d913787a33d9b9ce416da4b59ef61f 100644
--- a/tests/testthat/test-RunModel_Lag.R
+++ b/tests/testthat/test-RunModel_Lag.R
@@ -39,10 +39,19 @@ RunOptions <- suppressWarnings(CreateRunOptions(FUN_MOD = RunModel_GR4J,
InputsModel = InputsModel,
IndPeriod_Run = Ind_Run))
-test_that("InputsModel parameter should contain an OutputsModel key", {
+test_that("QcontribDown parameter should be a numeric vector or an OutputModel object", {
+ regexp = "'QcontribDown' must be a numeric vector or a 'OutputsModel' object"
expect_error(
- RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1),
- regexp = "'InputsModel' should contain an 'OutputsModel' key"
+ RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1, QcontribDown = "A"),
+ regexp = regexp
+ )
+ expect_error(
+ RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1, QcontribDown = NULL),
+ regexp = regexp
+ )
+ expect_error(
+ RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1, QcontribDown = matrix(1, ncol = 1)),
+ regexp = regexp
)
})
@@ -52,33 +61,24 @@ OutputsGR4JOnly <- RunModel_GR4J(InputsModel = InputsModel,
RunOptions = RunOptions,
Param = Param)
-test_that("InputsModel$OutputsModel should contain a Qsim key", {
- InputsModel$OutputsModel <- OutputsGR4JOnly
- InputsModel$OutputsModel$Qsim <- NULL
+test_that("QcontribDown should contain a Qsim key", {
+ QcontribDown <- OutputsGR4JOnly
+ QcontribDown$Qsim <- NULL
expect_error(
- RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1),
+ RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1, QcontribDown = QcontribDown),
regexp = "should contain a key 'Qsim'"
)
})
-test_that("'InputsModel$OutputsModel$Qim' should have the same lenght as 'RunOptions$IndPeriod_Run'", {
- InputsModel$OutputsModel <- OutputsGR4JOnly
- InputsModel$OutputsModel$Qsim <- c(InputsModel$OutputsModel$Qsim, 0)
+test_that("'QcontribDown$Qim' should have the same lenght as 'RunOptions$IndPeriod_Run'", {
+ QcontribDown <- OutputsGR4JOnly
+ QcontribDown$Qsim <- c(QcontribDown$Qsim, 0)
expect_error(
- RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1),
+ RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1, QcontribDown = QcontribDown),
regexp = "should have the same lenght as"
)
})
-test_that("'InputsModel$OutputsModel$Qsim' should contain no NA'", {
- InputsModel$OutputsModel <- OutputsGR4JOnly
- InputsModel$OutputsModel$Qsim[10L] <- NA
- expect_error(
- RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1),
- regexp = "contain no NA"
- )
-})
-
test_that("'Qupstream' contain NA values", {
expect_warning(
InputsModel <- CreateInputsModel(
@@ -96,16 +96,16 @@ test_that("'Qupstream' contain NA values", {
RunOptions <- suppressWarnings(CreateRunOptions(FUN_MOD = RunModel_GR4J,
InputsModel = InputsModel,
IndPeriod_Run = Ind_Run))
- InputsModel$OutputsModel <- OutputsGR4JOnly
+ QcontribDown <- OutputsGR4JOnly
# Warning with RunModel
expect_warning(
- RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1),
+ RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1, QcontribDown = QcontribDown),
regexp = "time steps with NA values"
)
# No warning during calibration
RunOptions$Outputs_Sim <- RunOptions$Outputs_Cal
expect_warning(
- RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1),
+ RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1, QcontribDown = QcontribDown),
regexp = NA
)
})