From 67e9f6968a5e4f61e42d27d8d9771033f7a2664b Mon Sep 17 00:00:00 2001
From: David <david.dorchies@inrae.fr>
Date: Tue, 2 Apr 2024 16:11:40 +0200
Subject: [PATCH] refactor: use RunModel.SD both for RunModel_Reservoir and
 RunModel.Supervision

Refs #144
---
 R/RunModel.InputsModel.R | 11 +----------
 R/RunModel.SD.R          | 34 ++++++++++++++++++++++------------
 R/RunModel.Supervisor.R  | 12 ++++++++----
 R/RunModel_Reservoir.R   |  4 +++-
 4 files changed, 34 insertions(+), 27 deletions(-)

diff --git a/R/RunModel.InputsModel.R b/R/RunModel.InputsModel.R
index 7bd17b6..17f2907 100644
--- a/R/RunModel.InputsModel.R
+++ b/R/RunModel.InputsModel.R
@@ -46,16 +46,7 @@ RunModel.InputsModel <- function(x = NULL,
 
   FUN_MOD <- match.fun(FUN_MOD)
   if (identical(FUN_MOD, RunModel_Lag)) {
-    QcontribDown <- list(
-      RunOptions = list(
-        WarmUpQsim = rep(0, length(RunOptions$IndPeriod_WarmUp))
-      ),
-      Qsim = rep(0, length(RunOptions$IndPeriod_Run))
-    )
-    class(QcontribDown) <- c("OutputsModel", class(RunOptions)[-1])
-    x$BasinAreas[length(x$BasinAreas)] <- 1
-    OutputsModel <- RunModel_Lag(x, RunOptions, Param, QcontribDown)
-    OutputsModel$DatesR <- x$DatesR[RunOptions$IndPeriod_Run]
+    OutputsModel <- RunModel.SD(x, RunOptions, Param)
   } else if ((inherits(x, "GR") & is.null(x$UpstreamNodes)) | identical(FUN_MOD, RunModel_Reservoir)) {
     # Upstream basins and Reservoir are launch directly
     OutputsModel <- FUN_MOD(x, RunOptions, Param)
diff --git a/R/RunModel.SD.R b/R/RunModel.SD.R
index 3abfc89..05bd21f 100644
--- a/R/RunModel.SD.R
+++ b/R/RunModel.SD.R
@@ -7,19 +7,29 @@
 #' @return `OutputsModel` object. See [airGR::RunModel_Lag]
 #' @noRd
 #'
-RunModel.SD <- function(x, RunOptions, Param, QcontribDown, ...) {
-  if (x$isReservoir) {
-    OutputsModel <- RunModel_Reservoir(x,
-                                       RunOptions = RunOptions,
-                                       Param = Param[1:2])
-  } else {
-    OutputsModel <- airGR::RunModel_Lag(x,
-                                        RunOptions = RunOptions,
-                                        Param = Param[1],
-                                        QcontribDown = QcontribDown)
-    OutputsModel <- calcOverAbstraction(OutputsModel, FALSE)
-    OutputsModel$RunOptions <- calcOverAbstraction(OutputsModel$RunOptions, TRUE)
+RunModel.SD <- function(x, RunOptions, Param, QcontribDown = NULL, ...) {
+  if (is.null(QcontribDown)) {
+    QcontribDown <- list(
+      RunOptions = list(
+        WarmUpQsim = rep(0, length(RunOptions$IndPeriod_WarmUp))
+      ),
+      Qsim = rep(0, length(RunOptions$IndPeriod_Run))
+    )
+    class(QcontribDown) <- c("OutputsModel", class(RunOptions)[-1])
+    x$BasinAreas[length(x$BasinAreas)] <- 1E-6
   }
+  OutputsModel <- airGR::RunModel_Lag(x,
+                                      RunOptions = RunOptions,
+                                      Param = Param[1],
+                                      QcontribDown = QcontribDown)
+  OutputsModel$DatesR <- x$DatesR[RunOptions$IndPeriod_Run]
+  if ("WarmUpQsim" %in% RunOptions$Outputs_Sim) {
+    OutputsModel$RunOptions$WarmUpQsim_m3 <-
+      OutputsModel$RunOptions$WarmUpQsim * sum(x$BasinAreas, na.rm = TRUE) * 1e3
+  }
+  OutputsModel <- calcOverAbstraction(OutputsModel, FALSE)
+  OutputsModel$RunOptions <- calcOverAbstraction(OutputsModel$RunOptions, TRUE)
+
   OutputsModel$RunOptions$TimeStep <- RunOptions$FeatFUN_MOD$TimeStep
   return(OutputsModel)
 }
diff --git a/R/RunModel.Supervisor.R b/R/RunModel.Supervisor.R
index a29c2e9..7479a10 100644
--- a/R/RunModel.Supervisor.R
+++ b/R/RunModel.Supervisor.R
@@ -106,16 +106,20 @@ RunModel.Supervisor <- function(x, RunOptions, Param, ...) {
       # Run model for the sub-basin and one time step
       RunOptions[[id]]$IniStates <- serializeIniStates(x$OutputsModel[[id]]$StateEnd)
       RunOptions[[id]]$IndPeriod_Run <- iTS
-      if (RunOptions[[id]]$FeatFUN_MOD$IsSD) {
-        # Route upstream flows for SD nodes
+      # Route upstream flows for SD nodes
+      if (x$InputsModel[[id]]$isReservoir) {
+        x$OutputsModel[[id]] <- RunModel_Reservoir(
+          x$InputsModel[[id]],
+          RunOptions = RunOptions[[id]],
+          Param = Param[[id]]
+        )
+      } else {
         x$OutputsModel[[id]] <- RunModel.SD(
           x$InputsModel[[id]],
           RunOptions = RunOptions[[id]],
           Param = Param[[id]],
           QcontribDown = x$storedOutputs$QcontribDown[x$ts.index, id]
         )
-      } else {
-        x$OutputsModel[[id]]$Qsim_m3 <- x$storedOutputs$Qsim_m3[x$ts.index, id]
       }
       if (x$InputsModel[[id]]$hasDiversion) {
         # Compute diverted and simulated flows on Diversion nodes
diff --git a/R/RunModel_Reservoir.R b/R/RunModel_Reservoir.R
index 8cbc6c7..1d4e0e5 100644
--- a/R/RunModel_Reservoir.R
+++ b/R/RunModel_Reservoir.R
@@ -51,7 +51,9 @@ RunModel_Reservoir <- function(InputsModel, RunOptions, Param) {
   celerity <- Param[2]
 
   # Compute inflows with RunModel_Lag
-  OutputsModel <- RunModel(InputsModel, RunOptions, celerity, FUN_MOD = "RunModel_Lag")
+  OutputsModel <- RunModel.SD(InputsModel,
+                              RunOptions,
+                              Param = celerity)
   names(OutputsModel)[names(OutputsModel) == "Qsim_m3"] <- "Qinflows_m3"
   Qinflows_m3 <- c(OutputsModel$RunOptions$WarmUpQsim_m3,
                    OutputsModel$Qinflows_m3)
-- 
GitLab