Skip to content

GitLab

Commit 7dff15da authored by Delaigue Olivier's avatar Delaigue Olivier
Browse files

v1.2.12.12 CLEAN: many warning or error messages modified in many functions

parent dca99120
Show whitespace changes
Inline Side-by-side
DESCRIPTION
View file @ 7dff15da
Package: airGR
Type: Package
Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling
Version: 1.2.12.11
Date: 2019-03-29
Version: 1.2.12.12
Date: 2019-04-01
Authors@R: c(
person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")),
person("Olivier", "Delaigue", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-7668-8468"), email = "airGR@irstea.fr"),
......
NEWS.rmd
View file @ 7dff15da
......@@ -13,7 +13,7 @@ output:
### 1.2.12.11 Release Notes (2019-03-28)
### 1.2.12.12 Release Notes (2019-04-01)
......@@ -31,8 +31,6 @@ output:
#### New features
- Added <code>TransfoParam_CemaNeigeHyst()</code> function in order to take into account transformation of the parameters of the CemaNeige module when the hysteresis is used.
- <code>CreateInputsCrit()</code> now can prepare an <code>InputsCrit</code> object in order to compute a single criterion (<code>Single</code> class), multiple criteria (<code>Multi</code> class) with the <code>ErrorCrit()</code> function. So it is now possible to set the following arguments as atomic (as before) or as list: <code>FUN_CRIT</code>, <code>obs</code>, <code>BoolCrit</code>, <code>transfo</code>, <code>weights</code>. If the list format is chosen, all the lists must have the same length.
- <code>CreateInputsCrit()</code> now presents a <code>varObs</code> argument in order to allow to prepare an <code>InputsCrit</code> object in order run a criterion on other variable than observed discharges with the <code>ErrorCrit()</code> function (e.g. SCA, SWE).
......@@ -49,6 +47,8 @@ output:
- <code>CreateCalibOptions()</code> now presents a <code>IsHyst</code> argument to give the possibility to use the hysteresis with CemaNeige.
- Added <code>TransfoParam_CemaNeigeHyst()</code> function in order to take into account transformation of the parameters of the CemaNeige module when the hysteresis is used.
- Added the <code>X0310010</code> dataset to run the examples using the hysteresis with CemaNeige.
- Added the cemaneige_hysteresis vignette to explain how to manage the use of the hysteresis with CemaNeige.
......
R/Calibration_Michel.R
View file @ 7dff15da
......@@ -19,16 +19,16 @@ Calibration_Michel <- function(InputsModel,
##_____Arguments_check_____________________________________________________________________
if (!inherits(InputsModel, "InputsModel")) {
stop("InputsModel must be of class 'InputsModel'")
stop("'InputsModel' must be of class 'InputsModel'")
}
if (!inherits(RunOptions, "RunOptions")) {
stop("RunOptions must be of class 'RunOptions'")
stop("'RunOptions' must be of class 'RunOptions'")
}
if (!inherits(InputsCrit, "InputsCrit")) {
stop("InputsCrit must be of class 'InputsCrit'")
stop("'InputsCrit' must be of class 'InputsCrit'")
}
if (inherits(InputsCrit, "Multi")) {
stop("InputsCrit must be of class 'Single' or 'Compo'")
stop("'InputsCrit' must be of class 'Single' or 'Compo'")
}
if (inherits(InputsCrit, "Single")) {
listVarObs <- InputsCrit$varObs
......@@ -45,10 +45,10 @@ Calibration_Michel <- function(InputsModel,
RunOptions$Outputs_Cal <- c(RunOptions$Outputs_Cal, "SnowPack")
}
if (!inherits(CalibOptions, "CalibOptions")) {
stop("CalibOptions must be of class 'CalibOptions'")
stop("'CalibOptions' must be of class 'CalibOptions'")
}
if (!inherits(CalibOptions, "HBAN")) {
stop("CalibOptions must be of class 'HBAN' if Calibration_Michel is used")
stop("'CalibOptions' must be of class 'HBAN' if 'Calibration_Michel' is used")
}
if (!missing(FUN_CRIT)) {
warning("argument 'FUN_CRIT' is deprecated. The error criterion function is now automatically get from the 'InputsCrit' object")
......@@ -131,7 +131,7 @@ Calibration_Michel <- function(InputsModel,
}
if (is.null(FUN_TRANSFO)) {
stop("FUN_TRANSFO was not found (in Calibration function)")
stop("'FUN_TRANSFO' was not found (in 'Calibration' function)")
}
}
......@@ -512,7 +512,3 @@ Calibration_Michel <- function(InputsModel,
}
R/CreateCalibOptions.R
View file @ 7dff15da
......@@ -15,7 +15,7 @@ CreateCalibOptions <- function(FUN_MOD,
FUN_TRANSFO <- match.fun(FUN_TRANSFO)
}
if (!is.logical(IsHyst) | length(IsHyst) != 1L) {
stop("'IsHyst' must be a 'logical' of length 1")
stop("'IsHyst' must be a logical of length 1")
}
##check_FUN_MOD
BOOL <- FALSE
......@@ -64,7 +64,7 @@ CreateCalibOptions <- function(FUN_MOD,
ObjectClass <- c(ObjectClass, "hysteresis")
}
if (!BOOL) {
stop("incorrect FUN_MOD for use in CreateCalibOptions")
stop("incorrect 'FUN_MOD' for use in 'CreateCalibOptions'")
return(NULL)
}
......@@ -76,7 +76,7 @@ CreateCalibOptions <- function(FUN_MOD,
BOOL <- TRUE
}
if (!BOOL) {
stop("incorrect FUN_CALIB for use in CreateCalibOptions")
stop("incorrect 'FUN_CALIB' for use in 'CreateCalibOptions'")
return(NULL)
}
......@@ -113,7 +113,7 @@ CreateCalibOptions <- function(FUN_MOD,
}
}
if (is.null(FUN1)) {
stop("FUN1 was not found")
stop("'FUN1' was not found")
return(NULL)
}
##_set_FUN2
......@@ -164,7 +164,7 @@ CreateCalibOptions <- function(FUN_MOD,
}
}
if (is.null(FUN_TRANSFO)) {
stop("FUN_TRANSFO was not found")
stop("'FUN_TRANSFO' was not found")
return(NULL)
}
......@@ -211,13 +211,13 @@ CreateCalibOptions <- function(FUN_MOD,
stop("FixedParam must be a vector")
}
if (length(FixedParam) != NParam) {
stop("Incompatibility between FixedParam length and FUN_MOD")
stop("Incompatibility between 'FixedParam' length and 'FUN_MOD'")
}
if (all(!is.na(FixedParam))) {
stop("At least one parameter must be not set (NA)")
}
if (all(is.na(FixedParam))) {
warning("You have not set any parameter in \"FixedParam\"")
warning("You have not set any parameter in 'FixedParam'")
}
}
......@@ -229,19 +229,19 @@ CreateCalibOptions <- function(FUN_MOD,
} else {
if (!is.matrix(SearchRanges)) {
stop("SearchRanges must be a matrix")
stop("'SearchRanges' must be a matrix")
}
if (!is.numeric(SearchRanges)) {
stop("SearchRanges must be a matrix of numeric values")
stop("'SearchRanges' must be a matrix of numeric values")
}
if (sum(is.na(SearchRanges)) != 0) {
stop("SearchRanges must not include NA values")
stop("'SearchRanges' must not include NA values")
}
if (nrow(SearchRanges) != 2) {
stop("SearchRanges must have 2 rows")
stop("'SearchRanges' must have 2 rows")
}
if (ncol(SearchRanges) != NParam) {
stop("Incompatibility between SearchRanges ncol and FUN_MOD")
stop("Incompatibility between 'SearchRanges' ncol and 'FUN_MOD'")
}
}
......@@ -336,30 +336,30 @@ CreateCalibOptions <- function(FUN_MOD,
##check_StartParamList_and_StartParamDistrib__format
if ("HBAN" %in% ObjectClass & !is.null(StartParamList)) {
if (!is.matrix(StartParamList)) {
stop("StartParamList must be a matrix")
stop("'StartParamList' must be a matrix")
}
if (!is.numeric(StartParamList)) {
stop("StartParamList must be a matrix of numeric values")
stop("'StartParamList' must be a matrix of numeric values")
}
if (sum(is.na(StartParamList)) != 0) {
stop("StartParamList must not include NA values")
stop("'StartParamList' must not include NA values")
}
if (ncol(StartParamList) != NParam) {
stop("Incompatibility between StartParamList ncol and FUN_MOD")
stop("Incompatibility between 'StartParamList' ncol and 'FUN_MOD'")
}
}
if ("HBAN" %in% ObjectClass & !is.null(StartParamDistrib)) {
if (!is.matrix(StartParamDistrib)) {
stop("StartParamDistrib must be a matrix")
stop("'StartParamDistrib' must be a matrix")
}
if (!is.numeric(StartParamDistrib[1, ])) {
stop("StartParamDistrib must be a matrix of numeric values")
stop("'StartParamDistrib' must be a matrix of numeric values")
}
if (sum(is.na(StartParamDistrib[1, ])) != 0) {
stop("StartParamDistrib must not include NA values on the first line")
stop("'StartParamDistrib' must not include NA values on the first line")
}
if (ncol(StartParamDistrib) != NParam) {
stop("Incompatibility between StartParamDistrib ncol and FUN_MOD")
stop("Incompatibility between 'StartParamDistrib' ncol and 'FUN_MOD'")
}
}
......
R/CreateInputsCrit.R
View file @ 7dff15da
......@@ -30,10 +30,10 @@ CreateInputsCrit <- function(FUN_CRIT,
}
}
if (!missing(Ind_zeroes) & warnings) {
warning("Deprecated 'Ind_zeroes' argument")
warning("deprecated 'Ind_zeroes' argument")
}
if (!missing(verbose)) {
warning("Deprecated 'verbose' argument. Use 'warnings', instead")
warning("deprecated 'verbose' argument. Use 'warnings', instead")
}
......@@ -329,7 +329,7 @@ CreateInputsCrit <- function(FUN_CRIT,
apply(combInputsCrit, MARGIN = 2, function(i) {
equalInputsCrit <- identical(InputsCrit[[i[1]]], InputsCrit[[i[2]]])
if(equalInputsCrit) {
warning(sprintf("Elements %i and %i of the criteria list are identical. This might not be necessary", i[1], i[2]), call. = FALSE)
warning(sprintf("elements %i and %i of the criteria list are identical. This might not be necessary", i[1], i[2]), call. = FALSE)
}
})
}
......
R/CreateInputsModel.R
View file @ 7dff15da
......@@ -60,26 +60,26 @@ CreateInputsModel <- function(FUN_MOD,
BOOL <- TRUE
}
if (!BOOL) {
stop("Incorrect FUN_MOD for use in CreateInputsModel")
stop("incorrect 'FUN_MOD' for use in 'CreateInputsModel'")
}
##check_arguments
if ("GR" %in% ObjectClass | "CemaNeige" %in% ObjectClass) {
if (is.null(DatesR)) {
stop("DatesR is missing")
stop("'DatesR' is missing")
}
if (!"POSIXlt" %in% class(DatesR) & !"POSIXct" %in% class(DatesR)) {
stop("DatesR must be defined as POSIXlt or POSIXct")
stop("'DatesR' must be defined as 'POSIXlt' or 'POSIXct'")
}
if (!"POSIXlt" %in% class(DatesR)) {
DatesR <- as.POSIXlt(DatesR)
}
if (!difftime(tail(DatesR, 1), tail(DatesR, 2), units = "secs")[[1]] %in% TimeStep) {
TimeStepName <- grep("hourly|daily|monthly|yearly", ObjectClass, value = TRUE)
stop(paste0("The time step of the model inputs must be ", TimeStepName, "\n"))
stop(paste0("the time step of the model inputs must be ", TimeStepName, "\n"))
}
if (any(duplicated(DatesR))) {
stop("DatesR must not include duplicated values")
stop("'DatesR' must not include duplicated values")
}
LLL <- length(DatesR)
}
......@@ -88,73 +88,73 @@ CreateInputsModel <- function(FUN_MOD,
stop("Precip is missing")
}
if (is.null(PotEvap)) {
stop("PotEvap is missing")
stop("'PotEvap' is missing")
}
if (!is.vector(Precip) | !is.vector(PotEvap)) {
stop("Precip and PotEvap must be vectors of numeric values")
stop("'Precip' and 'PotEvap' must be vectors of numeric values")
}
if (!is.numeric(Precip) | !is.numeric(PotEvap)) {
stop("Precip and PotEvap must be vectors of numeric values")
stop("'Precip' and 'PotEvap' must be vectors of numeric values")
}
if (length(Precip) != LLL | length(PotEvap) != LLL) {
stop("Precip, PotEvap and DatesR must have the same length")
stop("'Precip', 'PotEvap' and 'DatesR' must have the same length")
}
}
if ("CemaNeige" %in% ObjectClass) {
if (is.null(Precip)) {
stop("Precip is missing")
stop("'Precip' is missing")
}
if (is.null(TempMean)) {
stop("TempMean is missing")
stop("'TempMean' is missing")
}
if (!is.vector(Precip) | !is.vector(TempMean)) {
stop("Precip and TempMean must be vectors of numeric values")
stop("'Precip' and 'TempMean' must be vectors of numeric values")
}
if (!is.numeric(Precip) | !is.numeric(TempMean)) {
stop("Precip and TempMean must be vectors of numeric values")
stop("'Precip' and 'TempMean' must be vectors of numeric values")
}
if (length(Precip) != LLL | length(TempMean) != LLL) {
stop("Precip, TempMean and DatesR must have the same length")
stop("'Precip', 'TempMean' and 'DatesR' must have the same length")
}
if (is.null(TempMin) != is.null(TempMax)) {
stop("TempMin and TempMax must be both defined if not null")
stop("'TempMin' and 'TempMax' must be both defined if not null")
}
if (!is.null(TempMin) & !is.null(TempMax)) {
if (!is.vector(TempMin) | !is.vector(TempMax)) {
stop("TempMin and TempMax must be vectors of numeric values")
stop("'TempMin' and 'TempMax' must be vectors of numeric values")
}
if (!is.numeric(TempMin) | !is.numeric(TempMax)) {
stop("TempMin and TempMax must be vectors of numeric values")
stop("'TempMin' and 'TempMax' must be vectors of numeric values")
}
if (length(TempMin) != LLL | length(TempMax) != LLL) {
stop("TempMin, TempMax and DatesR must have the same length")
stop("'TempMin', 'TempMax' and 'DatesR' must have the same length")
}
}
if (!is.null(HypsoData)) {
if (!is.vector(HypsoData)) {
stop("HypsoData must be a vector of numeric values if not null")
stop("'HypsoData' must be a vector of numeric values if not null")
}
if (!is.numeric(HypsoData)) {
stop("HypsoData must be a vector of numeric values if not null")
stop("'HypsoData' must be a vector of numeric values if not null")
}
if (length(HypsoData) != 101) {
stop("HypsoData must be of length 101 if not null")
stop("'HypsoData' must be of length 101 if not null")
}
if (sum(is.na(HypsoData)) != 0 & sum(is.na(HypsoData)) != 101) {
stop("HypsoData must not contain any NA if not null")
stop("'HypsoData' must not contain any NA if not null")
}
}
if (!is.null(ZInputs)) {
if (length(ZInputs) != 1) {
stop("\t ZInputs must be a single numeric value if not null")
stop("'ZInputs' must be a single numeric value if not null")
}
if (is.na(ZInputs) | !is.numeric(ZInputs)) {
stop("\t ZInputs must be a single numeric value if not null")
stop("'ZInputs' must be a single numeric value if not null")
}
}
if (is.null(HypsoData)) {
if (verbose) {
warning("\t HypsoData is missing => a single layer is used and no extrapolation is made")
warning("'HypsoData' is missing: a single layer is used and no extrapolation is made")
}
HypsoData <- as.numeric(rep(NA, 101))
ZInputs <- as.numeric(NA)
......@@ -163,15 +163,15 @@ CreateInputsModel <- function(FUN_MOD,
}
if (is.null(ZInputs)) {
if (verbose & !identical(HypsoData, as.numeric(rep(NA, 101)))) {
warning("\t ZInputs is missing => HypsoData[51] is used")
warning("'ZInputs' is missing: HypsoData[51] is used")
}
ZInputs <- HypsoData[51L]
}
if (NLayers <= 0) {
stop("NLayers must be a positive integer value")
stop("'NLayers' must be a positive integer value")
}
if (NLayers != as.integer(NLayers)) {
warning("Coerce NLayers to be of integer type (", NLayers, " => ", as.integer(NLayers), ")")
warning("Coerce 'NLayers' to be of integer type (", NLayers, ": ", as.integer(NLayers), ")")
NLayers <- as.integer(NLayers)
}
}
......@@ -185,14 +185,14 @@ CreateInputsModel <- function(FUN_MOD,
if (sum(BOOL_NA_TMP) != 0) {
BOOL_NA <- BOOL_NA | BOOL_NA_TMP
if (verbose) {
warning("\t Values < 0 or NA values detected in Precip series")
warning("Values < 0 or NA values detected in 'Precip' series")
}
}
BOOL_NA_TMP <- (PotEvap < 0) | is.na(PotEvap)
if (sum(BOOL_NA_TMP) != 0) {
BOOL_NA <- BOOL_NA | BOOL_NA_TMP
if (verbose) {
warning("\t Values < 0 or NA values detected in PotEvap series")
warning("Values < 0 or NA values detected in 'PotEvap' series")
}
}
}
......@@ -201,14 +201,14 @@ CreateInputsModel <- function(FUN_MOD,
if (sum(BOOL_NA_TMP) != 0) {
BOOL_NA <- BOOL_NA | BOOL_NA_TMP
if (verbose) {
warning("\t Values < 0 or NA values detected in Precip series")
warning("Values < 0 or NA values detected in 'Precip' series")
}
}
BOOL_NA_TMP <- (TempMean < (-150)) | is.na(TempMean)
if (sum(BOOL_NA_TMP) != 0) {
BOOL_NA <- BOOL_NA | BOOL_NA_TMP
if (verbose) {
warning("\t Values < -150) or NA values detected in TempMean series")
warning("Values < -150 or NA values detected in 'TempMean' series")
}
}
if (!is.null(TempMin) & !is.null(TempMax)) {
......@@ -216,26 +216,26 @@ CreateInputsModel <- function(FUN_MOD,
if (sum(BOOL_NA_TMP) != 0) {
BOOL_NA <- BOOL_NA | BOOL_NA_TMP
if (verbose) {
warning("\t Values < -150) or NA values detected in TempMin series")
warning("Values < -150 or NA values detected in 'TempMin' series")
}
}
BOOL_NA_TMP <- (TempMax < (-150)) | is.na(TempMax)
if (sum(BOOL_NA_TMP) != 0) {
BOOL_NA <- BOOL_NA | BOOL_NA_TMP
if (verbose) {
warning("\t Values < -150) or NA values detected in TempMax series")
warning("Values < -150 or NA values detected in 'TempMax' series")
}
}
}
}
if (sum(BOOL_NA) != 0) {
WTxt <- NULL
WTxt <- paste(WTxt, "\t Missing values are not allowed in InputsModel", sep = "")
WTxt <- paste(WTxt, "\t Missing values are not allowed in 'InputsModel'", sep = "")
Select <- (max(which(BOOL_NA)) + 1):length(BOOL_NA)
if (Select[1L] > Select[2L]) {
stop("Time series could not be trunced since missing values were detected at the list time-step")
stop("time series could not be trunced since missing values were detected at the list time-step")
}
if ("GR" %in% ObjectClass) {
Precip <- Precip[Select]
......@@ -252,8 +252,8 @@ CreateInputsModel <- function(FUN_MOD,
DatesR <- DatesR[Select]
WTxt <- paste(WTxt, "\t -> Data were trunced to keep the most recent available time-steps", sep = "")
WTxt <- paste(WTxt, "\t -> ", length(Select), " time-steps were kept", sep = "")
WTxt <- paste0(WTxt, "\t -> data were trunced to keep the most recent available time-steps")
WTxt <- paste0(WTxt, "\t -> ", length(Select), " time-steps were kept")
if (!is.null(WTxt) & verbose) {
warning(WTxt)
......@@ -270,9 +270,9 @@ CreateInputsModel <- function(FUN_MOD,
verbose = verbose)
if (verbose) {
if (NLayers == 1) {
message("\t Input series were successfully created on 1 elevation layer for use by CemaNeige")
message("input series were successfully created on 1 elevation layer for use by CemaNeige")
} else {
message( "\t Input series were successfully created on ", NLayers, " elevation layers for use by CemaNeige")
message( "input series were successfully created on ", NLayers, " elevation layers for use by CemaNeige")
}
}
}
......
R/CreateRunOptions.R
View file @ 7dff15da
......@@ -5,7 +5,7 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
warnings = TRUE, verbose = TRUE) {
if (!missing(RunSnowModule)) {
warning("argument 'RunSnowModule' is deprecated; please adapt 'FUN_MOD' instead.", call. = FALSE)
warning("deprecated 'RunSnowModule' argument: please adapt 'FUN_MOD' instead.", call. = FALSE)
}
if (!is.logical(IsHyst) | length(IsHyst) != 1L) {
stop("'IsHyst' must be a 'logical' of length 1")
......@@ -93,11 +93,11 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
##check_IndPeriod_WarmUp
WTxt <- NULL
if (is.null(IndPeriod_WarmUp)) {
WTxt <- paste0(WTxt,"\t Model warm up period not defined -> default configuration used")
WTxt <- paste(WTxt, "model warm up period not defined: default configuration used", sep = "")
##If_the_run_period_starts_at_the_very_beginning_of_the_time_series
if (IndPeriod_Run[1L] == 1L) {
IndPeriod_WarmUp <- as.integer(0)
WTxt <- paste0(WTxt,"\t No data were found for model warm up!")
WTxt <- paste0(WTxt,"\n no data were found for model warm up!")
##We_look_for_the_longest_period_preceeding_the_run_period_with_a_maximum_of_one_year
} else {
TmpDateR0 <- InputsModel$DatesR[IndPeriod_Run[1]]
......@@ -121,10 +121,10 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
TimeStep <- as.integer(365.25 * 24 * 60 * 60)
}
if (length(IndPeriod_WarmUp) * TimeStep / (365 * 24 * 60 * 60) >= 1) {
WTxt <- paste0(WTxt, "\t The year preceding the run period is used \n")
WTxt <- paste0(WTxt, "\n the year preceding the run period is used \n")
} else {
WTxt <- paste0(WTxt, "\t Less than a year (without missing values) was found for model warm up: \n")
WTxt <- paste0(WTxt, "\t (", length(IndPeriod_WarmUp), " time-steps are used for initialisation) \n")
WTxt <- paste0(WTxt, "\n less than a year (without missing values) was found for model warm up:")
WTxt <- paste0(WTxt, "\n (", length(IndPeriod_WarmUp), " time-steps are used for initialisation)")
}
}
}
......@@ -139,10 +139,10 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
stop("'IndPeriod_WarmUp' should be of type integer")
}
if (identical(IndPeriod_WarmUp, as.integer(0)) & verbose) {
message(paste0(WTxt, "\t No warm up period is used \n"))
message(paste0(WTxt, ". No warm up period is used"))
}
if ((IndPeriod_Run[1] - 1) != tail(IndPeriod_WarmUp, 1) & !identical(IndPeriod_WarmUp, as.integer(0))) {
WTxt <- paste0(WTxt, "\t Model warm up period is not directly before the model run period \n")
WTxt <- paste0(WTxt, ". Model warm up period is not directly before the model run period")
}
}
if (!is.null(WTxt) & warnings) {
......@@ -161,11 +161,11 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
identical(FUN_MOD, RunModel_GR5J) | identical(FUN_MOD, RunModel_CemaNeigeGR5J) |
identical(FUN_MOD, RunModel_GR2M)) &
length(IniResLevels) != 2) {
stop("The length of 'IniResLevels' must be 2 for the chosen 'FUN_MOD'")
stop("the length of 'IniResLevels' must be 2 for the chosen 'FUN_MOD'")
}
if ((identical(FUN_MOD,RunModel_GR6J) | identical(FUN_MOD,RunModel_CemaNeigeGR6J)) &
length(IniResLevels) != 3) {
stop("The length of 'IniResLevels' must be 3 for the chosen 'FUN_MOD'")
stop("the length of 'IniResLevels' must be 3 for the chosen 'FUN_MOD'")
}
} else if (is.null(IniStates)) {
if (identical(FUN_MOD, RunModel_GR6J) | identical(FUN_MOD, RunModel_CemaNeigeGR6J)) {
......@@ -181,10 +181,10 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
}
## check IniStates
if (is.null(IniStates) & is.null(IniResLevels) & warnings) {
warning("\t Model states initialisation not defined -> default configuration used")
warning("model states initialisation not defined: default configuration used")
}
if (!is.null(IniStates) & !is.null(IniResLevels) & warnings) {
warning("\t 'IniStates' and 'IniResLevels' are both defined -> Store levels are taken from 'IniResLevels'")
warning("'IniStates' and 'IniResLevels' are both defined: store levels are taken from 'IniResLevels'")
}
if ("CemaNeige" %in% ObjectClass) {
NLayers <- length(InputsModel$LayerPrecip)
......@@ -212,22 +212,22 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
stop("'IniStates' must be an object of class 'IniStates'\n")
}
if (sum(ObjectClass %in% class(IniStates)) < 2) {
stop(paste0("Non convenient 'IniStates' for this 'FUN_MOD'\n"))
stop(paste0("non convenient 'IniStates' for this 'FUN_MOD'\n"))
}
if (identical(FUN_MOD, RunModel_GR1A) & !is.null(IniStates)) { ## GR1A
stop(paste0("'IniStates' is not available for this 'FUN_MOD'\n"))
}
if ((identical(FUN_MOD, RunModel_GR5J) | identical(FUN_MOD, RunModel_CemaNeigeGR5J)) & !all(is.na(IniStates$UH$UH1))) { ## GR5J
stop(paste0("Non convenient IniStates for this 'FUN_MOD.' In 'IniStates', UH1 has to be a vector of NA for GR5J"))
stop(paste0("non convenient IniStates for this 'FUN_MOD.' In 'IniStates', 'UH1' has to be a vector of NA for GR5J"))
}
if ((identical(FUN_MOD, RunModel_GR6J) | identical(FUN_MOD, RunModel_CemaNeigeGR6J)) & is.na(IniStates$Store$Exp)) { ## GR6J
stop(paste0("Non convenient IniStates for this 'FUN_MOD.' GR6J needs an exponential store value in 'IniStates'"))
stop(paste0("non convenient IniStates for this 'FUN_MOD.' GR6J needs an exponential store value in 'IniStates'"))
}
if (!(identical(FUN_MOD, RunModel_GR6J) | identical(FUN_MOD, RunModel_CemaNeigeGR6J)) & !is.na(IniStates$Store$Exp)) { ## except GR6J
stop(paste0("Non convenient IniStates for this 'FUN_MOD.' No exponential store value needed in 'IniStates'"))
stop(paste0("non convenient IniStates for this 'FUN_MOD.' No exponential store value needed in 'IniStates'"))
}
# if (length(na.omit(unlist(IniStates))) != NState) {
# stop(paste0("The length of IniStates must be ", NState, " for the chosen FUN_MOD"))
# stop(paste0("the length of IniStates must be ", NState, " for the chosen FUN_MOD"))
# }
if (!"CemaNeige" %in% ObjectClass & any(is.na(IniStates$CemaNeigeLayers$G ))) {
IniStates$CemaNeigeLayers$G <- NULL
......@@ -274,13 +274,13 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
##check_Outputs_Sim
if (!is.vector(Outputs_Sim)) {
stop("Outputs_Sim must be a vector of characters")
stop("'Outputs_Sim' must be a vector of characters")
}
if (!is.character(Outputs_Sim)) {
stop("Outputs_Sim must be a vector of characters")
stop("'Outputs_Sim' must be a vector of characters")
}
if (sum(is.na(Outputs_Sim)) != 0) {
stop("Outputs_Sim must not contain NA")
stop("'Outputs_Sim' must not contain NA")
}
if ("all" %in% Outputs_Sim) {
Outputs_Sim <- c("DatesR", Outputs_all, "StateEnd")
......@@ -360,7 +360,7 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
MeanAnSolidPrecip <- rep(mean(SolidPrecip) * Factor, NLayers)
### default value: same Gseuil for all layers
if (warnings) {
warning("\t 'MeanAnSolidPrecip' not defined -> it was automatically set to c(",
warning("'MeanAnSolidPrecip' not defined: it was automatically set to c(",
paste(round(MeanAnSolidPrecip), collapse = ","), ") from the 'InputsModel' given to the function. ",
"Be careful in case your application is (short-term) forecasting.\n")
}
......@@ -382,8 +382,8 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
if ("GR" %in% ObjectClass & "CemaNeige" %in% ObjectClass) {
if (!"PliqAndMelt" %in% Outputs_Cal & !"all" %in% Outputs_Cal) {
WTxt <- NULL