Resolve "RunModel: Uncoupling of hydrological and hydraulic models"

Closes #28 (closed)

.Rbuildignore

-^griwrm\.Rproj$
+^airGRiwrm\.Rproj$
 ^\.Rproj\.user$
 ^LICENSE\.md$
 ^\.gitlab-ci\.yml$

DESCRIPTION

@@ -11,7 +11,7 @@ License: AGPL-3
 Encoding: UTF-8
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.1.0
+RoxygenNote: 7.1.1
 Imports:
     dplyr,
     utils,

R/DiagramGRiwrm.R

@@ -23,7 +23,7 @@ DiagramGRiwrm <- function(griwrm, display = TRUE, orientation = "LR") {
   if(Sys.getenv("RSTUDIO") != "1") {
     return()
   }
-  if(!"DiagrammeR" %in% rownames(installed.packages())) {
+  if(!"DiagrammeR" %in% rownames(utils::installed.packages())) {
     stop("The 'DiagrammeR' package should be installed. Type: install.packages('DiagrammeR')")
   }
   g2 <- griwrm[!is.na(griwrm$down),]

R/RunModel.GR.R

+#' Run rainfall-runoff part of a sub-basin model
+#'
+#' @inherit airGR::RunModel
+#' @param ... further arguments passed to or from other methods
+#'
+#' @export
+#'
+RunModel.GR <- function(InputsModel, RunOptions, Param, ...) {
+
+  if (inherits(InputsModel, "SD")) {
+    # Lag model take one parameter at the beginning of the vector
+    iFirstParamRunOffModel <- 2
+  } else {
+    # All parameters
+    iFirstParamRunOffModel <- 1
+  }
+
+  FUN_MOD <- match.fun(InputsModel$FUN_MOD)
+  FUN_MOD(InputsModel = InputsModel, RunOptions = RunOptions,
+          Param = Param[iFirstParamRunOffModel:length(Param)])
+}

R/RunModel.GRiwrmInputsModel.R

-#' Title
+#' RunModel function for GRiwrmInputsModel object
 #'
 #' @param InputsModel object of class \emph{GRiwrmInputsModel}, see \code{[CreateInputsModel.GRiwrm]} for details.
 #' @param RunOptions object of class \emph{GRiwrmRunOptions}, see \code{[CreateRunOptions.GRiwrm]} for details.
@@ -9,22 +9,30 @@
 #' @export
 RunModel.GRiwrmInputsModel <- function(InputsModel, RunOptions, Param, ...) {
 
-  OutputsModel <- list()
+  # Run runoff model for each sub-basin
+  OutputsModel <- lapply(X = InputsModel, FUN = function(IM) {
+    RunModel.GR(InputsModel = IM,
+                RunOptions = RunOptions[[IM$id]],
+                Param = Param[[IM$id]])
+    })
   class(OutputsModel) <- append(class(OutputsModel), "GRiwrmOutputsModel")
 
-  for(IM in InputsModel) {
-    message("RunModel.GRiwrmInputsModel: Treating sub-basin ", IM$id, "...")
+  # Loop over sub-basin using SD model
+  for(id in getSD_Ids(InputsModel)) {
+    IM <- InputsModel[[id]]
+    message("RunModel.GRiwrmInputsModel: Treating sub-basin ", id, "...")
 
     # Update InputsModel$Qupstream with simulated upstream flows
     if(any(IM$UpstreamIsRunoff)) {
-      IM <- UpdateQsimUpstream(IM, RunOptions[[IM$id]]$IndPeriod_Run, OutputsModel)
+      IM <- UpdateQsimUpstream(IM, RunOptions[[id]]$IndPeriod_Run, OutputsModel)
     }
 
-    # Run the model for the sub-basin
-    OutputsModel[[IM$id]] <- RunModel(
+    # Run the SD model for the sub-basin
+    OutputsModel[[id]] <- RunModel.SD(
       InputsModel = IM,
-      RunOptions = RunOptions[[IM$id]],
-      Param = Param[[IM$id]]
+      RunOptions = RunOptions[[id]],
+      Param = Param[[id]],
+      OutputsModel[[id]]
     )
 
   }