diff --git a/R/Calibration.GRiwrmInputsModel.R b/R/Calibration.GRiwrmInputsModel.R index 93bf186702806320306fa1c1b89b87af7bc113db..5d4d0d7af860809d0ccd3b530975f3c1cf622f0f 100644 --- a/R/Calibration.GRiwrmInputsModel.R +++ b/R/Calibration.GRiwrmInputsModel.R @@ -53,7 +53,6 @@ Calibration.GRiwrmInputsModel <- function(InputsModel, IM <- l$InputsModel message("Calibration.GRiwrmInputsModel: Processing sub-basins '", paste(names(IM), collapse = "', '"), "' with '", id, "' as gauged donor...") - IM$FUN_MOD <- "RunModel_Ungauged" attr(RunOptions[[id]], "GRiwrmRunOptions") <- l$RunOptions } else { message("Calibration.GRiwrmInputsModel: Processing sub-basin '", id, "'...") @@ -92,11 +91,10 @@ Calibration.GRiwrmInputsModel <- function(InputsModel, } if (hasUngauged) { - # Select nodes with model in the sub-network - g <- attr(IM, "GRiwrm") - Ids <- g$id[!is.na(g$donor) & g$donor == id & g$id != id] + Ids <- names(IM) + Ids <- Ids[Ids != id] for (uId in Ids) { - if (!IM[[uId]]$isReservoir) { + if (IM[[uId]]$gaugedId == id) { # Add OutputsCalib for ungauged nodes OutputsCalib[[uId]] <- list( ParamFinalR = transferGRparams(InputsModel, diff --git a/R/Calibration.R b/R/Calibration.R index 2b3e7d0d7bf50a9608a39ab0901d15ff8bffde25..3df39266c5e82afdc47d56f25c95e60edc9eec3d 100644 --- a/R/Calibration.R +++ b/R/Calibration.R @@ -4,7 +4,8 @@ #' function using the provided functions. #' #' This function can be used either for a catchment (with an \emph{InputsModel} -#' object) or for a network (with a \emph{GRiwrmInputsModel} object) +#' object), for a network (with a \emph{GRiwrmInputsModel} object), or for an +#' ungauged node cluster (with a \emph{Ungauged} object). #' #' @param InputsModel \[object of class \emph{InputsModel} or \emph{GRiwrmInputsModel}\] see [CreateInputsModel] #' @param RunOptions \[object of class \emph{RunOptions} or \emph{GRiwrmRunOptions}\] see [CreateRunOptions] @@ -35,3 +36,10 @@ Calibration <- function(InputsModel, ...) { UseMethod("Calibration", InputsModel) } + +#' @rdname Calibration +#' @export +Calibration.Ungauged <- function(InputsModel, ...) { + InputsModel$FUN_MOD <- "RunModel_Ungauged" + NextMethod() +} diff --git a/R/utils.Calibration.R b/R/utils.Calibration.R index 691743236513b5a5b64201afa0ee718349891a45..137273248381985a3061a42bdea39dfdc1f94768 100644 --- a/R/utils.Calibration.R +++ b/R/utils.Calibration.R @@ -115,8 +115,9 @@ updateParameters4Ungauged <- function(GaugedId, } } - # Add class InputsModel for airGR::Calibration checks - class(InputsModel) <- c("InputsModel", class(InputsModel)) + # Add class RunModel_Ungauged and InputsModel for preprocessind + # and processing airGR::Calibration + class(InputsModel) <- c("Ungauged", "InputsModel", class(InputsModel)) ### Modify RunOptions for the reduced network ### RunOptions <- reduceGRiwrmObj4Ungauged(g, RunOptions) diff --git a/tests/testthat/test-RunModel_Ungauged.R b/tests/testthat/test-RunModel_Ungauged.R index 76e575272abc28b69194970f20ceb00ef55db3e9..4392235896775e2698ab96f9bc085c566c03931c 100644 --- a/tests/testthat/test-RunModel_Ungauged.R +++ b/tests/testthat/test-RunModel_Ungauged.R @@ -366,6 +366,8 @@ test_that("Gauged node inside ungauged cluster must only work if parameters are for (x in ls(e)) assign(x, get(x, e)) rm(e) expect_error(Calibration(InputsModel, RunOptions, InputsCrit, CalibOptions), - regexp = "") - + regexp = "Node '54032' .* must have its parameters fixed") + CalibOptions[["54032"]]$FixedParam <- ParamMichel[["54032"]] + OC <- Calibration(InputsModel, RunOptions, InputsCrit, CalibOptions) + expect_equal(OC[["54032"]]$ParamFinalR, ParamMichel[["54032"]]) })