RunModel.InputsModel.R

#' Wrapper for [airGR::RunModel] for one sub-basin
#'
#' @inheritParams airGR::RunModel
#' @param x \[object of class \emph{InputsModel}\] see [airGR::CreateInputsModel] for details
#' @param ... Further arguments for compatibility with S3 methods
#'
#' @returns \[object of class \emph{OutputsModel}\] returned by [airGR::RunModel]
#' (See Value section of [airGR::RunModel_GR4J]) completed by new items:
#' - `Qsim_m3`: simulated flow in cubic meters per time step
#' - `Qover_m3` volumes of over abstractions which occurs when `RunModel_Lag` warns
#' for negative simulated flows
#' - `Qnat`: only present in case of Diversion in the node, simulated flow in mm
#' per time step before application of the Diversion
#' - `Qdiv_m3`: only present in case of Diversion in the node, simulated diverted flow in
#' cubic meters per time step. The latter differs from the flows time series provided
#' in argument `Qinf` of [CreateInputsModel.GRiwrm] by the limitation of diversion
#' applied by the minimum flow threshold `Qmin` to keep flowing in the river
#'
#' @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
    }
  }

  # Avoiding Error in `FUN_MOD(x, RunOptions, Param)`: NA/NaN/Inf in foreign function call (arg 7)
  RunOptions$IniStates[is.na(RunOptions$IniStates)] <- 0

  FUN_MOD <- match.fun(FUN_MOD)
  if (identical(FUN_MOD, RunModel_Lag)) {
    OutputsModel <- RunModel_Routing(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)
  } else {
    # Intermediate basins (other than reservoir) are launched 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 <- calcOverAbstraction(OutputsModel, FALSE)
    OutputsModel$RunOptions <- calcOverAbstraction(OutputsModel$RunOptions, TRUE)
  }
  OutputsModel$RunOptions$TimeStep <- RunOptions$FeatFUN_MOD$TimeStep
  if (is.null(OutputsModel$Qsim_m3)) {
    # Add Qsim_m3 in m3/timestep
    OutputsModel$Qsim_m3 <-
      OutputsModel$Qsim * sum(x$BasinAreas, na.rm = TRUE) * 1e3
  }