v1.0.9.34 CreateIniStates now runs with RunModel_CemaNaige without GR

DESCRIPTION

 Package: airGR
 Type: Package
 Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling
-Version: 1.0.9.33
+Version: 1.0.9.34
 Date: 2017-09-05
 Authors@R: c(
   person("Laurent", "Coron", role = c("aut", "trl")),

R/CreateIniStates.R

@@ -56,7 +56,7 @@ CreateIniStates <- function(FUN_MOD, InputsModel,
   }
   if ("CemaNeige" %in% ObjectClass &
       !inherits(InputsModel, "CemaNeige")) {
-    stop("'RunModel_CemaNeigeGR*' must be of class 'CemaNeige'")
+    stop("'InputsModel' must be of class 'CemaNeige'")
     return(NULL)
   }
   
@@ -87,7 +87,6 @@ CreateIniStates <- function(FUN_MOD, InputsModel,
       }
       UH2 <- rep(Inf, UH2n)
     }
-    
   }
   
   if ((identical(FUN_MOD, RunModel_GR5J) | identical(FUN_MOD, RunModel_CemaNeigeGR5J)) & !is.null(UH1)) {
@@ -96,7 +95,39 @@ CreateIniStates <- function(FUN_MOD, InputsModel,
     }
     UH1 <- rep(Inf, UH1n)
   }
-  
+ 
+  if ("CemaNeige" %in% ObjectClass & ! "GR" %in% ObjectClass) {
+    if (!is.null(ProdStore)) {
+      if (verbose) {
+        warning(sprintf("'%s' does not require 'ProdStore'. Values set to NA", as.character(substitute(FUN_MOD))))
+      }
+    }
+    ProdStore <- Inf
+    if (!is.null(RoutStore)) {
+      if (verbose) {
+        warning(sprintf("'%s' does not require 'RoutStore'. Values set to NA", as.character(substitute(FUN_MOD))))
+      }
+    }
+    RoutStore <- Inf
+    if (!is.null(ExpStore)) {
+      if (verbose) {
+        warning(sprintf("'%s' does not require 'ExpStore'. Values set to NA", as.character(substitute(FUN_MOD))))
+      }
+    }
+    ExpStore <- Inf
+    if (!is.null(UH1)) {
+      if (verbose) {
+        warning(sprintf("'%s' does not require 'UH1'. Values set to NA", as.character(substitute(FUN_MOD))))
+      }
+    }
+    UH1 <- rep(Inf, UH1n)
+    if (!is.null(UH2)) {
+      if (verbose) {
+        warning(sprintf("'%s' does not require 'UH2'. Values set to NA", as.character(substitute(FUN_MOD))))
+      }
+    }
+    UH2 <- rep(Inf, UH2n)
+  }
   if("CemaNeige" %in% ObjectClass &
      (is.null(GCemaNeigeLayers) | is.null(eTGCemaNeigeLayers))) {
     stop("'RunModel_CemaNeigeGR*' need values for 'GCemaNeigeLayers' and 'GCemaNeigeLayers'")
@@ -150,6 +181,7 @@ CreateIniStates <- function(FUN_MOD, InputsModel,
   
   ## check length
   if (!is.numeric(ProdStore) || length(ProdStore) != 1L) {
+    print(ProdStore)
     stop("'ProdStore' must be numeric of length one")
   }
   if (!is.numeric(RoutStore) || length(RoutStore) != 1L) {
@@ -177,52 +209,8 @@ CreateIniStates <- function(FUN_MOD, InputsModel,
     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)
-  # }
-  # else if ("monthly"  %in% ObjectClass) {
-  #   IniStates <- c(ProdStore, RoutStore)
-  # }
-  
-  
+
+  ## format output
   IniStates <- list(Store = list(Prod = ProdStore, Rout = RoutStore, Exp = ExpStore),
                     UH = list(UH1 = UH1, UH2 = UH2),
                     CemaNeigeLayers = list(G = GCemaNeigeLayers, eTG = eTGCemaNeigeLayers))

R/RunModel_CemaNeige.R

@@ -32,7 +32,7 @@ RunModel_CemaNeige <- function(InputsModel,RunOptions,Param){
 
     ##Call_DLL_CemaNeige_________________________
       for(iLayer in 1:NLayers){
-        StateStartCemaNeige <- RunOptions$IniStates[ (2*(iLayer-1)+1):(2*(iLayer-1)+2) ];
+        StateStartCemaNeige <- RunOptions$IniStates[(7+20+40) + c(iLayer, iLayer+NLayers)]
         RESULTS <- .Fortran("frun_CemaNeige",PACKAGE="airGR",
                         ##inputs
                             LInputs=as.integer(length(IndPeriod1)),                                        ### length of input and output series
@@ -52,6 +52,7 @@ RunModel_CemaNeige <- function(InputsModel,RunOptions,Param){
                          )
         RESULTS$Outputs[ round(RESULTS$Outputs ,3)==(-999.999)] <- NA;
         RESULTS$StateEnd[round(RESULTS$StateEnd,3)==(-999.999)] <- NA;
+        
 
         ##Data_storage
         CemaNeigeLayers[[iLayer]] <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]);
@@ -60,7 +61,16 @@ RunModel_CemaNeige <- function(InputsModel,RunOptions,Param){
         rm(RESULTS); 
       } ###ENDFOR_iLayer
       names(CemaNeigeLayers) <- paste("Layer",formatC(1:NLayers,width=2,flag="0"),sep="");
-
+      
+      if (ExportStateEnd) { 
+        CemaNeigeStateEnd <- CreateIniStates(FUN_MOD = RunModel_CemaNeige, InputsModel = InputsModel,
+                                             ProdStore = NULL, RoutStore = NULL, ExpStore = NULL,
+                                             UH1 = NULL, UH2 = NULL,
+                                             GCemaNeigeLayers = CemaNeigeStateEnd[seq_len(2*NLayers)[seq_len(2*NLayers) %% 2 == 1]],
+                                             eTGCemaNeigeLayers = CemaNeigeStateEnd[seq_len(2*NLayers)[seq_len(2*NLayers) %% 2 == 0]],
+                                             verbose = FALSE)
+      }
+      
       ##Output_data_preparation
       if(ExportDatesR==FALSE & ExportStateEnd==FALSE){
         OutputsModel <- list(CemaNeigeLayers);