Skip to content
GitLab
Select Git revision
Find file BlameHistoryPermalink
CreateRunOptions.R 15.51 KiB
1 
CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndPeriod_Run,
2 
                             IniStates = NULL, IniResLevels = NULL,
3 
                             Outputs_Cal = NULL, Outputs_Sim = "all",
4 
                             RunSnowModule, MeanAnSolidPrecip = NULL, IsHyst = FALSE,
5 
                             warnings = TRUE, verbose = TRUE) {
6
7 
  if (!missing(RunSnowModule)) {
8 
    warning("argument 'RunSnowModule' is deprecated; please adapt 'FUN_MOD' instead.", call. = FALSE)
9 
  }
10 
  if (!is.logical(IsHyst) | length(IsHyst) != 1L) {
11 
    stop("'IsHyst' must be a 'logical' of length 1")
12 
  }
13 
  ObjectClass <- NULL
14
15 
  FUN_MOD <- match.fun(FUN_MOD)
16
17 
  ##check_FUN_MOD
18 
  BOOL <- FALSE
19 
  if (identical(FUN_MOD, RunModel_GR4H)) {
20 
    ObjectClass <- c(ObjectClass, "GR", "hourly")
21 
    BOOL <- TRUE
22 
  }
23 
  if (identical(FUN_MOD, RunModel_GR4J) | identical(FUN_MOD, RunModel_GR5J) | identical(FUN_MOD, RunModel_GR6J)) {
24 
    ObjectClass <- c(ObjectClass, "GR", "daily")
25 
    BOOL <- TRUE
26 
  }
27 
  if (identical(FUN_MOD, RunModel_GR2M)) {
28 
    ObjectClass <- c(ObjectClass, "GR", "monthly")
29 
    BOOL <- TRUE
30 
  }
31 
  if (identical(FUN_MOD, RunModel_GR1A)) {
32 
    ObjectClass <- c(ObjectClass, "GR", "yearly")
33 
    BOOL <- TRUE
34 
  }
35 
  if (identical(FUN_MOD, RunModel_CemaNeige)) {
36 
    ObjectClass <- c(ObjectClass, "CemaNeige", "daily")
37 
    BOOL <- TRUE
38 
  }
39 
  if (identical(FUN_MOD, RunModel_CemaNeigeGR4J) | identical(FUN_MOD, RunModel_CemaNeigeGR5J) | identical(FUN_MOD, RunModel_CemaNeigeGR6J)) {
40 
    ObjectClass <- c(ObjectClass, "GR", "CemaNeige", "daily")
41 
    BOOL <- TRUE
42 
  }
43 
  if (IsHyst) {
44 
    ObjectClass <- c(ObjectClass, "hysteresis")
45 
  }
46 
  if (!BOOL) {
47 
    stop("incorrect 'FUN_MOD' for use in 'CreateRunOptions'")
48 
  }
49
50 
  ##check_InputsModel
51 
  if (!inherits(InputsModel, "InputsModel")) {
52 
    stop("'InputsModel' must be of class 'InputsModel'")
53 
  }
54 
  if ("GR" %in% ObjectClass & !inherits(InputsModel, "GR")) {
55 
    stop("'InputsModel' must be of class 'GR'")
56 
  }
57 
  if ("CemaNeige" %in% ObjectClass &
58 
      !inherits(InputsModel, "CemaNeige")) {
59 
    stop("'InputsModel' must be of class 'CemaNeige'")
60 
  }
61 
  if ("hourly" %in% ObjectClass &
62 
      !inherits(InputsModel, "hourly")) {
63 
    stop("'InputsModel' must be of class 'hourly'")
64 
  }
65 
  if ("daily" %in% ObjectClass & !inherits(InputsModel, "daily")) {
66 
    stop("'InputsModel' must be of class 'daily'")
67 
  }
68 
  if ("monthly" %in% ObjectClass &
69 
      !inherits(InputsModel, "monthly")) {
70 
    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 <- paste0(WTxt,"\t Model warm up period not defined -> default configuration used") ##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!") ##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") } 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") }
141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210
if (identical(IndPeriod_WarmUp, as.integer(0)) & verbose) { message(paste0(WTxt, "\t No warm up period is used \n")) } 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") } } if (!is.null(WTxt) & warnings) { warning(WTxt) } ## check IniResLevels if ("GR" %in% ObjectClass & ("monthly" %in% ObjectClass | "daily" %in% ObjectClass | "hourly" %in% ObjectClass)) { if (!is.null(IniResLevels)) { if (!is.vector(IniResLevels) | !is.numeric(IniResLevels) | any(is.na(IniResLevels))) { stop("'IniResLevels' must be a vector of numeric values") } if ((identical(FUN_MOD, RunModel_GR4H) | identical(FUN_MOD, RunModel_GR4J) | identical(FUN_MOD, RunModel_CemaNeigeGR4J) | 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'") } 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'") } } else if (is.null(IniStates)) { if (identical(FUN_MOD, RunModel_GR6J) | identical(FUN_MOD, RunModel_CemaNeigeGR6J)) { IniResLevels <- as.double(c(0.3, 0.5, 0)) } else { IniResLevels <- as.double(c(0.3, 0.5, NA)) } } } else { if (!is.null(IniResLevels)) { stop("'IniResLevels' can only be used with monthly or daily or hourly GR models") } } ## check IniStates if (is.null(IniStates) & is.null(IniResLevels) & warnings) { warning("\t 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'") } if ("CemaNeige" %in% ObjectClass) { NLayers <- length(InputsModel$LayerPrecip) } else { NLayers <- 0 } NState <- NULL if ("GR" %in% ObjectClass | "CemaNeige" %in% ObjectClass) { if ("hourly" %in% ObjectClass) { NState <- 7 + 3 * 24 * 20 } if ("daily" %in% ObjectClass) { NState <- 7 + 3 * 20 + 4 * NLayers } if ("monthly" %in% ObjectClass) { NState <- 2 } if ("yearly" %in% ObjectClass) { NState <- 1 } } if (!is.null(IniStates)) {