CreateIniStates.R

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

  FUN_MOD <- match.fun(FUN_MOD)

  FeatFUN_MOD <- .GetFeatModel(FUN_MOD = FUN_MOD, DatesR = InputsModel$DatesR)
  ObjectClass <- FeatFUN_MOD$Class

  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'")
  }


  ## 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", FeatFUN_MOD$NameFunMod))
    }
    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", FeatFUN_MOD$NameFunMod))
      }
      UH1 <- rep(Inf, UH1n)
    }
    if (!is.null(UH2)) {
      if (verbose) {
        warning(sprintf("'%s' does not require 'UH2'. Values set to NA", FeatFUN_MOD$NameFunMod))
      }
      UH2 <- rep(Inf, UH2n)
    }
  }