Commit 031b0716 authored by Dorchies David's avatar Dorchies David
Browse files

v1.6.1.12 fix: QobsUpstr should use RunOptions$IndPeriod_Run index in RunModel

- Add simple tests on ru of SD model
- Add also a control on the Qupstream series lenght

Refs #34
Showing with 92 additions and 3 deletions
+92 -3
......@@ -34,7 +34,7 @@ packrat/lib*/
/*.Rcheck/
# RStudio files
.Rproj.user/
.Rproj.user
# produced vignettes
vignettes/*.html
......
......@@ -207,6 +207,9 @@ CreateInputsModel <- function(FUN_MOD,
if (ncol(QobsUpstr)+1 != ncol(BasinAreas)) {
stop("'BasinAreas' must have one column more than 'QobsUpstr' and 'LengthHydro'")
}
if (nrow(QobsUpstr) != LLL) {
stop("'QobsUpstr' must have same number of rows as 'DatesR' length")
}
if (nrow(LengthHydro) != 1 | nrow(BasinAreas) != 1) {
stop("'LengthHydro' and 'BasinAreas' must have only one row")
}
......
......@@ -26,12 +26,13 @@ RunModel <- function (InputsModel, RunOptions, Param, FUN_MOD) {
OutputsModelDown$Qsim <- OutputsModelDown$QsimDown * InputsModel$BasinAreas[length(InputsModel$BasinAreas)] / AreaTot
for (upstream_basin in seq_len(NbUpBasins)) {
QobsUpstr <- InputsModel$QobsUpstr[RunOptions$IndPeriod_Run, upstream_basin]
OutputsModelDown$Qsim <- OutputsModelDown$Qsim +
c(rep(0, floor(PT[upstream_basin])),
InputsModel$QobsUpstr[(1 + floor(PT[upstream_basin])):LengthTs, upstream_basin]) *
QobsUpstr[(1 + floor(PT[upstream_basin])):LengthTs]) *
HUTRANS[1, upstream_basin] * InputsModel$BasinAreas[upstream_basin] / AreaTot +
c(rep(0, floor(PT[upstream_basin] + 1)),
InputsModel$QobsUpstr[(2 + floor(PT[upstream_basin])):LengthTs, upstream_basin]) *
QobsUpstr[(2 + floor(PT[upstream_basin])):LengthTs]) *
HUTRANS[2, upstream_basin] * InputsModel$BasinAreas[upstream_basin] / AreaTot
}
......
context("RunModel_LAG")
data(L0123001)
test_that("'BasinAreas' must have one column more than 'QobsUpstr' and 'LengthHydro'", {
expect_error(
InputsModel <- CreateInputsModel(
FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR,
Precip = BasinObs$P, PotEvap = BasinObs$E,
QobsUpstr = matrix(BasinObs$Qmm * 2,ncol=1),
LengthHydro = matrix(c(1),nrow=1),
BasinAreas = matrix(c(1),nrow=1)
),
regexp = "'BasinAreas' must have one column more than 'QobsUpstr' and 'LengthHydro'"
)
})
test_that("'BasinAreas' must have one column more than 'QobsUpstr' and 'LengthHydro'", {
expect_error(
InputsModel <- CreateInputsModel(
FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR,
Precip = BasinObs$P, PotEvap = BasinObs$E,
QobsUpstr = matrix(BasinObs$Qmm, ncol = 1),
LengthHydro = matrix(c(1), nrow = 1),
BasinAreas = matrix(c(1, 2),nrow = 1)
),
regexp = "'QobsUpstr' cannot contain any NA value"
)
})
QobsUpstr = BasinObs$Qmm
QobsUpstr[is.na(QobsUpstr)] = mean(QobsUpstr, na.rm = TRUE)
InputsModel <- CreateInputsModel(
FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR,
Precip = BasinObs$P, PotEvap = BasinObs$E,
QobsUpstr = matrix(QobsUpstr,ncol=1),
LengthHydro = matrix(c(1),nrow=1),
BasinAreas = matrix(c(BasinInfo$BasinArea,BasinInfo$BasinArea),nrow=1)
)
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")
)
RunOptions <- CreateRunOptions(
FUN_MOD = RunModel_GR4J,
InputsModel = InputsModel, IndPeriod_Run = Ind_Run
)
Param = c(257.237556, 1.012237, 88.234673, 2.207958) # From vignettes/V01_get_started
OutputsGR4JOnly <- RunModel_GR4J(InputsModel = InputsModel, RunOptions = RunOptions, Param = Param)
test_that("Upstream basin with nil area should return same Qdown as GR4J alone", {
UpstBasinArea = InputsModel$BasinAreas[1,1]
InputsModel$BasinAreas[1,1] <<- 0
OutputsSD <- RunModel(InputsModel, RunOptions, Param = c(Param, 1), FUN_MOD = RunModel_GR4J)
expect_equal(OutputsGR4JOnly$Qsim, OutputsSD$Qsim)
InputsModel$BasinAreas[1,1] <<- UpstBasinArea
})
test_that("Downstream basin with nil area and nul upstream length should return same Qdown as Qupstream alone", {
InputsModel <- CreateInputsModel(
FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR,
Precip = BasinObs$P, PotEvap = BasinObs$E,
QobsUpstr = matrix(QobsUpstr,ncol=1),
LengthHydro = matrix(c(0),nrow=1),
BasinAreas = matrix(c(BasinInfo$BasinArea,0),nrow=1)
)
OutputsSD <- RunModel(InputsModel, RunOptions, Param = c(Param, 1), FUN_MOD = RunModel_GR4J)
expect_equal(OutputsSD$Qsim, QobsUpstr[Ind_Run])
})
test_that("1 input with lag of 1 time step delay out gives an output delayed of one time step", {
QlsGR4Only <- OutputsGR4JOnly$Qsim * InputsModel$BasinAreas[2] * 1E6 / 86400
ParamSD = c(Param, InputsModel$LengthHydro * 1000 / (24 * 60 * 60))
OutputsSD <- RunModel(InputsModel, RunOptions, Param = ParamSD, FUN_MOD = RunModel_GR4J)
QlsSdSim <- OutputsSD$Qsim * sum(InputsModel$BasinAreas) * 1E6 / 86400
QlsUpstLagObs <- c(0, QobsUpstr[Ind_Run[1:(length(Ind_Run)-1)] + 1]) * InputsModel$BasinAreas[1] * 1E6 / 86400
expect_equal(QlsSdSim - QlsGR4Only, QlsUpstLagObs)
})
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