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) { ...@@ -6,7 +6,7 @@ CreateErrorCrit_GAPX <- function(FUN_TRANSFO) {
stop("'OutputsModel' must be of class 'OutputsModel'") 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) EC <- .ErrorCrit(InputsCrit = InputsCrit, Crit = "GAPX", OutputsModel = OutputsModel, warnings = warnings)
......
...@@ -48,10 +48,10 @@ RunModel_Lag <- function(InputsModel, RunOptions, Param, QcontribDown) { ...@@ -48,10 +48,10 @@ RunModel_Lag <- function(InputsModel, RunOptions, Param, QcontribDown) {
if (inherits(QcontribDown, "OutputsModel")) { if (inherits(QcontribDown, "OutputsModel")) {
OutputsModel <- QcontribDown OutputsModel <- QcontribDown
if (is.null(OutputsModel$WarmUpQsim)) { if (is.null(OutputsModel$RunOptions$WarmUpQsim)) {
OutputsModel$WarmUpQsim <- rep(NA, length(RunOptions$IndPeriod_WarmUp)) 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)) { } else if (is.vector(QcontribDown) && is.numeric(QcontribDown)) {
OutputsModel <- list() OutputsModel <- list()
class(OutputsModel) <- c("OutputsModel", class(RunOptions)[-1]) class(OutputsModel) <- c("OutputsModel", class(RunOptions)[-1])
...@@ -156,11 +156,11 @@ RunModel_Lag <- function(InputsModel, RunOptions, Param, QcontribDown) { ...@@ -156,11 +156,11 @@ RunModel_Lag <- function(InputsModel, RunOptions, Param, QcontribDown) {
# message("StateEnd: ", paste(OutputsModel$StateEnd$SD, collapse = ", ")) # message("StateEnd: ", paste(OutputsModel$StateEnd$SD, collapse = ", "))
} }
if ("WarmUpQsim" %in% RunOptions$Outputs_Sim) { 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) { 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") class(OutputsModel) <- c(class(OutputsModel), "SD")
......
...@@ -213,6 +213,9 @@ ...@@ -213,6 +213,9 @@
} }
return(res0) return(res0)
}) })
if (!is.null(x$RunOptions)) {
res$RunOptions <- x$RunOptions
}
if (!is.null(x$StateEnd)) { if (!is.null(x$StateEnd)) {
res$StateEnd <- x$StateEnd res$StateEnd <- x$StateEnd
} }
...@@ -221,7 +224,7 @@ ...@@ -221,7 +224,7 @@
} }
.IndexOutputsModel <- function(x, i) { .IndexOutputsModel <- function(x, i) {
# '[.OutputsModel' <- function(x, i) { # '[.OutputsModel' <- function(x, i) {
if (!inherits(x, "OutputsModel")) { if (!inherits(x, "OutputsModel")) {
stop("'x' must be of class 'OutputsModel'") stop("'x' must be of class 'OutputsModel'")
} }
......
...@@ -49,7 +49,7 @@ ...@@ -49,7 +49,7 @@
Q = OutputsModel$Qsim, Q = OutputsModel$Qsim,
SCA = rowMeans(sapply(OutputsModel$CemaNeigeLayers[InputsCrit$idLayer], FUN = "[[", "Gratio")), SCA = rowMeans(sapply(OutputsModel$CemaNeigeLayers[InputsCrit$idLayer], FUN = "[[", "Gratio")),
SWE = rowMeans(sapply(OutputsModel$CemaNeigeLayers[InputsCrit$idLayer], FUN = "[[", "SnowPack")), SWE = rowMeans(sapply(OutputsModel$CemaNeigeLayers[InputsCrit$idLayer], FUN = "[[", "SnowPack")),
ParamT = OutputsModel$ParamT ParamT = OutputsModel$RunOptions$ParamT
) )
VarSim[!InputsCrit$BoolCrit] <- NA VarSim[!InputsCrit$BoolCrit] <- NA
......
...@@ -39,18 +39,19 @@ ...@@ -39,18 +39,19 @@
} }
if ("WarmUpQsim" %in% RunOptions$Outputs_Sim) { 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")] 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) { if ("StateEnd" %in% RunOptions$Outputs_Sim) {
OutputsModel$StateEnd <- RESULTS$StateEnd OutputsModel$StateEnd <- RESULTS$StateEnd
} }
if ("Param" %in% RunOptions$Outputs_Sim) {
OutputsModel$Param <- Param
}
class(OutputsModel) <- c("OutputsModel", class(RunOptions)[-1]) 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 ...@@ -122,7 +122,7 @@ For using upstream simulated flows, we should concatenate a vector with the simu
```{r} ```{r}
Qsim_upstream <- rep(NA, length(BasinObs$DatesR)) Qsim_upstream <- rep(NA, length(BasinObs$DatesR))
# Simulated flow during warm-up period (365 days before run period) # 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 # Simulated flow during run period
Qsim_upstream[Ind_Run] <- OutputsModelUp$Qsim 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