Skip to content
GitLab
Select Git revision
  • master default
  • v2024_rc
  • 144-create-testing-framework-for-tests-automation
  • v2025_alpha
  • dev/dummy
  • code_refactor
  • board_v4
  • MB.2024.ter_restored
  • Refactor_mb_2023
  • MUX_board_v2024
  • EGU23
  • update_V2023
  • battery_charger
  • mqtt
  • Ohmpi_1.0x
  • v2024.0.34
  • v2024.0.33
  • v2024.0.32
  • v2024.0.31
  • v2024.0.30
  • v2024.0.29
  • v2024.0.28
  • v2024.0.27
  • v2024.0.26
  • v2024.0.25
  • v2024.0.24
  • v2024.0.23
  • v2024.0.22
  • v2024.0.21
  • v2024.0.20
  • v2024.0.19
  • v2024.0.18
  • v2024.0.17
  • v2024.0.16
  • v2024.0.15
Find file BlameHistoryPermalink
CreateIniStates.R 6.73 KiB
1 
CreateIniStates <- function(FUN_MOD, InputsModel,
2 
                            ProdStore = 0.3, RoutStore = 0.5, ExpStore = NULL,
3 
                            UH1 = NULL, UH2 = NULL,
4 
                            GCemaNeigeLayers = NULL, eTGCemaNeigeLayers = NULL,
5 
                            verbose = TRUE) {
6
7
8 
  ObjectClass <- NULL
9
10 
  UH1n <- 20L
11 
  UH2n <- UH1n * 2L
12
13
14 
  ## check FUN_MOD
15 
  BOOL <- FALSE
16 
  if (identical(FUN_MOD, RunModel_GR4H)) {
17 
    ObjectClass <- c(ObjectClass, "GR", "hourly")
18 
    BOOL <- TRUE
19 
  }
20 
  if (identical(FUN_MOD, RunModel_GR4J) |
21 
      identical(FUN_MOD, RunModel_GR5J) |
22 
      identical(FUN_MOD, RunModel_GR6J)) {
23 
    ObjectClass <- c(ObjectClass, "GR", "daily")
24 
    BOOL <- TRUE
25 
  }
26 
  if (identical(FUN_MOD, RunModel_GR2M)) {
27 
    ObjectClass <- c(ObjectClass, "GR", "monthly")
28 
    BOOL <- TRUE
29 
  }
30 
  if (identical(FUN_MOD, RunModel_GR1A)) {
31 
    stop("'RunModel_GR1A' does not require 'IniStates' object")
32 
  }
33 
  if (identical(FUN_MOD, RunModel_CemaNeige)) {
34 
    ObjectClass <- c(ObjectClass, "CemaNeige", "daily")
35 
    BOOL <- TRUE
36 
  }
37 
  if (identical(FUN_MOD, RunModel_CemaNeigeGR4J) |
38 
      identical(FUN_MOD, RunModel_CemaNeigeGR5J) |
39 
      identical(FUN_MOD, RunModel_CemaNeigeGR6J)) {
40 
    ObjectClass <- c(ObjectClass, "GR", "CemaNeige", "daily")
41 
    BOOL <- TRUE
42 
  }
43 
  if (!BOOL) {
44 
    stop("Incorrect 'FUN_MOD' for use in 'CreateIniStates'")
45 
    return(NULL)
46 
  }
47
48 
  ## check InputsModel
49 
  if (!inherits(InputsModel, "InputsModel")) {
50 
    stop("'InputsModel' must be of class 'InputsModel'")
51 
    return(NULL)
52 
  }
53 
  if ("GR" %in% ObjectClass & !inherits(InputsModel, "GR")) {
54 
    stop("'InputsModel' must be of class 'GR'")
55 
    return(NULL)
56 
  }
57 
  if ("CemaNeige" %in% ObjectClass &
58 
      !inherits(InputsModel, "CemaNeige")) {
59 
    stop("'RunModel_CemaNeigeGR*' must be of class 'CemaNeige'")
60 
    return(NULL)
61 
  }
62
63
64 
  ## check states
65 
  if (identical(FUN_MOD, RunModel_GR6J) | identical(FUN_MOD, RunModel_CemaNeigeGR6J)) {
66 
    if (is.null(ExpStore)) {
67 
      stop("'RunModel_*GR6J' need an 'ExpStore' value")
68 
      return(NULL)
69 
    }
70 
  } else if (!is.null(ExpStore) & verbose) {
7172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140
warning("This 'FUN_MOD' does not require 'ExpStore'. Value set to NA") ExpStore <- Inf } if (identical(FUN_MOD, RunModel_GR2M) & verbose) { if (!is.null(UH1)) { warning("This 'FUN_MOD' does not require 'UH1'. Values set to NA") UH1 <- rep(Inf, UH1n) } if (!is.null(UH2)) { warning("This 'FUN_MOD' does not require 'UH2'. Values set to NA") UH2 <- rep(Inf, UH2n) } } if ((identical(FUN_MOD, RunModel_GR5J) | identical(FUN_MOD, RunModel_CemaNeigeGR5J)) & !is.null(UH1) & verbose) { warning("This 'FUN_MOD' does not require 'UH1'. Values set to NA") UH1 <- rep(Inf, UH1n) } if("CemaNeige" %in% ObjectClass & (is.null(GCemaNeigeLayers) | is.null(eTGCemaNeigeLayers))) { stop("'RunModel_CemaNeigeGR*' need values for 'GCemaNeigeLayers' and 'GCemaNeigeLayers'") return(NULL) } if(!"CemaNeige" %in% ObjectClass & (!is.null(GCemaNeigeLayers) | !is.null(eTGCemaNeigeLayers)) & verbose) { warning("This 'FUN_MOD' does not require 'GCemaNeigeLayers' and 'GCemaNeigeLayers'. Values set to NA") GCemaNeigeLayers <- Inf eTGCemaNeigeLayers <- Inf } ## set states if("CemaNeige" %in% ObjectClass) { NLayers <- length(InputsModel$LayerPrecip) } else { NLayers <- 1 } ## manage NULL values if (is.null(ExpStore)) { ExpStore <- Inf } if (is.null(UH1)) { if ("hourly" %in% ObjectClass) { k <- 24 } else { k <- 1 } UH1 <- rep(Inf, 20 * k) } if (is.null(UH2)) { if ("hourly" %in% ObjectClass) { k <- 24 } else { k <- 1 } UH2 <- rep(Inf, 40 * k) } if (is.null(GCemaNeigeLayers)) { GCemaNeigeLayers <- rep(Inf, NLayers) } if (is.null(eTGCemaNeigeLayers)) { eTGCemaNeigeLayers <- rep(Inf, NLayers) }
141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210
## check length if (!is.numeric(ProdStore) || length(ProdStore) != 1L) { stop("'ProdStore' must be numeric of length one") } if (!is.numeric(RoutStore) || length(RoutStore) != 1L) { stop("'RoutStore' must be numeric of length one") } if (!is.numeric(ExpStore) || length(ExpStore) != 1L) { stop("'ExpStore' must be numeric of length one") } if ( "hourly" %in% ObjectClass & (!is.numeric(UH1) || length(UH1) != 480L)) { stop(sprintf("'UH1' must be numeric of length 480 (%i * 24)", UH1n)) } if (!"hourly" %in% ObjectClass & (!is.numeric(UH1) || length(UH1) != 20L)) { stop(sprintf("'UH1' must be numeric of length %i", UH1n)) } if ( "hourly" %in% ObjectClass & (!is.numeric(UH2) || length(UH2) != 960L)) { stop(sprintf("'UH2' must be numeric of length 960 (%i * 24)", UH2n)) } if (!"hourly" %in% ObjectClass & (!is.numeric(UH2) || length(UH2) != 40L)) { stop(sprintf("'UH2' must be numeric of length %i (2 * %i)", UH2n, UH1n)) } if (!is.numeric(GCemaNeigeLayers) || length(GCemaNeigeLayers) != NLayers) { stop(sprintf("'GCemaNeigeLayers' must be numeric of length %i", NLayers)) } if (!is.numeric(eTGCemaNeigeLayers) || length(eTGCemaNeigeLayers) != NLayers) { stop(sprintf("'eTGCemaNeigeLayers' must be numeric of length %i", NLayers)) } # if ("GR" %in% ObjectClass | "CemaNeige" %in% ObjectClass) { # if ("hourly" %in% ObjectClass) { # NState <- 3 * 24 * 20 + 7 # } # if ("daily" %in% ObjectClass) { # if (identical(FUN_MOD, RunModel_GR5J)) { # NState <- # 2 * 20 + 2 * NLayers + 7 # } else { # NState <- 3 * 20 + 2 * NLayers + 7 # } # } # if ("monthly" %in% ObjectClass) { # NState <- 2 # } # if ("yearly" %in% ObjectClass) { # NState <- 1 # } # } # if (!is.null(IniStates)) { # if (!is.vector(IniStates) | !is.numeric(IniStates)) { # stop("IniStates must be a vector of numeric values") # return(NULL) # } # if (length(IniStates) != NState) { # stop(paste0( # "The length of IniStates must be ", # NState, # " for the chosen FUN_MOD" # )) # return(NULL) # } # } else { # IniStates <- as.double(rep(0.0, NState)) # IniStates[1:3] <- NA # } # if ("yearly" %in% ObjectClass) { # IniStates <- c(ProdStore) # }
211212213214215216217218219220221222223224225226227228
# else if ("monthly" %in% ObjectClass) { # IniStates <- c(ProdStore, RoutStore) # } IniStates <- list(Store = list(Prod = ProdStore, Rout = RoutStore, Exp = ExpStore), UH = list(UH1 = UH1, UH2 = UH2), CemaNeigeLayers = list(G = GCemaNeigeLayers, eTG = eTGCemaNeigeLayers)) IniStatesNA <- unlist(IniStates) IniStatesNA[is.infinite(IniStatesNA)] <- NA IniStatesNA <- relist(IniStatesNA, skeleton = IniStates) class(IniStatesNA) <- c("IniStates", ObjectClass) return(IniStatesNA) }