diff --git a/R/CreateInputsModel.GRiwrm.R b/R/CreateInputsModel.GRiwrm.R
index 557ae31009ebe931e61a1c94609bc9bb413625ec..801fd131260d502142be96bfa9c3b954e7c38efb 100644
--- a/R/CreateInputsModel.GRiwrm.R
+++ b/R/CreateInputsModel.GRiwrm.R
@@ -278,11 +278,13 @@ CreateOneGRiwrmInputsModel <- function(id, griwrm, ..., Qobs, Qmin) {
griwrm$area[UpstreamNodeRows],
node$area - sum(griwrm$area[UpstreamNodeRows], na.rm = TRUE)
)
- if (BasinAreas[length(BasinAreas)] < 0) {
- stop(sprintf(
- "Area of the catchment %s must be greater than the sum of the areas of its upstream catchments",
- id
- ))
+ if (!is.na(node$area)) {
+ if (BasinAreas[length(BasinAreas)] < 0) {
+ stop(sprintf(
+ "Area of the catchment %s must be greater than the sum of the areas of its upstream catchments",
+ id
+ ))
+ }
}
names(BasinAreas) <- c(griwrm$id[UpstreamNodeRows], id)
}
diff --git a/R/CreateRunOptions.R b/R/CreateRunOptions.R
index 48dfeca159a60f37504a9142d6577f60f1a61add..e6762391d008c9c850e558160ca951d6ca8f56c7 100644
--- a/R/CreateRunOptions.R
+++ b/R/CreateRunOptions.R
@@ -3,15 +3,22 @@
#' This function can be used either for a catchment (with an \emph{InputsModel} object) or for a network (with a \emph{GRiwrmInputsModel} object)
#'
#' @template param_x
+#' @param InputsModel object of class \emph{InputsModel} (only used to be consistent
+#' with the original [airGR::CreateRunOptions] which has `FUN_MOD` as first
+#' parameter)
+#' see [airGR::CreateInputsModel] for details
#' @param ... arguments passed to [airGR::CreateRunOptions], see details
#'
#' @details See [airGR::CreateRunOptions] documentation for a complete list of arguments.
#'
-#' If `InputsModel` argument is a \emph{GRiwrmInputsModel} object, `IniStates` must be a list of [numeric] object of class \emph{IniStates} with one item per modeled sub-catchment.
+#' If `x` argument is a \emph{GRiwrmInputsModel} object, `IniStates` must be a
+#' list of [numeric] object of class \emph{IniStates} with one item per modeled sub-catchment.
#'
-#' With a \emph{GRiwrmInputsModel} object, all arguments are applied on each sub-catchments of the network.
+#' With a \emph{GRiwrmInputsModel} object, all arguments are applied on each
+#' sub-catchments of the network.
#'
-#' @return Depending on the class of `InputsModel` argument (respectively \emph{InputsModel} and \emph{GRiwrmInputsModel} object), the returned value is respectively:
+#' @return Depending on the class of `InputsModel` argument (respectively
+#' \emph{InputsModel} and \emph{GRiwrmInputsModel} object), the returned value is respectively:
#' - a `RunOptions` object (See [airGR::CreateRunOptions])
#' - a `GRiwrmRunOptions` object which is a [list] of `RunOptions` objects with one item per modeled sub-catchment
#'
@@ -25,28 +32,38 @@ CreateRunOptions <- function(x, ...) {
#' @rdname CreateRunOptions
#' @export
CreateRunOptions.InputsModel <- function(x, ...) {
- if (!exists("FUN_MOD") && !is.null(x$FUN_MOD)) {
- airGR::CreateRunOptions(FUN_MOD = x$FUN_MOD,
- InputsModel = x,
- ...)
- } else {
- airGR::CreateRunOptions(InputsModel = x,
- ...)
+ dots <- list(...)
+ dots$InputsModel <- x
+
+ # Add FUN_MOD in parameters if carried by InputsModel
+ if (!"FUN_MOD" %in% names(dots)) {
+ if(!is.null(x$FUN_MOD)) {
+ dots$FUN_MOD <- x$FUN_MOD
+ } else {
+ stop(" The parameter `FUN_MOD` must be defined")
+ }
+ }
+
+ # Temporary fix waiting for resolution of HYCAR-Hydro/airgr#167
+ if (identical(match.fun(dots$FUN_MOD), RunModel_Lag)) {
+ dots$IniStates <- CreateIniStates(RunModel_Lag, x)
}
+ # End of temporary fix HYCAR-Hydro/airgr#167
+ do.call(airGR::CreateRunOptions, dots)
}
#' @rdname CreateRunOptions
#' @export
-CreateRunOptions.character <- function(x, ...) {
-
- airGR::CreateRunOptions(FUN_MOD = x,
- ...)
+CreateRunOptions.character <- function(x, InputsModel, ...) {
+ CreateRunOptions(x = InputsModel,
+ FUN_MOD = x,
+ ...)
}
#' @rdname CreateRunOptions
#' @export
-CreateRunOptions.function <- function(x, ...) {
-
- airGR::CreateRunOptions(FUN_MOD = x,
- ...)
+CreateRunOptions.function <- function(x, InputsModel, ...) {
+ CreateRunOptions(x = InputsModel,
+ FUN_MOD = x,
+ ...)
}
diff --git a/man/CreateRunOptions.Rd b/man/CreateRunOptions.Rd
index b2765e8075bfaed8408b1a6941a7b60b585e4657..8e860ca9911cfc1f279bcab4fe120da7278660e4 100644
--- a/man/CreateRunOptions.Rd
+++ b/man/CreateRunOptions.Rd
@@ -15,9 +15,9 @@ CreateRunOptions(x, ...)
\method{CreateRunOptions}{InputsModel}(x, ...)
-\method{CreateRunOptions}{character}(x, ...)
+\method{CreateRunOptions}{character}(x, InputsModel, ...)
-\method{CreateRunOptions}{`function`}(x, ...)
+\method{CreateRunOptions}{`function`}(x, InputsModel, ...)
}
\arguments{
\item{x}{For a single catchment, it can be an object of class \emph{InputsModel} or a \link{function} or a \link{character} corresponding to \code{FUN_MOD} (compliant with \strong{airGR} call). For a network, it should be an object of class \emph{GRiwrmInputsModel}. See \link{CreateInputsModel} for details}
@@ -25,9 +25,15 @@ CreateRunOptions(x, ...)
\item{IniStates}{(optional) \link{numeric} object or \link{list} of \link{numeric} object of class \emph{IniStates}, see \link[airGR:CreateIniStates]{airGR::CreateIniStates} for details}
\item{...}{arguments passed to \link[airGR:CreateRunOptions]{airGR::CreateRunOptions}, see details}
+
+\item{InputsModel}{object of class \emph{InputsModel} (only used to be consistent
+with the original \link[airGR:CreateRunOptions]{airGR::CreateRunOptions} which has \code{FUN_MOD} as first
+parameter)
+see \link[airGR:CreateInputsModel]{airGR::CreateInputsModel} for details}
}
\value{
-Depending on the class of \code{InputsModel} argument (respectively \emph{InputsModel} and \emph{GRiwrmInputsModel} object), the returned value is respectively:
+Depending on the class of \code{InputsModel} argument (respectively
+\emph{InputsModel} and \emph{GRiwrmInputsModel} object), the returned value is respectively:
\itemize{
\item a \code{RunOptions} object (See \link[airGR:CreateRunOptions]{airGR::CreateRunOptions})
\item a \code{GRiwrmRunOptions} object which is a \link{list} of \code{RunOptions} objects with one item per modeled sub-catchment
@@ -39,9 +45,11 @@ This function can be used either for a catchment (with an \emph{InputsModel} obj
\details{
See \link[airGR:CreateRunOptions]{airGR::CreateRunOptions} documentation for a complete list of arguments.
-If \code{InputsModel} argument is a \emph{GRiwrmInputsModel} object, \code{IniStates} must be a list of \link{numeric} object of class \emph{IniStates} with one item per modeled sub-catchment.
+If \code{x} argument is a \emph{GRiwrmInputsModel} object, \code{IniStates} must be a
+list of \link{numeric} object of class \emph{IniStates} with one item per modeled sub-catchment.
-With a \emph{GRiwrmInputsModel} object, all arguments are applied on each sub-catchments of the network.
+With a \emph{GRiwrmInputsModel} object, all arguments are applied on each
+sub-catchments of the network.
}
\examples{
###################################################################
diff --git a/tests/testthat/test-RunModel.R b/tests/testthat/test-RunModel.R
index 27868ca43cd226af01dd04738ea3acb5b5afc8bb..cb29c0597a969b24af5e91054b22d9336ece6894 100644
--- a/tests/testthat/test-RunModel.R
+++ b/tests/testthat/test-RunModel.R
@@ -127,3 +127,21 @@ test_that("Huge minimum remaining flow results in Qdiv = 0", {
expect_equal(OM[["54029"]]$Qsim, OM[["54029"]]$Qnat)
expect_equal(OM[["54029"]]$Qdiv_m3, rep(0, length(IndPeriod_Run)))
})
+
+test_that("RunModel_Lag should work", {
+ # This example is a network of 2 nodes which can be describe like this:
+ db <- data.frame(id = c("54095", "DownLag"),
+ length = c(1, NA),
+ down = c("DownLag", NA),
+ area = as.double(c(3722.68, NA)),
+ model = c("RunModel_GR4J", "RunModel_Lag"),
+ stringsAsFactors = FALSE)
+ g <- CreateGRiwrm(db)
+ IM <- CreateInputsModel(g,
+ DatesR = DatesR,
+ Precip = Precip[, "54095", drop = FALSE],
+ PotEvap = PotEvap[, "54095", drop = FALSE])
+ RO <- CreateRunOptions(IM,
+ IndPeriod_Run = IndPeriod_Run,
+ IndPeriod_WarmUp = IndPeriod_WarmUp)
+})