Commit 84d860ae authored by Delaigue Olivier's avatar Delaigue Olivier
Browse files

Merge branch...

Merge branch '137-fix-extractoutputsmodel-function-to-manage-the-new-elements-of-outputsmodel' into 'dev'

Resolve "Fix .ExtractOutputsModel function to manage the new elements of OutputsModel"

Closes #137

See merge request !58
parents b3a73e00 ede467bb
Pipeline #28777 failed with stages
in 136 minutes and 34 seconds
......@@ -6,7 +6,7 @@ CreateErrorCrit_GAPX <- function(FUN_TRANSFO) {
stop("'OutputsModel' must be of class 'OutputsModel'")
}
OutputsModel$ParamT <- FUN_TRANSFO(OutputsModel$Param, "RT")
OutputsModel$RunOptions$ParamT <- FUN_TRANSFO(OutputsModel$RunOptions$Param, "RT")
EC <- .ErrorCrit(InputsCrit = InputsCrit, Crit = "GAPX", OutputsModel = OutputsModel, warnings = warnings)
......
......@@ -48,10 +48,10 @@ RunModel_Lag <- function(InputsModel, RunOptions, Param, QcontribDown) {
if (inherits(QcontribDown, "OutputsModel")) {
OutputsModel <- QcontribDown
if (is.null(OutputsModel$WarmUpQsim)) {
OutputsModel$WarmUpQsim <- rep(NA, length(RunOptions$IndPeriod_WarmUp))
if (is.null(OutputsModel$RunOptions$WarmUpQsim)) {
OutputsModel$RunOptions$WarmUpQsim <- rep(NA, length(RunOptions$IndPeriod_WarmUp))
}
QsimDown <- c(OutputsModel$WarmUpQsim, OutputsModel$Qsim)
QsimDown <- c(OutputsModel$RunOptions$WarmUpQsim, OutputsModel$Qsim)
} else if (is.vector(QcontribDown) && is.numeric(QcontribDown)) {
OutputsModel <- list()
class(OutputsModel) <- c("OutputsModel", class(RunOptions)[-1])
......@@ -156,11 +156,11 @@ RunModel_Lag <- function(InputsModel, RunOptions, Param, QcontribDown) {
# message("StateEnd: ", paste(OutputsModel$StateEnd$SD, collapse = ", "))
}
if ("WarmUpQsim" %in% RunOptions$Outputs_Sim) {
OutputsModel$WarmUpQsim <- Qsim_m3[seq_len(length(RunOptions$IndPeriod_WarmUp))] / sum(InputsModel$BasinAreas, na.rm = TRUE) / 1e3
OutputsModel$RunOptions$WarmUpQsim <- Qsim_m3[seq_len(length(RunOptions$IndPeriod_WarmUp))] / sum(InputsModel$BasinAreas, na.rm = TRUE) / 1e3
}
if ("Param" %in% RunOptions$Outputs_Sim) {
OutputsModel$Param <- c(Param, OutputsModel$Param)
OutputsModel$RunOptions$Param <- c(Param, OutputsModel$RunOptions$Param)
}
class(OutputsModel) <- c(class(OutputsModel), "SD")
......
......@@ -213,6 +213,9 @@
}
return(res0)
})
if (!is.null(x$RunOptions)) {
res$RunOptions <- x$RunOptions
}
if (!is.null(x$StateEnd)) {
res$StateEnd <- x$StateEnd
}
......@@ -221,7 +224,7 @@
}
.IndexOutputsModel <- function(x, i) {
# '[.OutputsModel' <- function(x, i) {
# '[.OutputsModel' <- function(x, i) {
if (!inherits(x, "OutputsModel")) {
stop("'x' must be of class 'OutputsModel'")
}
......
......@@ -49,7 +49,7 @@
Q = OutputsModel$Qsim,
SCA = rowMeans(sapply(OutputsModel$CemaNeigeLayers[InputsCrit$idLayer], FUN = "[[", "Gratio")),
SWE = rowMeans(sapply(OutputsModel$CemaNeigeLayers[InputsCrit$idLayer], FUN = "[[", "SnowPack")),
ParamT = OutputsModel$ParamT
ParamT = OutputsModel$RunOptions$ParamT
)
VarSim[!InputsCrit$BoolCrit] <- NA
......
......@@ -39,18 +39,19 @@
}
if ("WarmUpQsim" %in% RunOptions$Outputs_Sim) {
OutputsModel$WarmUpQsim <- RESULTS$Outputs[seq_len(length(RunOptions$IndPeriod_WarmUp)),
OutputsModel$RunOptions$WarmUpQsim <- RESULTS$Outputs[seq_len(length(RunOptions$IndPeriod_WarmUp)),
which(FortranOutputs == "Qsim")]
class(OutputsModel$WarmUpQsim) <- c("WarmUpOutputsModelItem", class(OutputsModel$WarmUpQsim))
# class(OutputsModel$RunOptions$WarmUpQsim) <- c("WarmUpOutputsModelItem", class(OutputsModel$RunOptions$WarmUpQsim))
}
if ("Param" %in% RunOptions$Outputs_Sim) {
OutputsModel$RunOptions$Param <- Param
}
if ("StateEnd" %in% RunOptions$Outputs_Sim) {
OutputsModel$StateEnd <- RESULTS$StateEnd
}
if ("Param" %in% RunOptions$Outputs_Sim) {
OutputsModel$Param <- Param
}
class(OutputsModel) <- c("OutputsModel", class(RunOptions)[-1])
......
context("Extract")
## loading catchment data
data(L0123002)
## preparation of the InputsModel object
InputsModel <- CreateInputsModel(FUN_MOD = RunModel_CemaNeigeGR4J, DatesR = BasinObs$DatesR,
Precip = BasinObs$P, PotEvap = BasinObs$E, TempMean = BasinObs$T,
ZInputs = median(BasinInfo$HypsoData),
HypsoData = BasinInfo$HypsoData, NLayers = 5)
## run period selection
Ind_Run <- seq(which(format(BasinObs$DatesR, format = "%Y-%m-%d")=="1990-01-01"),
which(format(BasinObs$DatesR, format = "%Y-%m-%d")=="1999-12-31"))
## preparation of the RunOptions object
RunOptions <- CreateRunOptions(FUN_MOD = RunModel_CemaNeigeGR4J, InputsModel = InputsModel,
IndPeriod_Run = Ind_Run)
## simulation
Param <- c(X1 = 408.774, X2 = 2.646, X3 = 131.264, X4 = 1.174,
CNX1 = 0.962, CNX2 = 2.249)
OutputsModel <- RunModel_CemaNeigeGR4J(InputsModel = InputsModel,
RunOptions = RunOptions, Param = Param)
## -----
test_that("Names of InputsModel", {
expect_equal(names(InputsModel), names(InputsModel[1:5]))
})
test_that("Names of OutputsModel", {
expect_equal(names(OutputsModel), names(airGR:::.ExtractOutputsModel(OutputsModel, 1:5)))
})
......@@ -122,7 +122,7 @@ For using upstream simulated flows, we should concatenate a vector with the simu
```{r}
Qsim_upstream <- rep(NA, length(BasinObs$DatesR))
# Simulated flow during warm-up period (365 days before run period)
Qsim_upstream[Ind_Run[seq_len(365)] - 365] <- OutputsModelUp$WarmUpQsim
Qsim_upstream[Ind_Run[seq_len(365)] - 365] <- OutputsModelUp$RunOptions$WarmUpQsim
# Simulated flow during run period
Qsim_upstream[Ind_Run] <- OutputsModelUp$Qsim
......
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