RunModel_LRQ.R

RunModel_LRQ <- function(InputsModel, RunOptions, Param, QcontribDown) {
  NParam <- 2
  #RunModel_LRQ
  ## argument check
  if (!inherits(InputsModel, "InputsModel")) {
    stop("'InputsModel' must be of class 'InputsModel'")
  }
  if (!inherits(InputsModel, "SD")) {
    stop("'InputsModel' must be of class 'SD'")
  }
  if (!inherits(RunOptions, "RunOptions")) {
    stop("'RunOptions' must be of class 'RunOptions'")
  }
  if (!is.vector(Param) | !is.numeric(Param)) {
    stop("'Param' must be a numeric vector")
  }
  if (sum(!is.na(Param)) != NParam) {
    stop(paste("'Param' must be a vector of length", NParam, "and contain no NA"))
  }
  if (inherits(QcontribDown, "OutputsModel")) {
    if (is.null(QcontribDown$Qsim)) {
      stop("'QcontribDown' should contain a key 'Qsim' containing the output of the runoff of the downstream subcatchment")
    }
    if (length(QcontribDown$Qsim) != length(RunOptions$IndPeriod_Run)) {
      stop("Time series Qsim in 'QcontribDown' should have the same length as 'RunOptions$IndPeriod_Run'")
    }
    if (!identical(RunOptions$IndPeriod_WarmUp, 0L) && !identical(RunOptions$Outputs_Sim, RunOptions$Outputs_Cal)) {
      # This test is not necessary during calibration but usefull in other cases because
      # WarmUpQsim is then used for downstream sub-basins because of the delay in Qupstream
      if (is.null(QcontribDown$RunOptions$WarmUpQsim) ||
          length(QcontribDown$RunOptions$WarmUpQsim) != length(RunOptions$IndPeriod_WarmUp)) {
        stop("Time series WarmUpQsim in 'QcontribDown' should have the same length as 'RunOptions$IndPeriod_WarmUp'")
      }
    }
  } else if (is.vector(QcontribDown) && is.numeric(QcontribDown)) {
    if (length(QcontribDown) != length(RunOptions$IndPeriod_Run)) {
      stop("'QcontribDown' should have the same length as 'RunOptions$IndPeriod_Run'")
    }
  } else {
    stop("'QcontribDown' must be a numeric vector or a 'OutputsModel' object")
  }

  # data set up

  NbUpBasins <- length(InputsModel$LengthHydro)
  if (identical(RunOptions$IndPeriod_WarmUp, 0L)) {
    RunOptions$IndPeriod_WarmUp <- NULL
  }
  IndPeriod1   <- c(RunOptions$IndPeriod_WarmUp, RunOptions$IndPeriod_Run)
  LInputSeries <- as.integer(length(IndPeriod1))
  IndPeriod2 <- (length(RunOptions$IndPeriod_WarmUp)+1):LInputSeries

  if (inherits(QcontribDown, "OutputsModel")) {
    OutputsModel <- QcontribDown
    if (is.null(OutputsModel$RunOptions$WarmUpQsim)) {
      OutputsModel$RunOptions$WarmUpQsim <- rep(NA, length(RunOptions$IndPeriod_WarmUp))
    }
    QsimDown <- c(OutputsModel$RunOptions$WarmUpQsim, OutputsModel$Qsim)
  } else if (is.vector(QcontribDown) && is.numeric(QcontribDown)) {
    OutputsModel <- list()
    class(OutputsModel) <- c("OutputsModel", class(RunOptions)[-1])
    QsimDown <- c(rep(NA, length(RunOptions$IndPeriod_WarmUp)),
                  QcontribDown)
  }


  ## Parameters set up
  CParam <- Param[1L] # CParam in m/s
  KParam <- Param[2L] # KParam in mm/TS