diff --git a/DESCRIPTION b/DESCRIPTION
index f9177051b19d633644d4333b5287e59a38116a91..0d179e0473e6af9332ae85113d46350235a6967d 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,7 +1,7 @@
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")),
diff --git a/R/CreateIniStates.R b/R/CreateIniStates.R
index af764d46a2ab0a1aeaa8a336229517108cc45104..5644dcce597e68d3bf7d12adce50d3f774f4c0fe 100644
--- a/R/CreateIniStates.R
+++ b/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))
diff --git a/R/RunModel_CemaNeige.R b/R/RunModel_CemaNeige.R
index fa4e637e70a7409c6653e59fcc962fabdd55c376..d9bdac3f0598fdc71c2849cce760e173fe3310b7 100644
--- a/R/RunModel_CemaNeige.R
+++ b/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);