From cba36bf13f1dd436379f8974fcba8133e57410f9 Mon Sep 17 00:00:00 2001
From: Delaigue Olivier <olivier.delaigue@irstea.priv>
Date: Fri, 29 Mar 2019 15:48:35 +0100
Subject: [PATCH] v1.2.12.9 CLEAN check added in TransfoParam* funs
---
DESCRIPTION | 2 +-
NEWS.rmd | 4 +-
R/TransfoParam_CemaNeige.R | 8 ++--
R/TransfoParam_CemaNeigeHyst.R | 6 ++-
R/TransfoParam_GR1A.R | 31 ++++++++++-----
R/TransfoParam_GR2M.R | 32 +++++++++++-----
R/TransfoParam_GR4H.R | 63 ++++++++++++++++++++----------
R/TransfoParam_GR4J.R | 64 +++++++++++++++++++++----------
R/TransfoParam_GR5J.R | 70 ++++++++++++++++++++++------------
R/TransfoParam_GR6J.R | 68 ++++++++++++++++-----------------
10 files changed, 223 insertions(+), 125 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index 3a469b06..94004115 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.2.12.8
+Version: 1.2.12.9
Date: 2019-03-29
Authors@R: c(
person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")),
diff --git a/NEWS.rmd b/NEWS.rmd
index 4e1af921..1c3e2ec3 100644
--- a/NEWS.rmd
+++ b/NEWS.rmd
@@ -13,7 +13,7 @@ output:
-### 1.2.12.8 Release Notes (2019-03-28)
+### 1.2.12.9 Release Notes (2019-03-28)
@@ -89,6 +89,8 @@ output:
- <code>plot.OutputsModel()</code> does not return a warning message anymore when <code>Qobs = NULL</code>.
+- Inputs of <code>TransfoParam*()</code> functions are now checked.
+
- The order of authors has been updated in the DESCRIPTION and the CITATION files.
____________________________________________________________________________________
diff --git a/R/TransfoParam_CemaNeige.R b/R/TransfoParam_CemaNeige.R
index 9c015276..b0b40417 100644
--- a/R/TransfoParam_CemaNeige.R
+++ b/R/TransfoParam_CemaNeige.R
@@ -4,7 +4,7 @@ TransfoParam_CemaNeige <- function(ParamIn, Direction) {
NParam <- 2L
- ## check_arguments
+ ## check arguments
isVecParamIn <- is.vector(ParamIn)
if (isVecParamIn) {
ParamIn <- matrix(ParamIn, nrow = 1)
@@ -22,16 +22,18 @@ TransfoParam_CemaNeige <- 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)
}
if (Direction == "RT") {
- ParamOut <- ParamIn
+ 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)
}
+
+ ## check output
if (isVecParamIn) {
ParamOut <- as.vector(ParamOut)
}
diff --git a/R/TransfoParam_CemaNeigeHyst.R b/R/TransfoParam_CemaNeigeHyst.R
index efd8c54f..c4ee434b 100644
--- a/R/TransfoParam_CemaNeigeHyst.R
+++ b/R/TransfoParam_CemaNeigeHyst.R
@@ -4,7 +4,7 @@ TransfoParam_CemaNeigeHyst <- function(ParamIn, Direction) {
NParam <- 4L
- ## check_arguments
+ ## check arguments
isVecParamIn <- is.vector(ParamIn)
if (isVecParamIn) {
ParamIn <- matrix(ParamIn, nrow = 1)
@@ -16,7 +16,7 @@ TransfoParam_CemaNeigeHyst <- function(ParamIn, Direction) {
stop("'Direction' must be a character vector of length 1 equal to 'RT' or 'TR'")
}
if (ncol(ParamIn) != NParam) {
- stop(sprintf( "the CemaNeige module with linear hysteresis requires %i parameters", NParam))
+ stop(sprintf("the CemaNeige module with linear hysteresis requires %i parameters", NParam))
}
@@ -36,6 +36,8 @@ TransfoParam_CemaNeigeHyst <- function(ParamIn, Direction) {
ParamOut[, 4] <- (ParamIn[, 4] - 0.5) * 19.98 ### Hyst CV
}
+
+ ## check output
if (isVecParamIn) {
ParamOut <- as.vector(ParamOut)
}
diff --git a/R/TransfoParam_GR1A.R b/R/TransfoParam_GR1A.R
index 3c3e85af..11ed1c93 100644
--- a/R/TransfoParam_GR1A.R
+++ b/R/TransfoParam_GR1A.R
@@ -1,16 +1,27 @@
TransfoParam_GR1A <- function(ParamIn, Direction) {
- NParam <- 1
- Bool <- is.matrix(ParamIn)
+ ## number of model parameters
+ NParam <- 1L
+ NParam <- 2L
- if (Bool == FALSE) {
- ParamIn <- rbind(ParamIn)
- }
+ ## check arguments
+ isVecParamIn <- is.vector(ParamIn)
+ if (isVecParamIn) {
+ ParamIn <- matrix(ParamIn, nrow = 1)
+ }
+ if (!inherits(ParamIn, "matrix")) {
+ stop("'ParamIn' must be of class 'matrix'")
+ }
+ if (!inherits(Direction, "character") | length(Direction) != 1 | any(!Direction %in% c("RT", "TR"))) {
+ stop("'Direction' must be a character vector of length 1 equal to 'RT' or 'TR'")
+ }
if (ncol(ParamIn) != NParam) {
- stop(paste("the GR1A model requires ", NParam, " parameters", sep = ""))
+ stop(sprintf("the GR1A model requires %i parameters", NParam))
}
+
+ ## transformation
if (Direction == "TR") {
ParamOut <- (ParamIn + 10.0) / 8
}
@@ -18,10 +29,12 @@ TransfoParam_GR1A <- function(ParamIn, Direction) {
ParamOut <- ParamIn * 8 - 10.0
}
- if (Bool == FALSE) {
- ParamOut <- ParamOut[1, ]
-
+
+ ## check output
+ if (isVecParamIn) {
+ ParamOut <- as.vector(ParamOut)
}
+
return(ParamOut)
}
diff --git a/R/TransfoParam_GR2M.R b/R/TransfoParam_GR2M.R
index 2e093192..8f9f9e25 100644
--- a/R/TransfoParam_GR2M.R
+++ b/R/TransfoParam_GR2M.R
@@ -1,29 +1,43 @@
TransfoParam_GR2M <- function(ParamIn, Direction) {
- NParam <- 2
- Bool <- is.matrix(ParamIn)
+ ## number of model parameters
+ NParam <- 2L
- if (Bool == FALSE) {
- ParamIn <- rbind(ParamIn)
+
+ ## check arguments
+ isVecParamIn <- is.vector(ParamIn)
+ if (isVecParamIn) {
+ ParamIn <- matrix(ParamIn, nrow = 1)
+ }
+ if (!inherits(ParamIn, "matrix")) {
+ stop("'ParamIn' must be of class 'matrix'")
+ }
+ if (!inherits(Direction, "character") | length(Direction) != 1 | any(!Direction %in% c("RT", "TR"))) {
+ stop("'Direction' must be a character vector of length 1 equal to 'RT' or 'TR'")
}
if (ncol(ParamIn) != NParam) {
- stop(paste("the GR2M model requires ", NParam, " parameters", sep = ""))
+ stop(sprintf("the GR2M model requires %i parameters", NParam))
}
+
+ ## transformation
if (Direction == "TR") {
- ParamOut <- ParamIn
+ ParamOut <- ParamIn
ParamOut[, 1] <- exp(ParamIn[, 1])
ParamOut[, 2] <- ParamIn[, 2] / 4 + 2.5
}
if (Direction == "RT") {
- ParamOut <- ParamIn
+ ParamOut <- ParamIn
ParamOut[, 1] <- log(ParamIn[, 1])
ParamOut[, 2] <- (ParamIn[, 2] - 2.5) * 4
}
- if (Bool == FALSE) {
- ParamOut <- ParamOut[1, ]
+
+ ## check output
+ if (isVecParamIn) {
+ ParamOut <- as.vector(ParamOut)
}
+
return(ParamOut)
}
diff --git a/R/TransfoParam_GR4H.R b/R/TransfoParam_GR4H.R
index 4a63a787..898a0c3f 100644
--- a/R/TransfoParam_GR4H.R
+++ b/R/TransfoParam_GR4H.R
@@ -1,27 +1,48 @@
-TransfoParam_GR4H <- function(ParamIn,Direction){
+TransfoParam_GR4H <- function(ParamIn, Direction) {
- NParam <- 4;
- Bool <- is.matrix(ParamIn);
- if(Bool==FALSE){ ParamIn <- rbind(ParamIn); }
- if(ncol(ParamIn)!=NParam){ stop(paste("the GR4H model requires ",NParam," parameters",sep="")) }
-
- if(Direction=="TR"){
- ParamOut <- ParamIn;
- ParamOut[,1] <- exp(ParamIn[,1]); ### GR4H X1 (production store capacity)
- ParamOut[,2] <- sinh(ParamIn[, 2] / 3); ### GR4H X2 (groundwater exchange coefficient)
- ParamOut[,3] <- exp(ParamIn[,3]); ### GR4H X3 (routing store capacity)
- ParamOut[,4] <- 480 + (480 - 0.5) * (ParamIn[,4] - 9.99) / 19.98; ### GR4H X4 (unit hydrograph time constant)
- }
- if(Direction=="RT"){
- ParamOut <- ParamIn;
- ParamOut[,1] <- log(ParamIn[,1]); ### GR4H X1 (production store capacity)
- ParamOut[,2] <- 3 * asinh(ParamIn[,2]); ### GR4H X2 (groundwater exchange coefficient)
- ParamOut[,3] <- log(ParamIn[,3]); ### GR4H X3 (routing store capacity)
- ParamOut[,4] <- (ParamIn[,4] - 480) * 19.98 / (480 - 0.5) + 9.99; ### GR4H X4 (unit hydrograph time constant)
+ ## number of model parameters
+ NParam <- 4L
+
+
+ ## check arguments
+ isVecParamIn <- is.vector(ParamIn)
+ if (isVecParamIn) {
+ ParamIn <- matrix(ParamIn, nrow = 1)
+ }
+ if (!inherits(ParamIn, "matrix")) {
+ stop("'ParamIn' must be of class 'matrix'")
+ }
+ if (!inherits(Direction, "character") | length(Direction) != 1 | any(!Direction %in% c("RT", "TR"))) {
+ stop("'Direction' must be a character vector of length 1 equal to 'RT' or 'TR'")
+ }
+ if (ncol(ParamIn) != NParam) {
+ stop(sprintf("the GR4H model requires %i parameters", NParam))
+ }
+
+
+ ## transformation
+ if (Direction == "TR") {
+ ParamOut <- ParamIn
+ ParamOut[, 1] <- exp(ParamIn[, 1]) ### GR4H X1 (production store capacity)
+ ParamOut[, 2] <- sinh(ParamIn[, 2] / 3) ### GR4H X2 (groundwater exchange coefficient)
+ ParamOut[, 3] <- exp(ParamIn[, 3]) ### GR4H X3 (routing store capacity)
+ ParamOut[, 4] <- 480 + (480 - 0.5) * (ParamIn[, 4] - 9.99) / 19.98 ### GR4H X4 (unit hydrograph time constant)
+ }
+ if (Direction == "RT") {
+ ParamOut <- ParamIn
+ ParamOut[, 1] <- log(ParamIn[, 1]) ### GR4H X1 (production store capacity)
+ ParamOut[, 2] <- 3 * asinh(ParamIn[, 2]) ### GR4H X2 (groundwater exchange coefficient)
+ ParamOut[, 3] <- log(ParamIn[, 3]) ### GR4H X3 (routing store capacity)
+ ParamOut[, 4] <- (ParamIn[, 4] - 480) * 19.98 / (480 - 0.5) + 9.99 ### GR4H X4 (unit hydrograph time constant)
}
- if(Bool==FALSE){ ParamOut <- ParamOut[1,]; }
- return(ParamOut);
+
+ ## check output
+ if (isVecParamIn) {
+ ParamOut <- as.vector(ParamOut)
+ }
+
+ return(ParamOut)
}
diff --git a/R/TransfoParam_GR4J.R b/R/TransfoParam_GR4J.R
index c10e2815..f68b8335 100644
--- a/R/TransfoParam_GR4J.R
+++ b/R/TransfoParam_GR4J.R
@@ -1,27 +1,49 @@
-TransfoParam_GR4J <- function(ParamIn,Direction){
+TransfoParam_GR4J <- function(ParamIn, Direction) {
- NParam <- 4;
- Bool <- is.matrix(ParamIn);
- if(Bool==FALSE){ ParamIn <- rbind(ParamIn); }
- if(ncol(ParamIn)!=NParam){ stop(paste("the GR4J model requires ",NParam," parameters",sep="")) }
-
- if(Direction=="TR"){
- ParamOut <- ParamIn;
- ParamOut[,1] <- exp(ParamIn[,1]); ### GR4J X1 (production store capacity)
- ParamOut[,2] <- sinh(ParamIn[,2]); ### GR4J X2 (groundwater exchange coefficient)
- ParamOut[,3] <- exp(ParamIn[,3]); ### GR4J X3 (routing store capacity)
- ParamOut[,4] <- 20+19.5*(ParamIn[,4]-9.99)/19.98; ### GR4J X4 (unit hydrograph time constant)
- }
- if(Direction=="RT"){
- ParamOut <- ParamIn;
- ParamOut[,1] <- log(ParamIn[,1]); ### GR4J X1 (production store capacity)
- ParamOut[,2] <- asinh(ParamIn[,2]); ### GR4J X2 (groundwater exchange coefficient)
- ParamOut[,3] <- log(ParamIn[,3]); ### GR4J X3 (routing store capacity)
- ParamOut[,4] <- 9.99+19.98*(ParamIn[,4]-20)/19.5; ### GR4J X4 (unit hydrograph time constant)
+
+ ## number of model parameters
+ NParam <- 4L
+
+
+ ## check arguments
+ isVecParamIn <- is.vector(ParamIn)
+ if (isVecParamIn) {
+ ParamIn <- matrix(ParamIn, nrow = 1)
+ }
+ if (!inherits(ParamIn, "matrix")) {
+ stop("'ParamIn' must be of class 'matrix'")
+ }
+ if (!inherits(Direction, "character") | length(Direction) != 1 | any(!Direction %in% c("RT", "TR"))) {
+ stop("'Direction' must be a character vector of length 1 equal to 'RT' or 'TR'")
+ }
+ if (ncol(ParamIn) != NParam) {
+ stop(sprintf("the GR4J model requires %i parameters", NParam))
+ }
+
+
+ ## transformation
+ if (Direction == "TR") {
+ ParamOut <- ParamIn
+ ParamOut[, 1] <- exp(ParamIn[, 1]) ### GR4J X1 (production store capacity)
+ ParamOut[, 2] <- sinh(ParamIn[, 2]) ### GR4J X2 (groundwater exchange coefficient)
+ ParamOut[, 3] <- exp(ParamIn[, 3]) ### GR4J X3 (routing store capacity)
+ ParamOut[, 4] <- 20 + 19.5 * (ParamIn[, 4] - 9.99) / 19.98 ### GR4J X4 (unit hydrograph time constant)
+ }
+ if (Direction == "RT") {
+ ParamOut <- ParamIn
+ ParamOut[, 1] <- log(ParamIn[, 1]) ### GR4J X1 (production store capacity)
+ ParamOut[, 2] <- asinh(ParamIn[, 2]) ### GR4J X2 (groundwater exchange coefficient)
+ ParamOut[, 3] <- log(ParamIn[, 3]) ### GR4J X3 (routing store capacity)
+ ParamOut[, 4] <- 9.99 + 19.98 * (ParamIn[, 4] - 20) / 19.5 ### GR4J X4 (unit hydrograph time constant)
}
- if(Bool==FALSE){ ParamOut <- ParamOut[1,]; }
- return(ParamOut);
+
+ ## check output
+ if (isVecParamIn) {
+ ParamOut <- as.vector(ParamOut)
+ }
+
+ return(ParamOut)
}
diff --git a/R/TransfoParam_GR5J.R b/R/TransfoParam_GR5J.R
index 99f5a30a..177ea930 100644
--- a/R/TransfoParam_GR5J.R
+++ b/R/TransfoParam_GR5J.R
@@ -1,29 +1,51 @@
-TransfoParam_GR5J <- function(ParamIn,Direction){
-
- NParam <- 5;
- Bool <- is.matrix(ParamIn);
- if(Bool==FALSE){ ParamIn <- rbind(ParamIn); }
- if(ncol(ParamIn)!=NParam){ stop(paste("the GR5J model requires ",NParam," parameters",sep="")) }
-
- if(Direction=="TR"){
- ParamOut <- ParamIn;
- ParamOut[,1] <- exp(ParamIn[,1]); ### GR5J X1 (production store capacity)
- ParamOut[,2] <- sinh(ParamIn[,2]); ### GR5J X2 (groundwater exchange coefficient 1)
- ParamOut[,3] <- exp(ParamIn[,3]); ### GR5J X3 (routing store capacity)
- ParamOut[,4] <- 20+19.5*(ParamIn[,4]-9.99)/19.98; ### GR5J X4 (unit hydrograph time constant)
- ParamOut[,5] <- (ParamIn[,5] + 9.99) / 19.98; ### GR5J X5 (groundwater exchange coefficient 2)
- }
- if(Direction=="RT"){
- ParamOut <- ParamIn;
- ParamOut[,1] <- log(ParamIn[,1]); ### GR5J X1 (production store capacity)
- ParamOut[,2] <- asinh(ParamIn[,2]); ### GR5J X2 (groundwater exchange coefficient 1)
- ParamOut[,3] <- log(ParamIn[,3]); ### GR5J X3 (routing store capacity)
- ParamOut[,4] <- 9.99+19.98*(ParamIn[,4]-20)/19.5; ### GR5J X4 (unit hydrograph time constant)
- ParamOut[,5] <- ParamIn[,5] * 19.98 - 9.99; ### GR5J X5 (groundwater exchange coefficient 2)
+TransfoParam_GR5J <- function(ParamIn, Direction) {
+
+
+ ## number of model parameters
+ NParam <- 5L
+
+
+ ## check arguments
+ isVecParamIn <- is.vector(ParamIn)
+ if (isVecParamIn) {
+ ParamIn <- matrix(ParamIn, nrow = 1)
+ }
+ if (!inherits(ParamIn, "matrix")) {
+ stop("'ParamIn' must be of class 'matrix'")
+ }
+ if (!inherits(Direction, "character") | length(Direction) != 1 | any(!Direction %in% c("RT", "TR"))) {
+ stop("'Direction' must be a character vector of length 1 equal to 'RT' or 'TR'")
+ }
+ if (ncol(ParamIn) != NParam) {
+ stop(sprintf("the GR4J model requires %i parameters", NParam))
+ }
+
+
+ ## transformation
+ if (Direction == "TR") {
+ ParamOut <- ParamIn
+ ParamOut[, 1] <- exp(ParamIn[, 1]) ### GR5J X1 (production store capacity)
+ ParamOut[, 2] <- sinh(ParamIn[, 2]) ### GR5J X2 (groundwater exchange coefficient 1)
+ ParamOut[, 3] <- exp(ParamIn[, 3]) ### GR5J X3 (routing store capacity)
+ ParamOut[, 4] <- 20 + 19.5 * (ParamIn[, 4] - 9.99) / 19.98 ### GR5J X4 (unit hydrograph time constant)
+ ParamOut[, 5] <- (ParamIn[, 5] + 9.99) / 19.98 ### GR5J X5 (groundwater exchange coefficient 2)
+ }
+ if (Direction == "RT") {
+ ParamOut <- ParamIn
+ ParamOut[, 1] <- log(ParamIn[, 1]) ### GR5J X1 (production store capacity)
+ ParamOut[, 2] <- asinh(ParamIn[, 2]) ### GR5J X2 (groundwater exchange coefficient 1)
+ ParamOut[, 3] <- log(ParamIn[, 3]) ### GR5J X3 (routing store capacity)
+ ParamOut[, 4] <- 9.99 + 19.98 * (ParamIn[, 4] - 20) / 19.5 ### GR5J X4 (unit hydrograph time constant)
+ ParamOut[, 5] <- ParamIn[, 5] * 19.98 - 9.99 ### GR5J X5 (groundwater exchange coefficient 2)
}
- if(Bool==FALSE){ ParamOut <- ParamOut[1,]; }
- return(ParamOut);
+
+ ## check output
+ if (isVecParamIn) {
+ ParamOut <- as.vector(ParamOut)
+ }
+
+ return(ParamOut)
}
diff --git a/R/TransfoParam_GR6J.R b/R/TransfoParam_GR6J.R
index fce777ce..459d6f93 100644
--- a/R/TransfoParam_GR6J.R
+++ b/R/TransfoParam_GR6J.R
@@ -1,52 +1,52 @@
TransfoParam_GR6J <- function(ParamIn, Direction) {
- NParam <- 6
- Bool <- is.matrix(ParamIn)
+ ## number of model parameters
+ NParam <- 6L
- if (Bool == FALSE) {
- ParamIn <- rbind(ParamIn)
+
+ ## check arguments
+ isVecParamIn <- is.vector(ParamIn)
+ if (isVecParamIn) {
+ ParamIn <- matrix(ParamIn, nrow = 1)
+ }
+ if (!inherits(ParamIn, "matrix")) {
+ stop("'ParamIn' must be of class 'matrix'")
+ }
+ if (!inherits(Direction, "character") | length(Direction) != 1 | any(!Direction %in% c("RT", "TR"))) {
+ stop("'Direction' must be a character vector of length 1 equal to 'RT' or 'TR'")
}
if (ncol(ParamIn) != NParam) {
stop(sprintf("the GR6J model requires %i parameters", NParam))
}
+
+ ## transformation
if (Direction == "TR") {
- ParamOut <- ParamIn
-
- ParamOut[, 1] <- exp(ParamIn[, 1])
- ### GR6J X1 (production store capacity)
- ParamOut[, 2] <- sinh(ParamIn[, 2])
- ### GR6J X2 (groundwater exchange coefficient 1)
- ParamOut[, 3] <- exp(ParamIn[, 3])
- ### GR6J X3 (routing store capacity)
- ParamOut[, 4] <- 20 + 19.5 * (ParamIn[, 4] - 9.99) / 19.98
- ### GR6J X4 (unit hydrograph time constant)
- ParamOut[, 5] <- ParamIn[, 5] / 5.
- ### GR5J X5 (groundwater exchange coefficient 2)
- ParamOut[, 6] <- exp(ParamIn[, 6])
- ### GR6J X6 (coefficient for emptying exponential store)
+ ParamOut <- ParamIn
+ ParamOut[, 1] <- exp(ParamIn[, 1]) ### GR6J X1 (production store capacity)
+ ParamOut[, 2] <- sinh(ParamIn[, 2]) ### GR6J X2 (groundwater exchange coefficient 1)
+ ParamOut[, 3] <- exp(ParamIn[, 3]) ### GR6J X3 (routing store capacity)
+ ParamOut[, 4] <- 20 + 19.5 * (ParamIn[, 4] - 9.99) / 19.98 ### GR6J X4 (unit hydrograph time constant)
+ ParamOut[, 5] <- ParamIn[, 5] / 5 ### GR6J X5 (groundwater exchange coefficient 2)
+ ParamOut[, 6] <- exp(ParamIn[, 6]) ### GR6J X6 (coefficient for emptying exponential store)
}
if (Direction == "RT") {
- ParamOut <- ParamIn
-
- ParamOut[, 1] <- log(ParamIn[, 1])
- ### GR6J X1 (production store capacity)
- ParamOut[, 2] <- asinh(ParamIn[, 2])
- ### GR6J X2 (groundwater exchange coefficient 1)
- ParamOut[, 3] <- log(ParamIn[, 3])
- ### GR6J X3 (routing store capacity)
- ParamOut[, 4] <- 9.99 + 19.98 * (ParamIn[, 4] - 20) / 19.5
- ### GR6J X4 (unit hydrograph time constant)
- ParamOut[, 5] <- ParamIn[, 5] * 5.
- ### GR5J X5 (groundwater exchange coefficient 2)
- ParamOut[, 6] <- log(ParamIn[, 6])
- ### GR6J X6 (coefficient for emptying exponential store)
+ ParamOut <- ParamIn
+ ParamOut[, 1] <- log(ParamIn[, 1]) ### GR6J X1 (production store capacity)
+ ParamOut[, 2] <- asinh(ParamIn[, 2]) ### GR6J X2 (groundwater exchange coefficient 1)
+ ParamOut[, 3] <- log(ParamIn[, 3]) ### GR6J X3 (routing store capacity)
+ ParamOut[, 4] <- 9.99 + 19.98 * (ParamIn[, 4] - 20) / 19.5 ### GR6J X4 (unit hydrograph time constant)
+ ParamOut[, 5] <- ParamIn[, 5] * 5 ### GR6J X5 (groundwater exchange coefficient 2)
+ ParamOut[, 6] <- log(ParamIn[, 6]) ### GR6J X6 (coefficient for emptying exponential store)
}
- if (Bool == FALSE) {
- ParamOut <- ParamOut[1, ]
+
+ ## check output
+ if (isVecParamIn) {
+ ParamOut <- as.vector(ParamOut)
}
+
return(ParamOut)
}
--
GitLab