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 @@
^\.vscode$
^Rplots\.pdf$
^ci$
^data-raw$
^revdep$
......@@ -12,6 +12,8 @@ packrat/lib*/
*.pdf
!man/figures/*.pdf
# revdep
/revdep/
######################################################################################################
### Generic .gitignore for R (source: https://github.com/github/gitignore/blob/master/R.gitignore) ###
......
stages:
- check
- regression
- scheduled_tests
- revdepcheck
default:
......@@ -10,13 +10,14 @@ default:
- PATH=~/R/sources/R-${R_VERSION}/bin:$PATH
- R -e 'remotes::install_deps(dep = TRUE)'
.regression:
stage: regression
.scheduled_tests:
stage: scheduled_tests
script:
- Rscript tests/testthat/regression_tests.R stable
- Rscript tests/scheduled_tests/scheduled.R
- Rscript tests/scheduled_tests/regression.R stable
- R CMD INSTALL .
- Rscript tests/testthat/regression_tests.R dev
- Rscript tests/testthat/regression_tests.R compare
- Rscript tests/scheduled_tests/regression.R dev
- Rscript tests/scheduled_tests/regression.R compare
.check:
stage: check
......@@ -33,26 +34,31 @@ default:
NOT_CRAN: "false"
extends: .check
regression_patched:
scheduled_tests_patched:
only:
refs:
- dev
- master
- schedules
variables:
R_VERSION: "patched"
extends: .regression
extends: .scheduled_tests
regression_devel:
scheduled_tests_devel:
only:
refs:
- schedules
variables:
R_VERSION: "devel"
extends: .regression
extends: .scheduled_tests
regression_oldrel:
scheduled_tests_oldrel:
only:
refs:
- schedules
variables:
R_VERSION: "oldrel"
extends: .regression
extends: .scheduled_tests
check_not_cran_patched:
variables:
......
......@@ -4,3 +4,62 @@
# ignored variable : [Topic]<SPACE>[Variable].
# 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,
# Handling 'FUN_TRANSFO' from direct argument or provided by 'CaliOptions'
if (!is.null(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
} else {
stop("'FUN_TRANSFO' is not provided neither as 'FUN_TRANSFO' argument or in 'CaliOptions' argument")
......
......@@ -12,7 +12,7 @@ CreateCalibOptions <- function(FUN_MOD,
FUN_MOD <- match.fun(FUN_MOD)
FUN_CALIB <- match.fun(FUN_CALIB)
if(!is.null(FUN_TRANSFO)) {
if (!is.null(FUN_TRANSFO)) {
FUN_TRANSFO <- match.fun(FUN_TRANSFO)
}
if (!is.logical(IsHyst) | length(IsHyst) != 1L) {
......
......@@ -153,19 +153,19 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = F
}
UH2 <- rep(Inf, UH2n)
}
if(IsIntStore & is.null(IntStore)) {
if (IsIntStore & is.null(IntStore)) {
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))) {
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(GthrCemaNeigeLayers) | is.null(GlocmaxCemaNeigeLayers))) {
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))) {
if (verbose) {
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
GthrCemaNeigeLayers <- Inf
GlocmaxCemaNeigeLayers <- Inf
}
if(!"CemaNeige" %in% ObjectClass &
if (!"CemaNeige" %in% ObjectClass &
(!is.null(GCemaNeigeLayers) | !is.null(eTGCemaNeigeLayers) | !is.null(GthrCemaNeigeLayers) | !is.null(GlocmaxCemaNeigeLayers))) {
if (verbose) {
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
## set states
if("CemaNeige" %in% ObjectClass) {
if ("CemaNeige" %in% ObjectClass) {
NLayers <- length(InputsModel$LayerPrecip)
} else {
NLayers <- 1
......@@ -284,17 +284,17 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = F
}
# SD model state handling
if(!is.null(SD)) {
if(!inherits(InputsModel, "SD")) {
if (!is.null(SD)) {
if (!inherits(InputsModel, "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")
}
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",
sprintf(" (%i required, found %i)", length(InputsModel$LengthHydro), length(SD)))
}
......@@ -309,15 +309,15 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = F
IniStatesNA[is.infinite(IniStatesNA)] <- NA
IniStatesNA <- relist(IniStatesNA, skeleton = IniStates)
if(!is.null(SD)) {
if (!is.null(SD)) {
IniStatesNA$SD <- SD
}
class(IniStatesNA) <- c("IniStates", ObjectClass)
if(IsHyst) {
if (IsHyst) {
class(IniStatesNA) <- c(class(IniStatesNA), "hysteresis")
}
if(IsIntStore) {
if (IsIntStore) {
class(IniStatesNA) <- c(class(IniStatesNA), "interception")
}
......
......@@ -293,7 +293,7 @@ CreateInputsCrit <- function(FUN_CRIT,
listVarObs <- sapply(InputsCrit, FUN = "[[", "VarObs")
inCnVarObs <- c("SCA", "SWE")
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",
paste(sapply(inCnVarObs, shQuote), collapse = " or ")))
}
......@@ -348,7 +348,7 @@ CreateInputsCrit <- function(FUN_CRIT,
combInputsCrit <- combn(x = length(InputsCrit), m = 2)
apply(combInputsCrit, MARGIN = 2, function(i) {
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)
}
})
......
......@@ -153,10 +153,10 @@ CreateInputsModel <- function(FUN_MOD,
if (nrow(Qupstream) != LLL) {
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")
}
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")
}
QupstrUnit <- tolower(QupstrUnit)
......
......@@ -24,12 +24,17 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
ObjectClass <- FeatFUN_MOD$Class
TimeStepMean <- FeatFUN_MOD$TimeStepMean
## Model output variable list
FortranOutputs <- .FortranOutputs(GR = FeatFUN_MOD$CodeModHydro,
isCN = "CemaNeige" %in% FeatFUN_MOD$Class)
## manage class
if (IsIntStore) {
ObjectClass <- c(ObjectClass, "interception")
}
if (IsHyst) {
ObjectClass <- c(ObjectClass, "hysteresis")
FeatFUN_MOD$NbParam <- FeatFUN_MOD$NbParam + 2
}
if (!"CemaNeige" %in% ObjectClass & "hysteresis" %in% ObjectClass) {
......@@ -290,31 +295,7 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
##check_Outputs_Cal_and_Sim
##Outputs_all
Outputs_all <- NULL
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)
}
Outputs_all <- c("DatesR", unlist(FortranOutputs), "WarmUpQsim", "StateEnd")
##check_Outputs_Sim
if (!is.vector(Outputs_Sim)) {
......@@ -327,9 +308,9 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
stop("'Outputs_Sim' must not contain NA")
}
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) {
stop(paste0( "'Outputs_Sim' is incorrectly defined: ",
paste(Outputs_Sim[Test], collapse = ", "), " not found"))
......@@ -361,10 +342,9 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
}
}
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) {
stop(paste0("'Outputs_Cal' is incorrectly defined: ",
paste(Outputs_Cal[Test], collapse = ", "), " not found"))
......@@ -473,7 +453,9 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
IniStates = IniStates,
IniResLevels = IniResLevels,
Outputs_Cal = Outputs_Cal,
Outputs_Sim = Outputs_Sim)
Outputs_Sim = Outputs_Sim,
FortranOutputs = FortranOutputs,
FeatFUN_MOD = FeatFUN_MOD)
if ("CemaNeige" %in% ObjectClass) {
RunOptions <- c(RunOptions, list(MeanAnSolidPrecip = MeanAnSolidPrecip))
......
......@@ -148,7 +148,7 @@ RunModel_CemaNeige <- function(InputsModel, RunOptions, Param) {
## End
class(OutputsModel) <- c("OutputsModel", time_step, "CemaNeige")
if(IsHyst) {
if (IsHyst) {
class(OutputsModel) <- c(class(OutputsModel), "hysteresis")
}
return(OutputsModel)
......
......@@ -3,40 +3,12 @@ RunModel_CemaNeigeGR4H <- function(InputsModel, RunOptions, Param) {
## Initialization of variables
IsHyst <- inherits(RunOptions, "hysteresis")
NParam <- ifelse(test = IsHyst, yes = 8L, no = 6L)
NParamCN <- NParam - 4L
NParamCN <- RunOptions$FeatFUN_MOD$NbParam - 4L
NStates <- 4L
FortranOutputs <- .FortranOutputs(GR = "GR4H", isCN = TRUE)
## 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"))
}
.ArgumentsCheckGR(InputsModel, RunOptions, Param)
Param <- as.double(Param)
......@@ -76,9 +48,9 @@ RunModel_CemaNeigeGR4H <- function(InputsModel, RunOptions, Param) {
## CemaNeige________________________________________________________________________________
if (inherits(RunOptions, "CemaNeige")) {
if ("all" %in% RunOptions$Outputs_Sim) {
IndOutputsCemaNeige <- as.integer(1:length(FortranOutputs$CN))
IndOutputsCemaNeige <- as.integer(1:length(RunOptions$FortranOutputs$CN))
} else {
IndOutputsCemaNeige <- which(FortranOutputs$CN %in% RunOptions$Outputs_Sim)
IndOutputsCemaNeige <- which(RunOptions$FortranOutputs$CN %in% RunOptions$Outputs_Sim)
}
CemaNeigeLayers <- list()
CemaNeigeStateEnd <- NULL
......@@ -116,7 +88,7 @@ RunModel_CemaNeigeGR4H <- function(InputsModel, RunOptions, Param) {
## Data storage
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")
if (iLayer == 1) {
CatchMeltAndPliq <- RESULTS$Outputs[, IndPliqAndMelt] / NLayers
......@@ -142,9 +114,9 @@ RunModel_CemaNeigeGR4H <- function(InputsModel, RunOptions, Param) {
## GR model
if ("all" %in% RunOptions$Outputs_Sim) {
IndOutputsMod <- as.integer(1:length(FortranOutputs$GR))
IndOutputsMod <- as.integer(1:length(RunOptions$FortranOutputs$GR))
} else {
IndOutputsMod <- which(FortranOutputs$GR %in% RunOptions$Outputs_Sim)
IndOutputsMod <- which(RunOptions$FortranOutputs$GR %in% RunOptions$Outputs_Sim)
}
## Use of IniResLevels
......@@ -186,45 +158,14 @@ RunModel_CemaNeigeGR4H <- function(InputsModel, RunOptions, Param) {
}
if (inherits(RunOptions, "CemaNeige") & "Precip" %in% RunOptions$Outputs_Sim) {
RESULTS$Outputs[, which(FortranOutputs$GR[IndOutputsMod] == "Precip")] <- InputsModel$Precip[IndPeriod1]
}
## Output data preparation
## OutputsModel only
if (!ExportDatesR & !ExportStateEnd) {
OutputsModel <- c(lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
list(CemaNeigeLayers))
names(OutputsModel) <- c(FortranOutputs$GR[IndOutputsMod], NameCemaNeigeLayers)
}
## DatesR and OutputsModel only
if (ExportDatesR & !ExportStateEnd) {
OutputsModel <- c(list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
list(CemaNeigeLayers))
names(OutputsModel) <- c("DatesR", FortranOutputs$GR[IndOutputsMod], NameCemaNeigeLayers)
}
## OutputsModel and StateEnd only
if (!ExportDatesR & ExportStateEnd) {
OutputsModel <- c(lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
list(CemaNeigeLayers),
list(RESULTS$StateEnd))
names(OutputsModel) <- c(FortranOutputs$GR[IndOutputsMod], NameCemaNeigeLayers, "StateEnd")
}
## DatesR and OutputsModel and StateEnd
if (ExportDatesR & ExportStateEnd) {
OutputsModel <- c(list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
list(CemaNeigeLayers),
list(RESULTS$StateEnd))
names(OutputsModel) <- c("DatesR", FortranOutputs$GR[IndOutputsMod], NameCemaNeigeLayers, "StateEnd")
}
## End
rm(RESULTS)
class(OutputsModel) <- c("OutputsModel", "hourly", "GR", "CemaNeige")
if (IsHyst) {
class(OutputsModel) <- c(class(OutputsModel), "hysteresis")
RESULTS$Outputs[, which(RunOptions$FortranOutputs$GR[IndOutputsMod] == "Precip")] <-
InputsModel$Precip[IndPeriod1]
}
return(OutputsModel)
## OutputsModel generation
.GetOutputsModelGR(InputsModel,
RunOptions,
RESULTS,
LInputSeries,
CemaNeigeLayers)
}
RunModel_CemaNeigeGR4J <- function(InputsModel, RunOptions, Param) {
## Initialization of variables
IsHyst <- inherits(RunOptions, "hysteresis")
NParam <- ifelse(test = IsHyst, yes = 8L, no = 6L)
NParamCN <- NParam - 4L
NParamCN <- RunOptions$FeatFUN_MOD$NbParam - 4L
NStates <- 4L
FortranOutputs <- .FortranOutputs(GR = "GR4J", isCN = TRUE)
## 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(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"))
}
.ArgumentsCheckGR(InputsModel, RunOptions, Param)
Param <- as.double(Param)
Param_X1X3_threshold <- 1e-2
Param_X4_threshold <- 0.5
......@@ -53,8 +25,8 @@ RunModel_CemaNeigeGR4J <- function(InputsModel, RunOptions, Param) {
if (Param[4L] < Param_X4_threshold) {
warning(sprintf("Param[4] (X4: unit hydrograph time constant [d]) < %.2f\n X4 set to %.2f", Param_X4_threshold, Param_X4_threshold))
Param[4L] <- Param_X4_threshold
}
}
## Input data preparation
if (identical(RunOptions$IndPeriod_WarmUp, 0L)) {
RunOptions$IndPeriod_WarmUp <- NULL
......@@ -71,28 +43,28 @@ RunModel_CemaNeigeGR4J <- function(InputsModel, RunOptions, Param) {
## Output data preparation
ExportDatesR <- "DatesR" %in% RunOptions$Outputs_Sim
ExportStateEnd <- "StateEnd" %in% RunOptions$Outputs_Sim
## CemaNeige________________________________________________________________________________
if (inherits(RunOptions, "CemaNeige")) {
if ("all" %in% RunOptions$Outputs_Sim) {
IndOutputsCemaNeige <- as.integer(1:length(FortranOutputs$CN))
IndOutputsCemaNeige <- as.integer(1:length(RunOptions$FortranOutputs$CN))
} else {
IndOutputsCemaNeige <- which(FortranOutputs$CN %in% RunOptions$Outputs_Sim)
IndOutputsCemaNeige <- which(RunOptions$FortranOutputs$CN %in% RunOptions$Outputs_Sim)
}
CemaNeigeLayers <- list()
CemaNeigeStateEnd <- NULL
NameCemaNeigeLayers <- "CemaNeigeLayers"
## Call CemaNeige Fortran_________________________
for(iLayer in 1:NLayers) {
for (iLayer in 1:NLayers) {
if (!IsHyst) {
StateStartCemaNeige <- RunOptions$IniStates[(7 + 20 + 40) + c(iLayer, iLayer+NLayers)]
} else {