Commit 36154a79 authored by Delaigue Olivier's avatar Delaigue Olivier
Browse files

Merge branch 'dev' into '122-review-the-x-axis-management-of-the-plot-outputsmodel'

# Conflicts:
#   R/plot.OutputsModel.R
parents 90a095fc 265725dc
...@@ -9,3 +9,5 @@ ...@@ -9,3 +9,5 @@
^\.vscode$ ^\.vscode$
^Rplots\.pdf$ ^Rplots\.pdf$
^ci$ ^ci$
^data-raw$
^revdep$
...@@ -12,6 +12,8 @@ packrat/lib*/ ...@@ -12,6 +12,8 @@ packrat/lib*/
*.pdf *.pdf
!man/figures/*.pdf !man/figures/*.pdf
# revdep
/revdep/
###################################################################################################### ######################################################################################################
### Generic .gitignore for R (source: https://github.com/github/gitignore/blob/master/R.gitignore) ### ### Generic .gitignore for R (source: https://github.com/github/gitignore/blob/master/R.gitignore) ###
......
stages: stages:
- check - check
- regression - scheduled_tests
- revdepcheck - revdepcheck
default: default:
...@@ -10,13 +10,14 @@ default: ...@@ -10,13 +10,14 @@ default:
- PATH=~/R/sources/R-${R_VERSION}/bin:$PATH - PATH=~/R/sources/R-${R_VERSION}/bin:$PATH
- R -e 'remotes::install_deps(dep = TRUE)' - R -e 'remotes::install_deps(dep = TRUE)'
.regression: .scheduled_tests:
stage: regression stage: scheduled_tests
script: script:
- Rscript tests/testthat/regression_tests.R stable - Rscript tests/scheduled_tests/scheduled.R
- Rscript tests/scheduled_tests/regression.R stable
- R CMD INSTALL . - R CMD INSTALL .
- Rscript tests/testthat/regression_tests.R dev - Rscript tests/scheduled_tests/regression.R dev
- Rscript tests/testthat/regression_tests.R compare - Rscript tests/scheduled_tests/regression.R compare
.check: .check:
stage: check stage: check
...@@ -33,26 +34,31 @@ default: ...@@ -33,26 +34,31 @@ default:
NOT_CRAN: "false" NOT_CRAN: "false"
extends: .check extends: .check
regression_patched: scheduled_tests_patched:
only:
refs:
- dev
- master
- schedules
variables: variables:
R_VERSION: "patched" R_VERSION: "patched"
extends: .regression extends: .scheduled_tests
regression_devel: scheduled_tests_devel:
only: only:
refs: refs:
- schedules - schedules
variables: variables:
R_VERSION: "devel" R_VERSION: "devel"
extends: .regression extends: .scheduled_tests
regression_oldrel: scheduled_tests_oldrel:
only: only:
refs: refs:
- schedules - schedules
variables: variables:
R_VERSION: "oldrel" R_VERSION: "oldrel"
extends: .regression extends: .scheduled_tests
check_not_cran_patched: check_not_cran_patched:
variables: variables:
......
...@@ -4,3 +4,62 @@ ...@@ -4,3 +4,62 @@
# ignored variable : [Topic]<SPACE>[Variable]. # ignored variable : [Topic]<SPACE>[Variable].
# Example for ignoring OutputsModel variable produced by example("RunModel_GR2M"): RunModel_GR2M OutputsModel # Example for ignoring OutputsModel variable produced by example("RunModel_GR2M"): RunModel_GR2M OutputsModel
Calibration_Michel RunOptions
Calibration RunOptions
CreateCalibOptions RunOptions
CreateIniStates RunOptions
CreateInputsCrit RunOptions
CreateInputsModel RunOptions
CreateRunOptions RunOptions
ErrorCrit_KGE RunOptions
ErrorCrit_KGE2 RunOptions
ErrorCrit_NSE RunOptions
ErrorCrit_RMSE RunOptions
ErrorCrit RunOptions
Imax RunOptions
Param_Sets_GR4J RunOptions_Cal
Param_Sets_GR4J RunOptions_Val
RunModel_CemaNeige RunOptions
RunModel_CemaNeigeGR4J RunOptions
RunModel_CemaNeigeGR5J RunOptions
RunModel_CemaNeigeGR6J RunOptions
RunModel_GR1A RunOptions
RunModel_GR2M RunOptions
RunModel_GR4H RunOptions
RunModel_GR4J RunOptions
RunModel_GR5H RunOptions
RunModel_GR5J RunOptions
RunModel_GR6J RunOptions
RunModel_Lag RunOptions
RunModel RunOptions
SeriesAggreg RunOptions
Calibration OutputsModel
Calibration_Michel OutputsModel
CreateCalibOptions OutputsModel
CreateIniStates OutputsModel
CreateInputsCrit OutputsModel
CreateInputsModel OutputsModel
CreateRunOptions OutputsModel
ErrorCrit OutputsModel
ErrorCrit_KGE OutputsModel
ErrorCrit_KGE2 OutputsModel
ErrorCrit_NSE OutputsModel
ErrorCrit_RMSE OutputsModel
Imax OutputsModel
RunModel OutputsModel
RunModel_CemaNeige OutputsModel
RunModel_CemaNeigeGR4J OutputsModel
RunModel_CemaNeigeGR5J OutputsModel
RunModel_CemaNeigeGR6J OutputsModel
RunModel_GR1A OutputsModel
RunModel_GR2M OutputsModel
RunModel_GR4H OutputsModel
RunModel_GR4J OutputsModel
RunModel_GR5H OutputsModel
RunModel_GR5J OutputsModel
RunModel_GR6J OutputsModel
RunModel_Lag OutputsModel
SeriesAggreg OutputsModel
Param_Sets_GR4J OutputsModel_Val
RunModel_Lag OutputsModelDown
SeriesAggreg SimulatedMonthlyRegime
...@@ -17,7 +17,7 @@ Calibration_Michel <- function(InputsModel, ...@@ -17,7 +17,7 @@ Calibration_Michel <- function(InputsModel,
# Handling 'FUN_TRANSFO' from direct argument or provided by 'CaliOptions' # Handling 'FUN_TRANSFO' from direct argument or provided by 'CaliOptions'
if (!is.null(FUN_TRANSFO)) { if (!is.null(FUN_TRANSFO)) {
FUN_TRANSFO <- match.fun(FUN_TRANSFO) FUN_TRANSFO <- match.fun(FUN_TRANSFO)
} else if(!is.null(CalibOptions$FUN_TRANSFO)) { } else if (!is.null(CalibOptions$FUN_TRANSFO)) {
FUN_TRANSFO <- CalibOptions$FUN_TRANSFO FUN_TRANSFO <- CalibOptions$FUN_TRANSFO
} else { } else {
stop("'FUN_TRANSFO' is not provided neither as 'FUN_TRANSFO' argument or in 'CaliOptions' argument") stop("'FUN_TRANSFO' is not provided neither as 'FUN_TRANSFO' argument or in 'CaliOptions' argument")
......
...@@ -12,7 +12,7 @@ CreateCalibOptions <- function(FUN_MOD, ...@@ -12,7 +12,7 @@ CreateCalibOptions <- function(FUN_MOD,
FUN_MOD <- match.fun(FUN_MOD) FUN_MOD <- match.fun(FUN_MOD)
FUN_CALIB <- match.fun(FUN_CALIB) FUN_CALIB <- match.fun(FUN_CALIB)
if(!is.null(FUN_TRANSFO)) { if (!is.null(FUN_TRANSFO)) {
FUN_TRANSFO <- match.fun(FUN_TRANSFO) FUN_TRANSFO <- match.fun(FUN_TRANSFO)
} }
if (!is.logical(IsHyst) | length(IsHyst) != 1L) { if (!is.logical(IsHyst) | length(IsHyst) != 1L) {
......
...@@ -153,19 +153,19 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = F ...@@ -153,19 +153,19 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = F
} }
UH2 <- rep(Inf, UH2n) UH2 <- rep(Inf, UH2n)
} }
if(IsIntStore & is.null(IntStore)) { if (IsIntStore & is.null(IntStore)) {
stop(sprintf("'%s' need values for 'IntStore'", nameFUN_MOD)) stop(sprintf("'%s' need values for 'IntStore'", nameFUN_MOD))
} }
if("CemaNeige" %in% ObjectClass & !IsHyst & if ("CemaNeige" %in% ObjectClass & !IsHyst &
(is.null(GCemaNeigeLayers) | is.null(eTGCemaNeigeLayers))) { (is.null(GCemaNeigeLayers) | is.null(eTGCemaNeigeLayers))) {
stop(sprintf("'%s' need values for 'GCemaNeigeLayers' and 'GCemaNeigeLayers'", nameFUN_MOD)) stop(sprintf("'%s' need values for 'GCemaNeigeLayers' and 'GCemaNeigeLayers'", nameFUN_MOD))
} }
if("CemaNeige" %in% ObjectClass & IsHyst & if ("CemaNeige" %in% ObjectClass & IsHyst &
(is.null(GCemaNeigeLayers) | is.null(eTGCemaNeigeLayers) | (is.null(GCemaNeigeLayers) | is.null(eTGCemaNeigeLayers) |
is.null(GthrCemaNeigeLayers) | is.null(GlocmaxCemaNeigeLayers))) { is.null(GthrCemaNeigeLayers) | is.null(GlocmaxCemaNeigeLayers))) {
stop(sprintf("'%s' need values for 'GCemaNeigeLayers', 'GCemaNeigeLayers', 'GthrCemaNeigeLayers' and 'GlocmaxCemaNeigeLayers'", nameFUN_MOD)) stop(sprintf("'%s' need values for 'GCemaNeigeLayers', 'GCemaNeigeLayers', 'GthrCemaNeigeLayers' and 'GlocmaxCemaNeigeLayers'", nameFUN_MOD))
} }
if("CemaNeige" %in% ObjectClass & !IsHyst & if ("CemaNeige" %in% ObjectClass & !IsHyst &
(!is.null(GthrCemaNeigeLayers) | !is.null(GlocmaxCemaNeigeLayers))) { (!is.null(GthrCemaNeigeLayers) | !is.null(GlocmaxCemaNeigeLayers))) {
if (verbose) { if (verbose) {
warning(sprintf("'%s' does not require 'GthrCemaNeigeLayers' and 'GlocmaxCemaNeigeLayers'. Values set to NA", nameFUN_MOD)) warning(sprintf("'%s' does not require 'GthrCemaNeigeLayers' and 'GlocmaxCemaNeigeLayers'. Values set to NA", nameFUN_MOD))
...@@ -173,7 +173,7 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = F ...@@ -173,7 +173,7 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = F
GthrCemaNeigeLayers <- Inf GthrCemaNeigeLayers <- Inf
GlocmaxCemaNeigeLayers <- Inf GlocmaxCemaNeigeLayers <- Inf
} }
if(!"CemaNeige" %in% ObjectClass & if (!"CemaNeige" %in% ObjectClass &
(!is.null(GCemaNeigeLayers) | !is.null(eTGCemaNeigeLayers) | !is.null(GthrCemaNeigeLayers) | !is.null(GlocmaxCemaNeigeLayers))) { (!is.null(GCemaNeigeLayers) | !is.null(eTGCemaNeigeLayers) | !is.null(GthrCemaNeigeLayers) | !is.null(GlocmaxCemaNeigeLayers))) {
if (verbose) { if (verbose) {
warning(sprintf("'%s' does not require 'GCemaNeigeLayers' 'GCemaNeigeLayers', 'GthrCemaNeigeLayers' and 'GlocmaxCemaNeigeLayers'. Values set to NA", nameFUN_MOD)) warning(sprintf("'%s' does not require 'GCemaNeigeLayers' 'GCemaNeigeLayers', 'GthrCemaNeigeLayers' and 'GlocmaxCemaNeigeLayers'. Values set to NA", nameFUN_MOD))
...@@ -186,7 +186,7 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = F ...@@ -186,7 +186,7 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = F
## set states ## set states
if("CemaNeige" %in% ObjectClass) { if ("CemaNeige" %in% ObjectClass) {
NLayers <- length(InputsModel$LayerPrecip) NLayers <- length(InputsModel$LayerPrecip)
} else { } else {
NLayers <- 1 NLayers <- 1
...@@ -284,17 +284,17 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = F ...@@ -284,17 +284,17 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = F
} }
# SD model state handling # SD model state handling
if(!is.null(SD)) { if (!is.null(SD)) {
if(!inherits(InputsModel, "SD")) { if (!inherits(InputsModel, "SD")) {
stop("'SD' argument provided and 'InputsModel' is not of class 'SD'") stop("'SD' argument provided and 'InputsModel' is not of class 'SD'")
} }
if(!is.list(SD)) { if (!is.list(SD)) {
stop("'SD' argument must be a list") stop("'SD' argument must be a list")
} }
lapply(SD, function(x) { lapply(SD, function(x) {
if(!is.numeric(x)) stop("Each item of 'SD' list argument must be numeric") if (!is.numeric(x)) stop("Each item of 'SD' list argument must be numeric")
}) })
if(length(SD) != length(InputsModel$LengthHydro)) { if (length(SD) != length(InputsModel$LengthHydro)) {
stop("Number of items of 'SD' list argument must be the same as the number of upstream connections", stop("Number of items of 'SD' list argument must be the same as the number of upstream connections",
sprintf(" (%i required, found %i)", length(InputsModel$LengthHydro), length(SD))) sprintf(" (%i required, found %i)", length(InputsModel$LengthHydro), length(SD)))
} }
...@@ -309,15 +309,15 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = F ...@@ -309,15 +309,15 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = F
IniStatesNA[is.infinite(IniStatesNA)] <- NA IniStatesNA[is.infinite(IniStatesNA)] <- NA
IniStatesNA <- relist(IniStatesNA, skeleton = IniStates) IniStatesNA <- relist(IniStatesNA, skeleton = IniStates)
if(!is.null(SD)) { if (!is.null(SD)) {
IniStatesNA$SD <- SD IniStatesNA$SD <- SD
} }
class(IniStatesNA) <- c("IniStates", ObjectClass) class(IniStatesNA) <- c("IniStates", ObjectClass)
if(IsHyst) { if (IsHyst) {
class(IniStatesNA) <- c(class(IniStatesNA), "hysteresis") class(IniStatesNA) <- c(class(IniStatesNA), "hysteresis")
} }
if(IsIntStore) { if (IsIntStore) {
class(IniStatesNA) <- c(class(IniStatesNA), "interception") class(IniStatesNA) <- c(class(IniStatesNA), "interception")
} }
......
...@@ -293,7 +293,7 @@ CreateInputsCrit <- function(FUN_CRIT, ...@@ -293,7 +293,7 @@ CreateInputsCrit <- function(FUN_CRIT,
listVarObs <- sapply(InputsCrit, FUN = "[[", "VarObs") listVarObs <- sapply(InputsCrit, FUN = "[[", "VarObs")
inCnVarObs <- c("SCA", "SWE") inCnVarObs <- c("SCA", "SWE")
if (!"ZLayers" %in% names(InputsModel)) { if (!"ZLayers" %in% names(InputsModel)) {
if(any(listVarObs %in% inCnVarObs)) { if (any(listVarObs %in% inCnVarObs)) {
stop(sprintf("'VarObs' can not be equal to %i if CemaNeige is not used", stop(sprintf("'VarObs' can not be equal to %i if CemaNeige is not used",
paste(sapply(inCnVarObs, shQuote), collapse = " or "))) paste(sapply(inCnVarObs, shQuote), collapse = " or ")))
} }
...@@ -348,7 +348,7 @@ CreateInputsCrit <- function(FUN_CRIT, ...@@ -348,7 +348,7 @@ CreateInputsCrit <- function(FUN_CRIT,
combInputsCrit <- combn(x = length(InputsCrit), m = 2) combInputsCrit <- combn(x = length(InputsCrit), m = 2)
apply(combInputsCrit, MARGIN = 2, function(i) { apply(combInputsCrit, MARGIN = 2, function(i) {
equalInputsCrit <- identical(InputsCrit[[i[1]]], InputsCrit[[i[2]]]) equalInputsCrit <- identical(InputsCrit[[i[1]]], InputsCrit[[i[2]]])
if(equalInputsCrit) { if (equalInputsCrit) {
warning(sprintf("elements %i and %i of the criteria list are identical. This might not be necessary", i[1], i[2]), call. = FALSE) warning(sprintf("elements %i and %i of the criteria list are identical. This might not be necessary", i[1], i[2]), call. = FALSE)
} }
}) })
......
...@@ -153,10 +153,10 @@ CreateInputsModel <- function(FUN_MOD, ...@@ -153,10 +153,10 @@ CreateInputsModel <- function(FUN_MOD,
if (nrow(Qupstream) != LLL) { if (nrow(Qupstream) != LLL) {
stop("'Qupstream' must have same number of rows as 'DatesR' length") stop("'Qupstream' must have same number of rows as 'DatesR' length")
} }
if(any(is.na(Qupstream))) { if (any(is.na(Qupstream))) {
warning("'Qupstream' contains NA values: model outputs will contain NAs") warning("'Qupstream' contains NA values: model outputs will contain NAs")
} }
if(any(LengthHydro > 1000)) { if (any(LengthHydro > 1000)) {
warning("The unit of 'LengthHydro' has changed from m to km in airGR >= 1.6.12: values superior to 1000 km seem unrealistic") warning("The unit of 'LengthHydro' has changed from m to km in airGR >= 1.6.12: values superior to 1000 km seem unrealistic")
} }
QupstrUnit <- tolower(QupstrUnit) QupstrUnit <- tolower(QupstrUnit)
......
...@@ -24,12 +24,17 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, ...@@ -24,12 +24,17 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
ObjectClass <- FeatFUN_MOD$Class ObjectClass <- FeatFUN_MOD$Class
TimeStepMean <- FeatFUN_MOD$TimeStepMean TimeStepMean <- FeatFUN_MOD$TimeStepMean
## Model output variable list
FortranOutputs <- .FortranOutputs(GR = FeatFUN_MOD$CodeModHydro,
isCN = "CemaNeige" %in% FeatFUN_MOD$Class)
## manage class ## manage class
if (IsIntStore) { if (IsIntStore) {
ObjectClass <- c(ObjectClass, "interception") ObjectClass <- c(ObjectClass, "interception")
} }
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) {
...@@ -290,31 +295,7 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, ...@@ -290,31 +295,7 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
##check_Outputs_Cal_and_Sim ##check_Outputs_Cal_and_Sim
##Outputs_all ##Outputs_all
Outputs_all <- NULL Outputs_all <- c("DatesR", unlist(FortranOutputs), "WarmUpQsim", "StateEnd")
if (identical(FUN_MOD, RunModel_GR4H) | identical(FUN_MOD, RunModel_CemaNeigeGR4H)) {
Outputs_all <- c(Outputs_all, .FortranOutputs(GR = "GR4H")$GR)
}
if (identical(FUN_MOD, RunModel_GR5H) | identical(FUN_MOD, RunModel_CemaNeigeGR5H)) {
Outputs_all <- c(Outputs_all, .FortranOutputs(GR = "GR5H")$GR)
}
if (identical(FUN_MOD, RunModel_GR4J) | identical(FUN_MOD, RunModel_CemaNeigeGR4J)) {
Outputs_all <- c(Outputs_all, .FortranOutputs(GR = "GR4J")$GR)
}
if (identical(FUN_MOD, RunModel_GR5J) | identical(FUN_MOD, RunModel_CemaNeigeGR5J)) {
Outputs_all <- c(Outputs_all, .FortranOutputs(GR = "GR5J")$GR)
}
if (identical(FUN_MOD, RunModel_GR6J) | identical(FUN_MOD, RunModel_CemaNeigeGR6J)) {
Outputs_all <- c(Outputs_all, .FortranOutputs(GR = "GR6J")$GR)
}
if (identical(FUN_MOD, RunModel_GR2M)) {
Outputs_all <- c(Outputs_all, .FortranOutputs(GR = "GR2M")$GR)
}
if (identical(FUN_MOD, RunModel_GR1A)) {
Outputs_all <- c(Outputs_all, .FortranOutputs(GR = "GR1A")$GR)
}
if ("CemaNeige" %in% ObjectClass) {
Outputs_all <- c(Outputs_all, .FortranOutputs(GR = NULL, isCN = TRUE)$CN)
}
##check_Outputs_Sim ##check_Outputs_Sim
if (!is.vector(Outputs_Sim)) { if (!is.vector(Outputs_Sim)) {
...@@ -327,9 +308,9 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, ...@@ -327,9 +308,9 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
stop("'Outputs_Sim' must not contain NA") stop("'Outputs_Sim' must not contain NA")
} }
if ("all" %in% Outputs_Sim) { if ("all" %in% Outputs_Sim) {
Outputs_Sim <- c("DatesR", Outputs_all, "StateEnd") Outputs_Sim <- Outputs_all
} }
Test <- which(!Outputs_Sim %in% c("DatesR", Outputs_all, "StateEnd")) Test <- which(!Outputs_Sim %in% Outputs_all)
if (length(Test) != 0) { if (length(Test) != 0) {
stop(paste0( "'Outputs_Sim' is incorrectly defined: ", stop(paste0( "'Outputs_Sim' is incorrectly defined: ",
paste(Outputs_Sim[Test], collapse = ", "), " not found")) paste(Outputs_Sim[Test], collapse = ", "), " not found"))
...@@ -361,10 +342,9 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, ...@@ -361,10 +342,9 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
} }
} }
if ("all" %in% Outputs_Cal) { if ("all" %in% Outputs_Cal) {
Outputs_Cal <- c("DatesR", Outputs_all, "StateEnd") Outputs_Cal <- Outputs_all
} }
Test <- which(!Outputs_Cal %in% c("DatesR", Outputs_all, "StateEnd")) Test <- which(!Outputs_Cal %in% Outputs_all)
if (length(Test) != 0) { if (length(Test) != 0) {
stop(paste0("'Outputs_Cal' is incorrectly defined: ", stop(paste0("'Outputs_Cal' is incorrectly defined: ",
paste(Outputs_Cal[Test], collapse = ", "), " not found")) paste(Outputs_Cal[Test], collapse = ", "), " not found"))
...@@ -473,7 +453,9 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, ...@@ -473,7 +453,9 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
IniStates = IniStates, IniStates = IniStates,
IniResLevels = IniResLevels, IniResLevels = IniResLevels,
Outputs_Cal = Outputs_Cal, Outputs_Cal = Outputs_Cal,
Outputs_Sim = Outputs_Sim) Outputs_Sim = Outputs_Sim,
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))
......
...@@ -148,7 +148,7 @@ RunModel_CemaNeige <- function(InputsModel, RunOptions, Param) { ...@@ -148,7 +148,7 @@ RunModel_CemaNeige <- function(InputsModel, RunOptions, Param) {
## End ## End
class(OutputsModel) <- c("OutputsModel", time_step, "CemaNeige") class(OutputsModel) <- c("OutputsModel", time_step, "CemaNeige")
if(IsHyst) { if (IsHyst) {
class(OutputsModel) <- c(class(OutputsModel), "hysteresis") class(OutputsModel) <- c(class(OutputsModel), "hysteresis")
} }
return(OutputsModel) return(OutputsModel)
......
...@@ -3,40 +3,12 @@ RunModel_CemaNeigeGR4H <- function(InputsModel, RunOptions, Param) { ...@@ -3,40 +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
FortranOutputs <- .FortranOutputs(GR = "GR4H", isCN = TRUE)
## 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)
...@@ -76,9 +48,9 @@ RunModel_CemaNeigeGR4H <- function(InputsModel, RunOptions, Param) { ...@@ -76,9 +48,9 @@ RunModel_CemaNeigeGR4H <- function(InputsModel, RunOptions, Param) {
## CemaNeige________________________________________________________________________________ ## CemaNeige________________________________________________________________________________
if (inherits(RunOptions, "CemaNeige")) { if (inherits(RunOptions, "CemaNeige")) {
if ("all" %in% RunOptions$Outputs_Sim) { if ("all" %in% RunOptions$Outputs_Sim) {
IndOutputsCemaNeige <- as.integer(1:length(FortranOutputs$CN)) IndOutputsCemaNeige <- as.integer(1:length(RunOptions$FortranOutputs$CN))
} else { } else {
IndOutputsCemaNeige <- which(FortranOutputs$CN %in% RunOptions$Outputs_Sim) IndOutputsCemaNeige <- which(RunOptions$FortranOutputs$CN %in% RunOptions$Outputs_Sim)
} }
CemaNeigeLayers <- list() CemaNeigeLayers <- list()
CemaNeigeStateEnd <- NULL CemaNeigeStateEnd <- NULL
...@@ -116,7 +88,7 @@ RunModel_CemaNeigeGR4H <- function(InputsModel, RunOptions, Param) { ...@@ -116,7 +88,7 @@ RunModel_CemaNeigeGR4H <- function(InputsModel, RunOptions, Param) {
## 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])
names(CemaNeigeLayers[[iLayer]]) <- FortranOutputs$CN[IndOutputsCemaNeige] names(CemaNeigeLayers[[iLayer]]) <- RunOptions$FortranOutputs$CN[IndOutputsCemaNeige]
IndPliqAndMelt <- which(names(CemaNeigeLayers[[iLayer]]) == "PliqAndMelt") IndPliqAndMelt <- which(names(CemaNeigeLayers[[iLayer]]) == "PliqAndMelt")
if (iLayer == 1) { if (iLayer == 1) {
CatchMeltAndPliq <- RESULTS$Outputs[, IndPliqAndMelt] / NLayers CatchMeltAndPliq <- RESULTS$Outputs[, IndPliqAndMelt] / NLayers
...@@ -142,9 +114,9 @@ RunModel_CemaNeigeGR4H <- function(InputsModel, RunOptions, Param) { ...@@ -142,9 +114,9 @@ RunModel_CemaNeigeGR4H <- function(InputsModel, RunOptions, Param) {
## GR model ## GR model
if ("all" %in% RunOptions$Outputs_Sim) { if ("all" %in% RunOptions$Outputs_Sim) {
IndOutputsMod <- as.integer(1:length(FortranOutputs$GR))