From 4390ce3efeac8edad25a109253935fce36c9fbf3 Mon Sep 17 00:00:00 2001
From: Delaigue Olivier <olivier.delaigue@irstea.fr>
Date: Tue, 26 Jan 2021 20:26:24 +0100
Subject: [PATCH] Style v1.6.9.31: review whitespaces, semicolons and indents
in many functions
---
DESCRIPTION | 2 +-
R/CreateCalibOptions.R | 12 +-
R/CreateInputsModel.R | 532 +++++++++++++++----------------
R/DataAltiExtrapolation_Valery.R | 316 +++++++++---------
R/PE_Oudin.R | 4 +-
R/PEdaily_Oudin.R | 12 +-
R/RunModel_GR2M.R | 4 +-
R/RunModel_GR4H.R | 4 +-
R/RunModel_GR4J.R | 4 +-
R/RunModel_GR5H.R | 4 +-
R/RunModel_GR5J.R | 4 +-
R/RunModel_GR6J.R | 4 +-
R/TransfoParam_CemaNeige.R | 2 +-
R/TransfoParam_CemaNeigeHyst.R | 6 +-
R/TransfoParam_GR1A.R | 2 +-
R/TransfoParam_Lag.R | 2 +-
R/UtilsErrorCrit.R | 2 +-
17 files changed, 458 insertions(+), 458 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index 8cebdcc9..52f2699b 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.9.30
+Version: 1.6.9.31
Date: 2021-01-25
Authors@R: c(
person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")),
diff --git a/R/CreateCalibOptions.R b/R/CreateCalibOptions.R
index 77f7ffe5..2fcd84ff 100644
--- a/R/CreateCalibOptions.R
+++ b/R/CreateCalibOptions.R
@@ -319,8 +319,8 @@ CreateCalibOptions <- function(FUN_MOD,
##check_SearchRanges
if (is.null(SearchRanges)) {
- ParamT <- matrix(c(rep(-9.99, NParam), rep(+9.99, NParam)),
- ncol = NParam, byrow = TRUE)
+ ParamT <- matrix(c(rep(-9.99, NParam), rep(+9.99, NParam)),
+ ncol = NParam, byrow = TRUE)
SearchRanges <- TransfoParam(ParamIn = ParamT, Direction = "TR", FUN_TRANSFO = FUN_TRANSFO)
} else {
@@ -351,12 +351,12 @@ CreateCalibOptions <- function(FUN_MOD,
if (("GR5H" %in% ObjectClass) & ("interception" %in% ObjectClass)) {
ParamT <- matrix(c(+3.46, -1.25, +4.04, -9.53, -9.34,
+3.74, -0.41, +4.78, -8.94, -3.33,
- +4.29, +0.16, +5.39, -7.39, +3.33), ncol=5, byrow = TRUE);
+ +4.29, +0.16, +5.39, -7.39, +3.33), ncol = 5, byrow = TRUE)
}
if (("GR5H" %in% ObjectClass) & !("interception" %in% ObjectClass)) {
ParamT <- matrix(c(+3.28, -0.39, +4.14, -9.54, -7.49,
+3.62, -0.19, +4.80, -9.00, -6.31,
- +4.01, -0.04, +5.43, -7.53, -5.33), ncol=5, byrow = TRUE);
+ +4.01, -0.04, +5.43, -7.53, -5.33), ncol = 5, byrow = TRUE)
}
if ("GR4J" %in% ObjectClass) {
ParamT <- matrix(c(+5.13, -1.60, +3.03, -9.05,
@@ -399,12 +399,12 @@ CreateCalibOptions <- function(FUN_MOD,
if (("CemaNeigeGR5H" %in% ObjectClass) & ("interception" %in% ObjectClass)) {
ParamT <- matrix(c(+3.46, -1.25, +4.04, -9.53, -9.34, -9.96, +6.63,
+3.74, -0.41, +4.78, -8.94, -3.33, -9.14, +6.90,
- +4.29, +0.16, +5.39, -7.39, +3.33, +4.10, +7.21), ncol = 7, byrow = TRUE);
+ +4.29, +0.16, +5.39, -7.39, +3.33, +4.10, +7.21), ncol = 7, byrow = TRUE)
}
if (("CemaNeigeGR5H" %in% ObjectClass) & !("interception" %in% ObjectClass)) {
ParamT <- matrix(c(+3.28, -0.39, +4.14, -9.54, -7.49, -9.96, +6.63,
+3.62, -0.19, +4.80, -9.00, -6.31, -9.14, +6.90,
- +4.01, -0.04, +5.43, -7.53, -5.33, +4.10, +7.21), ncol = 7, byrow = TRUE);
+ +4.01, -0.04, +5.43, -7.53, -5.33, +4.10, +7.21), ncol = 7, byrow = TRUE)
}
if ("CemaNeigeGR4J" %in% ObjectClass) {
ParamT <- matrix(c(+5.13, -1.60, +3.03, -9.05, -9.96, +6.63,
diff --git a/R/CreateInputsModel.R b/R/CreateInputsModel.R
index 6fefda3f..d09031ca 100644
--- a/R/CreateInputsModel.R
+++ b/R/CreateInputsModel.R
@@ -8,333 +8,333 @@ CreateInputsModel <- function(FUN_MOD,
verbose = TRUE) {
- ObjectClass <- NULL
+ ObjectClass <- NULL
- FUN_MOD <- match.fun(FUN_MOD)
+ 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")
+ ##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)
+ 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")
+ 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)
+ TimeStep <- as.integer(24 * 60 * 60)
- BOOL <- TRUE
- }
- if (identical(FUN_MOD, RunModel_GR2M)) {
- ObjectClass <- c(ObjectClass, "GR", "monthly")
+ BOOL <- TRUE
+ }
+ if (identical(FUN_MOD, RunModel_GR2M)) {
+ ObjectClass <- c(ObjectClass, "GR", "monthly")
- TimeStep <- as.integer(c(28, 29, 30, 31) * 24 * 60 * 60)
+ TimeStep <- as.integer(c(28, 29, 30, 31) * 24 * 60 * 60)
- BOOL <- TRUE
- }
- if (identical(FUN_MOD, RunModel_GR1A)) {
- ObjectClass <- c(ObjectClass, "GR", "yearly")
+ BOOL <- TRUE
+ }
+ if (identical(FUN_MOD, RunModel_GR1A)) {
+ ObjectClass <- c(ObjectClass, "GR", "yearly")
- TimeStep <- as.integer(c(365, 366) * 24 * 60 * 60)
+ TimeStep <- as.integer(c(365, 366) * 24 * 60 * 60)
- BOOL <- TRUE
- }
- if (identical(FUN_MOD, RunModel_CemaNeige)) {
- ObjectClass <- c(ObjectClass, "daily", "CemaNeige")
+ BOOL <- TRUE
+ }
+ if (identical(FUN_MOD, RunModel_CemaNeige)) {
+ ObjectClass <- c(ObjectClass, "daily", "CemaNeige")
- TimeStep <- as.integer(24 * 60 * 60)
+ 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")
+ 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)
+ 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")
+ BOOL <- TRUE
+ }
+ if (identical(FUN_MOD, RunModel_CemaNeigeGR4H) | identical(FUN_MOD, RunModel_CemaNeigeGR5H)) {
+ ObjectClass <- c(ObjectClass, "hourly", "GR", "CemaNeige")
+
+ TimeStep <- as.integer(60 * 60)
- TimeStep <- as.integer(60 * 60)
+ BOOL <- TRUE
+ }
+ if (!BOOL) {
+ stop("incorrect 'FUN_MOD' for use in 'CreateInputsModel'")
+ }
- BOOL <- TRUE
+ ##check_arguments
+ if ("GR" %in% ObjectClass | "CemaNeige" %in% ObjectClass) {
+ if (is.null(DatesR)) {
+ stop("'DatesR' is missing")
}
- if (!BOOL) {
- stop("incorrect 'FUN_MOD' for use in 'CreateInputsModel'")
+ if (!"POSIXlt" %in% class(DatesR) & !"POSIXct" %in% class(DatesR)) {
+ stop("'DatesR' must be defined as 'POSIXlt' or 'POSIXct'")
}
-
- ##check_arguments
- if ("GR" %in% ObjectClass | "CemaNeige" %in% ObjectClass) {
- if (is.null(DatesR)) {
- stop("'DatesR' is missing")
- }
- if (!"POSIXlt" %in% class(DatesR) & !"POSIXct" %in% class(DatesR)) {
- stop("'DatesR' must be defined as 'POSIXlt' or 'POSIXct'")
- }
- if (!"POSIXlt" %in% class(DatesR)) {
- DatesR <- as.POSIXlt(DatesR)
- }
- if (!difftime(tail(DatesR, 1), tail(DatesR, 2), units = "secs")[[1]] %in% TimeStep) {
- TimeStepName <- grep("hourly|daily|monthly|yearly", ObjectClass, value = TRUE)
- stop(paste0("the time step of the model inputs must be ", TimeStepName, "\n"))
- }
- if (any(duplicated(DatesR))) {
- stop("'DatesR' must not include duplicated values")
- }
- LLL <- length(DatesR)
+ if (!"POSIXlt" %in% class(DatesR)) {
+ DatesR <- as.POSIXlt(DatesR)
}
- if ("GR" %in% ObjectClass) {
- if (is.null(Precip)) {
- stop("Precip is missing")
- }
- if (is.null(PotEvap)) {
- stop("'PotEvap' is missing")
- }
- if (!is.vector(Precip) | !is.vector(PotEvap)) {
- stop("'Precip' and 'PotEvap' must be vectors of numeric values")
+ if (!difftime(tail(DatesR, 1), tail(DatesR, 2), units = "secs")[[1]] %in% TimeStep) {
+ TimeStepName <- grep("hourly|daily|monthly|yearly", ObjectClass, value = TRUE)
+ stop(paste0("the time step of the model inputs must be ", TimeStepName, "\n"))
+ }
+ if (any(duplicated(DatesR))) {
+ stop("'DatesR' must not include duplicated values")
+ }
+ LLL <- length(DatesR)
+ }
+ if ("GR" %in% ObjectClass) {
+ if (is.null(Precip)) {
+ stop("Precip is missing")
+ }
+ if (is.null(PotEvap)) {
+ stop("'PotEvap' is missing")
+ }
+ if (!is.vector(Precip) | !is.vector(PotEvap)) {
+ stop("'Precip' and 'PotEvap' must be vectors of numeric values")
+ }
+ if (!is.numeric(Precip) | !is.numeric(PotEvap)) {
+ stop("'Precip' and 'PotEvap' must be vectors of numeric values")
+ }
+ if (length(Precip) != LLL | length(PotEvap) != LLL) {
+ stop("'Precip', 'PotEvap' and 'DatesR' must have the same length")
+ }
+ }
+ if ("CemaNeige" %in% ObjectClass) {
+ if (is.null(Precip)) {
+ stop("'Precip' is missing")
+ }
+ if (is.null(TempMean)) {
+ stop("'TempMean' is missing")
+ }
+ if (!is.vector(Precip) | !is.vector(TempMean)) {
+ stop("'Precip' and 'TempMean' must be vectors of numeric values")
+ }
+ if (!is.numeric(Precip) | !is.numeric(TempMean)) {
+ stop("'Precip' and 'TempMean' must be vectors of numeric values")
+ }
+ if (length(Precip) != LLL | length(TempMean) != LLL) {
+ stop("'Precip', 'TempMean' and 'DatesR' must have the same length")
+ }
+ if (is.null(TempMin) != is.null(TempMax)) {
+ stop("'TempMin' and 'TempMax' must be both defined if not null")
+ }
+ if (!is.null(TempMin) & !is.null(TempMax)) {
+ if (!is.vector(TempMin) | !is.vector(TempMax)) {
+ stop("'TempMin' and 'TempMax' must be vectors of numeric values")
}
- if (!is.numeric(Precip) | !is.numeric(PotEvap)) {
- stop("'Precip' and 'PotEvap' must be vectors of numeric values")
+ if (!is.numeric(TempMin) | !is.numeric(TempMax)) {
+ stop("'TempMin' and 'TempMax' must be vectors of numeric values")
}
- if (length(Precip) != LLL | length(PotEvap) != LLL) {
- stop("'Precip', 'PotEvap' and 'DatesR' must have the same length")
+ if (length(TempMin) != LLL | length(TempMax) != LLL) {
+ stop("'TempMin', 'TempMax' and 'DatesR' must have the same length")
}
}
- if ("CemaNeige" %in% ObjectClass) {
- if (is.null(Precip)) {
- stop("'Precip' is missing")
- }
- if (is.null(TempMean)) {
- stop("'TempMean' is missing")
- }
- if (!is.vector(Precip) | !is.vector(TempMean)) {
- stop("'Precip' and 'TempMean' must be vectors of numeric values")
+ if (!is.null(HypsoData)) {
+ if (!is.vector(HypsoData)) {
+ stop("'HypsoData' must be a vector of numeric values if not null")
}
- if (!is.numeric(Precip) | !is.numeric(TempMean)) {
- stop("'Precip' and 'TempMean' must be vectors of numeric values")
+ if (!is.numeric(HypsoData)) {
+ stop("'HypsoData' must be a vector of numeric values if not null")
}
- if (length(Precip) != LLL | length(TempMean) != LLL) {
- stop("'Precip', 'TempMean' and 'DatesR' must have the same length")
+ if (length(HypsoData) != 101) {
+ stop("'HypsoData' must be of length 101 if not null")
}
- if (is.null(TempMin) != is.null(TempMax)) {
- stop("'TempMin' and 'TempMax' must be both defined if not null")
+ if (sum(is.na(HypsoData)) != 0 & sum(is.na(HypsoData)) != 101) {
+ stop("'HypsoData' must not contain any NA if not null")
}
- if (!is.null(TempMin) & !is.null(TempMax)) {
- if (!is.vector(TempMin) | !is.vector(TempMax)) {
- stop("'TempMin' and 'TempMax' must be vectors of numeric values")
- }
- if (!is.numeric(TempMin) | !is.numeric(TempMax)) {
- stop("'TempMin' and 'TempMax' must be vectors of numeric values")
- }
- if (length(TempMin) != LLL | length(TempMax) != LLL) {
- stop("'TempMin', 'TempMax' and 'DatesR' must have the same length")
- }
+ }
+ if (!is.null(ZInputs)) {
+ if (length(ZInputs) != 1) {
+ stop("'ZInputs' must be a single numeric value if not null")
}
- if (!is.null(HypsoData)) {
- if (!is.vector(HypsoData)) {
- stop("'HypsoData' must be a vector of numeric values if not null")
- }
- if (!is.numeric(HypsoData)) {
- stop("'HypsoData' must be a vector of numeric values if not null")
- }
- if (length(HypsoData) != 101) {
- stop("'HypsoData' must be of length 101 if not null")
- }
- if (sum(is.na(HypsoData)) != 0 & sum(is.na(HypsoData)) != 101) {
- stop("'HypsoData' must not contain any NA if not null")
- }
+ if (is.na(ZInputs) | !is.numeric(ZInputs)) {
+ stop("'ZInputs' must be a single numeric value if not null")
}
- if (!is.null(ZInputs)) {
- if (length(ZInputs) != 1) {
- stop("'ZInputs' must be a single numeric value if not null")
- }
- if (is.na(ZInputs) | !is.numeric(ZInputs)) {
- stop("'ZInputs' must be a single numeric value if not null")
- }
+ }
+ if (is.null(HypsoData)) {
+ if (verbose) {
+ warning("'HypsoData' is missing: a single layer is used and no extrapolation is made")
}
- if (is.null(HypsoData)) {
- if (verbose) {
- warning("'HypsoData' is missing: a single layer is used and no extrapolation is made")
- }
- HypsoData <- as.numeric(rep(NA, 101))
- ZInputs <- as.numeric(NA)
- NLayers <- as.integer(1)
+ 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)))) {
+ warning("'ZInputs' is missing: HypsoData[51] is used")
}
- if (is.null(ZInputs)) {
- if (verbose & !identical(HypsoData, as.numeric(rep(NA, 101)))) {
- warning("'ZInputs' is missing: HypsoData[51] is used")
- }
- ZInputs <- HypsoData[51L]
- }
- if (NLayers <= 0) {
- stop("'NLayers' must be a positive integer value")
- }
- if (NLayers != as.integer(NLayers)) {
- warning("Coerce 'NLayers' to be of integer type (", NLayers, ": ", as.integer(NLayers), ")")
- NLayers <- as.integer(NLayers)
- }
+ ZInputs <- HypsoData[51L]
}
-
- ## check semi-distributed mode
- if (!is.null(Qupstream) & !is.null(LengthHydro) & !is.null(BasinAreas)) {
- ObjectClass <- c(ObjectClass, "SD")
- } else if (verbose & !all(c(is.null(Qupstream), is.null(LengthHydro), is.null(BasinAreas)))) {
- warning("Missing argument: 'Qupstream', 'LengthHydro' and 'BasinAreas' must all be set to run in a semi-distributed mode. The lumped mode will be used")
+ if (NLayers <= 0) {
+ stop("'NLayers' must be a positive integer value")
}
- if ("SD" %in% ObjectClass) {
- 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.numeric(Qupstream)) {
- stop("'Qupstream' must be a matrice 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) != length(LengthHydro)) {
- stop("'Qupstream' number of columns and 'LengthHydro' length must be equal")
- }
- 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(any(is.na(Qupstream))) {
- stop("'Qupstream' cannot contain any NA value")
- }
+ if (NLayers != as.integer(NLayers)) {
+ warning("Coerce 'NLayers' to be of integer type (", NLayers, ": ", as.integer(NLayers), ")")
+ NLayers <- as.integer(NLayers)
+ }
+ }
+
+ ## check semi-distributed mode
+ if (!is.null(Qupstream) & !is.null(LengthHydro) & !is.null(BasinAreas)) {
+ ObjectClass <- c(ObjectClass, "SD")
+ } else if (verbose & !all(c(is.null(Qupstream), is.null(LengthHydro), is.null(BasinAreas)))) {
+ warning("Missing argument: 'Qupstream', 'LengthHydro' and 'BasinAreas' must all be set to run in a semi-distributed mode. The lumped mode will be used")
+ }
+ if ("SD" %in% ObjectClass) {
+ 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.numeric(Qupstream)) {
+ stop("'Qupstream' must be a matrice 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) != length(LengthHydro)) {
+ stop("'Qupstream' number of columns and 'LengthHydro' length must be equal")
+ }
+ 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(any(is.na(Qupstream))) {
+ stop("'Qupstream' cannot contain any NA value")
+ }
+ }
- ##check_NA_values
- BOOL_NA <- rep(FALSE, length(DatesR))
+ ##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) {
- BOOL_NA <- BOOL_NA | BOOL_NA_TMP
- if (verbose) {
- warning("Values < 0 or NA values detected in 'Precip' series")
- }
+ if ("GR" %in% ObjectClass) {
+ BOOL_NA_TMP <- (Precip < 0) | is.na(Precip)
+ if (sum(BOOL_NA_TMP) != 0) {
+ BOOL_NA <- BOOL_NA | BOOL_NA_TMP
+ if (verbose) {
+ warning("Values < 0 or NA values detected in 'Precip' series")
}
- BOOL_NA_TMP <- (PotEvap < 0) | is.na(PotEvap)
- if (sum(BOOL_NA_TMP) != 0) {
- BOOL_NA <- BOOL_NA | BOOL_NA_TMP
- if (verbose) {
- warning("Values < 0 or NA values detected in 'PotEvap' series")
- }
+ }
+ BOOL_NA_TMP <- (PotEvap < 0) | is.na(PotEvap)
+ if (sum(BOOL_NA_TMP) != 0) {
+ BOOL_NA <- BOOL_NA | BOOL_NA_TMP
+ if (verbose) {
+ warning("Values < 0 or NA values detected in 'PotEvap' series")
}
}
- if ("CemaNeige" %in% ObjectClass) {
- BOOL_NA_TMP <- (Precip < 0) | is.na(Precip)
+ }
+ if ("CemaNeige" %in% ObjectClass) {
+ BOOL_NA_TMP <- (Precip < 0) | is.na(Precip)
+ if (sum(BOOL_NA_TMP) != 0) {
+ BOOL_NA <- BOOL_NA | BOOL_NA_TMP
+ if (verbose) {
+ warning("Values < 0 or NA values detected in 'Precip' series")
+ }
+ }
+ BOOL_NA_TMP <- (TempMean < (-150)) | is.na(TempMean)
+ if (sum(BOOL_NA_TMP) != 0) {
+ BOOL_NA <- BOOL_NA | BOOL_NA_TMP
+ if (verbose) {
+ warning("Values < -150 or NA values detected in 'TempMean' series")
+ }
+ }
+ if (!is.null(TempMin) & !is.null(TempMax)) {
+ BOOL_NA_TMP <- (TempMin < (-150)) | is.na(TempMin)
if (sum(BOOL_NA_TMP) != 0) {
BOOL_NA <- BOOL_NA | BOOL_NA_TMP
if (verbose) {
- warning("Values < 0 or NA values detected in 'Precip' series")
+ warning("Values < -150 or NA values detected in 'TempMin' series")
}
}
- BOOL_NA_TMP <- (TempMean < (-150)) | is.na(TempMean)
+ BOOL_NA_TMP <- (TempMax < (-150)) | is.na(TempMax)
if (sum(BOOL_NA_TMP) != 0) {
BOOL_NA <- BOOL_NA | BOOL_NA_TMP
if (verbose) {
- warning("Values < -150 or NA values detected in 'TempMean' series")
- }
- }
- if (!is.null(TempMin) & !is.null(TempMax)) {
- BOOL_NA_TMP <- (TempMin < (-150)) | is.na(TempMin)
- if (sum(BOOL_NA_TMP) != 0) {
- BOOL_NA <- BOOL_NA | BOOL_NA_TMP
- if (verbose) {
- warning("Values < -150 or NA values detected in 'TempMin' series")
- }
- }
- BOOL_NA_TMP <- (TempMax < (-150)) | is.na(TempMax)
- if (sum(BOOL_NA_TMP) != 0) {
- BOOL_NA <- BOOL_NA | BOOL_NA_TMP
- if (verbose) {
- warning("Values < -150 or NA values detected in 'TempMax' series")
- }
+ warning("Values < -150 or NA values detected in 'TempMax' series")
}
}
}
- 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")
- }
- if ("GR" %in% ObjectClass) {
- Precip <- Precip[Select]
- PotEvap <- PotEvap[Select]
- }
- if ("CemaNeige" %in% ObjectClass) {
- Precip <- Precip[Select]
- TempMean <- TempMean[Select]
- if (!is.null(TempMin) & !is.null(TempMax)) {
- TempMin <- TempMin[Select]
- TempMax <- TempMax[Select]
- }
- }
+ }
+ if (sum(BOOL_NA) != 0) {
+ WTxt <- NULL
+ WTxt <- paste(WTxt, "\t Missing values are not allowed in 'InputsModel'", sep = "")
- DatesR <- DatesR[Select]
+ Select <- (max(which(BOOL_NA)) + 1):length(BOOL_NA)
- 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)
- }
+ if (Select[1L] > Select[2L]) {
+ stop("time series could not be trunced since missing values were detected at the last time-step")
+ }
+ if ("GR" %in% ObjectClass) {
+ Precip <- Precip[Select]
+ PotEvap <- PotEvap[Select]
}
-
-
- ##DataAltiExtrapolation_Valery
if ("CemaNeige" %in% ObjectClass) {
- RESULT <- DataAltiExtrapolation_Valery(DatesR = DatesR,
- Precip = Precip, PrecipScale = PrecipScale,
- TempMean = TempMean, TempMin = TempMin, TempMax = TempMax,
- ZInputs = ZInputs, HypsoData = HypsoData, NLayers = NLayers,
- verbose = verbose)
- if (verbose) {
- if (NLayers == 1) {
- message("input series were successfully created on 1 elevation layer for use by CemaNeige")
- } else {
- message( "input series were successfully created on ", NLayers, " elevation layers for use by CemaNeige")
- }
+ Precip <- Precip[Select]
+ TempMean <- TempMean[Select]
+ if (!is.null(TempMin) & !is.null(TempMax)) {
+ TempMin <- TempMin[Select]
+ TempMax <- TempMax[Select]
}
}
+ DatesR <- DatesR[Select]
- ##Create_InputsModel
- InputsModel <- list(DatesR = DatesR)
- if ("GR" %in% ObjectClass) {
- InputsModel <- c(InputsModel, list(Precip = as.double(Precip), PotEvap = as.double(PotEvap)))
- }
- if ("CemaNeige" %in% ObjectClass) {
- InputsModel <- c(InputsModel, list(LayerPrecip = RESULT$LayerPrecip,
- LayerTempMean = RESULT$LayerTempMean,
- LayerFracSolidPrecip = RESULT$LayerFracSolidPrecip,
- ZLayers = RESULT$ZLayers))
+ 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)
}
- if ("SD" %in% ObjectClass) {
- InputsModel <- c(InputsModel, list(Qupstream = Qupstream,
- LengthHydro = LengthHydro,
- BasinAreas = BasinAreas))
+ }
+
+
+ ##DataAltiExtrapolation_Valery
+ if ("CemaNeige" %in% ObjectClass) {
+ RESULT <- DataAltiExtrapolation_Valery(DatesR = DatesR,
+ Precip = Precip, PrecipScale = PrecipScale,
+ TempMean = TempMean, TempMin = TempMin, TempMax = TempMax,
+ ZInputs = ZInputs, HypsoData = HypsoData, NLayers = NLayers,
+ verbose = verbose)
+ if (verbose) {
+ if (NLayers == 1) {
+ message("input series were successfully created on 1 elevation layer for use by CemaNeige")
+ } else {
+ message( "input series were successfully created on ", NLayers, " elevation layers for use by CemaNeige")
+ }
}
-
- class(InputsModel) <- c("InputsModel", ObjectClass)
-
- return(InputsModel)
+ }
+
+
+ ##Create_InputsModel
+ InputsModel <- list(DatesR = DatesR)
+ if ("GR" %in% ObjectClass) {
+ InputsModel <- c(InputsModel, list(Precip = as.double(Precip), PotEvap = as.double(PotEvap)))
+ }
+ if ("CemaNeige" %in% ObjectClass) {
+ InputsModel <- c(InputsModel, list(LayerPrecip = RESULT$LayerPrecip,
+ LayerTempMean = RESULT$LayerTempMean,
+ LayerFracSolidPrecip = RESULT$LayerFracSolidPrecip,
+ ZLayers = RESULT$ZLayers))
+ }
+ if ("SD" %in% ObjectClass) {
+ InputsModel <- c(InputsModel, list(Qupstream = Qupstream,
+ LengthHydro = LengthHydro,
+ BasinAreas = BasinAreas))
+ }
+
+ class(InputsModel) <- c("InputsModel", ObjectClass)
+
+ return(InputsModel)
diff --git a/R/DataAltiExtrapolation_Valery.R b/R/DataAltiExtrapolation_Valery.R
index d1e85cca..f95617a5 100644
--- a/R/DataAltiExtrapolation_Valery.R
+++ b/R/DataAltiExtrapolation_Valery.R
@@ -3,15 +3,15 @@ DataAltiExtrapolation_Valery <- function(DatesR,
TempMean, TempMin = NULL, TempMax = NULL,
ZInputs, HypsoData, NLayers,
verbose = TRUE) {
-
- ##Altitudinal_gradient_functions_______________________________________________________________
- ##unique_gradient_for_precipitation
- GradP_Valery2010 <- function() {
- return(0.00041) ### value from Valery PhD thesis page 126
- }
- ##daily_gradients_for_mean_min_and_max_air_temperature
- GradT_Valery2010 <- function() {
- RESULT <- matrix(c(
+
+ ##Altitudinal_gradient_functions_______________________________________________________________
+ ##unique_gradient_for_precipitation
+ GradP_Valery2010 <- function() {
+ return(0.00041) ### value from Valery PhD thesis page 126
+ }
+ ##daily_gradients_for_mean_min_and_max_air_temperature
+ GradT_Valery2010 <- function() {
+ RESULT <- matrix(c(
01, 01, 0.434, 0.366, 0.498,
02, 01, 0.434, 0.366, 0.500,
03, 01, 0.435, 0.367, 0.501,
@@ -378,174 +378,174 @@ DataAltiExtrapolation_Valery <- function(DatesR,
29, 12, 0.431, 0.366, 0.495,
30, 12, 0.432, 0.366, 0.496,
31, 12, 0.433, 0.366, 0.497), ncol = 5, byrow = TRUE)
-
- dimnames(RESULT) <- list(1:366, c("day", "month", "grad_Tmean", "grad_Tmin", "grad_Tmax"))
-
- return(RESULT)
-
- }
-
-
-
+
+ dimnames(RESULT) <- list(1:366, c("day", "month", "grad_Tmean", "grad_Tmin", "grad_Tmax"))
+
+ return(RESULT)
+
+ }
+
+
+
##Format_______________________________________________________________________________________
- HypsoData <- as.double(HypsoData)
- ZInputs <- as.double(ZInputs)
-
-
-
+ HypsoData <- as.double(HypsoData)
+ ZInputs <- as.double(ZInputs)
+
+
+
##ElevationLayers_Creation_____________________________________________________________________
- ZLayers <- as.double(rep(NA, NLayers))
-
- if (!identical(HypsoData, as.double(rep(NA, 101)))) {
- nmoy <- 100 %/% NLayers
- nreste <- 100 %% NLayers
- ncont <- 0
-
- for (iLayer in 1:NLayers) {
- if (nreste > 0) {
- nn <- nmoy + 1
- nreste <- nreste - 1
- } else {
- nn <- nmoy
- }
- if (nn == 1) {
- ZLayers[iLayer] <- HypsoData[ncont + 1]
- }
- if (nn == 2) {
- ZLayers[iLayer] <- 0.5 * (HypsoData[ncont + 1] + HypsoData[ncont + 2])
- }
- if (nn > 2) {
- ZLayers[iLayer] <- HypsoData[ncont + nn / 2]
- }
- ncont <- ncont + nn
+ ZLayers <- as.double(rep(NA, NLayers))
+
+ if (!identical(HypsoData, as.double(rep(NA, 101)))) {
+ nmoy <- 100 %/% NLayers
+ nreste <- 100 %% NLayers
+ ncont <- 0
+
+ for (iLayer in 1:NLayers) {
+ if (nreste > 0) {
+ nn <- nmoy + 1
+ nreste <- nreste - 1
+ } else {
+ nn <- nmoy
+ }
+ if (nn == 1) {
+ ZLayers[iLayer] <- HypsoData[ncont + 1]
}
+ if (nn == 2) {
+ ZLayers[iLayer] <- 0.5 * (HypsoData[ncont + 1] + HypsoData[ncont + 2])
+ }
+ if (nn > 2) {
+ ZLayers[iLayer] <- HypsoData[ncont + nn / 2]
+ }
+ ncont <- ncont + nn
}
-
-
+ }
+
+
##Precipitation_extrapolation__________________________________________________________________
##Initialisation
- if (identical(ZInputs, HypsoData[51]) & NLayers == 1) {
- LayerPrecip <- list(as.double(Precip))
- } else {
- ##Elevation_gradients_for_daily_mean_precipitation
- GradP <- GradP_Valery2010() ### single value
- TabGradP <- rep(GradP, length(Precip))
- ##Extrapolation
- ##Thresold_of_inputs_median_elevation
- Zthreshold <- 4000
- LayerPrecip_mat <- sapply(1:NLayers, function(iLayer) {
- ##If_layer_elevation_smaller_than_Zthreshold
- if (ZLayers[iLayer] <= Zthreshold) {
- prcp <- as.double(Precip * exp(TabGradP * (ZLayers[iLayer] - ZInputs)))
- ##If_layer_elevation_greater_than_Zthreshold
+ if (identical(ZInputs, HypsoData[51]) & NLayers == 1) {
+ LayerPrecip <- list(as.double(Precip))
+ } else {
+ ##Elevation_gradients_for_daily_mean_precipitation
+ GradP <- GradP_Valery2010() ### single value
+ TabGradP <- rep(GradP, length(Precip))
+ ##Extrapolation
+ ##Thresold_of_inputs_median_elevation
+ Zthreshold <- 4000
+ LayerPrecip_mat <- sapply(1:NLayers, function(iLayer) {
+ ##If_layer_elevation_smaller_than_Zthreshold
+ if (ZLayers[iLayer] <= Zthreshold) {
+ prcp <- as.double(Precip * exp(TabGradP * (ZLayers[iLayer] - ZInputs)))
+ ##If_layer_elevation_greater_than_Zthreshold
+ } else {
+ ##If_inputs_median_elevation_smaller_than_Zthreshold
+ if (ZInputs <= Zthreshold) {
+ prcp <- as.double(Precip * exp(TabGradP * (Zthreshold - ZInputs)))
+ ##If_inputs_median_elevation_greater_then_Zthreshold
} else {
- ##If_inputs_median_elevation_smaller_than_Zthreshold
- if (ZInputs <= Zthreshold) {
- prcp <- as.double(Precip * exp(TabGradP * (Zthreshold - ZInputs)))
- ##If_inputs_median_elevation_greater_then_Zthreshold
- } else {
- prcp <- as.double(Precip)
- }
+ prcp <- as.double(Precip)
}
- return(prcp)
- })
- if (PrecipScale) {
- LayerPrecip_mat <- LayerPrecip_mat / rowMeans(LayerPrecip_mat) * Precip
- LayerPrecip_mat[is.nan(LayerPrecip_mat)] <- 0
}
- LayerPrecip <- as.list(as.data.frame(LayerPrecip_mat))
+ return(prcp)
+ })
+ if (PrecipScale) {
+ LayerPrecip_mat <- LayerPrecip_mat / rowMeans(LayerPrecip_mat) * Precip
+ LayerPrecip_mat[is.nan(LayerPrecip_mat)] <- 0
}
-
-
-
+ LayerPrecip <- as.list(as.data.frame(LayerPrecip_mat))
+ }
+
+
+
##Temperature_extrapolation____________________________________________________________________
##Initialisation
- LayerTempMean <- list()
- LayerTempMin <- list()
- LayerTempMax <- list()
-
- if (identical(ZInputs, HypsoData[51]) & NLayers == 1) {
- LayerTempMean[[1]] <- as.double(TempMean)
-
+ LayerTempMean <- list()
+ LayerTempMin <- list()
+ LayerTempMax <- list()
+
+ if (identical(ZInputs, HypsoData[51]) & NLayers == 1) {
+ LayerTempMean[[1]] <- as.double(TempMean)
+
+ if (!is.null(TempMin) & !is.null(TempMax)) {
+ LayerTempMin[[1]] <- as.double(TempMin)
+ LayerTempMax[[1]] <- as.double(TempMax)
+ }
+ } else {
+ ##Elevation_gradients_for_daily_mean_min_and_max_temperature
+ GradT <- as.data.frame(GradT_Valery2010())
+ iday <- match(format(DatesR, format = "%d%m"),
+ sprintf("%02i%02i", GradT[, "day"], GradT[, "month"]))
+ TabGradT <-
+ GradT[iday, c("grad_Tmean", "grad_Tmin", "grad_Tmax")]
+ ##Extrapolation
+ ##On_each_elevation_layer...
+ for (iLayer in 1:NLayers) {
+ LayerTempMean[[iLayer]] <- as.double(TempMean + (ZInputs - ZLayers[iLayer]) * abs(TabGradT[, "grad_Tmean"]) / 100)
if (!is.null(TempMin) & !is.null(TempMax)) {
- LayerTempMin[[1]] <- as.double(TempMin)
- LayerTempMax[[1]] <- as.double(TempMax)
- }
- } else {
- ##Elevation_gradients_for_daily_mean_min_and_max_temperature
- GradT <- as.data.frame(GradT_Valery2010())
- iday <- match(format(DatesR, format = "%d%m"),
- sprintf("%02i%02i", GradT[, "day"], GradT[, "month"]))
- TabGradT <-
- GradT[iday, c("grad_Tmean", "grad_Tmin", "grad_Tmax")]
- ##Extrapolation
- ##On_each_elevation_layer...
- for (iLayer in 1:NLayers) {
- LayerTempMean[[iLayer]] <- as.double(TempMean + (ZInputs - ZLayers[iLayer]) * abs(TabGradT[, "grad_Tmean"]) / 100)
- if (!is.null(TempMin) & !is.null(TempMax)) {
- LayerTempMin[[iLayer]] <- as.double(TempMin + (ZInputs - ZLayers[iLayer]) * abs(TabGradT[, "grad_Tmin"]) / 100)
- LayerTempMax[[iLayer]] <- as.double(TempMax + (ZInputs - ZLayers[iLayer]) * abs(TabGradT[, "grad_Tmax"]) / 100)
- }
+ LayerTempMin[[iLayer]] <- as.double(TempMin + (ZInputs - ZLayers[iLayer]) * abs(TabGradT[, "grad_Tmin"]) / 100)
+ LayerTempMax[[iLayer]] <- as.double(TempMax + (ZInputs - ZLayers[iLayer]) * abs(TabGradT[, "grad_Tmax"]) / 100)
}
}
-
-
-
+ }
+
+
+
##Solid_Fraction_for_each_elevation_layer______________________________________________________
- LayerFracSolidPrecip <- list()
-
- ##Thresold_of_inputs_median_elevation
- Zthreshold <- 1500
-
- ##Option
- Option <- "USACE"
- if (!is.na(ZInputs)) {
- if (ZInputs < Zthreshold & !is.null(TempMin) & !is.null(TempMax)) {
- Option <- "Hydrotel"
- }
+ LayerFracSolidPrecip <- list()
+
+ ##Thresold_of_inputs_median_elevation
+ Zthreshold <- 1500
+
+ ##Option
+ Option <- "USACE"
+ if (!is.na(ZInputs)) {
+ if (ZInputs < Zthreshold & !is.null(TempMin) & !is.null(TempMax)) {
+ Option <- "Hydrotel"
}
-
- ##On_each_elevation_layer...
- for (iLayer in 1:NLayers) {
+ }
- ##Turcotte_formula_from_Hydrotel
- if (Option == "Hydrotel") {
- TempMin <- LayerTempMin[[iLayer]]
- TempMax <- LayerTempMax[[iLayer]]
- SolidFraction <- 1 - TempMax / (TempMax - TempMin)
- SolidFraction[TempMin >= 0] <- 0
- SolidFraction[TempMax <= 0] <- 1
- }
- ##USACE_formula
- if (Option == "USACE") {
- USACE_Tmin <- -1.0
- USACE_Tmax <- 3.0
- TempMean <- LayerTempMean[[iLayer]]
- SolidFraction <- 1 - (TempMean - USACE_Tmin) / (USACE_Tmax - USACE_Tmin)
- SolidFraction[TempMean > USACE_Tmax] <- 0
- SolidFraction[TempMean < USACE_Tmin] <- 1
- }
- LayerFracSolidPrecip[[iLayer]] <- as.double(SolidFraction)
+ ##On_each_elevation_layer...
+ for (iLayer in 1:NLayers) {
+
+ ##Turcotte_formula_from_Hydrotel
+ if (Option == "Hydrotel") {
+ TempMin <- LayerTempMin[[iLayer]]
+ TempMax <- LayerTempMax[[iLayer]]
+ SolidFraction <- 1 - TempMax / (TempMax - TempMin)
+ SolidFraction[TempMin >= 0] <- 0
+ SolidFraction[TempMax <= 0] <- 1
}
- namesLayer <- sprintf("L%i", seq_along(LayerPrecip))
- names(LayerPrecip) <- namesLayer
- names(LayerTempMean) <- namesLayer
- if (!is.null(TempMin) & !is.null(TempMax)) {
- names(LayerTempMin) <- namesLayer
- names(LayerTempMax) <- namesLayer
- }
- names(LayerFracSolidPrecip) <- namesLayer
-
-
-
+ ##USACE_formula
+ if (Option == "USACE") {
+ USACE_Tmin <- -1.0
+ USACE_Tmax <- 3.0
+ TempMean <- LayerTempMean[[iLayer]]
+ SolidFraction <- 1 - (TempMean - USACE_Tmin) / (USACE_Tmax - USACE_Tmin)
+ SolidFraction[TempMean > USACE_Tmax] <- 0
+ SolidFraction[TempMean < USACE_Tmin] <- 1
+ }
+ LayerFracSolidPrecip[[iLayer]] <- as.double(SolidFraction)
+ }
+ namesLayer <- sprintf("L%i", seq_along(LayerPrecip))
+ names(LayerPrecip) <- namesLayer
+ names(LayerTempMean) <- namesLayer
+ if (!is.null(TempMin) & !is.null(TempMax)) {
+ names(LayerTempMin) <- namesLayer
+ names(LayerTempMax) <- namesLayer
+ }
+ names(LayerFracSolidPrecip) <- namesLayer
+
+
+
##END__________________________________________________________________________________________
- return(list(LayerPrecip = LayerPrecip,
- LayerTempMean = LayerTempMean,
- LayerTempMin = LayerTempMin,
- LayerTempMax = LayerTempMax,
- LayerFracSolidPrecip = LayerFracSolidPrecip,
- ZLayers = ZLayers))
-
-
+ return(list(LayerPrecip = LayerPrecip,
+ LayerTempMean = LayerTempMean,
+ LayerTempMin = LayerTempMin,
+ LayerTempMax = LayerTempMax,
+ LayerFracSolidPrecip = LayerFracSolidPrecip,
+ ZLayers = ZLayers))
+
+
}
diff --git a/R/PE_Oudin.R b/R/PE_Oudin.R
index 2ce49b33..173c9e4f 100644
--- a/R/PE_Oudin.R
+++ b/R/PE_Oudin.R
@@ -65,7 +65,7 @@ PE_Oudin <- function(JD, Temp,
LInputs = as.integer(length(Temp))
if (length(FI) == 1) {
- FI <- rep(FI, LInputs)
+ FI <- rep(FI, LInputs)
}
RESULTS <- .Fortran("frun_pe_oudin", PACKAGE = "airGR",
@@ -96,7 +96,7 @@ PE_Oudin <- function(JD, Temp,
COSOM <- -1
}
if (COSOM > 1) {
- COSOM <- 1
+ COSOM <- 1
}
COSOM2 <- COSOM * COSOM
diff --git a/R/PEdaily_Oudin.R b/R/PEdaily_Oudin.R
index 3eee9283..33472c88 100644
--- a/R/PEdaily_Oudin.R
+++ b/R/PEdaily_Oudin.R
@@ -70,7 +70,7 @@ PEdaily_Oudin <- function(JD,
COSOM <- -1
}
if (COSOM > 1) {
- COSOM <- 1
+ COSOM <- 1
}
COSOM2 <- COSOM * COSOM
@@ -94,11 +94,11 @@ PEdaily_Oudin <- function(JD,
if (is.na(Temp[k])) {
PE_Oudin_D[k] <- NA
} else {
- if (Temp[k] >= -5.0) {
- PE_Oudin_D[k] <- GE * (Temp[k] + 5) / 100 / 28.5
- } else {
- PE_Oudin_D[k] <- 0
- }
+ if (Temp[k] >= -5.0) {
+ PE_Oudin_D[k] <- GE * (Temp[k] + 5) / 100 / 28.5
+ } else {
+ PE_Oudin_D[k] <- 0
+ }
}
}
diff --git a/R/RunModel_GR2M.R b/R/RunModel_GR2M.R
index 385c5f1a..52e068c4 100644
--- a/R/RunModel_GR2M.R
+++ b/R/RunModel_GR2M.R
@@ -59,8 +59,8 @@ RunModel_GR2M <- function(InputsModel, RunOptions, Param) {
## Use of IniResLevels
if (!is.null(RunOptions$IniResLevels)) {
- RunOptions$IniStates[1] <- RunOptions$IniResLevels[1]*Param[1] ### production store level (mm)
- RunOptions$IniStates[2] <- RunOptions$IniResLevels[2]*Param[2] ### routing store level (mm)
+ RunOptions$IniStates[1] <- RunOptions$IniResLevels[1] * Param[1] ### production store level (mm)
+ RunOptions$IniStates[2] <- RunOptions$IniResLevels[2] * Param[2] ### routing store level (mm)
}
## Call GR model Fortan
diff --git a/R/RunModel_GR4H.R b/R/RunModel_GR4H.R
index 47c26ff9..749ae6a3 100644
--- a/R/RunModel_GR4H.R
+++ b/R/RunModel_GR4H.R
@@ -64,8 +64,8 @@ RunModel_GR4H <- function(InputsModel, RunOptions, Param) {
## Use of IniResLevels
if (!is.null(RunOptions$IniResLevels)) {
- RunOptions$IniStates[1] <- RunOptions$IniResLevels[1]*Param[1] ### production store level (mm)
- RunOptions$IniStates[2] <- RunOptions$IniResLevels[2]*Param[3] ### routing store level (mm)
+ RunOptions$IniStates[1] <- RunOptions$IniResLevels[1] * Param[1] ### production store level (mm)
+ RunOptions$IniStates[2] <- RunOptions$IniResLevels[2] * Param[3] ### routing store level (mm)
}
## Call GR model Fortan
diff --git a/R/RunModel_GR4J.R b/R/RunModel_GR4J.R
index fc647035..0be613be 100644
--- a/R/RunModel_GR4J.R
+++ b/R/RunModel_GR4J.R
@@ -63,8 +63,8 @@ RunModel_GR4J <- function(InputsModel, RunOptions, Param) {
## Use of IniResLevels
if (!is.null(RunOptions$IniResLevels)) {
- RunOptions$IniStates[1] <- RunOptions$IniResLevels[1]*Param[1] ### production store level (mm)
- RunOptions$IniStates[2] <- RunOptions$IniResLevels[2]*Param[3] ### routing store level (mm)
+ RunOptions$IniStates[1] <- RunOptions$IniResLevels[1] * Param[1] ### production store level (mm)
+ RunOptions$IniStates[2] <- RunOptions$IniResLevels[2] * Param[3] ### routing store level (mm)
}
## Call GR model Fortan
diff --git a/R/RunModel_GR5H.R b/R/RunModel_GR5H.R
index 27d7009d..3f985cb7 100644
--- a/R/RunModel_GR5H.R
+++ b/R/RunModel_GR5H.R
@@ -70,8 +70,8 @@ RunModel_GR5H <- function(InputsModel, RunOptions, Param) {
## Use of IniResLevels
if (!is.null(RunOptions$IniResLevels)) {
- RunOptions$IniStates[1] <- RunOptions$IniResLevels[1]*Param[1] ### production store level (mm)
- RunOptions$IniStates[2] <- RunOptions$IniResLevels[2]*Param[3] ### routing store level (mm)
+ RunOptions$IniStates[1] <- RunOptions$IniResLevels[1] * Param[1] ### production store level (mm)
+ RunOptions$IniStates[2] <- RunOptions$IniResLevels[2] * Param[3] ### routing store level (mm)
if (IsIntStore) {
RunOptions$IniStates[4] <- RunOptions$IniResLevels[4] * Imax ### interception store level (mm)
}
diff --git a/R/RunModel_GR5J.R b/R/RunModel_GR5J.R
index 33210729..ee8f7756 100644
--- a/R/RunModel_GR5J.R
+++ b/R/RunModel_GR5J.R
@@ -64,8 +64,8 @@ RunModel_GR5J <- function(InputsModel, RunOptions, Param) {
## Use of IniResLevels
if (!is.null(RunOptions$IniResLevels)) {
- RunOptions$IniStates[1] <- RunOptions$IniResLevels[1]*Param[1] ### production store level (mm)
- RunOptions$IniStates[2] <- RunOptions$IniResLevels[2]*Param[3] ### routing store level (mm)
+ RunOptions$IniStates[1] <- RunOptions$IniResLevels[1] * Param[1] ### production store level (mm)
+ RunOptions$IniStates[2] <- RunOptions$IniResLevels[2] * Param[3] ### routing store level (mm)
}
## Call GR model Fortan
diff --git a/R/RunModel_GR6J.R b/R/RunModel_GR6J.R
index c971056f..52df6553 100644
--- a/R/RunModel_GR6J.R
+++ b/R/RunModel_GR6J.R
@@ -68,8 +68,8 @@ RunModel_GR6J <- function(InputsModel, RunOptions, Param) {
## Use of IniResLevels
if (!is.null(RunOptions$IniResLevels)) {
- RunOptions$IniStates[1] <- RunOptions$IniResLevels[1]*Param[1] ### production store level (mm)
- RunOptions$IniStates[2] <- RunOptions$IniResLevels[2]*Param[3] ### routing store level (mm)
+ RunOptions$IniStates[1] <- RunOptions$IniResLevels[1] * Param[1] ### production store level (mm)
+ RunOptions$IniStates[2] <- RunOptions$IniResLevels[2] * Param[3] ### routing store level (mm)
RunOptions$IniStates[3] <- RunOptions$IniResLevels[3] ### exponential store level (mm)
}
diff --git a/R/TransfoParam_CemaNeige.R b/R/TransfoParam_CemaNeige.R
index add5b919..cd7e32af 100644
--- a/R/TransfoParam_CemaNeige.R
+++ b/R/TransfoParam_CemaNeige.R
@@ -28,7 +28,7 @@ TransfoParam_CemaNeige <- function(ParamIn, Direction) {
}
if (Direction == "RT") {
ParamOut <- ParamIn
- ParamOut[, 1] <- ParamIn[, 1] * 19.98 - 9.99 ### CemaNeige X1 (weighting coefficient for snow pack thermal state)
+ ParamOut[, 1] <- ParamIn[, 1] * 19.98 - 9.99 ### CemaNeige X1 (weighting coefficient for snow pack thermal state)
ParamOut[, 2] <- log(ParamIn[, 2] * 200) ### CemaNeige X2 (degree-day melt coefficient)
}
diff --git a/R/TransfoParam_CemaNeigeHyst.R b/R/TransfoParam_CemaNeigeHyst.R
index c4ee434b..6839edad 100644
--- a/R/TransfoParam_CemaNeigeHyst.R
+++ b/R/TransfoParam_CemaNeigeHyst.R
@@ -22,15 +22,15 @@ TransfoParam_CemaNeigeHyst <- function(ParamIn, Direction) {
## transformation
if (Direction == "TR") {
- ParamOut <- ParamIn
+ ParamOut <- ParamIn
ParamOut[, 1] <- (ParamIn[, 1] + 9.99) / 19.98 ### CemaNeige X1 (weighting coefficient for snow pack thermal state)
ParamOut[, 2] <- exp(ParamIn[, 2]) / 200 ### CemaNeige X2 (degree-day melt coefficient)
ParamOut[, 3] <- (ParamIn[, 3] * 5) + 50 ### Hyst Gaccum
ParamOut[, 4] <- (ParamIn[, 4] / 19.98) + 0.5 ### Hyst CV
}
if (Direction == "RT") {
- ParamOut <- ParamIn
- ParamOut[, 1] <- ParamIn[, 1] * 19.98 - 9.99 ### CemaNeige X1 (weighting coefficient for snow pack thermal state)
+ ParamOut <- ParamIn
+ ParamOut[, 1] <- ParamIn[, 1] * 19.98 - 9.99 ### CemaNeige X1 (weighting coefficient for snow pack thermal state)
ParamOut[, 2] <- log(ParamIn[, 2] * 200) ### CemaNeige X2 (degree-day melt coefficient)
ParamOut[, 3] <- (ParamIn[, 3] - 50) / 5 ### Hyst Gaccum
ParamOut[, 4] <- (ParamIn[, 4] - 0.5) * 19.98 ### Hyst CV
diff --git a/R/TransfoParam_GR1A.R b/R/TransfoParam_GR1A.R
index 59b09d7d..b52e75a4 100644
--- a/R/TransfoParam_GR1A.R
+++ b/R/TransfoParam_GR1A.R
@@ -25,7 +25,7 @@ TransfoParam_GR1A <- function(ParamIn, Direction) {
ParamOut <- (ParamIn + 10.0) / 8
}
if (Direction == "RT") {
- ParamOut <- ParamIn * 8 - 10.0
+ ParamOut <- ParamIn * 8 - 10.0
}
diff --git a/R/TransfoParam_Lag.R b/R/TransfoParam_Lag.R
index 2294d0ab..12d5c321 100644
--- a/R/TransfoParam_Lag.R
+++ b/R/TransfoParam_Lag.R
@@ -25,7 +25,7 @@ TransfoParam_Lag <- function(ParamIn, Direction) {
ParamOut <- 20 * (ParamIn + 10) / 20.0
}
if (Direction == "RT") {
- ParamOut <- ParamIn * 20.0 / 20 - 10
+ ParamOut <- ParamIn * 20.0 / 20 - 10
}
diff --git a/R/UtilsErrorCrit.R b/R/UtilsErrorCrit.R
index 95ca18fc..4e200bb2 100644
--- a/R/UtilsErrorCrit.R
+++ b/R/UtilsErrorCrit.R
@@ -91,7 +91,7 @@
VarSim[is.na(VarObs)] <- NA
VarSim <- sort(VarSim, na.last = TRUE)
VarObs <- sort(VarObs, na.last = TRUE)
- InputsCrit$BoolCrit <- sort(InputsCrit$BoolCrit, decreasing = TRUE)
+ InputsCrit$BoolCrit <- sort(InputsCrit$BoolCrit, decreasing = TRUE)
}
if (InputsCrit$transfo == "boxcox") {
muTransfoVarObs <- (0.01 * mean(VarObs, na.rm = TRUE))^0.25
--
GitLab