Forked from HYCAR-Hydro / airGR
Source project has a limited visibility.
CreateIniStates.R 10.94 KiB
CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = FALSE,
                            ProdStore = 350, RoutStore = 90, ExpStore = NULL, IntStore = NULL,
                            UH1 = NULL, UH2 = NULL,
                            GCemaNeigeLayers = NULL, eTGCemaNeigeLayers = NULL,
                            GthrCemaNeigeLayers = NULL, GlocmaxCemaNeigeLayers = NULL,
                            SD = NULL,
                            verbose = TRUE) {
  ObjectClass <- NULL
  UH1n <- 20L
  UH2n <- UH1n * 2L
  nameFUN_MOD <- as.character(substitute(FUN_MOD))
  FUN_MOD <- match.fun(FUN_MOD)
  ## check FUN_MOD
  BOOL <- FALSE
  if (identical(FUN_MOD, RunModel_GR4H) | identical(FUN_MOD, RunModel_GR5H)) {
    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)) {
    stop("'RunModel_GR1A' does not require 'IniStates' object")
  if (identical(FUN_MOD, RunModel_CemaNeige)) {
    ObjectClass <- c(ObjectClass, "CemaNeige", "daily")
    BOOL <- TRUE
  if (identical(FUN_MOD, RunModel_CemaNeigeGR4H) | identical(FUN_MOD, RunModel_CemaNeigeGR5H)) {
    ObjectClass <- c(ObjectClass, "GR", "CemaNeige", "hourly")
    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 'CreateIniStates'")
  if (!"CemaNeige" %in% ObjectClass & IsHyst) {
    stop("'IsHyst' cannot be TRUE if CemaNeige is not used in 'FUN_MOD'")
  if (!(identical(FUN_MOD, RunModel_GR5H) | identical(FUN_MOD, RunModel_CemaNeigeGR5H)) & IsIntStore) {
    stop("'IsIntStore' cannot be TRUE if GR5H is not used in 'FUN_MOD'")
  ## 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'")
7172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140
} ## check states if (any(eTGCemaNeigeLayers > 0)) { stop("Positive values are not allowed for 'eTGCemaNeigeLayers'") } if (identical(FUN_MOD, RunModel_GR6J) | identical(FUN_MOD, RunModel_CemaNeigeGR6J)) { if (is.null(ExpStore)) { stop("'RunModel_*GR6J' need an 'ExpStore' value") } } 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 ((!identical(FUN_MOD, RunModel_GR5H) | identical(FUN_MOD, RunModel_CemaNeigeGR5H)) & !is.null(IntStore)) { if (verbose) { warning(sprintf("'%s' does not require 'IntStore'. Values set to NA", nameFUN_MOD)) } IntStore <- Inf } 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(IntStore)) { if (verbose) { warning(sprintf("'%s' does not require 'IntStore'. Values set to NA", nameFUN_MOD)) }
141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210
} IntStore <- 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(IsIntStore & is.null(IntStore)) { stop(sprintf("'%s' need values for 'IntStore'", nameFUN_MOD)) } if("CemaNeige" %in% ObjectClass & !IsHyst & (is.null(GCemaNeigeLayers) | is.null(eTGCemaNeigeLayers))) { stop(sprintf("'%s' need values for 'GCemaNeigeLayers' and 'GCemaNeigeLayers'", nameFUN_MOD)) } if("CemaNeige" %in% ObjectClass & IsHyst & (is.null(GCemaNeigeLayers) | is.null(eTGCemaNeigeLayers) | is.null(GthrCemaNeigeLayers) | is.null(GlocmaxCemaNeigeLayers))) { stop(sprintf("'%s' need values for 'GCemaNeigeLayers', 'GCemaNeigeLayers', 'GthrCemaNeigeLayers' and 'GlocmaxCemaNeigeLayers'", nameFUN_MOD)) } if("CemaNeige" %in% ObjectClass & !IsHyst & (!is.null(GthrCemaNeigeLayers) | !is.null(GlocmaxCemaNeigeLayers))) { if (verbose) { warning(sprintf("'%s' does not require 'GthrCemaNeigeLayers' and 'GlocmaxCemaNeigeLayers'. Values set to NA", nameFUN_MOD)) } GthrCemaNeigeLayers <- Inf GlocmaxCemaNeigeLayers <- Inf } if(!"CemaNeige" %in% ObjectClass & (!is.null(GCemaNeigeLayers) | !is.null(eTGCemaNeigeLayers) | !is.null(GthrCemaNeigeLayers) | !is.null(GlocmaxCemaNeigeLayers))) { if (verbose) { warning(sprintf("'%s' does not require 'GCemaNeigeLayers' 'GCemaNeigeLayers', 'GthrCemaNeigeLayers' and 'GlocmaxCemaNeigeLayers'. Values set to NA", nameFUN_MOD)) } GCemaNeigeLayers <- Inf eTGCemaNeigeLayers <- Inf GthrCemaNeigeLayers <- Inf GlocmaxCemaNeigeLayers <- 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(IntStore)) { IntStore <- Inf } if (is.null(UH1)) { if ("hourly" %in% ObjectClass) { k <- 24 } else { k <- 1 } UH1 <- rep(Inf, UH1n * k) }