From 9e9619a958d7b88c8135748fcc14f1543223641f Mon Sep 17 00:00:00 2001
From: David <david.dorchies@inrae.fr>
Date: Thu, 5 Dec 2024 03:17:39 +0100
Subject: [PATCH] feat(RunModel_Lag): allow to run it with non SD InputsModel
Especially for Diversion on upstream nodes
Fix #175
---
R/RunModel_Routing.R | 20 +++++++++++---------
1 file changed, 11 insertions(+), 9 deletions(-)
diff --git a/R/RunModel_Routing.R b/R/RunModel_Routing.R
index 461b870..1694e37 100644
--- a/R/RunModel_Routing.R
+++ b/R/RunModel_Routing.R
@@ -40,7 +40,7 @@ RunModel_Lag_enhanced <- function(InputsModel, RunOptions, Param, QcontribDown)
stop("'InputsModel' must be of class 'InputsModel'")
}
if (!inherits(InputsModel, "SD")) {
- stop("'InputsModel' must be of class 'SD'")
+ warning("'InputsModel' may better be of class 'SD'")
}
if (!inherits(RunOptions, "RunOptions")) {
stop("'RunOptions' must be of class 'RunOptions'")
@@ -181,14 +181,16 @@ RunModel_Lag_enhanced <- function(InputsModel, RunOptions, Param, QcontribDown)
}
if ("StateEnd" %in% RunOptions$Outputs_Sim) {
- SD <- lapply(seq(NbUpBasins), function(x) {
- lastTS <- RunOptions$IndPeriod_Run[length(RunOptions$IndPeriod_Run)]
- InputsModel$Qupstream[(lastTS - floor(PT[x])):lastTS, x]
- })
- if (is.null(OutputsModel$StateEnd)) {
- OutputsModel$StateEnd <- list(SD = SD)
- } else {
- OutputsModel$StateEnd$SD <- SD
+ if (NbUpBasins > 0) {
+ SD <- lapply(seq(NbUpBasins), function(x) {
+ lastTS <- RunOptions$IndPeriod_Run[length(RunOptions$IndPeriod_Run)]
+ InputsModel$Qupstream[(lastTS - floor(PT[x])):lastTS, x]
+ })
+ if (is.null(OutputsModel$StateEnd)) {
+ OutputsModel$StateEnd <- list(SD = SD)
+ } else {
+ OutputsModel$StateEnd$SD <- SD
+ }
}
# message("StateEnd: ", paste(OutputsModel$StateEnd$SD, collapse = ", "))
}
--
GitLab