RunModel.InputsModel.R

#' Wrapper for [airGR::RunModel] for one sub-basin
#'
#' @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
#' - an item `$Qover_m3` storing the volumes of over abstraction which occurs
#' when `RunModel_Lag` warns for negative simulated flows. The latter reflects the volume
#' that was planned to be drawn from the sub-basin but could not be drawn because
#' of the lack of water.
#'
#' @inheritParams airGR::RunModel
#' @param x \[object of class \emph{InputsModel}\] see [airGR::CreateInputsModel] for details
#' @param ... Further arguments for compatibility with S3 methods
#'
#' @inherit airGR::RunModel return return
#'
#' @export
RunModel.InputsModel <- function(x = NULL,
                                 RunOptions,
                                 Param,
                                 FUN_MOD = NULL,
                                 InputsModel = NULL,
                                 ...) {
  if (is.null(x)) {
    if (!is.null(InputsModel)) {
      x <- InputsModel
    } else {
      stop("`x` or `InputsModel` must be defined")
    }
  } else {
    if (!is.null(InputsModel)) {
      stop("`x` and `InputsModel` can't be defined at the same time")
    }
  }

  if(is.null(FUN_MOD)) {
    if (x$isReservoir) {
      FUN_MOD <- "RunModel_Reservoir"
    } else {
      FUN_MOD <- x$FUN_MOD
    }
  }

  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]
  } 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)
  } else {
    # Intermediate basins (other than reservoir) are launch with SD capabilities
    if (!is.null(x$UpstreamNodes) & !inherits(x, "SD")) {
      # For calibration of node with diversion
      class(x) <- c(class(x), "SD")
    }
    OutputsModel <- airGR::RunModel(x, RunOptions, Param, FUN_MOD)
  }
  OutputsModel$RunOptions$TimeStep <- RunOptions$FeatFUN_MOD$TimeStep