Forked from Midoux Cedric / easy16S
Source project has a limited visibility.
Calibration.GRiwrmInputsModel.R 4.97 KiB
#' @param useUpstreamQsim boolean describing if simulated (\code{TRUE}) or observed (\code{FALSE}) flows are used for calibration. Default is \code{TRUE}
#' @rdname Calibration
#' @export
Calibration.GRiwrmInputsModel <- function(InputsModel,
                                          RunOptions,
                                          InputsCrit,
                                          CalibOptions,
                                          useUpstreamQsim = TRUE,
                                          ...) {
  # Argument checks
  # We invoke the mandatory arguments here for avoiding
  # a messy error message on "get(x)" if an argument is missing
  InputsModel
  RunOptions
  InputsCrit
  CalibOptions
  # Checking argument classes
  vars2check <- c("InputsModel", "RunOptions", "InputsCrit", "CalibOptions")
  lapply(vars2check, function(x) {
    if (!inherits(get(x), paste0("GRiwrm", x))) {
      stop(sprintf("'%1$s' must be of class GRiwrm%1$s, type '?Create%1$s' for help", x))
  OutputsCalib <- list()
  class(OutputsCalib) <- append("GRiwrmOutputsCalib", class(OutputsCalib))
  OutputsModel <- list()
  class(OutputsModel) <- append("GRiwrmOutputsModel", class(OutputsModel))
  b <- sapply(InputsModel, function(IM) !IM$inUngaugedCluster)
  gaugedIds <- names(b[b])
  for (id in gaugedIds) {
    IM <- InputsModel[[id]]
    hasUngauged <- IM$hasUngaugedNodes
    if (hasUngauged) {
      l  <- updateParameters4Ungauged(id,
                                      InputsModel,
                                      RunOptions,
                                      CalibOptions,
                                      OutputsModel,
                                      useUpstreamQsim)
      IM <- l$InputsModel
      message("Calibration.GRiwrmInputsModel: Processing sub-basins '",
              paste(names(IM), collapse = "', '"), "' with '", id, "' as gauged donor...")
      attr(RunOptions[[id]], "GRiwrmRunOptions") <- l$RunOptions
    } else {
      message("Calibration.GRiwrmInputsModel: Processing sub-basin '", id, "'...")
      if (useUpstreamQsim && any(IM$UpstreamIsModeled)) {
        # Update InputsModel$Qupstream with simulated upstream flows
        IM <- UpdateQsimUpstream(IM, RunOptions[[id]], OutputsModel)
    if (inherits(InputsCrit[[id]], "InputsCritLavenneFunction")) {
      IC <- getInputsCrit_Lavenne(id, OutputsModel, InputsCrit)
    } else {
      IC <- InputsCrit[[id]]
    if (!is.null(IM$isReservoir) && IM$isReservoir & any(is.na(CalibOptions[[id]]$FixedParam))) {
      stop("Parameters of node '", id, "' using `RunModel_Reservoir` can't be calibrated",
           "Fix its parameters by using the command:\n",
           "`CalibOptions[['", id, "']]$FixedParam <- c(Vmax, celerity)`")