Commit 3911d1bb authored by unknown's avatar unknown
Browse files

v1.0.9.34 CreateIniStates now runs with RunModel_CemaNaige without GR

Showing with 50 additions and 52 deletions
+50 -52
Package: airGR Package: airGR
Type: Package Type: Package
Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling
Version: 1.0.9.33 Version: 1.0.9.34
Date: 2017-09-05 Date: 2017-09-05
Authors@R: c( Authors@R: c(
person("Laurent", "Coron", role = c("aut", "trl")), person("Laurent", "Coron", role = c("aut", "trl")),
......
...@@ -56,7 +56,7 @@ CreateIniStates <- function(FUN_MOD, InputsModel, ...@@ -56,7 +56,7 @@ CreateIniStates <- function(FUN_MOD, InputsModel,
} }
if ("CemaNeige" %in% ObjectClass & if ("CemaNeige" %in% ObjectClass &
!inherits(InputsModel, "CemaNeige")) { !inherits(InputsModel, "CemaNeige")) {
stop("'RunModel_CemaNeigeGR*' must be of class 'CemaNeige'") stop("'InputsModel' must be of class 'CemaNeige'")
return(NULL) return(NULL)
} }
...@@ -87,7 +87,6 @@ CreateIniStates <- function(FUN_MOD, InputsModel, ...@@ -87,7 +87,6 @@ CreateIniStates <- function(FUN_MOD, InputsModel,
} }
UH2 <- rep(Inf, UH2n) UH2 <- rep(Inf, UH2n)
} }
} }
if ((identical(FUN_MOD, RunModel_GR5J) | identical(FUN_MOD, RunModel_CemaNeigeGR5J)) & !is.null(UH1)) { if ((identical(FUN_MOD, RunModel_GR5J) | identical(FUN_MOD, RunModel_CemaNeigeGR5J)) & !is.null(UH1)) {
...@@ -96,7 +95,39 @@ CreateIniStates <- function(FUN_MOD, InputsModel, ...@@ -96,7 +95,39 @@ CreateIniStates <- function(FUN_MOD, InputsModel,
} }
UH1 <- rep(Inf, UH1n) 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 & if("CemaNeige" %in% ObjectClass &
(is.null(GCemaNeigeLayers) | is.null(eTGCemaNeigeLayers))) { (is.null(GCemaNeigeLayers) | is.null(eTGCemaNeigeLayers))) {
stop("'RunModel_CemaNeigeGR*' need values for 'GCemaNeigeLayers' and 'GCemaNeigeLayers'") stop("'RunModel_CemaNeigeGR*' need values for 'GCemaNeigeLayers' and 'GCemaNeigeLayers'")
...@@ -150,6 +181,7 @@ CreateIniStates <- function(FUN_MOD, InputsModel, ...@@ -150,6 +181,7 @@ CreateIniStates <- function(FUN_MOD, InputsModel,
## check length ## check length
if (!is.numeric(ProdStore) || length(ProdStore) != 1L) { if (!is.numeric(ProdStore) || length(ProdStore) != 1L) {
print(ProdStore)
stop("'ProdStore' must be numeric of length one") stop("'ProdStore' must be numeric of length one")
} }
if (!is.numeric(RoutStore) || length(RoutStore) != 1L) { if (!is.numeric(RoutStore) || length(RoutStore) != 1L) {
...@@ -177,52 +209,8 @@ CreateIniStates <- function(FUN_MOD, InputsModel, ...@@ -177,52 +209,8 @@ CreateIniStates <- function(FUN_MOD, InputsModel,
stop(sprintf("'eTGCemaNeigeLayers' must be numeric of length %i", NLayers)) stop(sprintf("'eTGCemaNeigeLayers' must be numeric of length %i", NLayers))
} }
# if ("GR" %in% ObjectClass | "CemaNeige" %in% ObjectClass) { ## format output
# 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)
# }
IniStates <- list(Store = list(Prod = ProdStore, Rout = RoutStore, Exp = ExpStore), IniStates <- list(Store = list(Prod = ProdStore, Rout = RoutStore, Exp = ExpStore),
UH = list(UH1 = UH1, UH2 = UH2), UH = list(UH1 = UH1, UH2 = UH2),
CemaNeigeLayers = list(G = GCemaNeigeLayers, eTG = eTGCemaNeigeLayers)) CemaNeigeLayers = list(G = GCemaNeigeLayers, eTG = eTGCemaNeigeLayers))
......
...@@ -32,7 +32,7 @@ RunModel_CemaNeige <- function(InputsModel,RunOptions,Param){ ...@@ -32,7 +32,7 @@ RunModel_CemaNeige <- function(InputsModel,RunOptions,Param){
##Call_DLL_CemaNeige_________________________ ##Call_DLL_CemaNeige_________________________
for(iLayer in 1:NLayers){ 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", RESULTS <- .Fortran("frun_CemaNeige",PACKAGE="airGR",
##inputs ##inputs
LInputs=as.integer(length(IndPeriod1)), ### length of input and output series LInputs=as.integer(length(IndPeriod1)), ### length of input and output series
...@@ -52,6 +52,7 @@ RunModel_CemaNeige <- function(InputsModel,RunOptions,Param){ ...@@ -52,6 +52,7 @@ RunModel_CemaNeige <- function(InputsModel,RunOptions,Param){
) )
RESULTS$Outputs[ round(RESULTS$Outputs ,3)==(-999.999)] <- NA; RESULTS$Outputs[ round(RESULTS$Outputs ,3)==(-999.999)] <- NA;
RESULTS$StateEnd[round(RESULTS$StateEnd,3)==(-999.999)] <- NA; RESULTS$StateEnd[round(RESULTS$StateEnd,3)==(-999.999)] <- NA;
##Data_storage ##Data_storage
CemaNeigeLayers[[iLayer]] <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]); CemaNeigeLayers[[iLayer]] <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]);
...@@ -60,7 +61,16 @@ RunModel_CemaNeige <- function(InputsModel,RunOptions,Param){ ...@@ -60,7 +61,16 @@ RunModel_CemaNeige <- function(InputsModel,RunOptions,Param){
rm(RESULTS); rm(RESULTS);
} ###ENDFOR_iLayer } ###ENDFOR_iLayer
names(CemaNeigeLayers) <- paste("Layer",formatC(1:NLayers,width=2,flag="0"),sep=""); 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 ##Output_data_preparation
if(ExportDatesR==FALSE & ExportStateEnd==FALSE){ if(ExportDatesR==FALSE & ExportStateEnd==FALSE){
OutputsModel <- list(CemaNeigeLayers); OutputsModel <- list(CemaNeigeLayers);
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment