feat: Computation of over abstracted volumes

Refs #144

R/RunModel.InputsModel.R

@@ -2,7 +2,12 @@
 #'
 #' @details This function calls [airGR::RunModel] (See [airGR::RunModel] for further details).
 #'
-#' The list produced by the function (See Value section of [airGR::RunModel_GR4J]) is here completed by an item *$Qsim_m3* storing the simulated discharge series in m3/s.
+#' The list produced by the function (See Value section of [airGR::RunModel_GR4J])
+#' is here completed by:
+#'
+#' - an item `$Qsim_m3` storing the simulated discharge series in m3/s
+#' - an item `$Qover_m3` storing the volumes of over abstraction which occurs
+#' when `RunModel_Lag` warns for negative simulated flows.
 #'
 #' @inheritParams airGR::RunModel
 #' @param x \[object of class \emph{InputsModel}\] see [airGR::CreateInputsModel] for details
@@ -73,6 +78,8 @@ RunModel.InputsModel <- function(x = NULL,
   if (x$hasDiversion && !x$isReservoir) {
     OutputsModel <- RunModel_Diversion(x, RunOptions, OutputsModel)
   }
+  OutputsModel <- calcOverAbstraction(OutputsModel, FALSE)
+  OutputsModel$RunOptions <- calcOverAbstraction(OutputsModel$RunOptions, TRUE)
   return(OutputsModel)
 }
 
@@ -135,3 +142,27 @@ calc_Qdiv<- function(Qnat, Qdiv, Qmin) {
   }
   return(list(Qsim = Qsim, Qdiv = Qnat - Qsim))
 }
+
+
+#' Cap negative `OutputsModel$Qsim_m3` to zero and fill `OutputsModel$Qover_m3`
+#' with over-abstracted volumes
+#'
+#' @param O Either `OutputsModel` or `OutputsModel$RunOptions` (for warm-up Qsim)
+#' @param WarmUp `TRUE` if `O` is `OutputsModel$RunOptions`
+#'
+#' @return Modified `OutputsModel` or `OutputsModel$RunOptions`
+#' @noRd
+#'
+calcOverAbstraction <- function(O, WarmUp) {
+  f <- list(sim = "Qsim_m3", over = "Qover_m3")
+  if(WarmUp) {
+    f <- lapply(f, function(x) paste0("WarmUp", x))
+  }
+  if (any(O[[f$sim]] < 0)) {
+    O[[f$over]] <- rep(0, length(O[[f$sim]]))
+    O[[f$over]][O[[f$sim]] < 0] <- - O[[f$sim]][O[[f$sim]] < 0]
+    O[[f$sim]][O[[f$sim]] < 0] <- 0
+  }
+  return(O)
+}
+

man/RunModel.InputsModel.Rd

@@ -30,5 +30,11 @@ Wrapper for \link[airGR:RunModel]{airGR::RunModel} for one sub-basin
 \details{
 This function calls \link[airGR:RunModel]{airGR::RunModel} (See \link[airGR:RunModel]{airGR::RunModel} for further details).
 
-The list produced by the function (See Value section of \link[airGR:RunModel_GR4J]{airGR::RunModel_GR4J}) is here completed by an item \emph{$Qsim_m3} storing the simulated discharge series in m3/s.
+The list produced by the function (See Value section of \link[airGR:RunModel_GR4J]{airGR::RunModel_GR4J})
+is here completed by:
+\itemize{
+\item an item \verb{$Qsim_m3} storing the simulated discharge series in m3/s
+\item an item \verb{$Qover_m3} storing the volumes of over abstraction which occurs
+when \code{RunModel_Lag} warns for negative simulated flows.
+}
 }

tests/testthat/test-RunModel.R

@@ -246,3 +246,19 @@ test_that("A transparent upstream node with area=NA should return same result #1
   names(OM[["54001"]]$StateEnd$SD[[1]]) <- "54095" # For matching upstream IDs with ref
   expect_equal(OM[["54001"]], OM_GriwrmInputs[["54001"]])
 })
+
+test_that("RunModel should return water deficit (Qover_m3)", {
+  nodes <- loadSevernNodes()
+  nodes <- nodes[nodes$id %in% c("54095", "54001"), ]
+  nodes[nodes$id == "54001", c("down", "length")] <- c(NA, NA)
+  nodes <- rbind(
+    nodes,
+    data.frame(id = "P", down = "54001", length = 10, area = NA, model = NA)
+  )
+  g <- CreateGRiwrm(nodes)
+  Qobs2 <- data.frame(P = rep(-2E6, length(DatesR)))
+  e <- setupRunModel(griwrm = g, runRunModel = TRUE, Qobs2 = Qobs2)
+  for(x in ls(e)) assign(x, get(x, e))
+  expect_false(any(OM_GriwrmInputs$`54001`$Qsim_m3 < 0))
+  expect_true(all(OM_GriwrmInputs$`54001`$Qover_m3 >= 0))
+})