diff --git a/DESCRIPTION b/DESCRIPTION index 774120a47bb627e71b313ddcc9ced7a1e99ae825..a8180bc49055cfb626d9a9b819569a71c8d3cd6e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: airGR Type: Package Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling -Version: 1.6.1.15 +Version: 1.6.1.16 Date: 2020-06-04 Authors@R: c( person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")), diff --git a/R/CreateInputsModel.R b/R/CreateInputsModel.R index f79783188590841409863226de619af2ae012a09..6fefda3fffb27b90dc7c23c947de8d7f26c85769 100644 --- a/R/CreateInputsModel.R +++ b/R/CreateInputsModel.R @@ -194,24 +194,21 @@ CreateInputsModel <- function(FUN_MOD, if (!("daily" %in% ObjectClass) & !("hourly" %in% ObjectClass)) { stop("Only daily and hourly time steps can be used in a semi-distributed mode") } - if (!is.matrix(Qupstream) | !is.matrix(LengthHydro) | !is.matrix(BasinAreas)) { - stop("'Qupstream', 'LengthHydro' and 'BasinAreas' must be matrices of numeric values") + if (!is.matrix(Qupstream) | !is.numeric(Qupstream)) { + stop("'Qupstream' must be a matrice of numeric values") } - if (!is.numeric(Qupstream) | !is.numeric(LengthHydro) | !is.numeric(BasinAreas)) { - stop("'Qupstream', 'LengthHydro' and 'BasinAreas' must be matrices of numeric values") + if (!is.vector(LengthHydro) | !is.vector(BasinAreas) | !is.numeric(LengthHydro) | !is.numeric(BasinAreas)) { + stop("'LengthHydro' and 'BasinAreas' must be vectors of numeric values") } - if (ncol(Qupstream) != ncol(LengthHydro)) { - stop("'Qupstream' and 'LengthHydro' must have the same number of columns") + if (ncol(Qupstream) != length(LengthHydro)) { + stop("'Qupstream' number of columns and 'LengthHydro' length must be equal") } - if (ncol(Qupstream)+1 != ncol(BasinAreas)) { - stop("'BasinAreas' must have one column more than 'Qupstream' and 'LengthHydro'") + if (length(LengthHydro) + 1 != length(BasinAreas)) { + stop("'BasinAreas' must have one more element than 'LengthHydro'") } if (nrow(Qupstream) != LLL) { stop("'Qupstream' 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") - } if(any(is.na(Qupstream))) { stop("'Qupstream' cannot contain any NA value") } diff --git a/R/RunModel.R b/R/RunModel.R index cd851b656e0bb46b896faf6e783721d7487c15c9..002c4d45457479f03c6cb71484db1e90ca03d27f 100644 --- a/R/RunModel.R +++ b/R/RunModel.R @@ -18,7 +18,7 @@ RunModel <- function (InputsModel, RunOptions, Param, FUN_MOD) { AreaTot <- sum(InputsModel$BasinAreas) # propagation time from upstream meshes to outlet - PT <- InputsModel$LengthHydro[1, ] / Param[length(Param)] / TimeStep + PT <- InputsModel$LengthHydro / Param[length(Param)] / TimeStep HUTRANS <- rbind(1 - (PT - floor(PT)), PT - floor(PT)) NbUpBasins <- length(InputsModel$LengthHydro) diff --git a/tests/testthat/test-RunModel_LAG.R b/tests/testthat/test-RunModel_LAG.R index cd53e8ac843e3f25066e82170df810dd29f02228..71b34a2103db5f4011551ccf72d222be1c84887d 100644 --- a/tests/testthat/test-RunModel_LAG.R +++ b/tests/testthat/test-RunModel_LAG.R @@ -3,7 +3,7 @@ context("RunModel_LAG") data(L0123001) -test_that("'BasinAreas' must have one column more than 'Qupstream' and 'LengthHydro'", { +test_that("'BasinAreas' must have one more element than 'LengthHydro'", { expect_error( InputsModel <- CreateInputsModel( FUN_MOD = RunModel_GR4J, @@ -11,14 +11,14 @@ test_that("'BasinAreas' must have one column more than 'Qupstream' and 'LengthHy Precip = BasinObs$P, PotEvap = BasinObs$E, Qupstream = matrix(BasinObs$Qmm, ncol = 1), - LengthHydro = matrix(c(1), nrow = 1), - BasinAreas = matrix(c(1), nrow = 1) + LengthHydro = 1, + BasinAreas = 1 ), - regexp = "'BasinAreas' must have one column more than 'Qupstream' and 'LengthHydro'" + regexp = "'BasinAreas' must have one more element than 'LengthHydro'" ) }) -test_that("'BasinAreas' must have one column more than 'Qupstream' and 'LengthHydro'", { +test_that("'Qupstream' cannot contain any NA value", { expect_error( InputsModel <- CreateInputsModel( FUN_MOD = RunModel_GR4J, @@ -26,8 +26,8 @@ test_that("'BasinAreas' must have one column more than 'Qupstream' and 'LengthHy Precip = BasinObs$P, PotEvap = BasinObs$E, Qupstream = matrix(BasinObs$Qmm, ncol = 1), - LengthHydro = matrix(c(1), nrow = 1), - BasinAreas = matrix(c(1, 2), nrow = 1) + LengthHydro = 1, + BasinAreas = c(1, 2) ), regexp = "'Qupstream' cannot contain any NA value" ) @@ -42,10 +42,8 @@ InputsModel <- CreateInputsModel( Precip = BasinObs$P, PotEvap = BasinObs$E, Qupstream = matrix(Qupstream, ncol = 1), - LengthHydro = matrix(c(1000), nrow = 1), - BasinAreas = matrix(c( - BasinInfo$BasinArea * 2, BasinInfo$BasinArea - ), nrow = 1) + LengthHydro = 1000, + BasinAreas = c(BasinInfo$BasinArea * 2, BasinInfo$BasinArea) ) Ind_Run <- seq(which(format(BasinObs$DatesR, format = "%Y-%m-%d") == "1990-01-01"), @@ -64,15 +62,15 @@ OutputsGR4JOnly <- test_that("Upstream basin with nil area should return same Qdown as GR4J alone", { - UpstBasinArea = InputsModel$BasinAreas[1, 1] - InputsModel$BasinAreas[1, 1] <<- 0 + UpstBasinArea = InputsModel$BasinAreas[1] + InputsModel$BasinAreas[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 + InputsModel$BasinAreas[1] <<- UpstBasinArea }) test_that( @@ -84,8 +82,8 @@ test_that( Precip = BasinObs$P, PotEvap = BasinObs$E, Qupstream = matrix(Qupstream, ncol = 1), - LengthHydro = matrix(c(0), nrow = 1), - BasinAreas = matrix(c(BasinInfo$BasinArea, 0), nrow = 1) + LengthHydro = 0, + BasinAreas = c(BasinInfo$BasinArea, 0) ) OutputsSD <- RunModel(InputsModelZeroDown,