Failed to fetch fork details. Try again later.
-
Delaigue Olivier authoredc588a637
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, warnings = TRUE, verbose = TRUE) { if (!missing(RunSnowModule)) { warning("argument 'RunSnowModule' is deprecated; please adapt 'FUN_MOD' instead.", call. = FALSE) } ObjectClass <- NULL ##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 (!BOOL) { stop("incorrect 'FUN_MOD' for use in 'CreateRunOptions' \n") return(NULL) } ##check_InputsModel if (!inherits(InputsModel, "InputsModel")) { stop("'InputsModel' must be of class 'InputsModel' \n") return(NULL) } if ("GR" %in% ObjectClass & !inherits(InputsModel, "GR")) { stop("'InputsModel' must be of class 'GR' \n") return(NULL) } if ("CemaNeige" %in% ObjectClass & !inherits(InputsModel, "CemaNeige")) { stop("'InputsModel' must be of class 'CemaNeige' \n") return(NULL) } if ("hourly" %in% ObjectClass & !inherits(InputsModel, "hourly")) { stop("'InputsModel' must be of class 'hourly' \n") return(NULL) } if ("daily" %in% ObjectClass & !inherits(InputsModel, "daily")) { stop("'InputsModel' must be of class 'daily' \n") return(NULL) } if ("monthly" %in% ObjectClass & !inherits(InputsModel, "monthly")) { stop("'InputsModel' must be of class 'monthly' \n") return(NULL)7172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140
}
if ("yearly" %in% ObjectClass &
!inherits(InputsModel, "yearly")) {
stop("'InputsModel' must be of class 'yearly' \n")
return(NULL)
}
##check_IndPeriod_Run
if (!is.vector(IndPeriod_Run)) {
stop("'IndPeriod_Run' must be a vector of numeric values \n")
return(NULL)
}
if (!is.numeric(IndPeriod_Run)) {
stop("'IndPeriod_Run' must be a vector of numeric values \n")
return(NULL)
}
if (identical(as.integer(IndPeriod_Run), as.integer(seq(from = IndPeriod_Run[1], to = tail(IndPeriod_Run, 1), by = 1))) == FALSE) {
stop("'IndPeriod_Run' must be a continuous sequence of integers \n")
return(NULL)
}
if (storage.mode(IndPeriod_Run) != "integer") {
stop("'IndPeriod_Run' should be of type integer \n")
return(NULL)
}
##check_IndPeriod_WarmUp
WTxt <- NULL
if (is.null(IndPeriod_WarmUp)) {
WTxt <- paste0(WTxt,"\t Model warm up period not defined -> default configuration used \n")
##If_the_run_period_starts_at_the_very_beginning_of_the_time_series
if (IndPeriod_Run[1] == as.integer(1)) {
IndPeriod_WarmUp <- as.integer(0)
WTxt <- paste0(WTxt,"\t No data were found for model warm up! \n")
##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, "\t 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")
}
}
}
if (!is.null(IndPeriod_WarmUp)) {
if (!is.vector(IndPeriod_WarmUp)) {
stop("'IndPeriod_WarmUp' must be a vector of numeric values \n")
return(NULL)
}