Commit 65c221ea authored by Dorchies David's avatar Dorchies David

v1.6.1.13: Fix (CreateInputsModel): wrong warning message for lumped models

Refs #34
parent 9a99a6c5
Pipeline #13109 passed with stages
in 11 minutes and 58 seconds
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"),
......
......@@ -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)
}
Markdown is supported
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