Merge branch '106-runmodel_cemaneige-fails-in-createinputsmodel-at-the-hourly-time-step' into 'dev'

Resolve "RunModel_CemaNeige fails in CreateInputsModel at the hourly time step"

Closes #106

See merge request !36

NAMESPACE

@@ -66,6 +66,7 @@ export(TransfoParam_GR5J)
 export(TransfoParam_GR6J)
 export(TransfoParam_Lag)
 export(.ErrorCrit)
+export(.FeatModels)
 
 
 #####################################

R/CreateInputsModel.R

@@ -11,87 +11,29 @@ CreateInputsModel <- function(FUN_MOD,
 
   ObjectClass <- NULL
 
-  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, "hourly", "GR")
-
-    TimeStep <- as.integer(60 * 60)
-
-    BOOL <- TRUE
+  ## check DatesR
+  if (is.null(DatesR)) {
+    stop("'DatesR' is missing")
   }
-  if (identical(FUN_MOD, RunModel_GR4J) |
-      identical(FUN_MOD, RunModel_GR5J) |
-      identical(FUN_MOD, RunModel_GR6J)) {
-    ObjectClass <- c(ObjectClass, "daily", "GR")
-
-    TimeStep <- as.integer(24 * 60 * 60)
-
-    BOOL <- TRUE
+  if (!"POSIXlt" %in% class(DatesR) & !"POSIXct" %in% class(DatesR)) {
+    stop("'DatesR' must be defined as 'POSIXlt' or 'POSIXct'")
   }
-  if (identical(FUN_MOD, RunModel_GR2M)) {
-    ObjectClass <- c(ObjectClass, "GR", "monthly")
-
-    TimeStep <- as.integer(c(28, 29, 30, 31) * 24 * 60 * 60)
-
-    BOOL <- TRUE
-  }
-  if (identical(FUN_MOD, RunModel_GR1A)) {
-    ObjectClass <- c(ObjectClass, "GR", "yearly")
-
-    TimeStep <- as.integer(c(365, 366) * 24 * 60 * 60)
-
-    BOOL <- TRUE
-  }
-  if (identical(FUN_MOD, RunModel_CemaNeige)) {
-    ObjectClass <- c(ObjectClass, "daily", "CemaNeige")
-
-    TimeStep <- as.integer(24 * 60 * 60)
-
-    BOOL <- TRUE
+  if (!"POSIXlt" %in% class(DatesR)) {
+    DatesR <- as.POSIXlt(DatesR)
   }
-  if (identical(FUN_MOD, RunModel_CemaNeigeGR4J) |
-      identical(FUN_MOD, RunModel_CemaNeigeGR5J) |
-      identical(FUN_MOD, RunModel_CemaNeigeGR6J)) {
-    ObjectClass <- c(ObjectClass, "daily", "GR", "CemaNeige")
-
-    TimeStep <- as.integer(24 * 60 * 60)
-
-    BOOL <- TRUE
+  if (any(duplicated(DatesR))) {
+    stop("'DatesR' must not include duplicated values")
   }
-  if (identical(FUN_MOD, RunModel_CemaNeigeGR4H) | identical(FUN_MOD, RunModel_CemaNeigeGR5H)) {
-    ObjectClass <- c(ObjectClass, "hourly", "GR", "CemaNeige")
+  LLL <- length(DatesR)
 
-    TimeStep <- as.integer(60 * 60)
+  ## check FUN_MOD
+  FUN_MOD <- match.fun(FUN_MOD)
+  FeatFUN_MOD <- .GetFeatModel(FUN_MOD = FUN_MOD, DatesR = DatesR)
+  ObjectClass <- FeatFUN_MOD$Class
 
-    BOOL <- TRUE
-  }
-  if (!BOOL) {
-    stop("incorrect 'FUN_MOD' for use in 'CreateInputsModel'")
-  }
 
   ##check_arguments
-  if ("GR" %in% ObjectClass | "CemaNeige" %in% ObjectClass) {
-    if (is.null(DatesR)) {
-      stop("'DatesR' is missing")
-    }
-    if (!"POSIXlt" %in% class(DatesR) & !"POSIXct" %in% class(DatesR)) {
-      stop("'DatesR' must be defined as 'POSIXlt' or 'POSIXct'")
-    }
-    if (!"POSIXlt" %in% class(DatesR)) {
-      DatesR <- as.POSIXlt(DatesR)
-    }
-    if (!difftime(tail(DatesR, 1), tail(DatesR, 2), units = "secs")[[1]] %in% TimeStep) {
-      TimeStepName <- grep("hourly|daily|monthly|yearly", ObjectClass, value = TRUE)
-      stop(paste0("the time step of the model inputs must be ", TimeStepName, "\n"))
-    }
-    if (any(duplicated(DatesR))) {
-      stop("'DatesR' must not include duplicated values")
-    }
-    LLL <- length(DatesR)
-  }
+
   if ("GR" %in% ObjectClass) {
     if (is.null(Precip)) {
       stop("Precip is missing")

R/CreateRunOptions.R

@@ -4,7 +4,7 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
                              Outputs_Cal = NULL, Outputs_Sim = "all",
                              MeanAnSolidPrecip = NULL, IsHyst = FALSE,
                              warnings = TRUE, verbose = TRUE) {
-  
+
   if (!is.null(Imax)) {
     if (!is.numeric(Imax) | length(Imax) != 1L) {
       stop("'Imax' must be a non negative 'numeric' value of length 1")
@@ -17,57 +17,28 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
   } else {
     IsIntStore <- FALSE
   }
-  ObjectClass <- NULL
-  
+
+  ## check 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)) {
-    ObjectClass <- c(ObjectClass, "GR", "yearly")
-    BOOL <- TRUE
-  }
-  if (identical(FUN_MOD, RunModel_CemaNeige)) {
-    ObjectClass <- c(ObjectClass, "CemaNeige", "daily")
-    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 (identical(FUN_MOD, RunModel_CemaNeigeGR4H) | identical(FUN_MOD, RunModel_CemaNeigeGR5H)) {
-    ObjectClass <- c(ObjectClass, "GR", "CemaNeige", "hourly")
-    BOOL <- TRUE
-  }
+  FeatFUN_MOD <- .GetFeatModel(FUN_MOD = FUN_MOD, DatesR = InputsModel$DatesR)
+  ObjectClass <- FeatFUN_MOD$Class
+  TimeStepMean <- FeatFUN_MOD$TimeStepMean
+
+  ## manage class
   if (IsIntStore) {
     ObjectClass <- c(ObjectClass, "interception")
   }
   if (IsHyst) {
     ObjectClass <- c(ObjectClass, "hysteresis")
   }
-  if (!BOOL) {
-    stop("incorrect 'FUN_MOD' for use in 'CreateRunOptions'")
-  }
-  
+
   if (!"CemaNeige" %in% ObjectClass & "hysteresis" %in% ObjectClass) {
     stop("'IsHyst' cannot be TRUE for the chosen 'FUN_MOD'")
   }
   if (!(identical(FUN_MOD, RunModel_GR5H) | identical(FUN_MOD, RunModel_CemaNeigeGR5H)) & "interception" %in% ObjectClass) {
     stop("'IMax' cannot be set for the chosen 'FUN_MOD'")
   }
-  
+
   ##check_InputsModel
   if (!inherits(InputsModel, "InputsModel")) {
     stop("'InputsModel' must be of class 'InputsModel'")
@@ -94,8 +65,8 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
       !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")
@@ -109,8 +80,8 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
   if (storage.mode(IndPeriod_Run) != "integer") {
     stop("'IndPeriod_Run' should be of type integer")
   }
-  
-  
+
+
   ##check_IndPeriod_WarmUp
   WTxt <- NULL
   if (is.null(IndPeriod_WarmUp)) {
@@ -129,19 +100,7 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
         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) {
+      if (length(IndPeriod_WarmUp) * TimeStepMean / (365 * 24 * 60 * 60) >= 1) {
         WTxt <- paste0(WTxt, "\n  the year preceding the run period is used \n")
       } else {
         WTxt <- paste0(WTxt, "\n  less than a year (without missing values) was found for model warm up:")
@@ -169,34 +128,34 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
   if (!is.null(WTxt) & warnings) {
     warning(WTxt)
   }
-  
-  
-  ## check IniResLevels    
+
+
+  ## 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))) {
-      if (!is.vector(IniResLevels) | is.character(IniResLevels) | is.factor(IniResLevels) | length(IniResLevels) != 4) {      
+      if (!is.vector(IniResLevels) | is.character(IniResLevels) | is.factor(IniResLevels) | length(IniResLevels) != 4) {
         stop("'IniResLevels' must be a vector of 4 numeric values")
       }
       # if ((identical(FUN_MOD, RunModel_GR4H) | identical(FUN_MOD, RunModel_CemaNeigeGR4H) |
       #      # (identical(FUN_MOD, RunModel_GR5H) & !IsIntStore) |
-      #      identical(FUN_MOD, RunModel_GR5H) |          
+      #      identical(FUN_MOD, RunModel_GR5H) |
       #      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 (any(is.na(IniResLevels[1:2]))) {
         stop("the first 2 values of 'IniResLevels' cannot be missing values for the chosen 'FUN_MOD'")
       }
-      # if ((identical(FUN_MOD,RunModel_GR6J) | identical(FUN_MOD,RunModel_CemaNeigeGR6J) |
+      # if ((identical(FUN_MOD, RunModel_GR6J) | identical(FUN_MOD, RunModel_CemaNeigeGR6J) |
       #      (identical(FUN_MOD, RunModel_GR5H) & IsIntStore)) &
       #     length(IniResLevels) != 3) {
       #   stop("the length of 'IniResLevels' must be 3 for the chosen 'FUN_MOD'")
-      # }      
-      if ((identical(FUN_MOD,RunModel_GR6J) | identical(FUN_MOD,RunModel_CemaNeigeGR6J))) {
-        if (is.na(IniResLevels[3L])) {     
+      # }
+      if ((identical(FUN_MOD, RunModel_GR6J) | identical(FUN_MOD, RunModel_CemaNeigeGR6J))) {
+        if (is.na(IniResLevels[3L])) {
           stop("the third value of 'IniResLevels' cannot be a missing value for the chosen 'FUN_MOD'")
         }
       } else {
@@ -205,20 +164,20 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
           IniResLevels[3L] <- NA
         }
       }
-      if (identical(FUN_MOD,RunModel_GR5H) | identical(FUN_MOD,RunModel_CemaNeigeGR5H)) {
-        if (IsIntStore & is.na(IniResLevels[4L])) { 
+      if (identical(FUN_MOD, RunModel_GR5H) | identical(FUN_MOD, RunModel_CemaNeigeGR5H)) {
+        if (IsIntStore & is.na(IniResLevels[4L])) {
           stop("the fourth value of 'IniResLevels' cannot be a missing value for the chosen 'FUN_MOD' (GR5H with an interception store)")
         }
-        if (!IsIntStore & !is.na(IniResLevels[4L])) { 
+        if (!IsIntStore & !is.na(IniResLevels[4L])) {
           warning("the fourth value of 'IniResLevels' is set to NA value for the chosen 'FUN_MOD'. Only GR5H used with an 'Imax' value presents an interception store")
           IniResLevels[4L] <- NA
         }
       } else {
-        if (!is.na(IniResLevels[4L])) {  
+        if (!is.na(IniResLevels[4L])) {
           warning("the fourth value of 'IniResLevels' is set to NA value for the chosen 'FUN_MOD'. Only GR5H used with an 'Imax' value presents an interception store")
           IniResLevels[4L] <- NA
         }
-      }   
+      }
     } else if (is.null(IniStates)) {
       IniResLevels <- as.double(c(0.3, 0.5, NA, NA))
       if (identical(FUN_MOD, RunModel_GR6J) | identical(FUN_MOD, RunModel_CemaNeigeGR6J)) {
@@ -229,7 +188,7 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
       }
       # if (!identical(FUN_MOD, RunModel_GR6J) & !identical(FUN_MOD, RunModel_CemaNeigeGR6J) &
       #     !identical(FUN_MOD, RunModel_GR5H) & !identical(FUN_MOD, RunModel_CemaNeigeGR5H)) {
-      # if (is.null(IniStates)) {     
+      # if (is.null(IniStates)) {
       #   IniResLevels <- as.double(c(0.3, 0.5, NA, NA))
       # }
     }
@@ -253,7 +212,7 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
   NState <- NULL
   if ("GR" %in% ObjectClass | "CemaNeige" %in% ObjectClass) {
     if ("hourly"  %in% ObjectClass) {
-      NState <- 7 + 3 * 24 * 20+ 4 * NLayers
+      NState <- 7 + 3 * 24 * 20 + 4 * NLayers
     }
     if ("daily"   %in% ObjectClass) {
       NState <- 7 + 3 * 20 + 4 * NLayers
@@ -266,7 +225,7 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
     }
   }
   if (!is.null(IniStates)) {
-    
+
     if (!inherits(IniStates, "IniStates")) {
       stop("'IniStates' must be an object of class 'IniStates'")
     }
@@ -278,14 +237,14 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
     }
     if ((identical(FUN_MOD, RunModel_GR5J) | identical(FUN_MOD, RunModel_CemaNeigeGR5J) |
          identical(FUN_MOD, RunModel_GR5H) | identical(FUN_MOD, RunModel_CemaNeigeGR5H)) &
-        !all(is.na(IniStates$UH$UH1))) { ## GR5J or GR5H    
+        !all(is.na(IniStates$UH$UH1))) { ## GR5J or GR5H
       stop(paste0("non convenient 'IniStates' for the chosen 'FUN_MOD'.' In 'IniStates', 'UH1' has to be a vector of NA for GR5J"))
     }
     if ((identical(FUN_MOD, RunModel_GR6J) | identical(FUN_MOD, RunModel_CemaNeigeGR6J)) & is.na(IniStates$Store$Exp)) { ## GR6J
       stop(paste0("non convenient 'IniStates' for the chosen 'FUN_MOD'.' GR6J needs an exponential store value in 'IniStates'"))
     }
     if ((identical(FUN_MOD, RunModel_GR5H) | identical(FUN_MOD, RunModel_CemaNeigeGR5H)) & is.na(IniStates$Store$Int)) { ## GR5H interception
-      
+
       stop(paste0("non convenient 'IniStates' for the chosen 'FUN_MOD'.' GR5H (with interception store) needs an interception store value in 'IniStates'"))
     }
     if (!(identical(FUN_MOD, RunModel_GR6J) | identical(FUN_MOD, RunModel_CemaNeigeGR6J)) & !is.na(IniStates$Store$Exp)) { ## except GR6J
@@ -297,7 +256,7 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
     # if (length(na.omit(unlist(IniStates))) != NState) {
     #   stop(paste0("the length of IniStates must be ", NState, " for the chosen FUN_MOD"))
     # }
-    if ((!"CemaNeige" %in% ObjectClass &  inherits(IniStates, "CemaNeige")) | 
+    if ((!"CemaNeige" %in% ObjectClass &  inherits(IniStates, "CemaNeige")) |
         ( "CemaNeige" %in% ObjectClass & !inherits(IniStates, "CemaNeige"))) {
       stop("'FUN_MOD' and 'IniStates' must be both of class 'CemaNeige'")
     }
@@ -326,37 +285,37 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
   } else {
     IniStates <- as.double(rep(0.0, NState))
   }
-  
-  
+
+
   ##check_Outputs_Cal_and_Sim
-  
+
   ##Outputs_all
   Outputs_all <- NULL
-  if (identical(FUN_MOD,RunModel_GR4H) | identical(FUN_MOD,RunModel_CemaNeigeGR4H)) {
+  if (identical(FUN_MOD, RunModel_GR4H) | identical(FUN_MOD, RunModel_CemaNeigeGR4H)) {
     Outputs_all <- c(Outputs_all, .FortranOutputs(GR = "GR4H")$GR)
   }
-  if (identical(FUN_MOD,RunModel_GR5H) | identical(FUN_MOD,RunModel_CemaNeigeGR5H)) {
+  if (identical(FUN_MOD, RunModel_GR5H) | identical(FUN_MOD, RunModel_CemaNeigeGR5H)) {
     Outputs_all <- c(Outputs_all, .FortranOutputs(GR = "GR5H")$GR)
   }
-  if (identical(FUN_MOD,RunModel_GR4J) | identical(FUN_MOD,RunModel_CemaNeigeGR4J)) {
+  if (identical(FUN_MOD, RunModel_GR4J) | identical(FUN_MOD, RunModel_CemaNeigeGR4J)) {
     Outputs_all <- c(Outputs_all, .FortranOutputs(GR = "GR4J")$GR)
   }
-  if (identical(FUN_MOD,RunModel_GR5J) | identical(FUN_MOD,RunModel_CemaNeigeGR5J)) {
+  if (identical(FUN_MOD, RunModel_GR5J) | identical(FUN_MOD, RunModel_CemaNeigeGR5J)) {
     Outputs_all <- c(Outputs_all, .FortranOutputs(GR = "GR5J")$GR)
   }
-  if (identical(FUN_MOD,RunModel_GR6J) | identical(FUN_MOD,RunModel_CemaNeigeGR6J)) {
+  if (identical(FUN_MOD, RunModel_GR6J) | identical(FUN_MOD, RunModel_CemaNeigeGR6J)) {
     Outputs_all <- c(Outputs_all, .FortranOutputs(GR = "GR6J")$GR)
   }
-  if (identical(FUN_MOD,RunModel_GR2M)) {
+  if (identical(FUN_MOD, RunModel_GR2M)) {
     Outputs_all <- c(Outputs_all, .FortranOutputs(GR = "GR2M")$GR)
   }
-  if (identical(FUN_MOD,RunModel_GR1A)) {
+  if (identical(FUN_MOD, RunModel_GR1A)) {
     Outputs_all <- c(Outputs_all, .FortranOutputs(GR = "GR1A")$GR)
   }
   if ("CemaNeige" %in% ObjectClass) {
     Outputs_all <- c(Outputs_all, .FortranOutputs(GR = NULL, isCN = TRUE)$CN)
   }
-  
+
   ##check_Outputs_Sim
   if (!is.vector(Outputs_Sim)) {
     stop("'Outputs_Sim' must be a vector of characters")
@@ -376,8 +335,8 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
                  paste(Outputs_Sim[Test], collapse = ", "), " not found"))
   }
   Outputs_Sim <- Outputs_Sim[!duplicated(Outputs_Sim)]
-  
-  
+
+
   ##check_Outputs_Cal
   if (is.null(Outputs_Cal)) {
     if ("GR" %in% ObjectClass) {
@@ -403,7 +362,7 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
   }
   if ("all" %in% Outputs_Cal) {
     Outputs_Cal <- c("DatesR", Outputs_all, "StateEnd")
-    
+
   }
   Test <- which(!Outputs_Cal %in% c("DatesR", Outputs_all, "StateEnd"))
   if (length(Test) != 0) {
@@ -411,8 +370,8 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
                 paste(Outputs_Cal[Test], collapse = ", "), " not found"))
   }
   Outputs_Cal <- unique(Outputs_Cal)
-  
-  
+
+
   ##check_MeanAnSolidPrecip
   if ("CemaNeige" %in% ObjectClass & is.null(MeanAnSolidPrecip)) {
     NLayers <- length(InputsModel$LayerPrecip)
@@ -461,8 +420,8 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
       stop(paste0("'MeanAnSolidPrecip' must be a numeric vector of length ", NLayers, ""))
     }
   }
-  
-  
+
+
   ##check_PliqAndMelt
   if ("GR" %in% ObjectClass & "CemaNeige" %in% ObjectClass) {
     if (!"PliqAndMelt" %in% Outputs_Cal & !"all" %in% Outputs_Cal) {
@@ -484,8 +443,8 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
       Outputs_Sim <- c(Outputs_Sim, "PliqAndMelt")
     }
   }
-  
-  
+
+
   ##check_Qsim
   if ("GR" %in% ObjectClass) {
     if (!"Qsim" %in% Outputs_Cal & !"all" %in% Outputs_Cal) {
@@ -507,7 +466,7 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
       Outputs_Sim <- c(Outputs_Sim, "Qsim")
     }
   }
-  
+
   ##Create_RunOptions
   RunOptions <- list(IndPeriod_WarmUp = IndPeriod_WarmUp,
                      IndPeriod_Run = IndPeriod_Run,
@@ -515,7 +474,7 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
                      IniResLevels = IniResLevels,
                      Outputs_Cal = Outputs_Cal,
                      Outputs_Sim = Outputs_Sim)
-  
+
   if ("CemaNeige" %in% ObjectClass) {
     RunOptions <- c(RunOptions, list(MeanAnSolidPrecip = MeanAnSolidPrecip))
   }
@@ -523,9 +482,9 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
     RunOptions <- c(RunOptions, list(Imax = Imax))
   }
   class(RunOptions) <- c("RunOptions", ObjectClass)
-  
+
   return(RunOptions)
-  
-  
+
+
 }
 

R/Utils.R

@@ -13,6 +13,70 @@
 
 
 
+## =================================================================================
+## function to extract model features
+## =================================================================================
+
+## table of feature models
+.FeatModels <- function() {
+  path <- system.file("modelsFeatures/FeatModelsGR.csv", package = "airGR")
+  read.table(path, header = TRUE, sep = ";", stringsAsFactors = FALSE)
+}
+
+
+## function to extract model features
+.GetFeatModel <- function(FUN_MOD, DatesR = NULL) {
+  FeatMod <- .FeatModels()
+  NameFunMod <- ifelse(test = FeatMod$Pkg %in% "airGR",
+                       yes  = paste("RunModel", FeatMod$NameMod, sep = "_"),
+                       no   = FeatMod$NameMod)
+  FunMod <- lapply(NameFunMod, FUN = get)
+  IdMod <- which(sapply(FunMod, FUN = function(x) identical(FUN_MOD, x)))
+  if (length(IdMod) < 1) {
+    stop("'FUN_MOD' must be one of ", paste(NameFunMod, collapse = ", "))
+  } else {
+    res <- as.list(FeatMod[IdMod, ])
+    res$NameFunMod <- NameFunMod[IdMod]
+    if (!is.null(DatesR)) {
+      DiffTimeStep <- as.numeric(difftime(DatesR[length(DatesR)],
+                                          DatesR[length(DatesR)-1],
+                                          units = "secs"))
+      if (is.na(res$TimeUnit)) {
+        if (any(DiffTimeStep %in% 3600:3601)) { # 3601: leap second
+          res$TimeUnit <- "hourly"
+        } else {
+          res$TimeUnit <- "daily"
+        }
+      }
+    }
+    res$TimeStep <- switch(res$TimeUnit,
+                           hourly  =       1,
+                           daily   =       1 * 24,
+                           monthly =   28:31 * 24,
+                           yearly  = 365:366 * 24)
+    res$TimeStepMean <- switch(res$TimeUnit,
+                               hourly  =           1,
+                               daily   =           1 * 24,
+                               monthly = 365.25 / 12 * 24,
+                               yearly  =      365.25 * 24)
+    res$TimeStep     <- res$TimeStep * 3600
+    res$TimeStepMean <- as.integer(res$TimeStepMean * 3600)
+    res$Class <- c(res$TimeUnit, res$Class)
+    if (grepl("CemaNeige", res$NameFunMod)) {
+      res$Class <- c(res$Class, "CemaNeige")
+    }
+    res$Class <- res$Class[!is.na(res$Class)]
+    if (!is.null(DatesR)) {
+      if (all(DiffTimeStep != res$TimeStep)) {
+        stop("the time step of the model inputs must be ", res$TimeUnit)
+      }
+    }
+    return(res)
+  }
+}
+
+
+
 ## =================================================================================
 ## function to manage Fortran outputs
 ## =================================================================================

inst/modelsFeatures/FeatModelsGR.csv

+CodeMod;NameMod;NbParam;TimeUnit;Id;Class;Pkg
+GR1A;GR1A;1;yearly;NA;GR;airGR
+GR2M;GR2M;2;monthly;NA;GR;airGR
+GR4J;GR4J;4;daily;NA;GR;airGR
+GR5J;GR5J;5;daily;NA;GR;airGR
+GR6J;GR6J;6;daily;NA;GR;airGR
+GR4H;GR4H;4;hourly;NA;GR;airGR
+GR5H;GR5H;5;hourly;NA;GR;airGR
+CemaNeige;CemaNeige;2;NA;NA;NA;airGR
+CemaNeigeGR4J;CemaNeigeGR4J;6;daily;NA;GR;airGR
+CemaNeigeGR5J;CemaNeigeGR5J;7;daily;NA;GR;airGR
+CemaNeigeGR6J;CemaNeigeGR6J;8;daily;NA;GR;airGR
+CemaNeigeGR4H;CemaNeigeGR4H;6;hourly;NA;GR;airGR
+CemaNeigeGR5H;CemaNeigeGR5H;7;hourly;NA;GR;airGR