From 7cac70c3398980d35416d39215bb38a7d7610f69 Mon Sep 17 00:00:00 2001
From: Delaigue Olivier <olivier.delaigue@irstea.priv>
Date: Tue, 19 Mar 2019 08:34:51 +0100
Subject: [PATCH] v1.2.9.25 UPDATE: StartParamList completed in
CreateCalibOptions to take into account the use of hysteresis #5252
---
DESCRIPTION | 2 +-
NEWS.rmd | 2 +-
R/CreateCalibOptions.R | 93 +++++++++++++++++++++++++++++-------------
3 files changed, 67 insertions(+), 30 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index 0457fba9..84e67040 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.9.24
+Version: 1.2.9.25
Date: 2019-03-19
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 df544b7f..28c047ff 100644
--- a/NEWS.rmd
+++ b/NEWS.rmd
@@ -13,7 +13,7 @@ output:
-### 1.2.9.24 Release Notes (2019-03-19)
+### 1.2.9.25 Release Notes (2019-03-19)
diff --git a/R/CreateCalibOptions.R b/R/CreateCalibOptions.R
index e721c70b..3f24b564 100644
--- a/R/CreateCalibOptions.R
+++ b/R/CreateCalibOptions.R
@@ -99,8 +99,12 @@ CreateCalibOptions <- function(FUN_MOD,
if (identical(FUN_MOD, RunModel_GR1A)) {
FUN1 <- TransfoParam_GR1A
}
- if (identical(FUN_MOD, RunModel_CemaNeige)) {
- FUN1 <- TransfoParam_CemaNeige
+ if (identical(FUN_MOD, RunModel_CemaNeige)) {
+ if (inherits(FUN_MOD, "hysteresis")) {
+ FUN1 <- TransfoParam_CemaNeigeHyst
+ } else {
+ FUN1 <- TransfoParam_CemaNeige
+ }
}
if (is.null(FUN1)) {
stop("FUN1 was not found")
@@ -169,6 +173,10 @@ CreateCalibOptions <- function(FUN_MOD,
if ("CemaNeigeGR6J" %in% ObjectClass) {
NParam <- 8
}
+ if (inherits(FUN_MOD, "hysteresis")) {
+ NParam <- NParam + 2
+ }
+
##check_FixedParam
if (is.null(FixedParam)) {
@@ -218,53 +226,82 @@ CreateCalibOptions <- function(FUN_MOD,
if ("GR4H" %in% ObjectClass) {
ParamT <- matrix(c(+5.12, -1.18, +4.34, -9.69,
+5.58, -0.85, +4.74, -9.47,
- +6.01, -0.50, +5.14, -8.87), ncol = NParam, byrow = TRUE)
+ +6.01, -0.50, +5.14, -8.87), ncol = 4, byrow = TRUE)
}
if ("GR4J" %in% ObjectClass) {
ParamT <- matrix(c(+5.13, -1.60, +3.03, -9.05,
+5.51, -0.61, +3.74, -8.51,
- +6.07, -0.02, +4.42, -8.06), ncol = NParam, byrow = TRUE)
+ +6.07, -0.02, +4.42, -8.06), ncol = 4, byrow = TRUE)
}
if ("GR5J" %in% ObjectClass) {
ParamT <- matrix(c(+5.17, -1.13, +3.08, -9.37, -7.45,
+5.55, -0.46, +3.75, -9.09, -4.69,
- +6.10, -0.11, +4.43, -8.60, -0.66), ncol = NParam, byrow = TRUE)
+ +6.10, -0.11, +4.43, -8.60, -0.66), ncol = 5, byrow = TRUE)
}
if ("GR6J" %in% ObjectClass) {
ParamT <- matrix(c(+3.60, -1.00, +3.30, -9.10, -0.90, +3.00,
+3.90, -0.50, +4.10, -8.70, +0.10, +4.00,
- +4.50, +0.50, +5.00, -8.10, +1.10, +5.00), ncol = NParam, byrow = TRUE)
+ +4.50, +0.50, +5.00, -8.10, +1.10, +5.00), ncol = 6, byrow = TRUE)
}
if ("GR2M" %in% ObjectClass) {
ParamT <- matrix(c(+5.03, -7.15,
+5.22, -6.74,
- +5.85, -6.37), ncol = NParam, byrow = TRUE)
+ +5.85, -6.37), ncol = 2, byrow = TRUE)
}
if ("GR1A" %in% ObjectClass) {
ParamT <- matrix(c(-1.69,
-0.38,
- +1.39), ncol = NParam, byrow = TRUE)
- }
- if ("CemaNeige" %in% ObjectClass) {
- ParamT <- matrix(c(-9.96, +6.63,
- -9.14, +6.90,
- +4.10, +7.21), ncol = NParam, byrow = TRUE)
- }
- if ("CemaNeigeGR4J" %in% ObjectClass) {
- ParamT <- matrix(c(+5.13, -1.60, +3.03, -9.05, -9.96, +6.63,
- +5.51, -0.61, +3.74, -8.51, -9.14, +6.90,
- +6.07, -0.02, +4.42, -8.06, +4.10, +7.21), ncol = NParam, byrow = TRUE)
- }
- if ("CemaNeigeGR5J" %in% ObjectClass) {
- ParamT <- matrix(c(+5.17, -1.13, +3.08, -9.37, -7.45, -9.96, +6.63,
- +5.55, -0.46, +3.75, -9.09, -4.69, -9.14, +6.90,
- +6.10, -0.11, +4.43, -8.60, -0.66, +4.10, +7.21), ncol = NParam, byrow = TRUE)
- }
- if ("CemaNeigeGR6J" %in% ObjectClass) {
- ParamT <- matrix(c(+3.60, -1.00, +3.30, -9.10, -0.90, +3.00, -9.96, +6.63,
- +3.90, -0.50, +4.10, -8.70, +0.10, +4.00, -9.14, +6.90,
- +4.50, +0.50, +5.00, -8.10, +1.10, +5.00, +4.10, +7.21), ncol = NParam, byrow = TRUE)
+ +1.39), ncol = 1, byrow = TRUE)
+ }
+# if (inherits(FUN_MOD, "hysteresis")) {
+# if ("CemaNeige" %in% ObjectClass) {
+# ParamT <- matrix(c(-9.96, +6.63, -9.08, -6.99,
+# -9.14, +6.90, -8.00, -3.20,
+# +4.10, +7.21, -6.40, +9.99), ncol = NParam, byrow = TRUE)
+# }
+# if ("CemaNeigeGR4J" %in% ObjectClass) {
+# ParamT <- matrix(c(+5.13, -1.60, +3.03, -9.05, -9.96, +6.63, -9.08, -6.99,
+# +5.51, -0.61, +3.74, -8.51, -9.14, +6.90, -8.00, -3.20,
+# +6.07, -0.02, +4.42, -8.06, +4.10, +7.21, -6.40, +9.99), ncol = NParam, byrow = TRUE)
+# }
+# if ("CemaNeigeGR5J" %in% ObjectClass) {
+# ParamT <- matrix(c(+5.17, -1.13, +3.08, -9.37, -7.45, -9.96, +6.63, -9.08, -6.99,
+# +5.55, -0.46, +3.75, -9.09, -4.69, -9.14, +6.90, -8.00, -3.20,
+# +6.10, -0.11, +4.43, -8.60, -0.66, +4.10, +7.21, -6.40, +9.99), ncol = NParam, byrow = TRUE)
+# }
+# if ("CemaNeigeGR6J" %in% ObjectClass) {
+# ParamT <- matrix(c(+3.60, -1.00, +3.30, -9.10, -0.90, +3.00, -9.96, +6.63, -9.08, -6.99,
+# +3.90, -0.50, +4.10, -8.70, +0.10, +4.00, -9.14, +6.90, -8.00, -3.20,
+# +4.50, +0.50, +5.00, -8.10, +1.10, +5.00, +4.10, +7.21, -6.40, +9.99), ncol = NParam, byrow = TRUE)
+# }
+# } else {
+ if ("CemaNeige" %in% ObjectClass) {
+ ParamT <- matrix(c(-9.96, +6.63,
+ -9.14, +6.90,
+ +4.10, +7.21), ncol = 2, byrow = TRUE)
+ }
+ if ("CemaNeigeGR4J" %in% ObjectClass) {
+ ParamT <- matrix(c(+5.13, -1.60, +3.03, -9.05, -9.96, +6.63,
+ +5.51, -0.61, +3.74, -8.51, -9.14, +6.90,
+ +6.07, -0.02, +4.42, -8.06, +4.10, +7.21), ncol = 6, byrow = TRUE)
+ }
+ if ("CemaNeigeGR5J" %in% ObjectClass) {
+ ParamT <- matrix(c(+5.17, -1.13, +3.08, -9.37, -7.45, -9.96, +6.63,
+ +5.55, -0.46, +3.75, -9.09, -4.69, -9.14, +6.90,
+ +6.10, -0.11, +4.43, -8.60, -0.66, +4.10, +7.21), ncol = 7, byrow = TRUE)
+ }
+ if ("CemaNeigeGR6J" %in% ObjectClass) {
+ ParamT <- matrix(c(+3.60, -1.00, +3.30, -9.10, -0.90, +3.00, -9.96, +6.63,
+ +3.90, -0.50, +4.10, -8.70, +0.10, +4.00, -9.14, +6.90,
+ +4.50, +0.50, +5.00, -8.10, +1.10, +5.00, +4.10, +7.21), ncol = 8, byrow = TRUE)
+ }
+ # }
+ if (inherits(FUN_MOD, "hysteresis")) {
+ ParamTHyst <- matrix(c(-9.08, -6.99,
+ -8.00, -3.20,
+ -6.40, +9.99), ncol = 2, byrow = TRUE)
+ ParamT <- cbind(ParamT, ParamTHyst)
}
StartParamList <- NULL
--
GitLab