Commit 7fdd08de authored by Dorchies David's avatar Dorchies David
Browse files

fix(RunModel_Lag): issues with warm-up, initial and end states

- Add explicit management of "QsimDown" and "Qsim_m3" items to OutputsModel
- Remove OutputsModel$StateEnd from regression tests because of changing in class sorting of IniStates object

Refs #132
Showing with 23 additions and 3 deletions
+23 -3
...@@ -13,8 +13,10 @@ Param_Sets_GR4J RunOptions_Cal ...@@ -13,8 +13,10 @@ Param_Sets_GR4J RunOptions_Cal
Param_Sets_GR4J RunOptions_Val Param_Sets_GR4J RunOptions_Val
* OutputsModel$Param * OutputsModel$Param
* OutputsModel$WarmUpQsim * OutputsModel$WarmUpQsim
* OutputsModel$StateEnd
Param_Sets_GR4J OutputsModel_Val Param_Sets_GR4J OutputsModel_Val
RunModel_Lag InputsModel RunModel_Lag InputsModel
RunModel_Lag OutputsModel
RunModel_Lag OutputsModelDown RunModel_Lag OutputsModelDown
SeriesAggreg SimulatedMonthlyRegime SeriesAggreg SimulatedMonthlyRegime
* InputsCrit$FUN_CRIT * InputsCrit$FUN_CRIT
......
...@@ -303,6 +303,9 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, ...@@ -303,6 +303,9 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
##Outputs_all ##Outputs_all
Outputs_all <- c("DatesR", unlist(FortranOutputs), "WarmUpQsim", "StateEnd", "Param") Outputs_all <- c("DatesR", unlist(FortranOutputs), "WarmUpQsim", "StateEnd", "Param")
if (FeatFUN_MOD$IsSD) {
Outputs_all <- c(Outputs_all, "QsimDown", "Qsim_m3")
}
##check_Outputs_Sim ##check_Outputs_Sim
if (!is.vector(Outputs_Sim)) { if (!is.vector(Outputs_Sim)) {
......
...@@ -116,14 +116,21 @@ RunModel_Lag <- function(InputsModel, RunOptions, Param, QcontribDown) { ...@@ -116,14 +116,21 @@ RunModel_Lag <- function(InputsModel, RunOptions, Param, QcontribDown) {
## OutputsModel ## OutputsModel
OutputsModel$Qsim_m3 <- Qsim_m3[IndPeriod2] if ("Qsim_m3" %in% RunOptions$Outputs_Sim) {
OutputsModel$Qsim_m3 <- Qsim_m3[IndPeriod2]
}
if ("Qsim" %in% RunOptions$Outputs_Sim) { if ("Qsim" %in% RunOptions$Outputs_Sim) {
# Convert back Qsim to mm # Convert back Qsim to mm
OutputsModel$Qsim <- OutputsModel$Qsim_m3 / sum(InputsModel$BasinAreas, na.rm = TRUE) / 1e3 OutputsModel$Qsim <- Qsim_m3[IndPeriod2] / sum(InputsModel$BasinAreas, na.rm = TRUE) / 1e3
# message("Qsim: ", paste(OutputsModel$Qsim, collapse = ", ")) # message("Qsim: ", paste(OutputsModel$Qsim, collapse = ", "))
} }
if ("QsimDown" %in% RunOptions$Outputs_Sim) {
# Convert back Qsim to mm
OutputsModel$QsimDown <- QsimDown[IndPeriod2]
}
# Warning for negative flows or NAs only in extended outputs # Warning for negative flows or NAs only in extended outputs
if (length(RunOptions$Outputs_Sim) > 2) { if (length(RunOptions$Outputs_Sim) > 2) {
if (any(OutputsModel$Qsim[!is.na(OutputsModel$Qsim)] < 0)) { if (any(OutputsModel$Qsim[!is.na(OutputsModel$Qsim)] < 0)) {
...@@ -149,7 +156,7 @@ RunModel_Lag <- function(InputsModel, RunOptions, Param, QcontribDown) { ...@@ -149,7 +156,7 @@ 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))] OutputsModel$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) {
......
...@@ -81,6 +81,14 @@ test_that("'QcontribDown$Qim' should have the same lenght as 'RunOptions$IndPeri ...@@ -81,6 +81,14 @@ test_that("'QcontribDown$Qim' should have the same lenght as 'RunOptions$IndPeri
) )
}) })
test_that("OutputsModel must have a item 'QsimDown' equal to GR4J Qsim contribution", {
expect_equal(OutputsGR4JOnly$Qsim,
RunModel_Lag(InputsModel = InputsModel,
RunOptions = RunOptions,
Param = 1,
QcontribDown = OutputsGR4JOnly)$QsimDown)
})
test_that("RunModel(FUN=RunModel_Lag) should give same result as RunModel_Lag", { test_that("RunModel(FUN=RunModel_Lag) should give same result as RunModel_Lag", {
QcontribDown <- OutputsGR4JOnly QcontribDown <- OutputsGR4JOnly
Output_RunModel_Lag <- RunModel_Lag(InputsModel = InputsModel, Output_RunModel_Lag <- RunModel_Lag(InputsModel = InputsModel,
......
Supports Markdown
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