Newer
Older
Delaigue Olivier
committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
TransfoParam_CemaNeigeHyst <- function(ParamIn, Direction) {
NParam <- 4L
## 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(sprintf( "the CemaNeige module with hysteresis 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)
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[, 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
}
if (Bool) {
ParamOut <- as.vector(ParamOut)
}
return(ParamOut)
}