Commit 29dec7ea authored by Dorchies David's avatar Dorchies David
Browse files

refactor(RunModel_*GR*): argument check with the function .ArgumentsCheckGR

Refs #129
parent 8431b150
Pipeline #24009 passed with stages
in 32 minutes and 55 seconds
...@@ -25,9 +25,8 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, ...@@ -25,9 +25,8 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
TimeStepMean <- FeatFUN_MOD$TimeStepMean TimeStepMean <- FeatFUN_MOD$TimeStepMean
## Model output variable list ## Model output variable list
ModelHydro <- gsub("CemaNeige", "", FeatFUN_MOD$CodeMod) FortranOutputs <- .FortranOutputs(GR = FeatFUN_MOD$CodeModHydro,
FortranOutputs <- .FortranOutputs(GR = ModelHydro, isCN = "CemaNeige" %in% FeatFUN_MOD$Class)
isCN = substr(FeatFUN_MOD$CodeMod, 1, 9) == "CemaNeige")
## manage class ## manage class
if (IsIntStore) { if (IsIntStore) {
...@@ -35,6 +34,7 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, ...@@ -35,6 +34,7 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
} }
if (IsHyst) { if (IsHyst) {
ObjectClass <- c(ObjectClass, "hysteresis") ObjectClass <- c(ObjectClass, "hysteresis")
FeatFUN_MOD$NbParam <- FeatFUN_MOD$NbParam + 2
} }
if (!"CemaNeige" %in% ObjectClass & "hysteresis" %in% ObjectClass) { if (!"CemaNeige" %in% ObjectClass & "hysteresis" %in% ObjectClass) {
...@@ -479,7 +479,8 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, ...@@ -479,7 +479,8 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
IniResLevels = IniResLevels, IniResLevels = IniResLevels,
Outputs_Cal = Outputs_Cal, Outputs_Cal = Outputs_Cal,
Outputs_Sim = Outputs_Sim, Outputs_Sim = Outputs_Sim,
FortranOutputs = FortranOutputs) FortranOutputs = FortranOutputs,
FeatFUN_MOD = FeatFUN_MOD)
if ("CemaNeige" %in% ObjectClass) { if ("CemaNeige" %in% ObjectClass) {
RunOptions <- c(RunOptions, list(MeanAnSolidPrecip = MeanAnSolidPrecip)) RunOptions <- c(RunOptions, list(MeanAnSolidPrecip = MeanAnSolidPrecip))
......
...@@ -3,39 +3,12 @@ RunModel_CemaNeigeGR4H <- function(InputsModel, RunOptions, Param) { ...@@ -3,39 +3,12 @@ RunModel_CemaNeigeGR4H <- function(InputsModel, RunOptions, Param) {
## Initialization of variables ## Initialization of variables
IsHyst <- inherits(RunOptions, "hysteresis") IsHyst <- inherits(RunOptions, "hysteresis")
NParam <- ifelse(test = IsHyst, yes = 8L, no = 6L) NParamCN <- RunOptions$FeatFUN_MOD$NbParam - 4L
NParamCN <- NParam - 4L
NStates <- 4L NStates <- 4L
## Arguments check .ArgumentsCheckGR(InputsModel, RunOptions, Param)
if (!inherits(InputsModel, "InputsModel")) {
stop("'InputsModel' must be of class 'InputsModel'")
}
if (!inherits(InputsModel, "hourly")) {
stop("'InputsModel' must be of class 'hourly'")
}
if (!inherits(InputsModel, "GR")) {
stop("'InputsModel' must be of class 'GR'")
}
if (!inherits(InputsModel, "CemaNeige")) {
stop("'InputsModel' must be of class 'CemaNeige'")
}
if (!inherits(RunOptions, "RunOptions")) {
stop("'RunOptions' must be of class 'RunOptions'")
}
if (!inherits(RunOptions, "GR")) {
stop("'RunOptions' must be of class 'GR'")
}
if (!inherits(RunOptions, "CemaNeige")) {
stop("'RunOptions' must be of class 'CemaNeige'")
}
if (!is.vector(Param) | !is.numeric(Param)) {
stop("'Param' must be a numeric vector")
}
if (sum(!is.na(Param)) != NParam) {
stop(paste("'Param' must be a vector of length", NParam, "and contain no NA"))
}
Param <- as.double(Param) Param <- as.double(Param)
......
...@@ -3,39 +3,12 @@ RunModel_CemaNeigeGR4J <- function(InputsModel, RunOptions, Param) { ...@@ -3,39 +3,12 @@ RunModel_CemaNeigeGR4J <- function(InputsModel, RunOptions, Param) {
## Initialization of variables ## Initialization of variables
IsHyst <- inherits(RunOptions, "hysteresis") IsHyst <- inherits(RunOptions, "hysteresis")
NParam <- ifelse(test = IsHyst, yes = 8L, no = 6L) NParamCN <- RunOptions$FeatFUN_MOD$NbParam - 4L
NParamCN <- NParam - 4L
NStates <- 4L NStates <- 4L
## Arguments check .ArgumentsCheckGR(InputsModel, RunOptions, Param)
if (!inherits(InputsModel, "InputsModel")) {
stop("'InputsModel' must be of class 'InputsModel'")
}
if (!inherits(InputsModel, "daily")) {
stop("'InputsModel' must be of class 'daily'")
}
if (!inherits(InputsModel, "GR")) {
stop("'InputsModel' must be of class 'GR'")
}
if (!inherits(InputsModel, "CemaNeige")) {
stop("'InputsModel' must be of class 'CemaNeige'")
}
if (!inherits(RunOptions, "RunOptions")) {
stop("'RunOptions' must be of class 'RunOptions'")
}
if (!inherits(RunOptions, "GR")) {
stop("'RunOptions' must be of class 'GR'")
}
if (!inherits(RunOptions, "CemaNeige")) {
stop("'RunOptions' must be of class 'CemaNeige'")
}
if (!is.vector(Param) | !is.numeric(Param)) {
stop("'Param' must be a numeric vector")
}
if (sum(!is.na(Param)) != NParam) {
stop(paste("'Param' must be a vector of length", NParam, "and contain no NA"))
}
Param <- as.double(Param) Param <- as.double(Param)
......
...@@ -3,8 +3,7 @@ RunModel_CemaNeigeGR5H <- function(InputsModel, RunOptions, Param) { ...@@ -3,8 +3,7 @@ RunModel_CemaNeigeGR5H <- function(InputsModel, RunOptions, Param) {
## Initialization of variables ## Initialization of variables
IsHyst <- inherits(RunOptions, "hysteresis") IsHyst <- inherits(RunOptions, "hysteresis")
NParam <- ifelse(test = IsHyst, yes = 9L, no = 7L) NParamCN <- RunOptions$FeatFUN_MOD$NbParam - 5L
NParamCN <- NParam - 5L
NStates <- 4L NStates <- 4L
IsIntStore <- inherits(RunOptions, "interception") IsIntStore <- inherits(RunOptions, "interception")
if (IsIntStore) { if (IsIntStore) {
...@@ -13,35 +12,8 @@ RunModel_CemaNeigeGR5H <- function(InputsModel, RunOptions, Param) { ...@@ -13,35 +12,8 @@ RunModel_CemaNeigeGR5H <- function(InputsModel, RunOptions, Param) {
Imax <- -99 Imax <- -99
} }
.ArgumentsCheckGR(InputsModel, RunOptions, Param)
## Arguments check
if (!inherits(InputsModel, "InputsModel")) {
stop("'InputsModel' must be of class 'InputsModel'")
}
if (!inherits(InputsModel, "hourly")) {
stop("'InputsModel' must be of class 'hourly'")
}
if (!inherits(InputsModel, "GR")) {
stop("'InputsModel' must be of class 'GR'")
}
if (!inherits(InputsModel, "CemaNeige")) {
stop("'InputsModel' must be of class 'CemaNeige'")
}
if (!inherits(RunOptions, "RunOptions")) {
stop("'RunOptions' must be of class 'RunOptions'")
}
if (!inherits(RunOptions, "GR")) {
stop("'RunOptions' must be of class 'GR'")
}
if (!inherits(RunOptions, "CemaNeige")) {
stop("'RunOptions' must be of class 'CemaNeige'")
}
if (!is.vector(Param) | !is.numeric(Param)) {
stop("'Param' must be a numeric vector")
}
if (sum(!is.na(Param)) != NParam) {
stop(paste("'Param' must be a vector of length", NParam, "and contain no NA"))
}
Param <- as.double(Param) Param <- as.double(Param)
......
...@@ -3,39 +3,12 @@ RunModel_CemaNeigeGR5J <- function(InputsModel, RunOptions, Param) { ...@@ -3,39 +3,12 @@ RunModel_CemaNeigeGR5J <- function(InputsModel, RunOptions, Param) {
## Initialization of variables ## Initialization of variables
IsHyst <- inherits(RunOptions, "hysteresis") IsHyst <- inherits(RunOptions, "hysteresis")
NParam <- ifelse(test = IsHyst, yes = 9L, no = 7L) NParamCN <- RunOptions$FeatFUN_MOD$NbParam - 5L
NParamCN <- NParam - 5L
NStates <- 4L NStates <- 4L
## Arguments check .ArgumentsCheckGR(InputsModel, RunOptions, Param)
if (!inherits(InputsModel, "InputsModel")) {
stop("'InputsModel' must be of class 'InputsModel'")
}
if (!inherits(InputsModel, "daily")) {
stop("'InputsModel' must be of class 'daily'")
}
if (!inherits(InputsModel, "GR")) {
stop("'InputsModel' must be of class 'GR'")
}
if (!inherits(InputsModel, "CemaNeige")) {
stop("'InputsModel' must be of class 'CemaNeige'")
}
if (!inherits(RunOptions, "RunOptions")) {
stop("'RunOptions' must be of class 'RunOptions'")
}
if (!inherits(RunOptions, "GR")) {
stop("'RunOptions' must be of class 'GR'")
}
if (!inherits(RunOptions, "CemaNeige")) {
stop("'RunOptions' must be of class 'CemaNeige'")
}
if (!is.vector(Param) | !is.numeric(Param)) {
stop("'Param' must be a numeric vector")
}
if (sum(!is.na(Param)) != NParam) {
stop(paste("'Param' must be a vector of length", NParam, "and contain no NA"))
}
Param <- as.double(Param) Param <- as.double(Param)
......
...@@ -3,39 +3,12 @@ RunModel_CemaNeigeGR6J <- function(InputsModel, RunOptions, Param) { ...@@ -3,39 +3,12 @@ RunModel_CemaNeigeGR6J <- function(InputsModel, RunOptions, Param) {
## Initialization of variables ## Initialization of variables
IsHyst <- inherits(RunOptions, "hysteresis") IsHyst <- inherits(RunOptions, "hysteresis")
NParam <- ifelse(test = IsHyst, yes = 10L, no = 8L) NParamCN <- RunOptions$FeatFUN_MOD$NbParam - 6L
NParamCN <- NParam - 6L
NStates <- 4L NStates <- 4L
## Arguments check .ArgumentsCheckGR(InputsModel, RunOptions, Param)
if (!inherits(InputsModel, "InputsModel")) {
stop("'InputsModel' must be of class 'InputsModel'")
}
if (!inherits(InputsModel, "daily")) {
stop("'InputsModel' must be of class 'daily'")
}
if (!inherits(InputsModel, "GR")) {
stop("'InputsModel' must be of class 'GR'")
}
if (!inherits(InputsModel, "CemaNeige")) {
stop("'InputsModel' must be of class 'CemaNeige'")
}
if (!inherits(RunOptions, "RunOptions")) {
stop("'RunOptions' must be of class 'RunOptions'")
}
if (!inherits(RunOptions, "GR")) {
stop("'RunOptions' must be of class 'GR'")
}
if (!inherits(RunOptions, "CemaNeige")) {
stop("'RunOptions' must be of class 'CemaNeige'")
}
if (!is.vector(Param) | !is.numeric(Param)) {
stop("'Param' must be a numeric vector")
}
if (sum(!is.na(Param)) != NParam) {
stop(paste("'Param' must be a vector of length", NParam, "and contain no NA"))
}
Param <- as.double(Param) Param <- as.double(Param)
......
RunModel_GR1A <- function(InputsModel, RunOptions, Param) { RunModel_GR1A <- function(InputsModel, RunOptions, Param) {
.ArgumentsCheckGR(InputsModel, RunOptions, Param)
## Initialization of variables
NParam <- 1
## Arguments check
if (!inherits(InputsModel, "InputsModel")) {
stop("'InputsModel' must be of class 'InputsModel'")
}
if (!inherits(InputsModel, "yearly")) {
stop("'InputsModel' must be of class 'yearly'")
}
if (!inherits(InputsModel, "GR")) {
stop("'InputsModel' must be of class 'GR'")
}
if (!inherits(RunOptions, "RunOptions")) {
stop("'RunOptions' must be of class 'RunOptions'")
}
if (!inherits(RunOptions, "GR")) {
stop("'RunOptions' must be of class 'GR'")
}
if (!is.vector(Param) | !is.numeric(Param)) {
stop("'Param' must be a numeric vector")
}
if (sum(!is.na(Param)) != NParam) {
stop(paste("'Param' must be a vector of length", NParam, "and contain no NA"))
}
Param <- as.double(Param) Param <- as.double(Param)
......
RunModel_GR2M <- function(InputsModel, RunOptions, Param) { RunModel_GR2M <- function(InputsModel, RunOptions, Param) {
.ArgumentsCheckGR(InputsModel, RunOptions, Param)
## Initialization of variables
NParam <- 2
## Arguments check
if (!inherits(InputsModel, "InputsModel")) {
stop("'InputsModel' must be of class 'InputsModel'")
}
if (!inherits(InputsModel, "monthly")) {
stop("'InputsModel' must be of class 'monthly'")
}
if (!inherits(InputsModel, "GR")) {
stop("'InputsModel' must be of class 'GR'")
}
if (!inherits(RunOptions, "RunOptions")) {
stop("'RunOptions' must be of class 'RunOptions'")
}
if (!inherits(RunOptions, "GR")) {
stop("'RunOptions' must be of class 'GR'")
}
if (!is.vector(Param) | !is.numeric(Param)) {
stop("'Param' must be a numeric vector")
}
if (sum(!is.na(Param)) != NParam) {
stop(paste("'Param' must be a vector of length", NParam, "and contain no NA"))
}
Param <- as.double(Param) Param <- as.double(Param)
Param_X1X2_threshold <- 1e-2 Param_X1X2_threshold <- 1e-2
......
RunModel_GR4H <- function(InputsModel, RunOptions, Param) { RunModel_GR4H <- function(InputsModel, RunOptions, Param) {
.ArgumentsCheckGR(InputsModel, RunOptions, Param)
## Initialization of variables
NParam <- 4
## Arguments check
if (!inherits(InputsModel, "InputsModel")) {
stop("'InputsModel' must be of class 'InputsModel'")
}
if (!inherits(InputsModel, "hourly")) {
stop("'InputsModel' must be of class 'hourly'")
}
if (!inherits(InputsModel, "GR")) {
stop("'InputsModel' must be of class 'GR'")
}
if (!inherits(RunOptions, "RunOptions")) {
stop("'RunOptions' must be of class 'RunOptions'")
}
if (!inherits(RunOptions, "GR")) {
stop("'RunOptions' must be of class 'GR'")
}
if (!is.vector(Param) | !is.numeric(Param)) {
stop("'Param' must be a numeric vector")
}
if (sum(!is.na(Param)) != NParam) {
stop(paste("'Param' must be a vector of length", NParam, "and contain no NA"))
}
Param <- as.double(Param) Param <- as.double(Param)
Param_X1X3_threshold <- 1e-2 Param_X1X3_threshold <- 1e-2
......
RunModel_GR4J <- function(InputsModel, RunOptions, Param) { RunModel_GR4J <- function(InputsModel, RunOptions, Param) {
.ArgumentsCheckGR(InputsModel, RunOptions, Param)
## Initialization of variables
NParam <- 4
## Arguments check
if (!inherits(InputsModel, "InputsModel")) {
stop("'InputsModel' must be of class 'InputsModel'")
}
if (!inherits(InputsModel, "daily")) {
stop("'InputsModel' must be of class 'daily'")
}
if (!inherits(InputsModel, "GR")) {
stop("'InputsModel' must be of class 'GR'")
}
if (!inherits(RunOptions, "RunOptions")) {
stop("'RunOptions' must be of class 'RunOptions'")
}
if (!inherits(RunOptions, "GR")) {
stop("'RunOptions' must be of class 'GR'")
}
if (!is.vector(Param) | !is.numeric(Param)) {
stop("'Param' must be a numeric vector")
}
if (sum(!is.na(Param)) != NParam) {
stop(paste("'Param' must be a vector of length", NParam, "and contain no NA"))
}
Param <- as.double(Param) Param <- as.double(Param)
Param_X1X3_threshold <- 1e-2 Param_X1X3_threshold <- 1e-2
......
...@@ -2,7 +2,6 @@ RunModel_GR5H <- function(InputsModel, RunOptions, Param) { ...@@ -2,7 +2,6 @@ RunModel_GR5H <- function(InputsModel, RunOptions, Param) {
## Initialization of variables ## Initialization of variables
NParam <- 5
IsIntStore <- inherits(RunOptions, "interception") IsIntStore <- inherits(RunOptions, "interception")
if (IsIntStore) { if (IsIntStore) {
Imax <- RunOptions$Imax Imax <- RunOptions$Imax
...@@ -10,29 +9,8 @@ RunModel_GR5H <- function(InputsModel, RunOptions, Param) { ...@@ -10,29 +9,8 @@ RunModel_GR5H <- function(InputsModel, RunOptions, Param) {
Imax <- -99 Imax <- -99
} }
.ArgumentsCheckGR(InputsModel, RunOptions, Param)
## Arguments check
if (!inherits(InputsModel, "InputsModel")) {
stop("'InputsModel' must be of class 'InputsModel'")
}
if (!inherits(InputsModel, "hourly")) {
stop("'InputsModel' must be of class 'hourly'")
}
if (!inherits(InputsModel, "GR")) {
stop("'InputsModel' must be of class 'GR'")
}
if (!inherits(RunOptions, "RunOptions")) {
stop("'RunOptions' must be of class 'RunOptions'")
}
if (!inherits(RunOptions, "GR")) {
stop("'RunOptions' must be of class 'GR'")
}
if (!is.vector(Param) | !is.numeric(Param)) {
stop("'Param' must be a numeric vector")
}
if (sum(!is.na(Param)) != NParam) {
stop(paste("'Param' must be a vector of length", NParam, "and contain no NA"))
}
Param <- as.double(Param) Param <- as.double(Param)
Param_X1X3_threshold <- 1e-2 Param_X1X3_threshold <- 1e-2
......
RunModel_GR5J <- function(InputsModel, RunOptions, Param) { RunModel_GR5J <- function(InputsModel, RunOptions, Param) {
.ArgumentsCheckGR(InputsModel, RunOptions, Param)
## Initialization of variables
NParam <- 5
## Arguments check
if (!inherits(InputsModel, "InputsModel")) {
stop("'InputsModel' must be of class 'InputsModel'")
}
if (!inherits(InputsModel, "daily")) {
stop("'InputsModel' must be of class 'daily'")
}
if (!inherits(InputsModel, "GR")) {
stop("'InputsModel' must be of class 'GR'")
}
if (!inherits(RunOptions, "RunOptions")) {
stop("'RunOptions' must be of class 'RunOptions'")
}
if (!inherits(RunOptions, "GR")) {
stop("'RunOptions' must be of class 'GR'")
}
if (!is.vector(Param) | !is.numeric(Param)) {
stop("'Param' must be a numeric vector")
}
if (sum(!is.na(Param)) != NParam) {
stop(paste("'Param' must be a vector of length", NParam, "and contain no NA"))
}
Param <- as.double(Param) Param <- as.double(Param)
Param_X1X3_threshold <- 1e-2 Param_X1X3_threshold <- 1e-2
......
RunModel_GR6J <- function(InputsModel, RunOptions, Param) { RunModel_GR6J <- function(InputsModel, RunOptions, Param) {
.ArgumentsCheckGR(InputsModel, RunOptions, Param)
## Initialization of variables
NParam <- 6
## Arguments check
if (!inherits(InputsModel, "InputsModel")) {
stop("'InputsModel' must be of class 'InputsModel'")
}
if (!inherits(InputsModel, "daily")) {
stop("'InputsModel' must be of class 'daily'")
}
if (!inherits(InputsModel, "GR")) {
stop("'InputsModel' must be of class 'GR'")
}
if (!inherits(RunOptions, "RunOptions")) {
stop("'RunOptions' must be of class 'RunOptions'")
}
if (!inherits(RunOptions, "GR")) {
stop("'RunOptions' must be of class 'GR'")
}
if (!is.vector(Param) | !is.numeric(Param)) {
stop("'Param' must be a numeric vector")
}
if (sum(!is.na(Param)) != NParam) {
stop(paste("'Param' must be a vector of length", NParam, "and contain no NA"))
}
Param <- as.double(Param) Param <- as.double(Param)
Param_X1X3X6_threshold <- 1e-2 Param_X1X3X6_threshold <- 1e-2
......
...@@ -71,6 +71,7 @@ ...@@ -71,6 +71,7 @@
stop("the time step of the model inputs must be ", res$TimeUnit) stop("the time step of the model inputs must be ", res$TimeUnit)
} }
} }
res$CodeModHydro <- gsub("CemaNeige", "", res$CodeMod)
return(res) return(res)
} }
} }
......