From ad63d07c985b447b8e45473f42a9aa3ba04894f1 Mon Sep 17 00:00:00 2001
From: Delaigue Olivier <olivier.delaigue@irstea.fr>
Date: Wed, 14 Oct 2020 13:16:35 +0200
Subject: [PATCH] 1.6.3.4 style(RunModel_LAG): minor typo and code revisions
Refs #34
---
DESCRIPTION | 4 ++--
NEWS.md | 2 +-
R/RunModel_LAG.R | 37 +++++++++++++++++++++++--------------
3 files changed, 26 insertions(+), 17 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index c22d7738..590717fa 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,8 +1,8 @@
Package: airGR
Type: Package
Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling
-Version: 1.6.3.3
-Date: 2020-10-06
+Version: 1.6.3.4
+Date: 2020-10-14
Authors@R: c(
person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")),
person("Olivier", "Delaigue", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-7668-8468"), email = "airGR@inrae.fr"),
diff --git a/NEWS.md b/NEWS.md
index d112a86e..ee4bd1c0 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,6 +1,6 @@
## Release History of the airGR Package
-### 1.6.3.3 Release Notes (2020-10-06)
+### 1.6.3.4 Release Notes (2020-10-14)
#### New features
diff --git a/R/RunModel_LAG.R b/R/RunModel_LAG.R
index 20d858fd..2a84d411 100644
--- a/R/RunModel_LAG.R
+++ b/R/RunModel_LAG.R
@@ -1,27 +1,36 @@
-RunModel_LAG <- function(InputsModel,RunOptions,Param) {
+RunModel_LAG <- function(InputsModel, RunOptions, Param) {
NParam <- 1
##Arguments_check
- if(inherits(InputsModel,"InputsModel")==FALSE){ stop("'InputsModel' must be of class 'InputsModel'") }
- if(inherits(InputsModel,"SD" )==FALSE){ stop("'InputsModel' must be of class 'SD'") }
- if(inherits(RunOptions,"RunOptions" )==FALSE){ stop("'RunOptions' must be of class 'RunOptions'") }
- if(!is.vector(Param) | !is.numeric(Param)){ stop("'Param' must be a numeric vector") }
- if(sum(!is.na(Param))!=NParam){ stop(paste("'Param' must be a vector of length",NParam,"and contain no NA")) }
-
- if(is.null(InputsModel$OutputsModel)) {
+ if (!inherits(InputsModel, "InputsModel")) {
+ stop("'InputsModel' must be of class 'InputsModel'")
+ }
+ if (!inherits(InputsModel, "SD")) {
+ stop("'InputsModel' must be of class 'SD'")
+ }
+ if (!inherits(RunOptions, "RunOptions")) {
+ stop("'RunOptions' must be of class 'RunOptions'")
+ }
+ if (!is.vector(Param) | !is.numeric(Param)) {
+ stop("'Param' must be a numeric vector")
+ }
+ if (sum(!is.na(Param)) != NParam) {
+ stop(paste("'Param' must be a vector of length", NParam, "and contain no NA"))
+ }
+ if (is.null(InputsModel$OutputsModel)) {
stop("'InputsModel' should contain an 'OutputsModel' key containing the output of the runoff of the downstream subcatchment")
}
- if(is.null(InputsModel$OutputsModel$Qsim)) {
+ if (is.null(InputsModel$OutputsModel$Qsim)) {
stop("'InputsModel$OutputsModel' should contain a key 'Qsim' containing the output of the runoff of the downstream subcatchment")
}
- if(sum(!is.na(InputsModel$OutputsModel$Qsim)) != length(RunOptions$IndPeriod_Run)) {
+ if (sum(!is.na(InputsModel$OutputsModel$Qsim)) != length(RunOptions$IndPeriod_Run)) {
stop("'InputsModel$OutputsModel$Qim' should have the same lenght as 'RunOptions$IndPeriod_Run' and contain no NA")
}
OutputsModel <- InputsModel$OutputsModel
OutputsModel$QsimDown <- OutputsModel$Qsim
-
+
if (inherits(InputsModel, "daily")) {
TimeStep <- 60 * 60 * 24
}
@@ -30,7 +39,7 @@ RunModel_LAG <- function(InputsModel,RunOptions,Param) {
}
# propagation time from upstream meshes to outlet
- PT <- InputsModel$LengthHydro / Param[1] / TimeStep
+ PT <- InputsModel$LengthHydro / Param[1L] / TimeStep
HUTRANS <- rbind(1 - (PT - floor(PT)), PT - floor(PT))
NbUpBasins <- length(InputsModel$LengthHydro)
@@ -39,7 +48,7 @@ RunModel_LAG <- function(InputsModel,RunOptions,Param) {
for (upstream_basin in seq_len(NbUpBasins)) {
Qupstream <- InputsModel$Qupstream[RunOptions$IndPeriod_Run, upstream_basin]
- if(!is.na(InputsModel$BasinAreas[upstream_basin])) {
+ if (!is.na(InputsModel$BasinAreas[upstream_basin])) {
# Upstream flow with area needs to be converted to m3 by time step
Qupstream <- Qupstream * InputsModel$BasinAreas[upstream_basin] * 1E3
}
@@ -52,7 +61,7 @@ RunModel_LAG <- function(InputsModel,RunOptions,Param) {
HUTRANS[2, upstream_basin]
}
# Warning for negative flows
- if(any(OutputsModel$Qsim < 0)) {
+ if (any(OutputsModel$Qsim < 0)) {
warning(length(which(OutputsModel$Qsim < 0)), " time steps with negative flow, set to zero.")
OutputsModel$Qsim[OutputsModel$Qsim < 0] <- 0
}
--
GitLab