Skip to content

GitLab

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

v1.0.9.34 CreateIniStates now runs with RunModel_CemaNaige without GR

parent a1932326
Hide whitespace changes
Inline Side-by-side
DESCRIPTION
View file @ 3911d1bb
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
View file @ 3911d1bb
......@@ -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
View file @ 3911d1bb
......@@ -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);
......
Markdown is supported
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