Skip to content
GitLab
Select Git revision
Find file BlameHistoryPermalink
CreateIniStates.R 7.41 KiB
1 
CreateIniStates <- function(FUN_MOD, InputsModel,
2 
                            ProdStore = 350, RoutStore = 90, ExpStore = NULL,
3 
                            UH1 = NULL, UH2 = NULL,
4 
                            GCemaNeigeLayers = NULL, eTGCemaNeigeLayers = NULL,
5 
                            GthrCemaNeigeLayers = NULL, GlocmaxCemaNeigeLayers = NULL,
6 
                            verbose = TRUE) {
7
8
9 
  ObjectClass <- NULL
10
11 
  UH1n <- 20L
12 
  UH2n <- UH1n * 2L
13
14 
  nameFUN_MOD <- as.character(substitute(FUN_MOD))
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) |
24 
      identical(FUN_MOD, RunModel_GR5J) |
25 
      identical(FUN_MOD, RunModel_GR6J)) {
26 
    ObjectClass <- c(ObjectClass, "GR", "daily")
27 
    BOOL <- TRUE
28 
  }
29 
  if (identical(FUN_MOD, RunModel_GR2M)) {
30 
    ObjectClass <- c(ObjectClass, "GR", "monthly")
31 
    BOOL <- TRUE
32 
  }
33 
  if (identical(FUN_MOD, RunModel_GR1A)) {
34 
    stop("'RunModel_GR1A' does not require 'IniStates' object")
35 
  }
36 
  if (identical(FUN_MOD, RunModel_CemaNeige)) {
37 
    ObjectClass <- c(ObjectClass, "CemaNeige", "daily")
38 
    BOOL <- TRUE
39 
  }
40 
  if (identical(FUN_MOD, RunModel_CemaNeigeGR4J) |
41 
      identical(FUN_MOD, RunModel_CemaNeigeGR5J) |
42 
      identical(FUN_MOD, RunModel_CemaNeigeGR6J)) {
43 
    ObjectClass <- c(ObjectClass, "GR", "CemaNeige", "daily")
44 
    BOOL <- TRUE
45 
  }
46 
  if (!BOOL) {
47 
    stop("Incorrect 'FUN_MOD' for use in 'CreateIniStates'")
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
62
63 
  ## check states
64 
  if (any(eTGCemaNeigeLayers > 0)) {
65 
    stop("Positive values are not allowed for 'eTGCemaNeigeLayers'")
66 
  }
67
68 
  if (identical(FUN_MOD, RunModel_GR6J) | identical(FUN_MOD, RunModel_CemaNeigeGR6J)) {
69 
    if (is.null(ExpStore)) {
70 
      stop("'RunModel_*GR6J' need an 'ExpStore' value")
7172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140
} } else if (!is.null(ExpStore)) { if (verbose) { warning(sprintf("'%s' does not require 'ExpStore'. Value set to NA", nameFUN_MOD)) } ExpStore <- Inf } if (identical(FUN_MOD, RunModel_GR2M)) { if (!is.null(UH1)) { if (verbose) { warning(sprintf("'%s' does not require 'UH1'. Values set to NA", nameFUN_MOD)) } UH1 <- rep(Inf, UH1n) } if (!is.null(UH2)) { if (verbose) { warning(sprintf("'%s' does not require 'UH2'. Values set to NA", nameFUN_MOD)) } UH2 <- rep(Inf, UH2n) } } if ((identical(FUN_MOD, RunModel_GR5J) | identical(FUN_MOD, RunModel_CemaNeigeGR5J)) & !is.null(UH1)) { if (verbose) { warning(sprintf("'%s' does not require 'UH1'. Values set to NA", nameFUN_MOD)) } UH1 <- rep(Inf, UH1n) } if ("CemaNeige" %in% ObjectClass & ! "GR" %in% ObjectClass) { if (!is.null(ProdStore)) { if (verbose) { warning(sprintf("'%s' does not require 'ProdStore'. Values set to NA", nameFUN_MOD)) } } ProdStore <- Inf if (!is.null(RoutStore)) { if (verbose) { warning(sprintf("'%s' does not require 'RoutStore'. Values set to NA", nameFUN_MOD)) } } RoutStore <- Inf if (!is.null(ExpStore)) { if (verbose) { warning(sprintf("'%s' does not require 'ExpStore'. Values set to NA", nameFUN_MOD)) } } ExpStore <- Inf if (!is.null(UH1)) { if (verbose) { warning(sprintf("'%s' does not require 'UH1'. Values set to NA", nameFUN_MOD)) } } UH1 <- rep(Inf, UH1n) if (!is.null(UH2)) { if (verbose) { warning(sprintf("'%s' does not require 'UH2'. Values set to NA", nameFUN_MOD)) } } UH2 <- rep(Inf, UH2n) } if("CemaNeige" %in% ObjectClass & (is.null(GCemaNeigeLayers) | is.null(eTGCemaNeigeLayers))) { stop(sprintf("'%s' need values for 'GCemaNeigeLayers' and 'GCemaNeigeLayers'", nameFUN_MOD)) } if(!"CemaNeige" %in% ObjectClass & (!is.null(GCemaNeigeLayers) | !is.null(eTGCemaNeigeLayers))) { if (verbose) { warning(sprintf("'%s' does not require 'GCemaNeigeLayers' and 'GCemaNeigeLayers'. Values set to NA", nameFUN_MOD))