From 637aef7edeb73eaf39b36c83b14a8c131bfb5aeb Mon Sep 17 00:00:00 2001
From: Delaigue Olivier <olivier.delaigue@irstea.priv>
Date: Wed, 13 Feb 2019 09:18:18 +0100
Subject: [PATCH] CHECKOUT 93ed9b27dea41215a664b196ec0b73d53e8df143 v1.1.2.40
CLEAN: add check in TransfoParam_CemaNeige
---
R/TransfoParam_CemaNeige.R | 30 +++++++++++++++++++-----------
1 file changed, 19 insertions(+), 11 deletions(-)
diff --git a/R/TransfoParam_CemaNeige.R b/R/TransfoParam_CemaNeige.R
index d49d600d..4754595e 100644
--- a/R/TransfoParam_CemaNeige.R
+++ b/R/TransfoParam_CemaNeige.R
@@ -1,31 +1,39 @@
TransfoParam_CemaNeige <- function(ParamIn, Direction) {
- NParam <- 2
- Bool <- is.matrix(ParamIn)
-
- if (Bool == FALSE) {
- ParamIn <- rbind(ParamIn)
+
+ NParam <- 2L
+
+
+ ## check_arguments
+ Bool <- is.vector(ParamIn)
+ if (Bool) {
+ ParamIn <- matrix(ParamIn, nrow = 1)
+ warning("'ParamIn' automatically convert to 'matrix'")
+ }
+ 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 CemaNeige module requires ", NParam, " parameters \n", sep = "" ))
- return(NULL)
+ stop(sprintf( "the CemaNeige module requires %i parameters", NParam))
}
+
if (Direction == "TR") {
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[, 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)
}
- if (Bool == FALSE) {
- ParamOut <- ParamOut[1, ]
+ if (Bool) {
+ ParamOut <- as.vector(ParamOut)
}
return(ParamOut)
--
GitLab