From 65c221eadfd745baa2d13b9e7d210a8a44ae2e2c Mon Sep 17 00:00:00 2001
From: Dorchies David <david.dorchies@irstea.fr>
Date: Fri, 22 May 2020 14:59:26 +0200
Subject: [PATCH] v1.6.1.13: Fix (CreateInputsModel): wrong warning message for
lumped models
Refs #34
---
DESCRIPTION | 4 +--
R/CreateInputsModel.R | 83 +++++++++++++++++++++----------------------
2 files changed, 43 insertions(+), 44 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index bd31d3f2..66d5146b 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.1.11
-Date: 2020-04-07
+Version: 1.6.1.13
+Date: 2020-05-22
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/R/CreateInputsModel.R b/R/CreateInputsModel.R
index c55c9282..ad3635eb 100644
--- a/R/CreateInputsModel.R
+++ b/R/CreateInputsModel.R
@@ -4,73 +4,73 @@ CreateInputsModel <- function(FUN_MOD,
PotEvap = NULL,
TempMean = NULL, TempMin = NULL, TempMax = NULL,
ZInputs = NULL, HypsoData = NULL, NLayers = 5,
- QobsUpstr = NULL, LengthHydro = NULL, BasinAreas = NULL,
+ QobsUpstr = NULL, LengthHydro = NULL, BasinAreas = NULL,
verbose = TRUE) {
-
-
+
+
ObjectClass <- NULL
-
+
FUN_MOD <- match.fun(FUN_MOD)
-
+
##check_FUN_MOD
BOOL <- FALSE
if (identical(FUN_MOD, RunModel_GR4H) | identical(FUN_MOD, RunModel_GR5H)) {
ObjectClass <- c(ObjectClass, "hourly", "GR")
-
+
TimeStep <- as.integer(60 * 60)
-
+
BOOL <- TRUE
}
if (identical(FUN_MOD, RunModel_GR4J) |
identical(FUN_MOD, RunModel_GR5J) |
identical(FUN_MOD, RunModel_GR6J)) {
ObjectClass <- c(ObjectClass, "daily", "GR")
-
+
TimeStep <- as.integer(24 * 60 * 60)
-
+
BOOL <- TRUE
}
if (identical(FUN_MOD, RunModel_GR2M)) {
ObjectClass <- c(ObjectClass, "GR", "monthly")
-
+
TimeStep <- as.integer(c(28, 29, 30, 31) * 24 * 60 * 60)
-
+
BOOL <- TRUE
}
if (identical(FUN_MOD, RunModel_GR1A)) {
ObjectClass <- c(ObjectClass, "GR", "yearly")
-
+
TimeStep <- as.integer(c(365, 366) * 24 * 60 * 60)
-
+
BOOL <- TRUE
}
if (identical(FUN_MOD, RunModel_CemaNeige)) {
ObjectClass <- c(ObjectClass, "daily", "CemaNeige")
-
+
TimeStep <- as.integer(24 * 60 * 60)
-
+
BOOL <- TRUE
}
if (identical(FUN_MOD, RunModel_CemaNeigeGR4J) |
identical(FUN_MOD, RunModel_CemaNeigeGR5J) |
identical(FUN_MOD, RunModel_CemaNeigeGR6J)) {
ObjectClass <- c(ObjectClass, "daily", "GR", "CemaNeige")
-
+
TimeStep <- as.integer(24 * 60 * 60)
-
+
BOOL <- TRUE
}
if (identical(FUN_MOD, RunModel_CemaNeigeGR4H) | identical(FUN_MOD, RunModel_CemaNeigeGR5H)) {
ObjectClass <- c(ObjectClass, "hourly", "GR", "CemaNeige")
-
+
TimeStep <- as.integer(60 * 60)
-
+
BOOL <- TRUE
}
if (!BOOL) {
stop("incorrect 'FUN_MOD' for use in 'CreateInputsModel'")
}
-
+
##check_arguments
if ("GR" %in% ObjectClass | "CemaNeige" %in% ObjectClass) {
if (is.null(DatesR)) {
@@ -167,7 +167,7 @@ CreateInputsModel <- function(FUN_MOD,
HypsoData <- as.numeric(rep(NA, 101))
ZInputs <- as.numeric(NA)
NLayers <- as.integer(1)
-
+
}
if (is.null(ZInputs)) {
if (verbose & !identical(HypsoData, as.numeric(rep(NA, 101)))) {
@@ -183,12 +183,11 @@ CreateInputsModel <- function(FUN_MOD,
NLayers <- as.integer(NLayers)
}
}
-
+
## check semi-distributed mode
if (!is.null(QobsUpstr) & !is.null(LengthHydro) & !is.null(BasinAreas)) {
ObjectClass <- c(ObjectClass, "SD")
- }
- if (verbose & sum(is.null(QobsUpstr) | is.null(LengthHydro) | is.null(BasinAreas)) %in% 1:2) {
+ } else if (verbose & !all(c(is.null(QobsUpstr), is.null(LengthHydro), is.null(BasinAreas)))) {
warning("Missing argument: 'QobsUpstr', 'LengthHydro' and 'BasinAreas' must all be set to run in a semi-distributed mode. The lumped mode will be used")
}
if ("SD" %in% ObjectClass) {
@@ -217,10 +216,10 @@ CreateInputsModel <- function(FUN_MOD,
stop("'QobsUpstr' cannot contain any NA value")
}
}
-
+
##check_NA_values
BOOL_NA <- rep(FALSE, length(DatesR))
-
+
if ("GR" %in% ObjectClass) {
BOOL_NA_TMP <- (Precip < 0) | is.na(Precip)
if (sum(BOOL_NA_TMP) != 0) {
@@ -272,9 +271,9 @@ CreateInputsModel <- function(FUN_MOD,
if (sum(BOOL_NA) != 0) {
WTxt <- NULL
WTxt <- paste(WTxt, "\t Missing values are not allowed in 'InputsModel'", sep = "")
-
+
Select <- (max(which(BOOL_NA)) + 1):length(BOOL_NA)
-
+
if (Select[1L] > Select[2L]) {
stop("time series could not be trunced since missing values were detected at the last time-step")
}
@@ -290,18 +289,18 @@ CreateInputsModel <- function(FUN_MOD,
TempMax <- TempMax[Select]
}
}
-
+
DatesR <- DatesR[Select]
-
+
WTxt <- paste0(WTxt, "\t -> data were trunced to keep the most recent available time-steps")
WTxt <- paste0(WTxt, "\t -> ", length(Select), " time-steps were kept")
-
+
if (!is.null(WTxt) & verbose) {
warning(WTxt)
}
}
-
-
+
+
##DataAltiExtrapolation_Valery
if ("CemaNeige" %in% ObjectClass) {
RESULT <- DataAltiExtrapolation_Valery(DatesR = DatesR,
@@ -317,8 +316,8 @@ CreateInputsModel <- function(FUN_MOD,
}
}
}
-
-
+
+
##Create_InputsModel
InputsModel <- list(DatesR = DatesR)
if ("GR" %in% ObjectClass) {
@@ -331,15 +330,15 @@ CreateInputsModel <- function(FUN_MOD,
ZLayers = RESULT$ZLayers))
}
if ("SD" %in% ObjectClass) {
- InputsModel <- c(InputsModel, list(QobsUpstr = QobsUpstr,
+ InputsModel <- c(InputsModel, list(QobsUpstr = QobsUpstr,
LengthHydro = LengthHydro,
- BasinAreas = BasinAreas))
+ BasinAreas = BasinAreas))
}
-
+
class(InputsModel) <- c("InputsModel", ObjectClass)
-
+
return(InputsModel)
-
-
-
+
+
+
}
--
GitLab