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

Refs #34

DESCRIPTION

 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"),

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)
-    
-    
-    
+
+
+
 }