Failed to fetch fork details. Try again later.
-
Delaigue Olivier authored
v1.2.13.2 UPDATE: CreateRunOptions now check the compatibility between FUN_MOD, IniStates and IsHyst arguments
2f7c5399
Forked from
HYCAR-Hydro / airGR
Source project has a limited visibility.
CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndPeriod_Run, IniStates = NULL, IniResLevels = NULL, Outputs_Cal = NULL, Outputs_Sim = "all", RunSnowModule, MeanAnSolidPrecip = NULL, IsHyst = FALSE, warnings = TRUE, verbose = TRUE) { if (!missing(RunSnowModule)) { 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") } ObjectClass <- NULL FUN_MOD <- match.fun(FUN_MOD) ##check_FUN_MOD BOOL <- FALSE if (identical(FUN_MOD, RunModel_GR4H)) { ObjectClass <- c(ObjectClass, "GR", "hourly") BOOL <- TRUE } if (identical(FUN_MOD, RunModel_GR4J) | identical(FUN_MOD, RunModel_GR5J) | identical(FUN_MOD, RunModel_GR6J)) { ObjectClass <- c(ObjectClass, "GR", "daily") BOOL <- TRUE } if (identical(FUN_MOD, RunModel_GR2M)) { ObjectClass <- c(ObjectClass, "GR", "monthly") BOOL <- TRUE } if (identical(FUN_MOD, RunModel_GR1A)) { ObjectClass <- c(ObjectClass, "GR", "yearly") BOOL <- TRUE } if (identical(FUN_MOD, RunModel_CemaNeige)) { ObjectClass <- c(ObjectClass, "CemaNeige", "daily") BOOL <- TRUE } if (identical(FUN_MOD, RunModel_CemaNeigeGR4J) | identical(FUN_MOD, RunModel_CemaNeigeGR5J) | identical(FUN_MOD, RunModel_CemaNeigeGR6J)) { ObjectClass <- c(ObjectClass, "GR", "CemaNeige", "daily") BOOL <- TRUE } if (IsHyst) { ObjectClass <- c(ObjectClass, "hysteresis") } if (!BOOL) { stop("incorrect 'FUN_MOD' for use in 'CreateRunOptions'") } ##check_InputsModel if (!inherits(InputsModel, "InputsModel")) { stop("'InputsModel' must be of class 'InputsModel'") } if ("GR" %in% ObjectClass & !inherits(InputsModel, "GR")) { stop("'InputsModel' must be of class 'GR'") } if ("CemaNeige" %in% ObjectClass & !inherits(InputsModel, "CemaNeige")) { stop("'InputsModel' must be of class 'CemaNeige'") } if ("hourly" %in% ObjectClass & !inherits(InputsModel, "hourly")) { stop("'InputsModel' must be of class 'hourly'") } if ("daily" %in% ObjectClass & !inherits(InputsModel, "daily")) { stop("'InputsModel' must be of class 'daily'") } if ("monthly" %in% ObjectClass & !inherits(InputsModel, "monthly")) { stop("'InputsModel' must be of class 'monthly'")7172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140
}
if ("yearly" %in% ObjectClass &
!inherits(InputsModel, "yearly")) {
stop("'InputsModel' must be of class 'yearly'")
}
##check_IndPeriod_Run
if (!is.vector(IndPeriod_Run)) {
stop("'IndPeriod_Run' must be a vector of numeric values")
}
if (!is.numeric(IndPeriod_Run)) {
stop("'IndPeriod_Run' must be a vector of numeric values")
}
if (!identical(as.integer(IndPeriod_Run), as.integer(seq(from = IndPeriod_Run[1], to = tail(IndPeriod_Run, 1), by = 1)))) {
stop("'IndPeriod_Run' must be a continuous sequence of integers")
}
if (storage.mode(IndPeriod_Run) != "integer") {
stop("'IndPeriod_Run' should be of type integer")
}
##check_IndPeriod_WarmUp
WTxt <- NULL
if (is.null(IndPeriod_WarmUp)) {
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,"\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]]
TmpDateR <- TmpDateR0 - 365 * 24 * 60 * 60
### minimal date to start the warmup
if (format(TmpDateR, format = "%d") != format(TmpDateR0, format = "%d")) {
### leap year
TmpDateR <- TmpDateR - 1 * 24 * 60 * 60
}
IndPeriod_WarmUp <- which(InputsModel$DatesR == max(InputsModel$DatesR[1], TmpDateR)):(IndPeriod_Run[1] - 1)
if ("hourly" %in% ObjectClass) {
TimeStep <- as.integer(60 * 60)
}
if ("daily" %in% ObjectClass) {
TimeStep <- as.integer(24 * 60 * 60)
}
if ("monthly" %in% ObjectClass) {
TimeStep <- as.integer(30.44 * 24 * 60 * 60)
}
if ("yearly" %in% ObjectClass) {
TimeStep <- as.integer(365.25 * 24 * 60 * 60)
}
if (length(IndPeriod_WarmUp) * TimeStep / (365 * 24 * 60 * 60) >= 1) {
WTxt <- paste0(WTxt, "\n the year preceding the run period is used \n")
} else {
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)")
}
}
}
if (!is.null(IndPeriod_WarmUp)) {
if (!is.vector(IndPeriod_WarmUp)) {
stop("'IndPeriod_WarmUp' must be a vector of numeric values")
}
if (!is.numeric(IndPeriod_WarmUp)) {
stop("'IndPeriod_WarmUp' must be a vector of numeric values")
}
if (storage.mode(IndPeriod_WarmUp) != "integer") {
stop("'IndPeriod_WarmUp' should be of type integer")
}