v1.4.0.7 NEW: add a IsIntStore argument to CreatRunOptions in order to run...

v1.4.0.7 NEW: add a IsIntStore argument to CreatRunOptions in order to run GR5H with interception store #13

DESCRIPTION

 Package: airGR
 Type: Package
 Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling
-Version: 1.4.0.7
+Version: 1.4.0.8
 Date: 2019-12-05
 Authors@R: c(
   person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")),

NEWS.md

@@ -2,7 +2,7 @@
 
 
 
-### 1.4.0.7 Release Notes (2019-12-05)
+### 1.4.0.8 Release Notes (2019-12-05)
 
 
 #### New features

R/CreateRunOptions.R

 CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndPeriod_Run,
-                             IniStates = NULL, IniResLevels = NULL, 
+                             IniStates = NULL, IniResLevels = NULL, IsIntStore = NULL,
                              Outputs_Cal = NULL, Outputs_Sim = "all",
                              RunSnowModule, MeanAnSolidPrecip = NULL, IsHyst = FALSE, 
                              warnings = TRUE, verbose = TRUE) {
@@ -10,13 +10,16 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
   if (!is.logical(IsHyst) | length(IsHyst) != 1L) {
     stop("'IsHyst' must be a 'logical' of length 1")
   }
+  if (!is.logical(IsIntStore) | length(IsIntStore) != 1L) {
+    stop("'IsIntStore' must be a 'logical' of length 1")
+  }
   ObjectClass <- NULL
   
   FUN_MOD <- match.fun(FUN_MOD)
   
   ##check_FUN_MOD
   BOOL <- FALSE
-  if (identical(FUN_MOD, RunModel_GR4H)) {
+  if (identical(FUN_MOD, RunModel_GR4H) | identical(FUN_MOD, RunModel_GR5H)) {
     ObjectClass <- c(ObjectClass, "GR", "hourly")
     BOOL <- TRUE
   }
@@ -44,6 +47,9 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
     ObjectClass <- c(ObjectClass, "GR", "CemaNeige", "hourly")
     BOOL <- TRUE
   }
+  if (IsIntStore) {
+    ObjectClass <- c(ObjectClass, "interception")
+  }
   if (IsHyst) {
     ObjectClass <- c(ObjectClass, "hysteresis")
   }
@@ -51,6 +57,13 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
     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("'IsIntStore' cannot be TRUE for the chosen 'FUN_MOD'")
+  }
+  
   ##check_InputsModel
   if (!inherits(InputsModel, "InputsModel")) {
     stop("'InputsModel' must be of class 'InputsModel'")
@@ -161,21 +174,28 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
         stop("'IniResLevels' must be a vector of numeric values")
       }
       if ((identical(FUN_MOD, RunModel_GR4H) | identical(FUN_MOD, RunModel_CemaNeigeGR4H) |
+           (identical(FUN_MOD, RunModel_GR5H) & !IsIntStore) |
            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 ((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'")
       }
     } else if (is.null(IniStates)) {
       if (identical(FUN_MOD, RunModel_GR6J) | identical(FUN_MOD, RunModel_CemaNeigeGR6J)) {
-        IniResLevels <- as.double(c(0.3, 0.5, 0))
-      } else {
-        IniResLevels <- as.double(c(0.3, 0.5, NA))
+        IniResLevels <- as.double(c(0.3, 0.5, 0, NA))
+      }
+      if ((identical(FUN_MOD, RunModel_GR5H) | identical(FUN_MOD, RunModel_CemaNeigeGR5H)) & IsIntStore) {
+        IniResLevels <- as.double(c(0.3, 0.5, NA, 0))
+      }
+      if (!identical(FUN_MOD, RunModel_GR6J) & !identical(FUN_MOD, RunModel_CemaNeigeGR6J) &
+          !identical(FUN_MOD, RunModel_GR5H) & !identical(FUN_MOD, RunModel_CemaNeigeGR5H)) {
+        IniResLevels <- as.double(c(0.3, 0.5, NA, NA))
       }
     }
   } else {
@@ -221,15 +241,22 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
     if (identical(FUN_MOD, RunModel_GR1A) & !is.null(IniStates)) { ## GR1A
       stop(paste0("'IniStates' is not available for the chosen 'FUN_MOD'"))
     }
-    if ((identical(FUN_MOD, RunModel_GR5J) | identical(FUN_MOD, RunModel_CemaNeigeGR5J)) & !all(is.na(IniStates$UH$UH1))) { ## GR5J
+    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
       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
       stop(paste0("non convenient 'IniStates' for the chosen 'FUN_MOD'.' No exponential store value needed in 'IniStates'"))
     }
+    if (!(identical(FUN_MOD, RunModel_GR5H) | identical(FUN_MOD, RunModel_CemaNeigeGR5H)) & !is.na(IniStates$Store$Int)) { ## except GR5H interception
+      stop(paste0("non convenient 'IniStates' for the chosen 'FUN_MOD'.' No interception store value needed in 'IniStates'"))
+    }
     # if (length(na.omit(unlist(IniStates))) != NState) {
     #   stop(paste0("the length of IniStates must be ", NState, " for the chosen FUN_MOD"))
     # }
@@ -237,9 +264,6 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
         ( "CemaNeige" %in% ObjectClass & !inherits(IniStates, "CemaNeige"))) {
       stop("'FUN_MOD' and 'IniStates' must be both of class 'CemaNeige'")
     }
-    if (!"CemaNeige" %in% ObjectClass & "hysteresis" %in% ObjectClass) {
-      stop("'IsHyst' cannot be TRUE for the chosen 'FUN_MOD'")
-    }
     if (( "hysteresis" %in% ObjectClass & !inherits(IniStates, "hysteresis")) |
         (!"hysteresis" %in% ObjectClass &  inherits(IniStates, "hysteresis"))) {
       stop("'IsHyst' and 'IniStates' are not consistent on the use of the hysteresis")
@@ -256,7 +280,7 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
     if (!"CemaNeige" %in% ObjectClass & any(is.na(IniStates$CemaNeigeLayers$Glocmax))) {
       IniStates$CemaNeigeLayers$Glocmax <- NULL
     }
-    IniStates$Store$Rest <- rep(NA, 4)
+    IniStates$Store$Rest <- rep(NA, 3)
     IniStates <- unlist(IniStates)
     IniStates[is.na(IniStates)] <- 0
     if ("monthly" %in% ObjectClass) {
@@ -274,6 +298,9 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
   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)) {
+    Outputs_all <- c(Outputs_all, .FortranOutputs(GR = "GR5H")$GR)
+  }
   if (identical(FUN_MOD,RunModel_GR4J) | identical(FUN_MOD,RunModel_CemaNeigeGR4J)) {
     Outputs_all <- c(Outputs_all, .FortranOutputs(GR = "GR4J")$GR)
   }
@@ -455,6 +482,9 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
   if ("CemaNeige" %in% ObjectClass) {
     RunOptions <- c(RunOptions, list(MeanAnSolidPrecip = MeanAnSolidPrecip))
   }
+  if ("interception" %in% ObjectClass) {
+    RunOptions <- c(RunOptions, list(Imax = ))
+  }
   class(RunOptions) <- c("RunOptions", ObjectClass)
   
   return(RunOptions)