diff --git a/.Rbuildignore b/.Rbuildignore
index 02bca46bffb309865243a7c0ee8e0bd876f74ed7..7c1c5baa8f03668a04b8d352020ed07372de4599 100644
--- a/.Rbuildignore
+++ b/.Rbuildignore
@@ -2,3 +2,9 @@
^\.Rproj\.user$
^\.Rprofile$
^packrat/
+^tests/tmp/
+^\.gitlab-ci.yml$
+^\.regressionignore$
+^\.gitlab-ci\.yml$
+^\.vscode$
+^Rplots\.pdf$
diff --git a/.gitignore b/.gitignore
index 3c605852332ec79777be9f733f93d0c252b81397..5eb9ae2487a29398fd86791b85cf36ef46b8763e 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,5 +1,66 @@
-.Rproj.user
+# Specific files for airGR
+packrat/lib*/
+
+# Compiled files
+/src/*.o
+/src/*.so
+/src/*.dll
+/src-*
+
+# Test temporary files
+/tests/tmp/
+*.pdf
+!man/figures/*.pdf
+
+
+######################################################################################################
+### Generic .gitignore for R (source: https://github.com/github/gitignore/blob/master/R.gitignore) ###
+######################################################################################################
+
+# History files
.Rhistory
+.Rapp.history
+
+# Session Data files
.RData
-airGR.Rproj
-packrat/lib*/
+
+# User-specific files
+.Ruserdata
+
+# Example code in package build process
+*-Ex.R
+
+# Output files from R CMD build
+/*.tar.gz
+
+# Output files from R CMD check
+/*.Rcheck/
+
+# RStudio files
+.Rproj.user
+
+# produced vignettes
+vignettes/*.html
+vignettes/*.pdf
+
+# OAuth2 token, see https://github.com/hadley/httr/releases/tag/v0.3
+.httr-oauth
+
+# knitr and R markdown default cache directories
+*_cache/
+/cache/
+
+# Temporary files created by R markdown
+*.utf8.md
+*.knit.md
+
+# R Environment Variables
+.Renviron
+
+# pkgdown site
+docs/
+
+# vscode IDE
+.vscode/*
+*.code-workspace
+.history/
diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
new file mode 100644
index 0000000000000000000000000000000000000000..599ec847b10e5b32ad7701752284926fa025ca7d
--- /dev/null
+++ b/.gitlab-ci.yml
@@ -0,0 +1,158 @@
+stages:
+ - update_packages
+ - build
+ - regression
+ - tests
+
+default:
+ before_script:
+ - echo "setwd(\"$(pwd)\")" > .Rprofile
+ - PATH=~/R/sources/R-${R_VERSION}/bin:$PATH
+ - rename "s/${R_VERSION}.airGR/airGR/" *.tar.gz
+
+.update_packages:
+ stage: update_packages
+ only:
+ refs:
+ - tags
+ - schedules
+ script:
+ - Rscript -e "update.packages(ask=FALSE, repos=\"http://cran.r-project.org\")"
+
+.build:
+ stage: build
+ script:
+ - cd ..
+ - echo "setwd(\"$(pwd)\")" > .Rprofile
+ - R CMD build airgr
+ - rename "s/airGR/${R_VERSION}.airGR/" airGR_*.tar.gz
+ - mv *.tar.gz airgr/
+ artifacts:
+ untracked: true
+ expire_in: 1 week
+
+.regression:
+ stage: regression
+ script:
+ - Rscript tests/testthat/regression_tests.R stable
+ - R CMD INSTALL .
+ - Rscript tests/testthat/regression_tests.R dev
+ - Rscript tests/testthat/regression_tests.R compare
+
+.check_not_cran:
+ stage: tests
+ variables:
+ NOT_CRAN: "true"
+ script:
+ - R CMD check airGR_*.tar.gz
+
+.check_as_cran:
+ stage: tests
+ script:
+ - R CMD check --as-cran airGR_*.tar.gz
+
+update_packages_patched:
+ variables:
+ R_VERSION: "patched"
+ extends: .update_packages
+
+build_patched:
+ variables:
+ R_VERSION: "patched"
+ extends: .build
+
+regression_patched:
+ variables:
+ R_VERSION: "patched"
+ extends: .regression
+
+regression_devel:
+ only:
+ refs:
+ - schedules
+ variables:
+ R_VERSION: "devel"
+ extends: .regression
+
+regression_oldrel:
+ only:
+ refs:
+ - schedules
+ variables:
+ R_VERSION: "oldrel"
+ extends: .regression
+
+check_not_cran_patched:
+ variables:
+ R_VERSION: "patched"
+ extends: .check_not_cran
+
+check_as_cran_patched:
+ variables:
+ R_VERSION: "patched"
+ extends: .check_as_cran
+
+update_packages_devel:
+ variables:
+ R_VERSION: "devel"
+ extends: .update_packages
+
+build_devel:
+ only:
+ refs:
+ - tags
+ - schedules
+ variables:
+ R_VERSION: "devel"
+ extends: .build
+
+check_not_cran_devel:
+ only:
+ refs:
+ - tags
+ - schedules
+ variables:
+ R_VERSION: "devel"
+ extends: .check_not_cran
+
+check_as_cran_devel:
+ only:
+ refs:
+ - tags
+ - schedules
+ variables:
+ R_VERSION: "devel"
+ extends: .check_as_cran
+
+update_packages_oldrel:
+ variables:
+ R_VERSION: "oldrel"
+ extends: .update_packages
+
+build_oldrel:
+ only:
+ refs:
+ - tags
+ - schedules
+ variables:
+ R_VERSION: "oldrel"
+ extends: .build
+
+check_not_cran_oldrel:
+ only:
+ refs:
+ - tags
+ - schedules
+ variables:
+ R_VERSION: "oldrel"
+ extends: .check_not_cran
+
+check_as_cran_oldrel:
+ only:
+ refs:
+ - tags
+ - schedules
+ variables:
+ R_VERSION: "oldrel"
+ extends: .check_as_cran
+
diff --git a/.regressionignore b/.regressionignore
new file mode 100644
index 0000000000000000000000000000000000000000..1dd20c9de2d828cd149545d7fbc7da4326b40af2
--- /dev/null
+++ b/.regressionignore
@@ -0,0 +1,30 @@
+# .test-regression.ignore contains the list of topic/variables produces by
+# documentation examples that should be ignore in the regression test
+# The format of this file is: 5 lines of comments followed by one line by
+# ignored variable : [Topic]<SPACE>[Variable].
+# Example for ignoring OutputsModel variable produced by example("RunModel_GR2M"): RunModel_GR2M OutputsModel
+RunModel_GR1A BasinObs
+RunModel_GR1A ConvertFun
+RunModel_GR1A NewTabSeries
+RunModel_GR1A NewTimeFormat
+RunModel_GR1A OutputsModel
+RunModel_GR1A TabSeries
+RunModel_GR1A TimeFormat
+RunModel_GR1A YearFirstMonth
+RunModel_GR2M BasinObs
+RunModel_GR2M ConvertFun
+RunModel_GR2M NewTabSeries
+RunModel_GR2M NewTimeFormat
+RunModel_GR2M OutputsModel
+RunModel_GR2M RunOptions
+RunModel_GR1A OutputsModel
+Calibration_Michel CalibOptions
+Calibration CalibOptions
+CreateCalibOptions CalibOptions
+
+# New version of the SeriesAggreg function
+RunModel_GR2M TabSeries
+RunModel_GR2M TimeFormat
+SeriesAggreg BasinInfo
+SeriesAggreg BasinObs
+SeriesAggreg NewTabSeries
diff --git a/DESCRIPTION b/DESCRIPTION
index 36abd1051f9f5cff5087d418f4cd32cecd20ddce..0212f2fdc0d01862cdb32f9e14dd1b4cff1c7df2 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,16 +1,17 @@
Package: airGR
Type: Package
Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling
-Version: 1.4.3.65
-Date: 2020-02-28
+Version: 1.6.9.21
+Date: 2021-01-13
Authors@R: c(
person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")),
person("Olivier", "Delaigue", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-7668-8468"), email = "airGR@inrae.fr"),
person("Guillaume", "Thirel", role = c("aut"), comment = c(ORCID = "0000-0002-1444-1830")),
+ person("David", "Dorchies", role = c("aut"), comment = c(ORCID = "0000-0002-6595-7984")),
person("Charles", "Perrin", role = c("aut", "ths"), comment = c(ORCID = "0000-0001-8552-1881")),
person("Claude", "Michel", role = c("aut", "ths")),
person("Vazken", "Andréassian", role = c("ctb", "ths"), comment = c(ORCID = "0000-0001-7124-9303")),
- person("François", "Bourgin", role = c("ctb"), comment = c(ORCID = "0000-0002-2820-7260", vignette = "'Parameter estimation' vignettes")),
+ person("François", "Bourgin", role = c("ctb"), comment = c(ORCID = "0000-0002-2820-7260")),
person("Pierre", "Brigode", role = c("ctb"), comment = c(ORCID = "0000-0001-8257-0741")),
person("Nicolas", "Le Moine", role = c("ctb")),
person("Thibaut", "Mathevet", role = c("ctb"), comment = c(ORCID = "0000-0002-4142-4454")),
@@ -19,12 +20,20 @@ Authors@R: c(
person("Raji", "Pushpalatha", role = c("ctb")),
person("Audrey", "Valéry", role = c("ctb"))
)
-Depends: R (>= 3.0.1)
-Suggests: knitr, rmarkdown, coda, DEoptim, dplyr, FME, ggmcmc, Rmalschains
+Depends: R (>= 3.1.0)
+Imports:
+ graphics,
+ grDevices,
+ stats,
+ utils
+Suggests:
+ knitr, rmarkdown,
+ coda, DEoptim, dplyr, FME, ggmcmc, hydroPSO, imputeTS, Rmalschains,
+ testthat
Description: Hydrological modelling tools developed at INRAE-Antony (HYCAR Research Unit, France). The package includes several conceptual rainfall-runoff models (GR4H, GR5H, GR4J, GR5J, GR6J, GR2M, GR1A), a snow accumulation and melt model (CemaNeige) and the associated functions for their calibration and evaluation. Use help(airGR) for package description and references.
License: GPL-2
URL: https://hydrogr.github.io/airGR/
-BugReports: https://gitlab.irstea.fr/HYCAR-Hydro/airgr/issues
+BugReports: https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues
NeedsCompilation: yes
Encoding: UTF-8
VignetteBuilder: knitr
diff --git a/NAMESPACE b/NAMESPACE
index 17665070307a687ded3db7f9414c24dcad99ef09..bf71216c1b7e82680ccdaf969983b105c814200d 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -8,7 +8,13 @@ useDynLib(airGR, .registration = TRUE)
#####################################
## S3 methods ##
#####################################
-S3method("plot", "OutputsModel")
+S3method('[', InputsModel)
+S3method('[', OutputsModel)
+S3method(plot, OutputsModel)
+S3method(SeriesAggreg, data.frame)
+S3method(SeriesAggreg, list)
+S3method(SeriesAggreg, InputsModel)
+S3method(SeriesAggreg, OutputsModel)
@@ -45,6 +51,7 @@ export(RunModel_GR5H)
export(RunModel_GR4J)
export(RunModel_GR5J)
export(RunModel_GR6J)
+export(RunModel_Lag)
export(SeriesAggreg)
export(TransfoParam)
export(TransfoParam_CemaNeige)
@@ -56,10 +63,8 @@ export(TransfoParam_GR5H)
export(TransfoParam_GR4J)
export(TransfoParam_GR5J)
export(TransfoParam_GR6J)
-export(plot.OutputsModel)
-exportPattern(".FortranOutputs")
-exportPattern(".ErrorCrit")
-
+export(TransfoParam_Lag)
+export(.ErrorCrit)
#####################################
diff --git a/NEWS.md b/NEWS.md
index 024f9374b8a4e963aee373cb03f7d68193b1c11b..32457e1aff5ea3693ffe89ad081e2a2adc587267 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -2,14 +2,74 @@
+### 1.6.9.21 Release Notes (2021-01-13)
+#### New features
+
+- Added `SeriesAggreg` S3 method with functions for `InputsModel`, `OutputsModel`, `list`, `data.frame` class objects. This new version of the `SeriesAggreg()` function also allows to compute regimes. ([#25](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/25))
+- Added `.GetAggregConvertFun()` private function in order to choose automatically the `ConvertFun` to apply on each element of objects used in `SeriesAggreg.InputsModel()` and `SeriesAggreg.OutputsModel()`.
+- Added `.AggregConvertFunTable` data.frame that allows the user to see what names of list items or data.frame column names are guessed and eventually customise this correspondence table.
+- `PE_Oudin()` now presents a `RunFortran` argument to run the code in Fortran or in R. The Fortran mode is the fastest. ([#62](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/62))
+- Added `RunModel_Lag()` which allows to perform a single run for the Lag model over the test period in order to run semi-distributed GR models. ([#34](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/34))
+- Added the 'sd_model' vignette to explain how to manage the use of semi-distributed GR models. ([#34](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/34))
+- Added `[` S3 method for `InputsModel` and `OutputsModel` class objects in order to extract subsets of them. ([#67](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/67))
+
+
+#### Deprecated and defunct
+
+- The `TimeFormat` argument is now deprecated in `SeriesAggreg()`. ([#41](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/41))
+- The `NewTimeFormat` argument is now deprecated in `SeriesAggreg()` and replaced by the `Format` argument. ([#41](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/41))
+- The deprecated `RunSnowModule` argument has been removed from the `CreateRunOptions()` function. ([#23](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/23))
+
+
+#### Bug fixes
+
+- `TimeLag` of the `SeriesAggreg()` function now runs when `TimeLag >= 3600`.
+([#41](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/41))
+- `SeriesAggreg()` now runs when the time series contain some columns entirely filled with missing values. ([#43](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/43))
+- Fixed bug in `RunModel_GR1A()`. Reversed PotEvap and Precip outputs are now reordered (in the previous versions PotEvap contained the precipitation values and Precip contained the evapotranspiration values, the Qsim values were already correct). ([#65](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/65))
+
+
+
+#### Major user-visible changes
+
+- Added output to `RunModel_GR2M()` function (Ps). ([#51](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/51))
+- `PE_Oudin()` can now run for several locations (i.e. several latitudes) in the Fortran mode (`RunFortran = TRUE`). In this case `Lat` must be of the same length as `Temp`. ([#62](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/62))
+- `RunModel()` now allows to run semi-distributed GR models. ([#34](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/34))
+- The `ConvertFun` argument of the `SeriesAggreg()` function can now be set to names of aggregation functions that return value of length 1 (not only `"sum"` or `"mean"`, but e.g. `"min"`, `"max"`, `"Q95"`). ([#82](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/82))
+
+
+#### Minor user-visible changes
+
+- The `.FortranOutputs()` function is no longer exported in the namespace.
+- `RunModel_GR1A()` now uses the Fortran version of the model code. This code is no longer duplicated: the R version which was used was removed. ([#65](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/65))
+- Character argument verification now use partial matching in `PE_Oudin()` and `SeriesAggreg()` functions. ([#37](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/37))
+- `RunModel_*()` funcions were cleaned up, with no effect on their outputs. ([#14](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/14))
+- `.ErrorCrit()` function now returns a warning message when a criterion computed on less than 10 time-steps (whatever the unit of the time step). ([#14](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/14))
+- Added the diagram of GR5H in the `RunModel_GR5H()` documentation. ([#49](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/49))
+- The `Exch` was renames `AExch` in the `RunModel_GR2M()` output. ([#87](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/87))
+- Added 'Es' and 'Ps' on the GR2M diagram available in the `RunModel_GR2M()` help page. ([#88](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/88))
+
+
+#### Version control and issue tracking
+
+- Implement automatic tests in the package. ([#52](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/52))
-### 1.4.3.65 Release Notes (2020-02-28)
#### CRAN-compatibility updates
-- The run period is reduced in the example of the <code>Imax()<code> function in order to run faster.
+- 'airGR' now depends on R >= 3.1.0 because of the use of the `anyNA` function.
+- The 'hydroPSO' package is back on CRAN and it is again suggested (cf. the 'param_optim' vignette). ([#38](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/38))
+- For more safety, the following "basic" packages are now imported : 'graphics', 'grDevices', 'stats', 'utils. ([#74](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/74))
+
+____________________________________________________________________________________
+
+### 1.4.3.65 Release Notes (2020-02-28)
+
+#### CRAN-compatibility updates
+
+- The run period is reduced in the example of the `Imax()` function in order to run faster.
- The 'hydroPSO' package is no longer suggested (but the code linked to its use and is always present in the 'param_optim' vignette).
____________________________________________________________________________________
@@ -19,11 +79,11 @@ ________________________________________________________________________________
#### New features
-- A digital object identifier (DOI) now allows to identify the manual of the 'airGR' package. When you use airGR in your work, please always cite both the article and the manual. The last one allows to know the version of the package that is used in order to enhance reproducible research. The references can be displayed with the <code>citation("airGR")</code> command.
+- A digital object identifier (DOI) now allows to identify the manual of the 'airGR' package. When you use 'airGR' in your work, please always cite both the article and the manual. The last one allows to know the version of the package that is used in order to enhance reproducible research. The references can be displayed with the `citation("airGR")` command.
#### Bug fixes
-- Fixed bug in <code>Imax()</code>. The default value of the <code>TestedValues</code> argument was wrong due to a mistyped argument name in the <code>seq()</code> function.
+- Fixed bug in `Imax()`. The default value of the `TestedValues` argument was wrong due to a mistyped argument name in the `seq()` function.
____________________________________________________________________________________
@@ -33,28 +93,28 @@ ________________________________________________________________________________
#### New features
-- <code>plot.Outputsmodel()</code> now allows to draw actual evapotranspiration when <code>which = "ActuEvap"</code> or <code>which = "All"</code> (overlaid to potential evapotranspiration if already drawn).
-- Added <code>RunModel_GR5H()</code> and <code>RunModel_CemaNeigeGR5H()</code> functions to run the hourly model GR5H (with or without the CemaNeige module). These models present an optional additionnal interception store.
-- Added <code>Imax()</code> which allows to estimate the maximum capacity of the GR5H interception store.
+- `plot.Outputsmodel()` now allows to draw actual evapotranspiration when `which = "ActEvap"` or `which = "All"` (overlaid to potential evapotranspiration if already drawn). ([#2](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/2))
+- Added `RunModel_GR5H()` and `RunModel_CemaNeigeGR5H()` functions to run the hourly model GR5H (with or without the CemaNeige module). These models present an optional additionnal interception store. ([#13](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/13))
+- Added `Imax()` which allows to estimate the maximum capacity of the GR5H interception store. ([#13](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/13))
#### Bug fixes
-- Fixed bug in <code>TransfoParam_GR1A()</code>. The number of model parameters was wrong (2 instead of 1) which caused an error during the GR1A model calibration.
-- Fixed bug in <code>plot.OutputsModel()</code>. The function does not return any error message when <code>log_scale = TRUE</code>, <code>Qobs = NULL</code> and user want to draw flows time series.
-- Fixed bug in <code>RunModel_*GR*()</code>. The functions do not return any error message anymore due to slightly negative values returned by GR4H, GR4J, GR5J or GR6J Fortran codes (the message was returned by <code>CreateIniStates()</code> when the final states were created). The <code>RunModel_*GR*()</code> functions now return zero instead of these slightly negative values, except for the ExpStore where negatives values are allowed.
-- Fixed bug in the <code>.ErrorCrit()</code> function. The Box-Cox transformation formula is now corrected when the <code>ErrorCrit*()</code> functions are used.
+- Fixed bug in `TransfoParam_GR1A()`. The number of model parameters was wrong (2 instead of 1) which caused an error during the GR1A model calibration. ([#1](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/1))
+- Fixed bug in `plot.OutputsModel()`. The function does not return any error message when `log_scale = TRUE`, `Qobs = NULL` and user want to draw flows time series.
+- Fixed bug in `RunModel_*GR*()`. The functions do not return any error message anymore due to slightly negative values returned by GR4H, GR4J, GR5J or GR6J Fortran codes (the message was returned by `CreateIniStates()` when the final states were created). The `RunModel_*GR*()` functions now return zero instead of these slightly negative values, except for the ExpStore where negatives values are allowed.
+- Fixed bug in the `.ErrorCrit()` function. The Box-Cox transformation formula is now corrected when the `ErrorCrit*()` functions are used.
#### Major user-visible changes
-- Added outputs to <code>RunModel_GR4H()</code> function (Pn, Ps, AExch1, AExch2).
+- Added outputs to `RunModel_GR4H()` function (Pn, Ps, AExch1, AExch2).
#### Minor user-visible changes
-- Added the diagram of GR2M in the <code>RunModel_GR2M()</code> documentation.
-- Fortran codes cleant and translated from F77 to F90.
+- Added the diagram of GR2M in the `RunModel_GR2M()` documentation.
+- Fortran codes cleaned and translated from F77 to F90. ([#18](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/18))
#### CRAN-compatibility updates
@@ -69,19 +129,19 @@ ________________________________________________________________________________
#### Version control and issue tracking
-- Users can now track changes (<code>https://gitlab.irstea.fr/HYCAR-Hydro/airgr</code>) and issues (<code>https://gitlab.irstea.fr/HYCAR-Hydro/airgr/issues</code>).
+- Users can now track changes (`https://gitlab.irstea.fr/HYCAR-Hydro/airgr`) and issues (`https://gitlab.irstea.fr/HYCAR-Hydro/airgr/issues`).
#### Bug fixes
-- Fixed bug in <code>RunModel_CemaNeige()</code>. The function now runs correctly when <code>IndPeriod_WarmUp = 0L</code> in <code>CreateRunOptions()</code> in order to completely disable the warm-up period (e.g. to perform a forecast form a given initial state).
-- Fixed bug in <code>CreateIniStates()</code>. The function now returns the right number of end states when CemaNeige is used whithout hysteresis.
-- Fixed bug in the <code>RunModel_CemaNeige*()</code> functions. G and Gthr end states are no more inverted in the output values.
+- Fixed bug in `RunModel_CemaNeige()`. The function now runs correctly when `IndPeriod_WarmUp = 0L` in `CreateRunOptions()` in order to completely disable the warm-up period (e.g. to perform a forecast form a given initial state).
+- Fixed bug in `CreateIniStates()`. The function now returns the right number of end states when CemaNeige is used without hysteresis.
+- Fixed bug in the `RunModel_CemaNeige*()` functions. G and Gthr end states are no more inverted in the output values.
#### Minor user-visible changes
-- Spurious flows set to <code>NA</code> into the <code>BasinObs</code> time series of the <code>L0123001</code> dataset.
+- Spurious flows set to `NA` into the `BasinObs` time series of the `L0123001` dataset.
____________________________________________________________________________________
@@ -91,39 +151,33 @@ ________________________________________________________________________________
#### New features
-- <code>CreateInputsCrit()</code> now allows power (as a numeric or as a character) and the Box-Cox transformations in the <code>transfo</code> argument.
-
-- Added <code>RunModel_CemaNeigeGR4H()</code> function to run the hourly model GR4H with the CemaNeige module.
-
-- Added <code>PE_Oudin()</code> function to compute Oudin's potential evapotranspiration for hourly or daily time steps.
+- `CreateInputsCrit()` now allows power (as a numeric or as a character) and the Box-Cox transformations in the `transfo` argument.
+- Added `RunModel_CemaNeigeGR4H()` function to run the hourly model GR4H with the CemaNeige module.
+- Added `PE_Oudin()` function to compute Oudin's potential evapotranspiration for hourly or daily time steps.
+- `plot.OutputsModel()` now presents a `LayoutMat` argument (and additionnal related argument: `LayoutWidths`, `LayoutHeights`) to specify complex plot arrangements.
#### Deprecated and defunct
-- The <code>PEdaily_Oudin()</code> function is deprecated and his use has been replaced by the use of <code>PE_Oudin()</code>.
-
-- <code>plot.OutputsModel()</code> now presents a <code>LayoutMat</code> argument (and additionnal related argument: <code>LayoutWidths</code>, <code>LayoutHeights</code>) to specify complex plot arrangements.
+- The `PEdaily_Oudin()` function is deprecated and his use has been replaced by the use of `PE_Oudin()`.
#### Bug fixes
-- Fixed bug in <code>plot.OutputsModel()</code>. The function now runs correctly when the <code>which</code> argument contains the <code>"CorQQ"</code> value without <code>"CumFreq"</code>.
+- Fixed bug in `plot.OutputsModel()`. The function now runs correctly when the `which` argument contains the `"CorQQ"` value without `"CumFreq"`.
#### Major user-visible changes
-- <code>plot.OutputsModel()</code> can now draw PE or error time series if the <code>which</code> argument is set to <code>"all"</code> or <code>"PotEvap"</code> or <code>"Error"</code>.
-
-- <code>plot.OutputsModel()</code> now allows new values for the which argument: <code>"all"</code> corresponds to all graphs, <code>"synth"</code> corresponds to the main graphs (default value; corresponding to <code>"all"</code> in the previous versions of the package) (i.e. <code>c("Precip", "Temp", "SnowPack", "Flows", "Regime", "CumFreq", "CorQQ")</code>), <code>"ts"</code> corresponds to the time series graphs (i.e. <code>c("Precip", "PotEvap", "Temp", "SnowPack", "Flows")</code>) and "perf" corresponds to the performance graphs (i.e. <code>c("Error", "Regime", "CumFreq", "CorQQ")</code>).
+- `plot.OutputsModel()` can now draw PE or error time series if the `which` argument is set to `"all"` or `"PotEvap"` or `"Error"`.
+- `plot.OutputsModel()` now allows new values for the which argument: `"all"` corresponds to all graphs, `"synth"` corresponds to the main graphs (default value; corresponding to `"all"` in the previous versions of the package) (i.e. `c("Precip", "Temp", "SnowPack", "Flows", "Regime", "CumFreq", "CorQQ")`), `"ts"` corresponds to the time series graphs (i.e. `c("Precip", "PotEvap", "Temp", "SnowPack", "Flows")`) and "perf" corresponds to the performance graphs (i.e. `c("Error", "Regime", "CumFreq", "CorQQ")`).
#### Minor user-visible changes
-- <code>.ErrorCrit()</code> private function added to check inputs into <code>ErrorCrit_*()</code> functions. The <code>ErrorCrit_*()</code> functions were simplified accordingly.
-
-- <code>CreateInputsCrit()</code> now returns <code>FUN_CRIT</code> as a character string.
-
-- An example is addeed to illustred the use of the <code>plot.OutputsModel()</code> function.
+- `.ErrorCrit()` private function added to check inputs into `ErrorCrit_*()` functions. The `ErrorCrit_*()` functions were simplified accordingly.
+- `CreateInputsCrit()` now returns `FUN_CRIT` as a character string.
+- An example is addeed to illustred the use of the `plot.OutputsModel()` function.
____________________________________________________________________________________
@@ -133,79 +187,50 @@ ________________________________________________________________________________
#### New features
-- <code>CreateInputsCrit()</code> now presents a <code>VarObs</code> argument in order to allow to prepare an <code>InputsCrit</code> object in order to run a criterion on other variables than observed discharges with the <code>ErrorCrit()</code> function (at the moment SCA and SWE).
-
-- <code>CreateInputsCrit()</code> can now prepare an <code>InputsCrit</code> object in order to compute a single criterion (<code>Single</code> class), multiple criteria (<code>Multi</code> class) or a composite criterion (<code>Compo</code> class) with the <code>ErrorCrit()</code> function.
-
-- <code>CreateInputsCrit()</code> now presents a <code>Weights</code> argument in order to allow to prepare an <code>InputsCrit</code> object in order to compute a composite criterion (<code>Compo</code> class) with <code>ErrorCrit()</code> or <code>Calibration_Michel()</code>.
-
-- <code>CreateInputsCrit()</code> now returns a <code>idLayer</code> element to indicate which layer(s) to use for SCA or SWE aggregation.
-
-- <code>CreateInputsCrit()</code> now presents a <code>warnings</code> argument to replace the verbose action (the <code>verbose</code> argument is kept to print messages).
-
-- In <code>CreateInputsCrit()</code>, it is now possible to set the following arguments as atomic (as before) or as list: <code>FUN_CRIT</code>, <code>VarObs</code>, <code>Obs</code>, <code>BoolCrit</code>, <code>transfo</code>, <code>Weights</code>. If the list format is chosen, all the lists must have the same length.
-
-- <code>CreateRunOptions()</code>, <code>CreateIniStates()</code> and <code>CreateCalibOptions()</code> now present a <code>IsHyst</code> argument to give the possibility to use the Linear Hysteresis with CemaNeige. The objects returned present an <code>hysteresis</code> class.
-
-- <code>CreateRunOptions()</code> now presents a <code>warnings</code> argument to replace the verbose action (the <code>verbose</code> argument is kept to print messages).
-
-- Added <code>TransfoParam_CemaNeigeHyst()</code> function in order to take into account transformation of the parameters of the CemaNeige module when the Linear Hysteresis is used.
-
-- Added the <code>X0310010</code> dataset to run the examples using the Linear Hysteresis with CemaNeige (it contains necessary SCA data).
-
+- `CreateInputsCrit()` now presents a `VarObs` argument in order to allow to prepare an `InputsCrit` object in order to run a criterion on other variables than observed discharges with the `ErrorCrit()` function (at the moment SCA and SWE).
+- `CreateInputsCrit()` can now prepare an `InputsCrit` object in order to compute a single criterion (`Single` class), multiple criteria (`Multi` class) or a composite criterion (`Compo` class) with the `ErrorCrit()` function.
+- `CreateInputsCrit()` now presents a `Weights` argument in order to allow to prepare an `InputsCrit` object in order to compute a composite criterion (`Compo` class) with `ErrorCrit()` or `Calibration_Michel()`.
+- `CreateInputsCrit()` now returns a `idLayer` element to indicate which layer(s) to use for SCA or SWE aggregation.
+- `CreateInputsCrit()` now presents a `warnings` argument to replace the verbose action (the `verbose` argument is kept to print messages).
+- In `CreateInputsCrit()`, it is now possible to set the following arguments as atomic (as before) or as list: `FUN_CRIT`, `VarObs`, `Obs`, `BoolCrit`, `transfo`, `Weights`. If the list format is chosen, all the lists must have the same length.
+- `CreateRunOptions()`, `CreateIniStates()` and `CreateCalibOptions()` now present a `IsHyst` argument to give the possibility to use the Linear Hysteresis with CemaNeige. The objects returned present an `hysteresis` class.
+- `CreateRunOptions()` now presents a `warnings` argument to replace the verbose action (the `verbose` argument is kept to print messages).
+- Added `TransfoParam_CemaNeigeHyst()` function in order to take into account transformation of the parameters of the CemaNeige module when the Linear Hysteresis is used.
+- Added the `X0310010` dataset to run the examples using the Linear Hysteresis with CemaNeige (it contains necessary SCA data).
- Added the 'cemaneige_hysteresis' vignette to explain how to manage the use of the Linear Hysteresis with CemaNeige.
#### Deprecated and defunct
-- The <code>Qobs</code> argument is now deprecated in <code>CreateInputsCrit()</code> and has been renamed <code>Obs</code>.
-
-- The <code>FUN_CRIT</code> argument is now deprecated in <code>ErrorCrit()</code>. This function now gets this information from the <code>InputsCrit</code> argument.
-
-- The <code>FUN_CRIT</code> argument is now deprecated in <code>Calibration_Michel()</code>. This function now gets this information from the <code>InputsCrit</code> argument.
-
-- The <code>plot_OutputsModel()</code> had been deprecated in airGR 1.0.4 (it had been replaced by the use of <code>plot.OutputsModel()</code> or <code>plot()</code>) and is defunct now.
+- The `Qobs` argument is now deprecated in `CreateInputsCrit()` and has been renamed `Obs`.
+- The `FUN_CRIT` argument is now deprecated in `ErrorCrit()`. This function now gets this information from the `InputsCrit` argument.
+- The `FUN_CRIT` argument is now deprecated in `Calibration_Michel()`. This function now gets this information from the `InputsCrit` argument.
+- The `plot_OutputsModel()` had been deprecated in 'airGR' 1.0.4 (it had been replaced by the use of `plot.OutputsModel()` or `plot()`) and is defunct now.
#### Major user-visible changes
-- <code>CreateInputsCrit()</code> now return a list of <code>InputsCrit</code> (each element is of the <code>Single</code> class) in the cases of multiple or a composite criteria.
-
-- <code>ErrorCrit_*()</code> functions now return an error message if the <code>InputsCrit</code> object is of class <code>Multi</code> or <code>Compo</code>.
-
-- <code>ErrorCrit()</code> function can now run on a multiple or a composite <code>InputsCrit</code>. In these cases, it returns a list of <code>ErrorCrit</code>.
-
-- <code>ErrorCrit()</code> and <code>ErrorCrit_*()</code> functions can now assess Q, SCA or SWE simulations.
-
-- <code>Calibration_Michel()</code> function can now run on a composite <code>InputsCrit</code>. It returns a composite value of error and the formula used to calculate it.
-
-- Model diagrams added in documentations of <code>RunModel_GR4J()</code>, <code>RunModel_GR5J()</code> and <code>RunModel_GR6J()</code> functions.
-
-- It is now possible to be redirected to the <code>plot.OutputsModel()</code> documentation with <code>?plot</code>.
-
-- It is now possible to use a character vector for all <code>FUN_*</code> arguments (in addition to function objects) in the following functions: <code>Calibration()</code>, <code>Calibration_Michel()</code>, <code>CreateCalibOptions()</code>, <code>CreateIniStates()</code>, <code>CreateIniStates()</code>, <code>CreateInputsCrit()</code>, <code>CreateInputsModel()</code>, <code>CreateRunOptions()</code>, <code>ErrorCrit()</code>, <code>RunModel()</code> and <code>TransfoParam()</code>.
+- `CreateInputsCrit()` now return a list of `InputsCrit` (each element is of the `Single` class) in the cases of multiple or a composite criteria.
+- `ErrorCrit_*()` functions now return an error message if the `InputsCrit` object is of class `Multi` or `Compo`.
+- `ErrorCrit()` function can now run on a multiple or a composite `InputsCrit`. In these cases, it returns a list of `ErrorCrit`.
+- `ErrorCrit()` and `ErrorCrit_*()` functions can now assess Q, SCA or SWE simulations.
+- `Calibration_Michel()` function can now run on a composite `InputsCrit`. It returns a composite value of error and the formula used to calculate it.
+- Model diagrams added in documentations of `RunModel_GR4J()`, `RunModel_GR5J()` and `RunModel_GR6J()` functions.
+- It is now possible to be redirected to the `plot.OutputsModel()` documentation with `?plot`.
+- It is now possible to use a character vector for all `FUN_*` arguments (in addition to function objects) in the following functions: `Calibration()`, `Calibration_Michel()`, `CreateCalibOptions()`, `CreateIniStates()`, `CreateIniStates()`, `CreateInputsCrit()`, `CreateInputsModel()`, `CreateRunOptions()`, `ErrorCrit()`, `RunModel()` and `TransfoParam()`.
#### Minor user-visible changes
-- <code>ErrorCrit_*()</code> functions now return objects of class <code>ErrorCrit</code> and <code>NSE</code>, <code>KGE</code>, <code>KGE2</code> or <code>RMSE</code>.
-
-- <code>.FortranOutputs()</code> private function added to manage Fortran outputs.
-
-- Outputs of <code>frun_GR2M</code> Fortran subroutine were reordered.
-
-- <code>DataAltiExtrapolation_Valery()</code> now returns named elements of lists relative to elevation layer.
-
-- <code>Calibration()</code> function now returns an error message if <code>FUN_CALIB</code> is not a function.
-
-- Inputs of <code>PEdaily_Oudin()</code> are now checked.
-
-- <code>PEdaily_Oudin()</code> example corrected (the Julian day was one day too early).
-
-- <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.
-
+- `ErrorCrit_*()` functions now return objects of class `ErrorCrit` and `NSE`, `KGE`, `KGE2` or `RMSE`.
+- `.FortranOutputs()` private function added to manage Fortran outputs.
+- Outputs of `frun_GR2M` Fortran subroutine were reordered.
+- `DataAltiExtrapolation_Valery()` now returns named elements of lists relative to elevation layer.
+- `Calibration()` function now returns an error message if `FUN_CALIB` is not a function.
+- Inputs of `PEdaily_Oudin()` are now checked.
+- `PEdaily_Oudin()` example corrected (the Julian day was one day too early).
+- `plot.OutputsModel()` does not return a warning message anymore when `Qobs = NULL`.
+- Inputs of `TransfoParam*()` functions are now checked.
- The order of authors has been updated in the DESCRIPTION and the CITATION files.
@@ -221,17 +246,17 @@ ________________________________________________________________________________
#### Bug fixes
-- Fixed bug in <code>CreateRunOptions()</code>. The function now accounts correctly for leap years when no warm-up period is defined.
+- Fixed bug in `CreateRunOptions()`. The function now accounts correctly for leap years when no warm-up period is defined.
#### Minor user-visible changes
-- <code>CreateRunOptions()</code> was cleant, with no effect on its outputs.
+- `CreateRunOptions()` was cleaned up, with no effect on its outputs.
#### CRAN-compatibility updates
-- The <code>vignetteParam*.rda</code> datasets moved to the inst directory. It contains different objects needed for 'param_optim' and 'param_mcmc' vignettes.
+- The `vignetteParam*.rda` datasets moved to the inst directory. It contains different objects needed for 'param_optim' and 'param_mcmc' vignettes.
____________________________________________________________________________________
@@ -241,47 +266,37 @@ ________________________________________________________________________________
#### New features
-- <code>PEdaily_Oudin()</code> now presents a <code>LatUnit</code> argument which allows to choose the unit of the latitude (radians and degrees).
-
+- `PEdaily_Oudin()` now presents a `LatUnit` argument which allows to choose the unit of the latitude (radians and degrees).
#### Deprecated and defunct
-- The <code>LatRad</code> argument is now deprecated in <code>PEdaily_Oudin()</code> and replaced by the <code>Lat</code> argument.
-
-- The unused <code>Ind_zeroes</code> argument of the <code>CreateInputsCrit()</code> function is now deprecated.
-
+- The `LatRad` argument is now deprecated in `PEdaily_Oudin()` and replaced by the `Lat` argument.
+- The unused `Ind_zeroes` argument of the `CreateInputsCrit()` function is now deprecated.
+- The `verbose` argument is now deprecated in `CreateInputsCrit()` and replaced by the `warnings` argument.
#### Major user-visible changes
-- <code>Calibration_Michel()</code> is now faster during the grid-screening step when a parameter is set using <code>FixedParam</code> in <code>CreateCalibOptions()</code>.
-
-- <code>CreateCalibOptions()</code> now returns an error when all the parameters are set in the <code>FixedParam</code> argument and a warning message when all the parameters are free (NA) in the <code>FixedParam</code> argument.
-
-- <code>CreateInputsCrit()</code> now returns an error when <code>epsilon</code> is not positive.
-
-- <code>CreateInputsCrit()</code> now returns a warning message in the following case: there are zeroes values in <code>Qobs</code>, <code>epsilon = NULL</code> and <code>transfo = log</code> or <code>inv</code>.
-
-- <code>ErrorCrit_*()</code> functions now return a warning message in the following case: there are zeroes values in <code>Qobs</code> or <code>Qsim</code>, <code>epsilon = NULL</code> and <code>transfo = log</code> or <code>inv</code>.
+- `Calibration_Michel()` is now faster during the grid-screening step when a parameter is set using `FixedParam` in `CreateCalibOptions()`.
+- `CreateCalibOptions()` now returns an error when all the parameters are set in the `FixedParam` argument and a warning message when all the parameters are free (NA) in the `FixedParam` argument.
+- `CreateInputsCrit()` now returns an error when `epsilon` is not positive.
+- `CreateInputsCrit()` now returns a warning message in the following case: there are zeroes values in `Qobs`, `epsilon = NULL` and `transfo = log` or `inv`.
+- `ErrorCrit_*()` functions now return a warning message in the following case: there are zeroes values in `Qobs` or `Qsim`, `epsilon = NULL` and `transfo = log` or `inv`.
#### Minor user-visible changes
-- Several functions of the package were cleant or slightly modified, with no effect on their outputs.
-
+- Several functions of the package were cleaned up or slightly modified, with no effect on their outputs.
- Dubious Qls and Qmm values set to NA values between 1997-01-05 and 1997-01-21 in the L0123001 dataset.
-
- ORCID numbers are now joined to the names of the authors of the package.
#### CRAN-compatibility updates
- Function name changed in a vignettes to avoid error during the check on Debian distribution
-
-- As recomanded by CRAN managers, the NEWS file is now at the text format and is no more just a link to the airGR Website
-
-- Added the <code>Vignette_Param.</code> datasets in order to reduce runtime during the re-building of vignettes. It contains different objects needed for param_optim and param_mcmc vignettes.
+- As recomanded by CRAN managers, the NEWS file is now at the text format and is no more just a link to the 'airGR' Website
+- Added the `Vignette_Param.` datasets in order to reduce runtime during the re-building of vignettes. It contains different objects needed for param_optim and param_mcmc vignettes.
____________________________________________________________________________________
@@ -291,15 +306,13 @@ ________________________________________________________________________________
#### Bug fixes
-- Fixed bug in <code>RunModel_GR2M()</code>. The function now returns the total precipitation (P) instead of the net rainfall (P1).
+- Fixed bug in `RunModel_GR2M()`. The function now returns the total precipitation (P) instead of the net rainfall (P1).
#### Major user-visible changes
-- <code>RunModel_GR2M()</code> now returns more explicit precipitation outputs names.
-
-- <code>CreateInputsCrit()</code> now returns a warning message when the KGE (or KGE') is used with a log transformation on flows.
-
+- `RunModel_GR2M()` now returns more explicit precipitation outputs names.
+- `CreateInputsCrit()` now returns a warning message when the KGE (or KGE') is used with a log transformation on flows.
- The article reference is corrected.
@@ -315,50 +328,38 @@ ________________________________________________________________________________
#### New features
-- An article describing the 'airGR' package has been published. Its reference has been added and will be displayed with <code>citation("airGR")</code>.
-
-- Added <code>CreateIniStates()</code> function in order to help user to format the <code>IniStates</code> argument for <code>CreateRunOptions()</code>.
-
-- Added the <code>Param_Sets_GR4J</code> dataset. It contains generalist parameter sets for the GR4J model.
-
+- An article describing the 'airGR' package has been published. Its reference has been added and will be displayed with `citation("airGR")`.
+- Added `CreateIniStates()` function in order to help user to format the `IniStates` argument for `CreateRunOptions()`.
+- Added the `Param_Sets_GR4J` dataset. It contains generalist parameter sets for the GR4J model.
- Three vignettes have been added. They are relative to different calibration methods (including the generalist parameters sets of the GR4J model).
#### Deprecated and defunct
-- The <code>RunSnowModule</code> argument is now deprecated in <code>CreateRunOptions()</code>.
+- The `RunSnowModule` argument is now deprecated in `CreateRunOptions()`.
#### Bug fixes
-- Fixed bug in <code>RunModel_GR4H()</code>: in <code>frun_GR4H</code> Fortran subroutine, <code>St(2)</code> is now set to 0 (instead of <code>St(1)</code>) when <code>St(2) < 0</code>.
-
-- Fixed bug in <code>plot.OutputsModel()</code> for the regime plot when the period is less than 1 year.
-
-- Fixed bug in <code>plot.OutputsModel()</code> when there is no common data to plot the cumulative frequency or the correlation QQ.
-
-- Fixed bug in <code>plot.OutputsModel()</code> for the y-axis labelling of flows time series when <code>log_scale = TRUE</code> and <code>BasinArea</code> is used.
+- Fixed bug in `RunModel_GR4H()`: in `frun_GR4H` Fortran subroutine, `St(2)` is now set to 0 (instead of `St(1)`) when `St(2) < 0`.
+- Fixed bug in `plot.OutputsModel()` for the regime plot when the period is less than 1 year.
+- Fixed bug in `plot.OutputsModel()` when there is no common data to plot the cumulative frequency or the correlation QQ.
+- Fixed bug in `plot.OutputsModel()` for the y-axis labelling of flows time series when `log_scale = TRUE` and `BasinArea` is used.
#### Major user-visible changes
-- <code>RunModel_GR4J()</code>, <code>RunModel_GR5J()</code> and <code>RunModel_GR6J()</code> (and <code>CemaNeige_GR*J()</code>) now return Ps, Pn and actual exchanges. See the model Fortran codes for more details about the calculation of these variables.
-
-- <code>CreateInputsModel()</code> now returns an error when <code>DatesR</code> contains duplicated values.
-
-- <code>RunModel_GR5J</code> now returns <code>StateEnd</code> in the same order as the other models.
+- `RunModel_GR4J()`, `RunModel_GR5J()` and `RunModel_GR6J()` (and `CemaNeige_GR*J()`) now return Ps, Pn and actual exchanges. See the model Fortran codes for more details about the calculation of these variables.
+- `CreateInputsModel()` now returns an error when `DatesR` contains duplicated values.
+- `RunModel_GR5J` now returns `StateEnd` in the same order as the other models.
#### Minor user-visible changes
-- <code>plot.OutputsModel()</code> now returns a warning message when the length of Qobs is different from the length of Qsim.
-
-- The X1 parameter from GR4H, GR4J, GR2M, GR5J and GR6J, the X3 parameter from GR4H, GR4J, GR5J and GR6J and the X6 parameter from GR6J are now set to 1e-2 when they are fixed to lower values. <code>RunModel_*()</code> functions now return a warning message in this case. <code>RunModel_*()</code> functions now return a warning when X4 < 0.5 and its value is set to 0.5.
-
-- The commands <code>?L0123001</code>, <code>?L0123002</code> and <code>?L0123003</code> now return the documentation page related to <code>BasinObs</code>.
-
-- Many functions of the package were cleant or slightly modified, with no effect on their outputs.
-
+- `plot.OutputsModel()` now returns a warning message when the length of Qobs is different from the length of Qsim.
+- The X1 parameter from GR4H, GR4J, GR2M, GR5J and GR6J, the X3 parameter from GR4H, GR4J, GR5J and GR6J and the X6 parameter from GR6J are now set to 1e-2 when they are fixed to lower values. `RunModel_*()` functions now return a warning message in this case. `RunModel_*()` functions now return a warning when X4 < 0.5 and its value is set to 0.5.
+- The commands `?L0123001`, `?L0123002` and `?L0123003` now return the documentation page related to `BasinObs`.
+- Many functions of the package were cleaned up or slightly modified, with no effect on their outputs.
- The documentation and help of several functions were improved.
@@ -374,17 +375,17 @@ ________________________________________________________________________________
#### New features
-- <code>DataAltiExtrapolation_Valery()</code> and <code>CreateInputsModel()</code> now present a <code>PrecipScale</code> argument which allows rescaling precipitation when it is interpolated on the elevation layers when CemaNeige is used.
+- `DataAltiExtrapolation_Valery()` and `CreateInputsModel()` now present a `PrecipScale` argument which allows rescaling precipitation when it is interpolated on the elevation layers when CemaNeige is used.
#### Bug fixes
-- Fixed bug in <code>DataAltiExtrapolation_Valery()</code>. The elevation gradients for air temperature returned by <code>CreateInputsModel()</code> are improved.
+- Fixed bug in `DataAltiExtrapolation_Valery()`. The elevation gradients for air temperature returned by `CreateInputsModel()` are improved.
#### User-visible changes
-- <code>DataAltiExtrapolation_Valery()</code> has been improved. <code>DataAltiExtrapolation_Valery()</code> now runs faster (and by consequence <code>CreateInputsModel()</code> too, when CemaNeige is used).
+- `DataAltiExtrapolation_Valery()` has been improved. `DataAltiExtrapolation_Valery()` now runs faster (and by consequence `CreateInputsModel()` too, when CemaNeige is used).
____________________________________________________________________________________
@@ -394,19 +395,18 @@ ________________________________________________________________________________
#### New features
-- <code>RunModel_CemaNeige()</code>, <code>RunModel_CemaNeigeGR4J()</code>, <code>RunModel_CemaNeigeGR5J()</code> and <code>RunModel_CemaNeigeGR6J()</code> now return air temperature for each elevation layer.
+- `RunModel_CemaNeige()`, `RunModel_CemaNeigeGR4J()`, `RunModel_CemaNeigeGR5J()` and `RunModel_CemaNeigeGR6J()` now return air temperature for each elevation layer.
#### Deprecated and defunct
-- S3 plot method defined for <code>OutputsModel</code> objects. It means that the <code>plot_OutputsModel()</code> function is deprecated and his use has been replaced by the use of <code>plot.OutputsModel()</code> or <code>plot()</code>.
-
-- In <code>plot.OutputsModel()</code> the <code>PlotChoice</code> argument is deprecated and has been renamed <code>which</code>.
+- S3 plot method defined for `OutputsModel` objects. It means that the `plot_OutputsModel()` function is deprecated and his use has been replaced by the use of `plot.OutputsModel()` or `plot()`.
+- In `plot.OutputsModel()` the `PlotChoice` argument is deprecated and has been renamed `which`.
#### User-visible changes
-- <code>plot.OutputsModel()</code> displays air temperature time series for each layer when <code>CemaNeige</code> is used (argument <code>which = "Temp"</code> or <code>"all"</code>).
+- `plot.OutputsModel()` displays air temperature time series for each layer when `CemaNeige` is used (argument `which = "Temp"` or `"all"`).
____________________________________________________________________________________
@@ -416,20 +416,18 @@ ________________________________________________________________________________
#### New features
-- <code>ErrorCrit_*()</code> functions gain a <code>warnings</code> argument to replace the verbose action and the <code>verbose</code> argument now prints the criterion value(s).
+- `ErrorCrit_*()` functions gain a `warnings` argument to replace the verbose action and the `verbose` argument now prints the criterion value(s).
#### Bug fixes
-- Fixed bug in <code>CreateCalibOptions()</code> when <code>StartParamList</code> or <code>StartParamDistrib</code> arguments are used.
+- Fixed bug in `CreateCalibOptions()` when `StartParamList` or `StartParamDistrib` arguments are used.
#### User-visible changes
-- <code>CreateInputsModel()</code> now returns an error if <code>NLayers <= 0</code> when <code>CemaNeige</code> is used.
-
-- <code>plot_OutputsModel()</code> now displays raw values on the y-axis when the discharge time series is represented with log scale (formerly, log values of discharges were displayed on the y-axis).
-
+- `CreateInputsModel()` now returns an error if `NLayers <= 0` when `CemaNeige` is used.
+- `plot_OutputsModel()` now displays raw values on the y-axis when the discharge time series is represented with log scale (formerly, log values of discharges were displayed on the y-axis).
____________________________________________________________________________________
@@ -439,39 +437,35 @@ ________________________________________________________________________________
#### New features
-- <code>SeriesAggreg()</code> gains a TimeLag argument that corresponds to a numeric value indicating a time lag (in seconds) for the time series aggregation (useful to aggregate hourly time series to the daily time step for instance).
- In addition, the function now accepts input dates in both <code>POSIXt</code> formats (<code>POSIXct</code> and <code>POSIXlt</code>). The output is in <code>POSIXct</code> format.
-
-- <code>plot_OutputsModel()</code> gains a <code>log_scale</code> argument in order to plot the flow with a log scale.
-
+- `SeriesAggreg()` gains a `TimeLag` argument that corresponds to a numeric value indicating a time lag (in seconds) for the time series aggregation (useful to aggregate hourly time series to the daily time step for instance).
+ In addition, the function now accepts input dates in both `POSIXt` formats (`POSIXct` and `POSIXlt`). The output is in `POSIXct` format.
+- `plot_OutputsModel()` gains a `log_scale` argument in order to plot the flow with a log scale.
- A tutorial is available online on the following link: https://hydrogr.github.io/airGR/.
- It can also be displayed with the <code>vignette("airGR")</code> command.
-
+ It can also be displayed with the `vignette("airGR")` command.
-#### Deprecated and defunct
-- <code>CreateCalibOptions()</code> loses the OptimParam argument that was redundant with the <code>FixedParam</code> argument. The <code>Calibration_Michel()</code> was modified to take into account this change by using directly <code>FixedParam</code>, but this is transparent to the user.
+#### Deprecated and defunct
-- <code>CreateCalibOptions()</code> loses the StartParam argument that was not used.
+- `CreateCalibOptions()` loses the `OptimParam` argument that was redundant with the `FixedParam` argument. The `Calibration_Michel()` was modified to take into account this change by using directly `FixedParam`, but this is transparent to the user.
+- `CreateCalibOptions()` loses the `StartParam` argument that was not used.
#### Bug fixes
-- The value <code>sort</code> for the <code>transfo</code> argument of <code>CreateInputsCrit()</code> was not taken into account. It is now fixed.
+- The value `sort` for the `transfo` argument of `CreateInputsCrit()` was not taken into account. It is now fixed.
+
-
#### Major user-visible changes
-- The <code>RunModel_GR6J()</code> and <code>RunModel_CemaNeigeGR6J()</code> models were modified back to versions previous to 1.0.1 to prevent from unwanted efficiency criteria deterioration related to the calibration with <code>Calibration_Michel()</code>.
- The actual model codes were not modified but the <code>TransfoParam_GR6J()</code> and <code>CreateCalibOptions()</code> functions were modified regarding the X5 parameter.
- It is strongly advised to use airGR 1.0.2 for the <code>RunModel_GR6J()</code> and <code>RunModel_CemaNeigeGR6J()</code> functions if you are using <code>Calibration_Michel()</code>, as they are much more efficient.
- In case you were using your own calibration algorithm, you will not notice any difference.
+- The `RunModel_GR6J()` and `RunModel_CemaNeigeGR6J()` models were modified back to versions previous to 1.0.1 to prevent from unwanted efficiency criteria deterioration related to the calibration with `Calibration_Michel()`.
+ The actual model codes were not modified but the `TransfoParam_GR6J()` and `CreateCalibOptions()` functions were modified regarding the X5 parameter.
+ It is strongly advised to use airGR 1.0.2 for the `RunModel_GR6J()` and `RunModel_CemaNeigeGR6J()` functions if you are using `Calibration_Michel()`, as they are much more efficient.
+ In case you were using your own calibration algorithm, you will not notice any difference.
#### Minor user-visible changes
-- <code>CreateInputsModel()</code> and <code>DataAltiExtrapolation_Valery()</code> functions now allow both <code>POSIXt</code> formats (<code>POSIXct</code> and <code>POSIXlt</code>).
-
+- `CreateInputsModel()` and `DataAltiExtrapolation_Valery()` functions now allow both `POSIXt` formats (`POSIXct` and `POSIXlt`).
____________________________________________________________________________________
@@ -481,21 +475,17 @@ ________________________________________________________________________________
#### Deprecated and defunct
-- The <code>Calibration_HBAN()</code> and <code>DataAltiExtrapolation_HBAN()</code> functions have respectively been renamed as <code>Calibration_Michel()</code> and <code>DataAltiExtrapolation_Valery()</code> after the names of their creators.
-
-- The <code>Calibration_optim()</code> function has been removed from the package.
-
-- The silent mode is now defined by the <code>verbose = TRUE</code> argument (formerly <code>quiet = FALSE</code>) in the following functions:
-<code>Calibration()</code>, <code>Calibration_Michel()</code>, <code>CreateInputsModel()</code>, <code>CreateRunOptions()</code>, <code>DataAltiExtrapolation_Valery()</code>, <code>ErrorCrit()</code>, <code>ErrorCrit_KGE()</code>, <code>ErrorCrit_KGE2()</code>, <code>ErrorCrit_NSE()</code>, <code>ErrorCrit_RMSE()</code>, <code>plot_OutputsModel()</code>, <code>SeriesAggreg()</code>.
+- The `Calibration_HBAN()` and `DataAltiExtrapolation_HBAN()` functions have respectively been renamed as `Calibration_Michel()` and `DataAltiExtrapolation_Valery()` after the names of their creators.
+- The `Calibration_optim()` function has been removed from the package.
+- The silent mode is now defined by the `verbose = TRUE` argument (formerly `quiet = FALSE`) in the following functions:
+`Calibration()`, `Calibration_Michel()`, `CreateInputsModel()`, `CreateRunOptions()`, `DataAltiExtrapolation_Valery()`, `ErrorCrit()`, `ErrorCrit_KGE()`, `ErrorCrit_KGE2()`, `ErrorCrit_NSE()`, `ErrorCrit_RMSE()`, `plot_OutputsModel()`, `SeriesAggreg()`.
#### Major user-visible changes
- The GR5J model has been modified: previously, two unit hydrographs were used, now only one is remaining.
- As a consequence, simulations from the GR5J (<code>RunModel_GR5J()</code> function) and CemaNeige (<code>RunModel_CemaNeigeGR5J()</code> function) models will be different.
-
-- An important proportion of the transformations of the parameters have been modified (<code>TransfoParam_*()</code> functions). Since this modifies the local search, calibration results will be different .
-
-- The quantiles of the parameters have been recalculated with the new transformations (<code>CreateCalibOptions()</code> function). Since these quantiles constitute the starting point of the calibration algorithm, calibration results will be different.
+ As a consequence, simulations from the GR5J (`RunModel_GR5J()` function) and CemaNeige (`RunModel_CemaNeigeGR5J()` function) models will be different.
+- An important proportion of the transformations of the parameters have been modified (`TransfoParam_*()` functions). Since this modifies the local search, calibration results will be different .
+- The quantiles of the parameters have been recalculated with the new transformations (`CreateCalibOptions()` function). Since these quantiles constitute the starting point of the calibration algorithm, calibration results will be different.
#### Minor user-visible changes
@@ -503,10 +493,8 @@ ________________________________________________________________________________
- The Fortran model core codes have been modified:
- optimisation of the codes for fastening of computation;
- simplification of the internal variables for easier reading and understanding.
-
- The list of the contributors and authors is now full.
-
-- The references of the package has been updated; they are returned by the following R-command <code>citation("airGR")</code>.
+- The references of the package has been updated; they are returned by the following R-command `citation("airGR")`.
____________________________________________________________________________________
@@ -516,20 +504,18 @@ ________________________________________________________________________________
#### Bug fixes
-- Fixed bug in <code>CreateInputsModel()</code> that was related to the handling of missing values.
-
-- Fixed bug in <code>CreateRunOptions()</code> that prevented the correct use of the <code>IniResLevels</code> argument (to manually set the filling rate of the production and routing stores).
+- Fixed bug in `CreateInputsModel()` that was related to the handling of missing values.
+- Fixed bug in `CreateRunOptions()` that prevented the correct use of the `IniResLevels` argument (to manually set the filling rate of the production and routing stores).
#### Minor user-visible changes
-- Removal of an unnecessary warning when <code>IndPeriod_WarmUp = 0</code>.
+- Removal of an unnecessary warning when `IndPeriod_WarmUp = 0`.
#### CRAN-compatibility updates
-- Modification of namespace file to ensure proper use under linux whithout compilation issues.
-
+- Modification of namespace file to ensure proper use under linux without compilation issues.
____________________________________________________________________________________
@@ -539,34 +525,28 @@ ________________________________________________________________________________
#### New features
-- Three new hydrological models: <code>RunModel_GR4H() function for </code> GR4H (hourly), <code>RunModel_GR2M()</code> function for GR2M (monthly) and <code>RunModel_GR1A()</code> function for GR1A (yearly).
-
-- New function <code>SeriesAggreg()</code> to easily aggreg timesteps.
+- Three new hydrological models: `RunModel_GR4H() function for ` GR4H (hourly), `RunModel_GR2M()` function for GR2M (monthly) and `RunModel_GR1A()` function for GR1A (yearly).
+- New function `SeriesAggreg()` to easily aggreg timesteps.
#### Bug fixes
-- Fixed bug in <code>ErrorCrit_RMSE()</code> which led to incorrect calibration (the criterion was maximised instead of minimised).
+- Fixed bug in `ErrorCrit_RMSE()` which led to incorrect calibration (the criterion was maximised instead of minimised).
#### Major user-visible changes
-- Update of the functions <code>CreateRunOptions()</code>, <code>CreateCalibOptions()</code> and <code>plot_OutputsModel()</code> to handle the new models.
-
+- Update of the functions `CreateRunOptions()`, `CreateCalibOptions()` and `plot_OutputsModel()` to handle the new models.
- Modification of CemaNeige Fortran code to add an update of Gratio after the SnowPack update (no impact on snow simulation).
#### Minor user-visible changes
-- Improvement of the <code>plot_OutputsModel()</code> function to allow a selection among available plots.
-
-- Minor update in <code>ErrorCrit_KGE()</code> and <code>ErrorCrit_KGE2()</code> to handle case when only one values in not NA.
-
-- Update of the scripts in airGR-advanced-example to match the structures of the <code>BasinData</code> objects.
-
+- Improvement of the `plot_OutputsModel()` function to allow a selection among available plots.
+- Minor update in `ErrorCrit_KGE()` and `ErrorCrit_KGE2()` to handle case when only one values in not NA.
+- Update of the scripts in airGR-advanced-example to match the structures of the `BasinData` objects.
- Correction of formatting issue in airGR-advanced-example regarding the "List_HypsoData.txt" file.
-
____________________________________________________________________________________
@@ -575,49 +555,39 @@ ________________________________________________________________________________
#### New features
-- New argument in many functions (<code>quiet = TRUE</code> or <code>FALSE</code>) to choose if the warnings should be suppressed or not.
+- New argument in many functions (`quiet = TRUE` or `FALSE`) to choose if the warnings should be suppressed or not.
#### Deprecated and defunct
-- The <code>CalibrationAlgo_*()</code> functions were renamed into <code>Calibration_*()</code>.
+- The `CalibrationAlgo_*()` functions were renamed into `Calibration_*()`.
#### Bug fixes
-- Fixed bug in <code>CreateCalibOptions()</code> to handle models with only one parameter.
-
-- Fixed bug in <code>Calibration_HBAN()</code>. The function was not working properly with models having only one parameter.
+- Fixed bug in `CreateCalibOptions()` to handle models with only one parameter.
+- Fixed bug in `Calibration_HBAN()`. The function was not working properly with models having only one parameter.
#### Major user-visible changes
-- CemaNeige users must now specify one <code>MeanAnSolidPrecip</code> for each elevation layer. The <code>CreateRunOptions()</code> function is impacted.
-
-- CemaNeige users can now specify the mean elevation of the input series (before it was always considered equal to the catchment median elevation).
- The impacted functions are <code>CreateInputsModel()</code> and <code>DataAltiExtrapolation_HBAN()</code>.
-
+- CemaNeige users must now specify one `MeanAnSolidPrecip` for each elevation layer. The `CreateRunOptions()` function is impacted.
+- CemaNeige users can now specify the mean elevation of the input series (before it was always considered equal to the catchment median elevation).
+ The impacted functions are `CreateInputsModel()` and `DataAltiExtrapolation_HBAN()`.
- New architecture with better format verification procedure (using classes) and simpler setting of default configuration.
-
- New architecture where the model, calibration and error functions are in the arguments of the functions
(the exotic use of "generic function" created by the users has been removed).
-
-- Improved documentation and examples.
+- Improved documentation and examples.
#### Minor user-visible changes
- Improvements allowing the arrival of new models.
-
-- Improvements of the argument verifications in <code>CreateInputsModel()</code>, <code>CreateRunOptions()</code>, <code>CreateInputsCrit()</code>, <code>CreateCalibOptions()</code>.
-
-- Improvements of all the <code>ErrorCrit()</code> functions to better account for the cases with constant flow values or local zeros.
-
-- Improvement of the <code>plot_OutputsModel</code> function (to handle 0 in Qobs and Qsim).
-
+- Improvements of the argument verifications in `CreateInputsModel()`, `CreateRunOptions()`, `CreateInputsCrit()`, `CreateCalibOptions()`.
+- Improvements of all the `ErrorCrit()` functions to better account for the cases with constant flow values or local zeros.
+- Improvement of the `plot_OutputsModel` function (to handle 0 in Qobs and Qsim).
- Improved documentation.
-
____________________________________________________________________________________
@@ -626,49 +596,39 @@ ________________________________________________________________________________
#### New features
-- Additional functions for results plotting (the <code>{zoo}</code> package is required for some of them).
-
-- Add multi-objective calibration using <code>nsga2()</code> (the 'mco' package is required).
-
+- Additional functions for results plotting (the 'zoo' package is required for some of them).
+- Add multi-objective calibration using `nsga2()` (the 'mco' package is required).
- The field Multiplier has been added in the ErrorCrit() outputs, to indicate whether the criterion is an error (to minimise) or and efficiency (to maximise).
This allows to provide real efficiency values in the outputs e.g. NSE[Q] instead of (-1) × NSE[Q].
#### Deprecated and defunct
-- <code>EfficiencyCrit()</code> have been replaced by <code>ErrorCrit()</code> to avoid misunderstanding (by default, the algorithms minimise the error criterion).
+- `EfficiencyCrit()` have been replaced by `ErrorCrit()` to avoid misunderstanding (by default, the algorithms minimise the error criterion).
#### Bug fixes
- RC11 bug correction: the automatic selection of the warm-up period was not working properly when no data was available from warm-up (i.e. when the user had set the run to start at the very first index).
-
-- RC10 bug correction: the <code>CalibrationAlgo_HBAN()</code> function was not working in the very rare case when the diagonal search was activated and lead to a set outside the authorised range.
-
-- RC9 bug correction: the <code>CalibrationAlgo_HBAN()</code> function was not working properly with models having only one parameter.
-
-- RC8 bug correction of the <code>ModelDefaultIniOptions()</code> function (this bug was introduced in the RC7 and caused an error when <code>IndPeriod_WarmUp = NULL</code>.
-
-- RC7 bug correction of the <code>ModelDefaultIniOptions()</code> function (the automatic selection of one year for warm-up was not handling properly missing data).
-
+- RC10 bug correction: the `CalibrationAlgo_HBAN()` function was not working in the very rare case when the diagonal search was activated and lead to a set outside the authorised range.
+- RC9 bug correction: the `CalibrationAlgo_HBAN()` function was not working properly with models having only one parameter.
+- RC8 bug correction of the `ModelDefaultIniOptions()` function (this bug was introduced in the RC7 and caused an error when `IndPeriod_WarmUp = NULL`.
+- RC7 bug correction of the `ModelDefaultIniOptions()` function (the automatic selection of one year for warm-up was not handling properly missing data).
- RC6 correction of the help files (the description of CemaNeige parameters were inverted).
-
- RC5 differs from previous releases in the way the data are read and stored (in a list instead of individual vectors).
The package is similar, only the examples of Main and the files in MyScriptBlocks have changed.
- All basin data are now stored inside a list named <code>BasinData</code>. This will greatly ease the future use of Rdata files (instead of txt files) as storage format for the time series of observation.
+ All basin data are now stored inside a list named `BasinData`. This will greatly ease the future use of Rdata files (instead of txt files) as storage format for the time series of observation.
#### Major user-visible changes
-- The definition of the generic function is now made in a much simpler way (e.g. see <code>DefineFunctions_Model()</code> or <code>DefineFunctions_ErrorCrit()</code>).
+- The definition of the generic function is now made in a much simpler way (e.g. see `DefineFunctions_Model()` or `DefineFunctions_ErrorCrit()`).
#### Minor user-visible changes
- Code improvements to reduce the computation time.
-
- Clearer instructions for the adding and modification of a model.
-
- Improvements of the documentation.
@@ -680,22 +640,17 @@ ________________________________________________________________________________
#### Deprecated and defunct
-- The <code>SelectPer</code> arguments are replaced by <code>IndPeriod</code> to ease understanding.
-
-- The <code>PE</code> arguments are replaced by <code>PotEvap()</code> to ease understanding.
-
-- The <code>Fsol</code> arguments are replaced by <code>FracSolidPrecip</code> to ease understanding.
+- The `SelectPer` arguments are replaced by `IndPeriod` to ease understanding.
+- The `PE` arguments are replaced by `PotEvap()` to ease understanding.
+- The `Fsol` arguments are replaced by `FracSolidPrecip` to ease understanding.
#### Major user-visible changes
-- R 2.15 in not supported by default.
-
-- The check that <code>SelectPer_Run()</code> is continuous is now made in the <code>CheckArg()</code> functions.
-
+- R <= 2.15 in not supported by default.
+- The check that `SelectPer_Run()` is continuous is now made in the `CheckArg()` functions.
- Check of the model functioning time step.
-
-- Name of the calibration criterion provided in <code>OutputsAlgo()</code>.
+- Name of the calibration criterion provided in `OutputsAlgo()`.
#### Minor user-visible changes
@@ -711,15 +666,11 @@ ________________________________________________________________________________
#### New features
-- New <code>EfficiencyCrit_NSE_sqrtQ()</code> function to compute NSE criterion on sqrt flows.
+- New `EfficiencyCrit_NSE_sqrtQ()` function to compute NSE criterion on sqrt flows.
#### Bug fixes
-- Incorrect arguments in the call to <code>RunModelAndCrit</code> from <code>CalibrationAlgo_optim_stats</code> and <code>CalibrationAlgo_nlminb_stats</code>.
-
-- <code>CalibrationAlgo_nlminb_stats</code> argument was wrongly defined in <code>DefineFunctions_CalibrationAlgo()</code> (<code>optim</code> instead of <code>nlminb</code>).
-
-- Format checking for <code>RunOptions</code> was incorrectly made in <code>CheckArg()</code> function.
-
-
+- Incorrect arguments in the call to `RunModelAndCrit` from `CalibrationAlgo_optim_stats` and `CalibrationAlgo_nlminb_stats`.
+- `CalibrationAlgo_nlminb_stats` argument was wrongly defined in `DefineFunctions_CalibrationAlgo()` (`optim` instead of `nlminb`).
+- Format checking for `RunOptions` was incorrectly made in `CheckArg()` function.
diff --git a/R/Calibration_Michel.R b/R/Calibration_Michel.R
index 759630eaee92ea5208624b1bf7fc29d805e50973..cfa85ac63c9c52b86e691caa3f7dfa46b3e4fcba 100644
--- a/R/Calibration_Michel.R
+++ b/R/Calibration_Michel.R
@@ -1,29 +1,34 @@
-Calibration_Michel <- function(InputsModel,
- RunOptions,
- InputsCrit,
+Calibration_Michel <- function(InputsModel,
+ RunOptions,
+ InputsCrit,
CalibOptions,
- FUN_MOD,
+ FUN_MOD,
FUN_CRIT, # deprecated
- FUN_TRANSFO = NULL,
+ FUN_TRANSFO = NULL,
verbose = TRUE) {
-
-
+
+
FUN_MOD <- match.fun(FUN_MOD)
if (!missing(FUN_CRIT)) {
FUN_CRIT <- match.fun(FUN_CRIT)
}
+
+ # Handling 'FUN_TRANSFO' from direct argument or provided by 'CaliOptions'
if (!is.null(FUN_TRANSFO)) {
FUN_TRANSFO <- match.fun(FUN_TRANSFO)
+ } else if(!is.null(CalibOptions$FUN_TRANSFO)) {
+ FUN_TRANSFO <- CalibOptions$FUN_TRANSFO
+ } else {
+ stop("'FUN_TRANSFO' is not provided neither as 'FUN_TRANSFO' argument or in 'CaliOptions' argument")
}
-
-
+
##_____Arguments_check_____________________________________________________________________
if (!inherits(InputsModel, "InputsModel")) {
stop("'InputsModel' must be of class 'InputsModel'")
- }
+ }
if (!inherits(RunOptions, "RunOptions")) {
stop("'RunOptions' must be of class 'RunOptions'")
- }
+ }
if (!inherits(InputsCrit, "InputsCrit")) {
stop("'InputsCrit' must be of class 'InputsCrit'")
}
@@ -46,106 +51,15 @@ Calibration_Michel <- function(InputsModel,
}
if (!inherits(CalibOptions, "CalibOptions")) {
stop("'CalibOptions' must be of class 'CalibOptions'")
- }
+ }
if (!inherits(CalibOptions, "HBAN")) {
stop("'CalibOptions' must be of class 'HBAN' if 'Calibration_Michel' is used")
}
if (!missing(FUN_CRIT)) {
warning("argument 'FUN_CRIT' is deprecated. The error criterion function is now automatically get from the 'InputsCrit' object")
- }
-
-
- ##_check_FUN_TRANSFO
- if (is.null(FUN_TRANSFO)) {
- if (identical(FUN_MOD, RunModel_GR4H )) {
- FUN_TRANSFO <- TransfoParam_GR4H
- }
- if (identical(FUN_MOD, RunModel_GR5H )) {
- FUN_TRANSFO <- TransfoParam_GR5H
- }
- if (identical(FUN_MOD, RunModel_GR4J )) {
- FUN_TRANSFO <- TransfoParam_GR4J
- }
- if (identical(FUN_MOD, RunModel_GR5J )) {
- FUN_TRANSFO <- TransfoParam_GR5J
- }
- if (identical(FUN_MOD, RunModel_GR6J )) {
- FUN_TRANSFO <- TransfoParam_GR6J
- }
- if (identical(FUN_MOD, RunModel_GR2M )) {
- FUN_TRANSFO <- TransfoParam_GR2M
- }
- if (identical(FUN_MOD, RunModel_GR1A )) {
- FUN_TRANSFO <- TransfoParam_GR1A
- }
- if (identical(FUN_MOD, RunModel_CemaNeige )) {
- if (inherits(CalibOptions, "hysteresis")) {
- FUN_TRANSFO <- TransfoParam_CemaNeigeHyst
- } else {
- FUN_TRANSFO <- TransfoParam_CemaNeige
- }
- }
- if (identical(FUN_MOD, RunModel_CemaNeigeGR4H) | identical(FUN_MOD, RunModel_CemaNeigeGR5H) |
- identical(FUN_MOD, RunModel_CemaNeigeGR4J) | identical(FUN_MOD, RunModel_CemaNeigeGR5J) | identical(FUN_MOD, RunModel_CemaNeigeGR6J)) {
- if (identical(FUN_MOD, RunModel_CemaNeigeGR4H)) {
- FUN1 <- TransfoParam_GR4H
- }
- if (identical(FUN_MOD, RunModel_CemaNeigeGR5H)) {
- FUN1 <- TransfoParam_GR5H
- }
- if (identical(FUN_MOD, RunModel_CemaNeigeGR4J)) {
- FUN1 <- TransfoParam_GR4J
- }
- if (identical(FUN_MOD, RunModel_CemaNeigeGR5J)) {
- FUN1 <- TransfoParam_GR5J
- }
- if (identical(FUN_MOD, RunModel_CemaNeigeGR6J)) {
- FUN1 <- TransfoParam_GR6J
- }
- if (inherits(CalibOptions, "hysteresis")) {
- FUN2 <- TransfoParam_CemaNeigeHyst
- } else {
- FUN2 <- TransfoParam_CemaNeige
- }
- if (inherits(CalibOptions, "hysteresis")) {
- FUN_TRANSFO <- function(ParamIn, Direction) {
- Bool <- is.matrix(ParamIn)
- if (!Bool) {
- ParamIn <- rbind(ParamIn)
- }
- ParamOut <- NA * ParamIn
- NParam <- ncol(ParamIn)
- ParamOut[, 1:(NParam-4)] <- FUN1(ParamIn[, 1:(NParam-4)], Direction)
- ParamOut[, (NParam-3):NParam ] <- FUN2(ParamIn[, (NParam-3):NParam ], Direction)
- if (!Bool) {
- ParamOut <- ParamOut[1, ]
- }
- return(ParamOut)
- }
- } else {
- FUN_TRANSFO <- function(ParamIn, Direction) {
- Bool <- is.matrix(ParamIn)
- if (!Bool) {
- ParamIn <- rbind(ParamIn)
- }
- ParamOut <- NA * ParamIn
- NParam <- ncol(ParamIn)
- ParamOut[, 1:(NParam-2)] <- FUN1(ParamIn[, 1:(NParam-2)], Direction)
- ParamOut[, (NParam-1):NParam ] <- FUN2(ParamIn[, (NParam-1):NParam ], Direction)
- if (!Bool) {
- ParamOut <- ParamOut[1, ]
- }
- return(ParamOut)
- }
- }
-
- }
- if (is.null(FUN_TRANSFO)) {
- stop("'FUN_TRANSFO' was not found (in 'Calibration' function)")
- }
}
-
- ##_variables_initialisation
+
+ ##_variables_initialisation
ParamFinalR <- NULL
ParamFinalT <- NULL
CritFinal <- NULL
@@ -174,20 +88,20 @@ Calibration_Michel <- function(InputsModel,
CritOptim <- +1e100
##_temporary_change_of_Outputs_Sim
RunOptions$Outputs_Sim <- RunOptions$Outputs_Cal ### this reduces the size of the matrix exchange with fortran and therefore speeds the calibration
-
-
-
+
+
+
##_____Parameter_Grid_Screening____________________________________________________________
-
-
+
+
##Definition_of_the_function_creating_all_possible_parameter_sets_from_different_values_for_each_parameter
ProposeCandidatesGrid <- function(DistribParam) {
NewCandidates <- expand.grid(lapply(seq_len(ncol(DistribParamR)), function(x) DistribParam[, x]))
NewCandidates <- unique(NewCandidates) # to avoid duplicates when a parameter is set
Output <- list(NewCandidates = NewCandidates)
- }
-
-
+ }
+
+
##Creation_of_new_candidates_______________________________________________
OptimParam <- is.na(CalibOptions$FixedParam)
if (PrefilteringType == 1) {
@@ -208,7 +122,7 @@ Calibration_Michel <- function(InputsModel,
} else {
CandidatesParamR <- cbind(CandidatesParamR)
}
-
+
##Loop_to_test_the_various_candidates______________________________________
iNewOptim <- 0
Ncandidates <- nrow(CandidatesParamR)
@@ -227,12 +141,12 @@ Calibration_Michel <- function(InputsModel,
if (iNew == round(k / 10 * Ncandidates)) {
message(" ", 10 * k, "%", appendLF = FALSE)
}
- }
+ }
}
##Model_run
Param <- CandidatesParamR[iNew, ]
- OutputsModel <- FUN_MOD(InputsModel, RunOptions, Param)
-
+ OutputsModel <- RunModel(InputsModel, RunOptions, Param, FUN_MOD = FUN_MOD)
+
##Calibration_criterion_computation
OutputsCrit <- ErrorCrit(InputsCrit, OutputsModel, verbose = FALSE)
if (!is.na(OutputsCrit$CritValue)) {
@@ -251,8 +165,8 @@ Calibration_Michel <- function(InputsModel,
if (verbose & Ncandidates > 1) {
message(" 100%)\n", appendLF = FALSE)
}
-
-
+
+
##End_of_first_step_Parameter_Screening____________________________________
ParamStartR <- CandidatesParamR[iNewOptim, ]
if (!is.matrix(ParamStartR)) {
@@ -275,13 +189,13 @@ Calibration_Michel <- function(InputsModel,
HistParamR[1, ] <- ParamStartR
HistParamT[1, ] <- ParamStartT
HistCrit[1, ] <- CritStart
-
-
-
-
+
+
+
+
##_____Steepest_Descent_Local_Search_______________________________________________________
-
-
+
+
##Definition_of_the_function_creating_new_parameter_sets_through_a_step_by_step_progression_procedure
ProposeCandidatesLoc <- function(NewParamOptimT, OldParamOptimT, RangesT, OptimParam, Pace) {
##Format_checking
@@ -332,11 +246,11 @@ Calibration_Michel <- function(InputsModel,
Output$NewCandidatesT <- matrix(VECT, ncol = NParam, byrow = TRUE)
return(Output)
}
-
-
+
+
##Initialisation_of_variables
if (verbose) {
- message("Steepest-descent local search in progress")
+ message("Steepest-descent local search in progress")
}
Pace <- 0.64
PaceDiag <- rep(0, NParam)
@@ -348,18 +262,18 @@ Calibration_Michel <- function(InputsModel,
RangesT <- FUN_TRANSFO(RangesR, "RT")
NewParamOptimT <- ParamStartT
OldParamOptimT <- ParamStartT
-
-
+
+
##START_LOOP_ITER_________________________________________________________
for (ITER in 1:(100 * NParam)) {
-
-
+
+
##Exit_loop_when_Pace_becomes_too_small___________________________________
if (Pace < 0.01) {
break
}
-
-
+
+
##Creation_of_new_candidates______________________________________________
CandidatesParamT <- ProposeCandidatesLoc(NewParamOptimT, OldParamOptimT, RangesT, OptimParam, Pace)$NewCandidatesT
CandidatesParamR <- FUN_TRANSFO(CandidatesParamT, "TR")
@@ -373,16 +287,16 @@ Calibration_Michel <- function(InputsModel,
} else {
CandidatesParamR <- cbind(CandidatesParamR)
}
-
-
+
+
##Loop_to_test_the_various_candidates_____________________________________
iNewOptim <- 0
for (iNew in 1:nrow(CandidatesParamR)) {
##Model_run
Param <- CandidatesParamR[iNew, ]
- OutputsModel <- FUN_MOD(InputsModel, RunOptions, Param)
+ OutputsModel <- RunModel(InputsModel, RunOptions, Param, FUN_MOD = FUN_MOD)
##Calibration_criterion_computation
- OutputsCrit <- ErrorCrit(InputsCrit, OutputsModel, verbose = FALSE)
+ OutputsCrit <- ErrorCrit(InputsCrit, OutputsModel, verbose = FALSE)
if (!is.na(OutputsCrit$CritValue)) {
if (OutputsCrit$CritValue * OutputsCrit$Multiplier < CritOptim) {
CritOptim <- OutputsCrit$CritValue * OutputsCrit$Multiplier
@@ -391,8 +305,8 @@ Calibration_Michel <- function(InputsModel,
}
}
NRuns <- NRuns + nrow(CandidatesParamR)
-
-
+
+
##When_a_progress_has_been_achieved_______________________________________
if (iNewOptim != 0) {
##We_store_the_optimal_set
@@ -407,7 +321,7 @@ Calibration_Michel <- function(InputsModel,
##We_update_PaceDiag
VectPace <- NewParamOptimT-OldParamOptimT
for (iC in 1:NParam) {
- if (OptimParam[iC]) {
+ if (OptimParam[iC]) {
PaceDiag[iC] <- CLG * PaceDiag[iC] + (1-CLG) * VectPace[iC]
}
}
@@ -416,8 +330,8 @@ Calibration_Michel <- function(InputsModel,
Pace <- Pace / 2
Compt <- 0
}
-
-
+
+
##Test_of_an_additional_candidate_using_diagonal_progress_________________
if (ITER > 4 * NParam) {
NRuns <- NRuns + 1
@@ -441,7 +355,7 @@ Calibration_Michel <- function(InputsModel,
CandidatesParamR <- FUN_TRANSFO(CandidatesParamT, "TR")
##Model_run
Param <- CandidatesParamR[iNew, ]
- OutputsModel <- FUN_MOD(InputsModel, RunOptions, Param)
+ OutputsModel <- RunModel(InputsModel, RunOptions, Param, FUN_MOD = FUN_MOD)
##Calibration_criterion_computation
OutputsCrit <- ErrorCrit(InputsCrit, OutputsModel, verbose = FALSE)
if (OutputsCrit$CritValue * OutputsCrit$Multiplier < CritOptim) {
@@ -453,34 +367,34 @@ Calibration_Michel <- function(InputsModel,
OldParamOptimT <- NewParamOptimT
NewParamOptimT <- matrix(CandidatesParamT[iNewOptim, 1:NParam], nrow = 1)
}
-
+
}
-
-
+
+
##Results_archiving_______________________________________________________
NewParamOptimR <- FUN_TRANSFO(NewParamOptimT, "TR")
HistParamR[ITER+1, ] <- NewParamOptimR
HistParamT[ITER+1, ] <- NewParamOptimT
HistCrit[ITER+1, ] <- CritOptim
### if (verbose) { cat(paste("\t Iter ",formatC(ITER,format="d",width=3), " Crit ",formatC(CritOptim,format="f",digits=4), " Pace ",formatC(Pace,format="f",digits=4), "\n",sep=""))}
-
-
-
+
+
+
} ##END_LOOP_ITER_________________________________________________________
ITER <- ITER - 1
-
-
+
+
##Case_when_the_starting_parameter_set_remains_the_best_solution__________
- if (CritOptim == CritStart & verbose) {
+ if (CritOptim == CritStart & verbose) {
message("\t No progress achieved")
}
-
+
##End_of_Steepest_Descent_Local_Search____________________________________
ParamFinalR <- NewParamOptimR
ParamFinalT <- NewParamOptimT
CritFinal <- CritOptim
NIter <- 1 + ITER
- if (verbose) {
+ if (verbose) {
message(sprintf("\t Calibration completed (%s iterations, %s runs)", NIter, NRuns))
message("\t Param = ", paste(sprintf("%8.3f", ParamFinalR), collapse = ", "))
message(sprintf("\t Crit. %-12s = %.4f", CritName, CritFinal * Multiplier))
@@ -502,13 +416,13 @@ Calibration_Michel <- function(InputsModel,
colnames(HistParamT) <- paste0("Param", 1:NParam)
HistCrit <- cbind(HistCrit[1:NIter, ])
###colnames(HistCrit) <- paste("HistCrit")
-
+
BoolCrit_Actual <- InputsCrit$BoolCrit
BoolCrit_Actual[OutputsCrit$Ind_notcomputed] <- FALSE
MatBoolCrit <- cbind(InputsCrit$BoolCrit, BoolCrit_Actual)
colnames(MatBoolCrit) <- c("BoolCrit_Requested", "BoolCrit_Actual")
-
-
+
+
##_____Output______________________________________________________________________________
OutputsCalib <- list(ParamFinalR = as.double(ParamFinalR), CritFinal = CritFinal * Multiplier,
NIter = NIter, NRuns = NRuns,
@@ -517,8 +431,7 @@ Calibration_Michel <- function(InputsModel,
CritName = CritName, CritBestValue = CritBestValue)
class(OutputsCalib) <- c("OutputsCalib", "HBAN")
return(OutputsCalib)
-
-
-
-}
+
+
+}
diff --git a/R/CreateCalibOptions.R b/R/CreateCalibOptions.R
index 56dedd9654b67e3fb79a509274229c42e4db7446..7b64ef2167fd56cf19479abe726c9e852218b183 100644
--- a/R/CreateCalibOptions.R
+++ b/R/CreateCalibOptions.R
@@ -2,13 +2,14 @@ CreateCalibOptions <- function(FUN_MOD,
FUN_CALIB = Calibration_Michel,
FUN_TRANSFO = NULL,
IsHyst = FALSE,
+ IsSD = FALSE,
FixedParam = NULL,
SearchRanges = NULL,
StartParamList = NULL,
StartParamDistrib = NULL) {
-
+
ObjectClass <- NULL
-
+
FUN_MOD <- match.fun(FUN_MOD)
FUN_CALIB <- match.fun(FUN_CALIB)
if(!is.null(FUN_TRANSFO)) {
@@ -17,9 +18,12 @@ CreateCalibOptions <- function(FUN_MOD,
if (!is.logical(IsHyst) | length(IsHyst) != 1L) {
stop("'IsHyst' must be a logical of length 1")
}
+ if (!is.logical(IsSD) | length(IsSD) != 1L) {
+ stop("'IsSD' must be a logical of length 1")
+ }
##check_FUN_MOD
BOOL <- FALSE
-
+
if (identical(FUN_MOD, RunModel_GR4H)) {
ObjectClass <- c(ObjectClass, "GR4H")
BOOL <- TRUE
@@ -55,7 +59,7 @@ CreateCalibOptions <- function(FUN_MOD,
if (identical(FUN_MOD, RunModel_CemaNeigeGR4H)) {
ObjectClass <- c(ObjectClass, "CemaNeigeGR4H")
BOOL <- TRUE
- }
+ }
if (identical(FUN_MOD, RunModel_CemaNeigeGR5H)) {
ObjectClass <- c(ObjectClass, "CemaNeigeGR5H")
BOOL <- TRUE
@@ -75,14 +79,17 @@ CreateCalibOptions <- function(FUN_MOD,
if (IsHyst) {
ObjectClass <- c(ObjectClass, "hysteresis")
}
+ if (IsSD) {
+ ObjectClass <- c(ObjectClass, "SD")
+ }
if (!BOOL) {
stop("incorrect 'FUN_MOD' for use in 'CreateCalibOptions'")
return(NULL)
}
-
+
##check_FUN_CALIB
BOOL <- FALSE
-
+
if (identical(FUN_CALIB, Calibration_Michel)) {
ObjectClass <- c(ObjectClass, "HBAN")
BOOL <- TRUE
@@ -90,60 +97,81 @@ CreateCalibOptions <- function(FUN_MOD,
if (!BOOL) {
stop("incorrect 'FUN_CALIB' for use in 'CreateCalibOptions'")
return(NULL)
-
+
}
-
+
##check_FUN_TRANSFO
if (is.null(FUN_TRANSFO)) {
##_set_FUN1
if (identical(FUN_MOD, RunModel_GR4H) |
identical(FUN_MOD, RunModel_CemaNeigeGR4H)) {
- FUN1 <- TransfoParam_GR4H
+ FUN_GR <- TransfoParam_GR4H
}
if (identical(FUN_MOD, RunModel_GR5H) |
identical(FUN_MOD, RunModel_CemaNeigeGR5H)) {
- FUN1 <- TransfoParam_GR5H
+ FUN_GR <- TransfoParam_GR5H
}
if (identical(FUN_MOD, RunModel_GR4J) |
identical(FUN_MOD, RunModel_CemaNeigeGR4J)) {
- FUN1 <- TransfoParam_GR4J
+ FUN_GR <- TransfoParam_GR4J
}
if (identical(FUN_MOD, RunModel_GR5J) |
identical(FUN_MOD, RunModel_CemaNeigeGR5J)) {
- FUN1 <- TransfoParam_GR5J
+ FUN_GR <- TransfoParam_GR5J
}
if (identical(FUN_MOD, RunModel_GR6J) |
identical(FUN_MOD, RunModel_CemaNeigeGR6J)) {
- FUN1 <- TransfoParam_GR6J
+ FUN_GR <- TransfoParam_GR6J
}
if (identical(FUN_MOD, RunModel_GR2M)) {
- FUN1 <- TransfoParam_GR2M
+ FUN_GR <- TransfoParam_GR2M
}
if (identical(FUN_MOD, RunModel_GR1A)) {
- FUN1 <- TransfoParam_GR1A
+ FUN_GR <- TransfoParam_GR1A
}
if (identical(FUN_MOD, RunModel_CemaNeige)) {
if (IsHyst) {
- FUN1 <- TransfoParam_CemaNeigeHyst
+ FUN_GR <- TransfoParam_CemaNeigeHyst
} else {
- FUN1 <- TransfoParam_CemaNeige
+ FUN_GR <- TransfoParam_CemaNeige
}
}
- if (is.null(FUN1)) {
- stop("'FUN1' was not found")
+ if (is.null(FUN_GR)) {
+ stop("'FUN_GR' was not found")
return(NULL)
}
##_set_FUN2
if (IsHyst) {
- FUN2 <- TransfoParam_CemaNeigeHyst
+ FUN_SNOW <- TransfoParam_CemaNeigeHyst
} else {
- FUN2 <- TransfoParam_CemaNeige
- }
+ FUN_SNOW <- TransfoParam_CemaNeige
+ }
+ ##_set_FUN_LAG
+ if (IsSD) {
+ FUN_LAG <- TransfoParam_Lag
+ }
##_set_FUN_TRANSFO
if (sum(ObjectClass %in% c("GR4H", "GR5H", "GR4J", "GR5J", "GR6J", "GR2M", "GR1A", "CemaNeige")) > 0) {
- FUN_TRANSFO <- FUN1
+ if (!IsSD) {
+ FUN_TRANSFO <- FUN_GR
+ } else {
+ FUN_TRANSFO <- function(ParamIn, Direction) {
+ Bool <- is.matrix(ParamIn)
+ if (!Bool) {
+ ParamIn <- rbind(ParamIn)
+ }
+ ParamOut <- NA * ParamIn
+ NParam <- ncol(ParamIn)
+ ParamOut[, 2:NParam] <- FUN_GR(ParamIn[, 2:NParam], Direction)
+ ParamOut[, 1 ] <- FUN_LAG(as.matrix(ParamIn[, 1]), Direction)
+ if (!Bool) {
+ ParamOut <- ParamOut[1, ]
+ }
+ return(ParamOut)
+ }
+ }
} else {
- if (IsHyst) {
+ if (IsHyst & !IsSD) {
FUN_TRANSFO <- function(ParamIn, Direction) {
Bool <- is.matrix(ParamIn)
if (!Bool) {
@@ -151,14 +179,52 @@ CreateCalibOptions <- function(FUN_MOD,
}
ParamOut <- NA * ParamIn
NParam <- ncol(ParamIn)
- ParamOut[, 1:(NParam - 4)] <- FUN1(ParamIn[, 1:(NParam - 4)], Direction)
- ParamOut[, (NParam - 3):NParam] <- FUN2(ParamIn[, (NParam - 3):NParam], Direction)
+ ParamOut[, 1:(NParam - 4) ] <- FUN_GR(ParamIn[, 1:(NParam - 4) ], Direction)
+ ParamOut[, (NParam - 3):NParam] <- FUN_SNOW(ParamIn[, (NParam - 3):NParam], Direction)
if (!Bool) {
ParamOut <- ParamOut[1, ]
}
return(ParamOut)
}
- } else {
+ }
+ if (!IsHyst & !IsSD) {
+ FUN_TRANSFO <- function(ParamIn, Direction) {
+ Bool <- is.matrix(ParamIn)
+ if (!Bool) {
+ ParamIn <- rbind(ParamIn)
+ }
+ ParamOut <- NA * ParamIn
+ NParam <- ncol(ParamIn)
+ if (NParam <= 3) {
+ ParamOut[, 1:(NParam - 2)] <- FUN_GR(cbind(ParamIn[, 1:(NParam - 2)]), Direction)
+ } else {
+ ParamOut[, 1:(NParam - 2)] <- FUN_GR( ParamIn[, 1:(NParam - 2)], Direction)
+ }
+ ParamOut[, (NParam - 1):NParam] <- FUN_SNOW(ParamIn[, (NParam - 1):NParam], Direction)
+ if (!Bool) {
+ ParamOut <- ParamOut[1, ]
+ }
+ return(ParamOut)
+ }
+ }
+ if (IsHyst & IsSD) {
+ FUN_TRANSFO <- function(ParamIn, Direction) {
+ Bool <- is.matrix(ParamIn)
+ if (!Bool) {
+ ParamIn <- rbind(ParamIn)
+ }
+ ParamOut <- NA * ParamIn
+ NParam <- ncol(ParamIn)
+ ParamOut[, 2:(NParam - 4) ] <- FUN_GR( ParamIn[, 2:(NParam - 4) ], Direction)
+ ParamOut[, (NParam - 3):NParam] <- FUN_SNOW( ParamIn[, (NParam - 3):NParam], Direction)
+ ParamOut[, 1 ] <- FUN_LAG(as.matrix(ParamIn[, 1 ]), Direction)
+ if (!Bool) {
+ ParamOut <- ParamOut[1, ]
+ }
+ return(ParamOut)
+ }
+ }
+ if (!IsHyst & IsSD) {
FUN_TRANSFO <- function(ParamIn, Direction) {
Bool <- is.matrix(ParamIn)
if (!Bool) {
@@ -167,11 +233,12 @@ CreateCalibOptions <- function(FUN_MOD,
ParamOut <- NA * ParamIn
NParam <- ncol(ParamIn)
if (NParam <= 3) {
- ParamOut[, 1:(NParam - 2)] <- FUN1(cbind(ParamIn[, 1:(NParam - 2)]), Direction)
+ ParamOut[, 2:(NParam - 2)] <- FUN_GR(cbind(ParamIn[, 2:(NParam - 2)]), Direction)
} else {
- ParamOut[, 1:(NParam - 2)] <- FUN1(ParamIn[, 1:(NParam - 2)], Direction)
+ ParamOut[, 2:(NParam - 2)] <- FUN_GR( ParamIn[, 2:(NParam - 2)], Direction)
}
- ParamOut[, (NParam - 1):NParam] <- FUN2(ParamIn[, (NParam - 1):NParam], Direction)
+ ParamOut[, (NParam - 1):NParam] <- FUN_SNOW( ParamIn[, (NParam - 1):NParam], Direction)
+ ParamOut[, 1 ] <- FUN_LAG(as.matrix(ParamIn[, 1]), Direction)
if (!Bool) {
ParamOut <- ParamOut[1, ]
}
@@ -184,7 +251,7 @@ CreateCalibOptions <- function(FUN_MOD,
stop("'FUN_TRANSFO' was not found")
return(NULL)
}
-
+
##NParam
if ("GR4H" %in% ObjectClass) {
NParam <- 4
@@ -212,10 +279,10 @@ CreateCalibOptions <- function(FUN_MOD,
}
if ("CemaNeigeGR4H" %in% ObjectClass) {
NParam <- 6
- }
+ }
if ("CemaNeigeGR5H" %in% ObjectClass) {
NParam <- 7
- }
+ }
if ("CemaNeigeGR4J" %in% ObjectClass) {
NParam <- 6
}
@@ -228,7 +295,10 @@ CreateCalibOptions <- function(FUN_MOD,
if (IsHyst) {
NParam <- NParam + 2
}
-
+ if (IsSD) {
+ NParam <- NParam + 1
+ }
+
##check_FixedParam
if (is.null(FixedParam)) {
FixedParam <- rep(NA, NParam)
@@ -246,13 +316,13 @@ CreateCalibOptions <- function(FUN_MOD,
warning("You have not set any parameter in 'FixedParam'")
}
}
-
+
##check_SearchRanges
if (is.null(SearchRanges)) {
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 {
if (!is.matrix(SearchRanges)) {
stop("'SearchRanges' must be a matrix")
@@ -270,34 +340,34 @@ CreateCalibOptions <- function(FUN_MOD,
stop("Incompatibility between 'SearchRanges' ncol and 'FUN_MOD'")
}
}
-
+
##check_StartParamList_and_StartParamDistrib__default_values
if (("HBAN" %in% ObjectClass & is.null(StartParamList) & is.null(StartParamDistrib))) {
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 = 4, byrow = TRUE)
+ +6.01, -0.50, +5.14, -8.87), ncol = 4, byrow = TRUE)
}
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,
+5.51, -0.61, +3.74, -8.51,
- +6.07, -0.02, +4.42, -8.06), ncol = 4, 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 = 5, byrow = TRUE)
-
+
}
if ("GR6J" %in% ObjectClass) {
ParamT <- matrix(c(+3.60, -1.00, +3.30, -9.10, -0.90, +3.00,
@@ -314,8 +384,8 @@ CreateCalibOptions <- function(FUN_MOD,
-0.38,
+1.39), ncol = 1, byrow = TRUE)
}
-
-
+
+
if ("CemaNeige" %in% ObjectClass) {
ParamT <- matrix(c(-9.96, +6.63,
-9.14, +6.90,
@@ -325,16 +395,16 @@ CreateCalibOptions <- function(FUN_MOD,
ParamT <- matrix(c(+5.12, -1.18, +4.34, -9.69, -9.96, +6.63,
+5.58, -0.85, +4.74, -9.47, -9.14, +6.90,
+6.01, -0.50, +5.14, -8.87, +4.10, +7.21), ncol = 6, byrow = TRUE)
- }
+ }
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,
@@ -351,19 +421,25 @@ CreateCalibOptions <- function(FUN_MOD,
+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 (IsHyst) {
ParamTHyst <- matrix(c(-7.00, -7.00,
-0.00, -0.00,
+7.00, +7.00), ncol = 2, byrow = TRUE)
ParamT <- cbind(ParamT, ParamTHyst)
}
-
+ if (IsSD) {
+ ParamTSD <- matrix(c(+1.25,
+ +2.50,
+ +5.00), ncol = 1, byrow = TRUE)
+ ParamT <- cbind(ParamTSD, ParamT)
+ }
+
StartParamList <- NULL
StartParamDistrib <- TransfoParam(ParamIn = ParamT, Direction = "TR", FUN_TRANSFO = FUN_TRANSFO)
-
+
}
-
+
##check_StartParamList_and_StartParamDistrib__format
if ("HBAN" %in% ObjectClass & !is.null(StartParamList)) {
if (!is.matrix(StartParamList)) {
@@ -393,11 +469,11 @@ CreateCalibOptions <- function(FUN_MOD,
stop("Incompatibility between 'StartParamDistrib' ncol and 'FUN_MOD'")
}
}
-
-
+
+
##Create_CalibOptions
- CalibOptions <- list(FixedParam = FixedParam, SearchRanges = SearchRanges)
-
+ CalibOptions <- list(FixedParam = FixedParam, SearchRanges = SearchRanges, FUN_TRANSFO = FUN_TRANSFO)
+
if (!is.null(StartParamList)) {
CalibOptions <- c(CalibOptions, list(StartParamList = StartParamList))
}
@@ -405,7 +481,7 @@ CreateCalibOptions <- function(FUN_MOD,
CalibOptions <- c(CalibOptions, list(StartParamDistrib = StartParamDistrib))
}
class(CalibOptions) <- c("CalibOptions", ObjectClass)
-
+
return(CalibOptions)
-
+
}
diff --git a/R/CreateIniStates.R b/R/CreateIniStates.R
index d3a6c9481cf7bbe77cecb536fbe7d1345154980b..6b311d414f2e3f5fd486056b5ace76e0b605c724 100644
--- a/R/CreateIniStates.R
+++ b/R/CreateIniStates.R
@@ -3,17 +3,18 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = F
UH1 = NULL, UH2 = NULL,
GCemaNeigeLayers = NULL, eTGCemaNeigeLayers = NULL,
GthrCemaNeigeLayers = NULL, GlocmaxCemaNeigeLayers = NULL,
+ SD = NULL,
verbose = TRUE) {
-
-
+
+
ObjectClass <- NULL
-
+
UH1n <- 20L
UH2n <- UH1n * 2L
-
+
nameFUN_MOD <- as.character(substitute(FUN_MOD))
FUN_MOD <- match.fun(FUN_MOD)
-
+
## check FUN_MOD
BOOL <- FALSE
if (identical(FUN_MOD, RunModel_GR4H) | identical(FUN_MOD, RunModel_GR5H)) {
@@ -56,7 +57,7 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = F
if (!(identical(FUN_MOD, RunModel_GR5H) | identical(FUN_MOD, RunModel_CemaNeigeGR5H)) & IsIntStore) {
stop("'IsIntStore' cannot be TRUE if GR5H is not used in 'FUN_MOD'")
}
-
+
## check InputsModel
if (!inherits(InputsModel, "InputsModel")) {
stop("'InputsModel' must be of class 'InputsModel'")
@@ -68,13 +69,13 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = F
!inherits(InputsModel, "CemaNeige")) {
stop("'InputsModel' must be of class 'CemaNeige'")
}
-
-
+
+
## check states
if (any(eTGCemaNeigeLayers > 0)) {
stop("Positive values are not allowed for 'eTGCemaNeigeLayers'")
- }
-
+ }
+
if (identical(FUN_MOD, RunModel_GR6J) | identical(FUN_MOD, RunModel_CemaNeigeGR6J)) {
if (is.null(ExpStore)) {
stop("'RunModel_*GR6J' need an 'ExpStore' value")
@@ -85,7 +86,7 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = F
}
ExpStore <- Inf
}
-
+
if (identical(FUN_MOD, RunModel_GR2M)) {
if (!is.null(UH1)) {
if (verbose) {
@@ -100,20 +101,20 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = F
UH2 <- rep(Inf, UH2n)
}
}
-
+
if ((identical(FUN_MOD, RunModel_GR5J) | identical(FUN_MOD, RunModel_CemaNeigeGR5J)) & !is.null(UH1)) {
if (verbose) {
warning(sprintf("'%s' does not require 'UH1'. Values set to NA", nameFUN_MOD))
}
UH1 <- rep(Inf, UH1n)
- }
+ }
if ((!identical(FUN_MOD, RunModel_GR5H) | identical(FUN_MOD, RunModel_CemaNeigeGR5H)) & !is.null(IntStore)) {
if (verbose) {
warning(sprintf("'%s' does not require 'IntStore'. Values set to NA", nameFUN_MOD))
}
IntStore <- Inf
}
-
+
if ("CemaNeige" %in% ObjectClass & ! "GR" %in% ObjectClass) {
if (!is.null(ProdStore)) {
if (verbose) {
@@ -170,7 +171,7 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = F
warning(sprintf("'%s' does not require 'GthrCemaNeigeLayers' and 'GlocmaxCemaNeigeLayers'. Values set to NA", nameFUN_MOD))
}
GthrCemaNeigeLayers <- Inf
- GlocmaxCemaNeigeLayers <- Inf
+ GlocmaxCemaNeigeLayers <- Inf
}
if(!"CemaNeige" %in% ObjectClass &
(!is.null(GCemaNeigeLayers) | !is.null(eTGCemaNeigeLayers) | !is.null(GthrCemaNeigeLayers) | !is.null(GlocmaxCemaNeigeLayers))) {
@@ -180,24 +181,24 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = F
GCemaNeigeLayers <- Inf
eTGCemaNeigeLayers <- Inf
GthrCemaNeigeLayers <- Inf
- GlocmaxCemaNeigeLayers <- Inf
+ GlocmaxCemaNeigeLayers <- Inf
}
-
-
+
+
## set states
if("CemaNeige" %in% ObjectClass) {
NLayers <- length(InputsModel$LayerPrecip)
} else {
NLayers <- 1
}
-
-
+
+
## manage NULL values
if (is.null(ExpStore)) {
- ExpStore <- Inf
+ ExpStore <- Inf
}
if (is.null(IntStore)) {
- IntStore <- Inf
+ IntStore <- Inf
}
if (is.null(UH1)) {
if ("hourly" %in% ObjectClass) {
@@ -232,16 +233,16 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = F
}
if (any(is.infinite(GlocmaxCemaNeigeLayers))) {
GlocmaxCemaNeigeLayers <- rep(Inf, NLayers)
- }
-
+ }
+
# check negative values
if (any(ProdStore < 0) | any(RoutStore < 0) | any(IntStore < 0) |
any(UH1 < 0) | any(UH2 < 0) |
any(GCemaNeigeLayers < 0)) {
stop("Negative values are not allowed for any of 'ProdStore', 'RoutStore', 'IntStore', 'UH1', 'UH2', 'GCemaNeigeLayers'")
}
-
-
+
+
## check length
if (!is.numeric(ProdStore) || length(ProdStore) != 1L) {
stop("'ProdStore' must be numeric of length one")
@@ -281,7 +282,23 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = F
stop(sprintf("'eTGCemaNeigeLayers' must be numeric of length %i", NLayers))
}
}
-
+
+ # SD model state handling
+ if(!is.null(SD)) {
+ if(!inherits(InputsModel, "SD")) {
+ stop("'SD' argument provided and 'InputsModel' is not of class 'SD'")
+ }
+ if(!is.list(SD)) {
+ stop("'SD' argument must be a list")
+ }
+ lapply(SD, function(x) {
+ if(!is.numeric(x)) stop("Each item of 'SD' list argument must be numeric")
+ })
+ if(length(SD) != length(InputsModel$LengthHydro)) {
+ stop("Number of items of 'SD' list argument must be the same as the number of upstream connections",
+ sprintf(" (%i required, found %i)", length(InputsModel$LengthHydro), length(SD)))
+ }
+ }
## format output
IniStates <- list(Store = list(Prod = ProdStore, Rout = RoutStore, Exp = ExpStore, Int = IntStore),
@@ -291,7 +308,11 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = F
IniStatesNA <- unlist(IniStates)
IniStatesNA[is.infinite(IniStatesNA)] <- NA
IniStatesNA <- relist(IniStatesNA, skeleton = IniStates)
-
+
+ if(!is.null(SD)) {
+ IniStatesNA$SD <- SD
+ }
+
class(IniStatesNA) <- c("IniStates", ObjectClass)
if(IsHyst) {
class(IniStatesNA) <- c(class(IniStatesNA), "hysteresis")
@@ -299,8 +320,8 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = F
if(IsIntStore) {
class(IniStatesNA) <- c(class(IniStatesNA), "interception")
}
-
+
return(IniStatesNA)
-
-
+
+
}
diff --git a/R/CreateInputsCrit.R b/R/CreateInputsCrit.R
index 4f314eae9f231d01bc4bfc71119740f19fd7e557..56e1732b03f3781842908774c2c21a2d7ab25ad2 100644
--- a/R/CreateInputsCrit.R
+++ b/R/CreateInputsCrit.R
@@ -10,14 +10,14 @@ CreateInputsCrit <- function(FUN_CRIT,
Ind_zeroes = NULL, # deprecated
epsilon = NULL,
warnings = TRUE,
- verbose = TRUE) {
-
-
+ verbose = TRUE) { # deprecated
+
+
ObjectClass <- NULL
-
-
+
+
## ---------- check arguments
-
+
if (!missing(Qobs)) {
if (missing(Obs)) {
if (warnings) {
@@ -35,18 +35,18 @@ CreateInputsCrit <- function(FUN_CRIT,
if (!missing(verbose)) {
warning("deprecated 'verbose' argument. Use 'warnings', instead")
}
-
-
+
+
## check 'InputsModel'
if (!inherits(InputsModel, "InputsModel")) {
stop("'InputsModel' must be of class 'InputsModel'")
}
-
-
+
+
## length of index of period to be used for the model run
LLL <- length(InputsModel$DatesR[RunOptions$IndPeriod_Run])
-
-
+
+
## check 'Obs' and definition of idLayer
vecObs <- unlist(Obs)
if (length(vecObs) %% LLL != 0 | !is.numeric(vecObs)) {
@@ -65,8 +65,8 @@ CreateInputsCrit <- function(FUN_CRIT,
})
Obs <- lapply(Obs, function(x) rowMeans(as.data.frame(x)))
}
-
-
+
+
## create list of arguments
listArgs <- list(FUN_CRIT = FUN_CRIT,
Obs = Obs,
@@ -76,8 +76,8 @@ CreateInputsCrit <- function(FUN_CRIT,
transfo = as.character(transfo),
Weights = Weights,
epsilon = epsilon)
-
-
+
+
## check lists lengths
for (iArgs in names(listArgs)) {
if (iArgs %in% c("Weights", "BoolCrit", "epsilon")) {
@@ -92,11 +92,11 @@ CreateInputsCrit <- function(FUN_CRIT,
listArgs[[iArgs]] <- list(listArgs[[iArgs]])
}
}
-
+
## check 'FUN_CRIT'
listArgs$FUN_CRIT <- lapply(listArgs$FUN_CRIT, FUN = match.fun)
-
-
+
+
## check 'VarObs'
if (missing(VarObs)) {
listArgs$VarObs <- as.list(rep("Q", times = length(listArgs$Obs)))
@@ -104,8 +104,8 @@ CreateInputsCrit <- function(FUN_CRIT,
# warning("'VarObs' automatically set to \"Q\"")
# }
}
-
-
+
+
## check 'VarObs' + 'RunOptions'
if ("Q" %in% VarObs & !inherits(RunOptions, "GR")) {
stop("'VarObs' cannot contain Q if a GR rainfall-runoff model is not used")
@@ -119,40 +119,40 @@ CreateInputsCrit <- function(FUN_CRIT,
if ("SWE" %in% VarObs & inherits(RunOptions, "CemaNeige") & !"SnowPack" %in% RunOptions$Outputs_Sim) {
stop("'SnowPack' is missing in 'Outputs_Sim' of 'RunOptions', which is necessary to output SWE with CemaNeige")
}
-
-
+
+
## check 'transfo'
if (missing(transfo)) {
listArgs$transfo <- as.list(rep("", times = length(listArgs$Obs)))
# if (warnings) {
# warning("'transfo' automatically set to \"\"")
# }
- }
-
+ }
+
## check length of each args
if (length(unique(sapply(listArgs, FUN = length))) != 1) {
stopListArgs <- paste(sapply(names(listArgs), shQuote), collapse = ", ")
stop(sprintf("arguments %s must have the same length", stopListArgs))
}
-
-
+
+
## check 'RunOptions'
if (!inherits(RunOptions , "RunOptions")) {
stop("'RunOptions' must be of class 'RunOptions'")
}
-
-
+
+
## check 'Weights'
if (length(listArgs$Weights) > 1 & sum(unlist(listArgs$Weights)) == 0 & !any(sapply(listArgs$Weights, is.null))) {
stop("sum of 'Weights' cannot be equal to zero")
}
-
-
+
+
## ---------- reformat
-
+
## reformat list of arguments
listArgs2 <- lapply(seq_along(listArgs$FUN_CRIT), function(i) lapply(listArgs, "[[", i))
-
+
## preparation of warning messages
inVarObs <- c("Q", "SCA", "SWE")
msgVarObs <- "'VarObs' must be a (list of) character vector(s) and one of %s"
@@ -160,12 +160,12 @@ CreateInputsCrit <- function(FUN_CRIT,
inTransfo <- c("", "sqrt", "log", "inv", "sort", "boxcox") # pow is not checked by inTransfo, but appears in the warning message and checkef after (see ## check 'transfo')
msgTransfo <- "'transfo' must be a (list of) character vector(s) and one of %s, or numeric value for power transformation"
msgTransfo <- sprintf(msgTransfo, paste(sapply(inTransfo, shQuote), collapse = ", "))
-
-
+
+
## ---------- loop on the list of inputs
-
+
InputsCrit <- lapply(listArgs2, function(iListArgs2) {
-
+
## check 'FUN_CRIT'
if (!(identical(iListArgs2$FUN_CRIT, ErrorCrit_NSE ) | identical(iListArgs2$FUN_CRIT, ErrorCrit_KGE ) |
identical(iListArgs2$FUN_CRIT, ErrorCrit_KGE2) | identical(iListArgs2$FUN_CRIT, ErrorCrit_RMSE))) {
@@ -174,12 +174,12 @@ CreateInputsCrit <- function(FUN_CRIT,
if (identical(iListArgs2$FUN_CRIT, ErrorCrit_RMSE) & length(listArgs$Weights) > 1 & all(!is.null(unlist(listArgs$Weights)))) {
stop("calculating a composite criterion with the RMSE is not allowed since RMSE is not a dimensionless metric", call. = FALSE)
}
-
+
## check 'Obs'
if (!is.vector(iListArgs2$Obs) | length(iListArgs2$Obs) != LLL | !is.numeric(iListArgs2$Obs)) {
stop(sprintf("'Obs' must be a (list of) vector(s) of numeric values of length %i", LLL), call. = FALSE)
}
-
+
## check 'BoolCrit'
if (is.null(iListArgs2$BoolCrit)) {
iListArgs2$BoolCrit <- rep(TRUE, length(iListArgs2$Obs))
@@ -190,12 +190,12 @@ CreateInputsCrit <- function(FUN_CRIT,
if (length(iListArgs2$BoolCrit) != LLL) {
stop("'BoolCrit' and the period defined in 'RunOptions' must have the same length", call. = FALSE)
}
-
+
## check 'VarObs'
if (!is.vector(iListArgs2$VarObs) | length(iListArgs2$VarObs) != 1 | !is.character(iListArgs2$VarObs) | !all(iListArgs2$VarObs %in% inVarObs)) {
stop(msgVarObs, call. = FALSE)
}
-
+
## check 'VarObs' + 'Obs'
if (any(iListArgs2$VarObs %in% "SCA")) {
idSCA <- which(iListArgs2$VarObs == "SCA")
@@ -207,7 +207,7 @@ CreateInputsCrit <- function(FUN_CRIT,
if (min(vecSCA, na.rm = TRUE) < 0 | max(vecSCA, na.rm = TRUE) > 1) {
stop("'Obs' outside [0,1] for \"SCA\"", call. = FALSE)
}
- }
+ }
inPosVarObs <- c("Q", "SWE")
if (any(iListArgs2$VarObs %in% inPosVarObs)) {
idQSS <- which(iListArgs2$VarObs %in% inPosVarObs)
@@ -223,8 +223,8 @@ CreateInputsCrit <- function(FUN_CRIT,
stop(sprintf("'Obs' outside [0,Inf[ for \"%s\"", iListArgs2$VarObs), call. = FALSE)
}
}
-
-
+
+
## check 'transfo'
if (is.null(iListArgs2$transfo) | !is.vector(iListArgs2$transfo) | length(iListArgs2$transfo) != 1 | !is.character(iListArgs2$transfo)) {
stop(msgTransfo, call. = FALSE)
@@ -239,14 +239,14 @@ CreateInputsCrit <- function(FUN_CRIT,
}
iListArgs2$transfo <- paste0("^", iListArgs2$transfo)
}
-
+
## check 'Weights'
if (!is.null(iListArgs2$Weights)) {
if (!is.vector(iListArgs2$Weights) | length(iListArgs2$Weights) != 1 | !is.numeric(iListArgs2$Weights) | any(iListArgs2$Weights < 0)) {
stop("'Weights' must be a single (list of) positive or equal to zero value(s)", call. = FALSE)
}
}
-
+
## check 'epsilon'
if (!is.null(iListArgs2$epsilon)) {
if (!is.vector(iListArgs2$epsilon) | length(iListArgs2$epsilon) != 1 | !is.numeric(iListArgs2$epsilon) | any(iListArgs2$epsilon <= 0)) {
@@ -255,7 +255,7 @@ CreateInputsCrit <- function(FUN_CRIT,
} else if (iListArgs2$transfo %in% c("log", "inv") & any(iListArgs2$Obs %in% 0) & warnings) {
warning("zeroes detected in Obs: the corresponding time-steps will be excluded by the 'ErrorCrit*' functions as the epsilon argument was set to NULL", call. = FALSE)
}
-
+
## check 'transfo' + 'FUN_CRIT'
if (iListArgs2$transfo == "log" & warnings) {
warn_log_kge <- "we do not advise using the %s with a log transformation on Obs (see the details section in the 'CreateInputsCrit' help)"
@@ -266,7 +266,7 @@ CreateInputsCrit <- function(FUN_CRIT,
warning(sprintf(warn_log_kge, "KGE'"), call. = FALSE)
}
}
-
+
## Create InputsCrit
iInputsCrit <- list(FUN_CRIT = iListArgs2$FUN_CRIT,
@@ -279,17 +279,17 @@ CreateInputsCrit <- function(FUN_CRIT,
Weights = iListArgs2$Weights)
class(iInputsCrit) <- c("Single", "InputsCrit", ObjectClass)
return(iInputsCrit)
-
+
})
names(InputsCrit) <- paste0("IC", seq_along(InputsCrit))
-
+
## define FUN_CRIT as a characater string
listErrorCrit <- c("ErrorCrit_KGE", "ErrorCrit_KGE2", "ErrorCrit_NSE", "ErrorCrit_RMSE")
InputsCrit <- lapply(InputsCrit, function(i) {
i$FUN_CRIT <- listErrorCrit[sapply(listErrorCrit, function(j) identical(i$FUN_CRIT, get(j)))]
i
})
-
+
listVarObs <- sapply(InputsCrit, FUN = "[[", "VarObs")
inCnVarObs <- c("SCA", "SWE")
if (!"ZLayers" %in% names(InputsModel)) {
@@ -311,7 +311,7 @@ CreateInputsCrit <- function(FUN_CRIT,
}
}
}
-
+
## define idLayer as an index of the layer to use
for (iInCnVarObs in unique(listVarObs)) {
if (iInCnVarObs == "Q") {
@@ -330,8 +330,8 @@ CreateInputsCrit <- function(FUN_CRIT,
}
}
}
-
-
+
+
## if only one criterion --> not a list of InputsCrit but directly an InputsCrit
if (length(InputsCrit) < 2) {
InputsCrit <- InputsCrit[[1L]]
@@ -353,7 +353,7 @@ CreateInputsCrit <- function(FUN_CRIT,
}
})
}
-
+
return(InputsCrit)
-
+
}
diff --git a/R/CreateInputsModel.R b/R/CreateInputsModel.R
index 510ea517d40e075b206f1af096ec9ae24fc23829..6fefda3fffb27b90dc7c23c947de8d7f26c85769 100644
--- a/R/CreateInputsModel.R
+++ b/R/CreateInputsModel.R
@@ -4,72 +4,73 @@ CreateInputsModel <- function(FUN_MOD,
PotEvap = NULL,
TempMean = NULL, TempMin = NULL, TempMax = NULL,
ZInputs = NULL, HypsoData = NULL, NLayers = 5,
+ Qupstream = NULL, LengthHydro = NULL, BasinAreas = NULL,
verbose = TRUE) {
-
-
+
+
ObjectClass <- NULL
-
+
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")
-
+
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")
-
+
TimeStep <- as.integer(24 * 60 * 60)
-
+
BOOL <- TRUE
}
if (identical(FUN_MOD, RunModel_GR2M)) {
ObjectClass <- c(ObjectClass, "GR", "monthly")
-
+
TimeStep <- as.integer(c(28, 29, 30, 31) * 24 * 60 * 60)
-
+
BOOL <- TRUE
}
if (identical(FUN_MOD, RunModel_GR1A)) {
ObjectClass <- c(ObjectClass, "GR", "yearly")
-
+
TimeStep <- as.integer(c(365, 366) * 24 * 60 * 60)
-
+
BOOL <- TRUE
}
if (identical(FUN_MOD, RunModel_CemaNeige)) {
ObjectClass <- c(ObjectClass, "daily", "CemaNeige")
-
+
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")
-
+
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")
-
+
TimeStep <- as.integer(60 * 60)
-
+
BOOL <- TRUE
}
if (!BOOL) {
stop("incorrect 'FUN_MOD' for use in 'CreateInputsModel'")
}
-
+
##check_arguments
if ("GR" %in% ObjectClass | "CemaNeige" %in% ObjectClass) {
if (is.null(DatesR)) {
@@ -166,7 +167,7 @@ CreateInputsModel <- function(FUN_MOD,
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)))) {
@@ -182,11 +183,40 @@ CreateInputsModel <- function(FUN_MOD,
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))
-
+
if ("GR" %in% ObjectClass) {
BOOL_NA_TMP <- (Precip < 0) | is.na(Precip)
if (sum(BOOL_NA_TMP) != 0) {
@@ -238,9 +268,9 @@ CreateInputsModel <- function(FUN_MOD,
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")
}
@@ -256,18 +286,18 @@ CreateInputsModel <- function(FUN_MOD,
TempMax <- TempMax[Select]
}
}
-
+
DatesR <- DatesR[Select]
-
+
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)
}
}
-
-
+
+
##DataAltiExtrapolation_Valery
if ("CemaNeige" %in% ObjectClass) {
RESULT <- DataAltiExtrapolation_Valery(DatesR = DatesR,
@@ -283,8 +313,8 @@ CreateInputsModel <- function(FUN_MOD,
}
}
}
-
-
+
+
##Create_InputsModel
InputsModel <- list(DatesR = DatesR)
if ("GR" %in% ObjectClass) {
@@ -296,11 +326,16 @@ CreateInputsModel <- function(FUN_MOD,
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/CreateRunOptions.R b/R/CreateRunOptions.R
index 7ec1ec6e01b10a1daa0696cbf33897ed7587c44f..d7acd32963b782bc09d6807ade8e3c016e4622f0 100644
--- a/R/CreateRunOptions.R
+++ b/R/CreateRunOptions.R
@@ -1,13 +1,10 @@
-CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndPeriod_Run,
+CreateRunOptions <- function(FUN_MOD, InputsModel,
+ IndPeriod_WarmUp = NULL, IndPeriod_Run,
IniStates = NULL, IniResLevels = NULL, Imax = NULL,
Outputs_Cal = NULL, Outputs_Sim = "all",
- RunSnowModule, MeanAnSolidPrecip = NULL,
- IsHyst = FALSE,
+ MeanAnSolidPrecip = NULL, IsHyst = FALSE,
warnings = TRUE, verbose = TRUE) {
- if (!missing(RunSnowModule)) {
- warning("deprecated 'RunSnowModule' argument: please adapt 'FUN_MOD' instead.", call. = FALSE)
- }
if (!is.null(Imax)) {
if (!is.numeric(Imax) | length(Imax) != 1L) {
stop("'Imax' must be a non negative 'numeric' value of length 1")
diff --git a/R/ErrorCrit.R b/R/ErrorCrit.R
index 28e9368ab21237b371452d32d5c24533e1f4e230..e6ef4b4ef3f858c286e68cb680fb23ac191646fb 100644
--- a/R/ErrorCrit.R
+++ b/R/ErrorCrit.R
@@ -1,22 +1,22 @@
ErrorCrit <- function(InputsCrit, OutputsModel, FUN_CRIT, warnings = TRUE, verbose = TRUE) {
-
-
+
+
## ---------- Arguments check
-
+
if (!inherits(InputsCrit, "InputsCrit")) {
stop("InputsCrit must be of class 'InputsCrit'")
- }
+ }
if (!inherits(OutputsModel, "OutputsModel")) {
stop("OutputsModel must be of class 'OutputsModel'")
- }
+ }
if (!missing(FUN_CRIT)) {
warning("deprecated 'FUN_CRIT' argument. The error criterion function is now automatically get from the 'InputsCrit' object", call. = FALSE)
}
-
-
-
+
+
+
## ---------- Criterion computation
-
+
## ----- Single criterion
if (inherits(InputsCrit, "Single")) {
FUN_CRIT <- match.fun(InputsCrit$FUN_CRIT)
@@ -25,10 +25,10 @@ ErrorCrit <- function(InputsCrit, OutputsModel, FUN_CRIT, warnings = TRUE, verbo
warnings = warnings,
verbose = verbose)
}
-
-
+
+
## ----- Multiple criteria or Composite criterion
-
+
if (inherits(InputsCrit, "Multi") | inherits(InputsCrit, "Compo")) {
listOutputsCrit <- lapply(InputsCrit, FUN = function(iInputsCrit) {
FUN_CRIT <- match.fun(iInputsCrit$FUN_CRIT)
@@ -37,12 +37,12 @@ ErrorCrit <- function(InputsCrit, OutputsModel, FUN_CRIT, warnings = TRUE, verbo
warnings = warnings,
verbose = verbose)
})
-
+
listValCrit <- sapply(listOutputsCrit, function(x) x[["CritValue"]])
listNameCrit <- sapply(listOutputsCrit, function(x) x[["CritName"]])
listweights <- unlist(lapply(InputsCrit, function(x) x[["Weights"]]))
- listweights <- listweights / sum(listweights)
-
+ listweights <- listweights / sum(listweights)
+
if (inherits(InputsCrit, "Compo")) {
CritValue <- sum(listValCrit * listweights)
OutputsCritCompo <- list(MultiCritValues = listValCrit,
@@ -61,7 +61,7 @@ ErrorCrit <- function(InputsCrit, OutputsModel, FUN_CRIT, warnings = TRUE, verbo
message("Crit. Composite = ", sprintf("%.4f", CritValue))
msgForm <- paste(sprintf("%.2f", listweights), listNameCrit, sep = " * ", collapse = ", ")
msgForm <- unlist(strsplit(msgForm, split = ","))
- msgFormSep <- rep(c(",", ",", ",\n\t\t "), times = ceiling(length(msgForm)/3))[1: length(msgForm)]
+ msgFormSep <- rep(c(",", ",", ",\n\t\t "), times = ceiling(length(msgForm)/3))[1:length(msgForm)]
msgForm <- paste(msgForm, msgFormSep, sep = "", collapse = "")
msgForm <- gsub("\\,\\\n\\\t\\\t $|\\,$", "", msgForm)
message("\tFormula: sum(", msgForm, ")\n")
@@ -70,10 +70,10 @@ ErrorCrit <- function(InputsCrit, OutputsModel, FUN_CRIT, warnings = TRUE, verbo
OutputsCrit <- listOutputsCrit
class(OutputsCrit) <- c("Multi", "ErrorCrit")
}
-
+
}
-
+
return(OutputsCrit)
-
+
}
diff --git a/R/Imax.R b/R/Imax.R
index 41768866b7190655b8910de34ec7e7b3c2a4b670..3c6058f1b1c4945ee734b2a50a185c5ae3d9f8c5 100644
--- a/R/Imax.R
+++ b/R/Imax.R
@@ -32,7 +32,7 @@ Imax <- function(InputsModel,
TabSeries <- data.frame(DatesR = InputsModel$DatesR[IndPeriod_Run],
Precip = InputsModel$Precip[IndPeriod_Run],
PotEvap = InputsModel$PotEvap[IndPeriod_Run])
- daily_data <- SeriesAggreg(TabSeries, "hourly", "daily",
+ daily_data <- SeriesAggreg(TabSeries, Format = "%Y%m%d",
ConvertFun = c("sum", "sum"))
##calculate total interception of daily GR models on the period
diff --git a/R/PE_Oudin.R b/R/PE_Oudin.R
index 9814dc7fa45891dedf331f2e8a0f8c5ae178f7dc..2ce49b334736ff8ab69e7ac6823be62d7b4f3684 100644
--- a/R/PE_Oudin.R
+++ b/R/PE_Oudin.R
@@ -1,16 +1,11 @@
PE_Oudin <- function(JD, Temp,
Lat, LatUnit = c("rad", "deg"),
- TimeStepIn = "daily", TimeStepOut = "daily") {
-
-
+ TimeStepIn = "daily", TimeStepOut = "daily",
+ RunFortran = FALSE) {
+
+
## ---------- check arguments
-
- # if (!missing(LatRad)) {
- # warning("Deprecated 'LatRad' argument. Please, use 'Lat' instead.")
- # if (missing(Lat)) {
- # Lat <- LatRad
- # }
- # }
+
if (!(inherits(JD, "numeric") | inherits(JD, "integer"))) {
stop("'JD' must be of class 'numeric'")
}
@@ -18,19 +13,20 @@ PE_Oudin <- function(JD, Temp,
stop("'Temp' must be of class 'numeric'")
}
if (length(JD) != length(Temp)) {
- stop("'Temp' and 'LatUnit' must have the same length")
+ stop("'JD' and 'Temp' must have the same length")
}
- if (!any(LatUnit %in% c("rad", "deg"))) {
- stop("'LatUnit' must be one of \"rad\" or \"deg\"")
- }
- if (!inherits(Lat, "numeric") | length(Lat) != 1) {
+ if (!RunFortran & (!inherits(Lat, "numeric") | length(Lat) != 1)) {
stop("'Lat' must be a 'numeric' of length one")
}
- if (LatUnit[1L] == "rad" & ((Lat >= pi/2) | (Lat <= -pi/2))) {
+ if (RunFortran & (!inherits(Lat, "numeric") | (!length(Lat) %in% c(1, length(Temp))))) {
+ stop("'Lat' must be a 'numeric' of length one or of the same length as 'Temp'")
+ }
+ LatUnit <- match.arg(LatUnit, choices = c("rad", "deg"))
+ if (LatUnit[1L] == "rad" & (all(Lat >= pi/2) | all(Lat <= -pi/2))) {
stop("'Lat' must be comprised between -pi/2 and +pi/2 degrees")
}
- if (LatUnit[1L] == "deg" & ((Lat >= 90) | (Lat <= -90))) {
- stop("'Lat' must be comprised between -90 and +90 degrees")
+ if (LatUnit[1L] == "deg" & (all(Lat >= 90) | all(Lat <= -90))) {
+ stop("'Lat' must be comprised between -90 and +90 degrees")
}
if (LatUnit[1L] == "rad") {
FI <- Lat
@@ -41,18 +37,9 @@ PE_Oudin <- function(JD, Temp,
if (any(JD < 0) | any(JD > 366)) {
stop("'JD' must only contain integers from 1 to 366")
}
- if (!inherits(TimeStepIn, "character") | length(TimeStepIn) != 1) {
- stop("'TimeStepIn' must be a 'character' of length one")
- }
- if (!inherits(TimeStepOut, "character") | length(TimeStepOut) != 1) {
- stop("'TimeStepIn' must be a 'character' of length one")
- }
- if (!(TimeStepIn %in% c("daily", "hourly"))) {
- stop("'TimeStepIn' must be one of \"daily\" or \"hourly\"")
- }
- if (!(TimeStepOut %in% c("daily", "hourly"))) {
- stop("'TimeStepOut' must be one of \"daily\" or \"hourly\"")
- }
+ TimeStep <- c("daily", "hourly")
+ TimeStepIn <- match.arg(TimeStepIn , choices = TimeStep)
+ TimeStepOut <- match.arg(TimeStepOut, choices = TimeStep)
rleJD <- rle(JD)
if (TimeStepIn == "daily" & any(rleJD$lengths != 1)) {
stop("each day must have only one identical value of julian days")
@@ -60,71 +47,92 @@ PE_Oudin <- function(JD, Temp,
if (TimeStepIn == "hourly" & any(rleJD$lengths != 24)) {
stop("each day must have 24 identical values of julian days (one for each hour)")
}
-
-
+
+
## ---------- hourly inputs aggregation
-
+
if (TimeStepIn == "hourly") {
JD <- rleJD$values
idJD <- rep(seq_along(JD), each = rleJD$lengths[1L])
Temp <- as.vector(tapply(X = Temp, INDEX = idJD, FUN = mean))
}
-
-
+
+
## ---------- Oudin's formula
-
- PE_Oudin_D <- rep(NA, length(Temp))
- COSFI <- cos(FI)
- AFI <- abs(FI / 42)
-
- for (k in seq_along(Temp)) {
-
- TETA <- 0.4093 * sin(JD[k] / 58.1 - 1.405)
- COSTETA <- cos(TETA)
- COSGZ <- max(0.001, cos(FI - TETA))
- GZ <- acos(COSGZ)
- COSOM <- 1 - COSGZ / COSFI / COSTETA
-
- if (COSOM < -1) {
- COSOM <- -1
- }
- if (COSOM > 1) {
- COSOM <- 1
- }
-
- COSOM2 <- COSOM * COSOM
-
- if (COSOM2 >= 1) {
- SINOM <- 0
- } else {
- SINOM <- sqrt(1 - COSOM2)
+
+ if (RunFortran) {
+
+ LInputs = as.integer(length(Temp))
+
+ if (length(FI) == 1) {
+ FI <- rep(FI, LInputs)
}
-
- OM <- acos(COSOM)
- COSPZ <- COSGZ + COSFI * COSTETA * (SINOM/OM - 1)
-
- if (COSPZ < 0.001) {
- COSPZ <- 0.001
- }
-
- ETA <- 1 + cos(JD[k] / 58.1) / 30
- GE <- 446 * OM * COSPZ * ETA
-
- 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
+
+ RESULTS <- .Fortran("frun_pe_oudin", PACKAGE = "airGR",
+ ##inputs
+ LInputs = LInputs,
+ InputsLAT = as.double(FI),
+ InputsTT = as.double(Temp),
+ InputsJJ = as.double(JD),
+ ##outputs
+ PE_Oudin_D = rep(as.double(-999.999), LInputs)
+ )
+ PE_Oudin_D = RESULTS$PE_Oudin_D
+
+ } else {
+
+ PE_Oudin_D <- rep(NA, length(Temp))
+ COSFI <- cos(FI)
+
+ for (k in seq_along(Temp)) {
+
+ TETA <- 0.4093 * sin(JD[k] / 58.1 - 1.405)
+ COSTETA <- cos(TETA)
+ COSGZ <- max(0.001, cos(FI - TETA))
+ GZ <- acos(COSGZ)
+ COSOM <- 1 - COSGZ / COSFI / COSTETA
+
+ if (COSOM < -1) {
+ COSOM <- -1
+ }
+ if (COSOM > 1) {
+ COSOM <- 1
+ }
+
+ COSOM2 <- COSOM * COSOM
+
+ if (COSOM2 >= 1) {
+ SINOM <- 0
+ } else {
+ SINOM <- sqrt(1 - COSOM2)
+ }
+
+ OM <- acos(COSOM)
+ COSPZ <- COSGZ + COSFI * COSTETA * (SINOM/OM - 1)
+
+ if (COSPZ < 0.001) {
+ COSPZ <- 0.001
+ }
+
+ ETA <- 1 + cos(JD[k] / 58.1) / 30
+ GE <- 446 * OM * COSPZ * ETA
+
+ if (is.na(Temp[k])) {
+ PE_Oudin_D[k] <- NA
} 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
+ }
}
+
}
-
+
}
-
-
+
## ---------- disaggregate PE from daily to hourly
-
+
if (TimeStepOut == "hourly") {
parab_D2H <- c(0.000, 0.000, 0.000, 0.000, 0.000, 0.000,
0.035, 0.062, 0.079, 0.097, 0.110, 0.117,
@@ -132,10 +140,10 @@ PE_Oudin <- function(JD, Temp,
0.000, 0.000, 0.000, 0.000, 0.000, 0.000)
PE_Oudin_H <- rep(PE_Oudin_D, each = 24) * rep(parab_D2H, times = length(PE_Oudin_D))
}
-
-
+
+
## ---------- outputs warnings
-
+
if (any(is.na(Temp))) {
if (any(is.na(PE_Oudin_D))) {
warning("'Temp' time series, and therefore the returned 'PE' time series, contain missing value(s)")
@@ -146,12 +154,12 @@ PE_Oudin <- function(JD, Temp,
if (!any(is.na(Temp)) & any(is.na(PE_Oudin_D))) {
warning("returned 'PE' time series contains missing value(s)")
}
-
+
if (TimeStepOut == "daily") {
PE_Oudin <- PE_Oudin_D
} else {
PE_Oudin <- PE_Oudin_H
}
return(PE_Oudin)
-
+
}
diff --git a/R/PEdaily_Oudin.R b/R/PEdaily_Oudin.R
index b71ac99926c6d2725c2ef712575d2cee14a69cb9..3eee9283489c7d66f89f676f81f255c5b640cf4c 100644
--- a/R/PEdaily_Oudin.R
+++ b/R/PEdaily_Oudin.R
@@ -1,15 +1,19 @@
-PEdaily_Oudin <- function(JD, Temp, LatRad, Lat, LatUnit = c("rad", "deg")) {
-
+PEdaily_Oudin <- function(JD,
+ Temp,
+ LatRad, # deprecated
+ Lat,
+ LatUnit = c("rad", "deg")) {
+
## ---------- deprecated function
-
+
.Deprecated(new = "PEdaily_Oudin", package = NULL,
-
+
msg = "deprecated function\nplease, use PE_Oudin() instead",
-
+
old = as.character(sys.call(sys.parent()))[1L])
-
+
## ---------- check arguments
-
+
if (!missing(LatRad)) {
warning("Deprecated \"LatRad\" argument. Please, use \"Lat\" instead.")
if (missing(Lat)) {
@@ -46,47 +50,47 @@ PEdaily_Oudin <- function(JD, Temp, LatRad, Lat, LatUnit = c("rad", "deg")) {
if (any(JD < 0) | any(JD > 366)) {
stop("'JD' must only contain integers from 1 to 366")
}
-
-
+
+
## ---------- Oudin's formula
-
+
PE_Oudin_D <- rep(NA, length(Temp))
COSFI <- cos(FI)
- AFI <- abs(FI / 42)
-
+ AFI <- abs(FI / 42)
+
for (k in seq_along(Temp)) {
-
+
TETA <- 0.4093 * sin(JD[k] / 58.1 - 1.405)
COSTETA <- cos(TETA)
COSGZ <- max(0.001, cos(FI - TETA))
GZ <- acos(COSGZ)
COSOM <- 1 - COSGZ / COSFI / COSTETA
-
+
if (COSOM < -1) {
COSOM <- -1
}
if (COSOM > 1) {
COSOM <- 1
}
-
+
COSOM2 <- COSOM * COSOM
-
+
if (COSOM2 >= 1) {
SINOM <- 0
} else {
SINOM <- sqrt(1 - COSOM2)
}
-
+
OM <- acos(COSOM)
COSPZ <- COSGZ + COSFI * COSTETA * (SINOM/OM - 1)
-
+
if (COSPZ < 0.001) {
COSPZ <- 0.001
}
-
+
ETA <- 1 + cos(JD[k] / 58.1) / 30
GE <- 446 * OM * COSPZ * ETA
-
+
if (is.na(Temp[k])) {
PE_Oudin_D[k] <- NA
} else {
@@ -96,9 +100,9 @@ PEdaily_Oudin <- function(JD, Temp, LatRad, Lat, LatUnit = c("rad", "deg")) {
PE_Oudin_D[k] <- 0
}
}
-
+
}
-
+
if (any(is.na(Temp))) {
if (any(is.na(PE_Oudin_D))) {
warning("'Temp' time series, and therefore the returned 'PE' time series, contain missing value(s)")
@@ -109,7 +113,7 @@ PEdaily_Oudin <- function(JD, Temp, LatRad, Lat, LatUnit = c("rad", "deg")) {
if (!any(is.na(Temp)) & any(is.na(PE_Oudin_D))) {
warning("returned 'PE' time series contains missing value(s)")
}
-
+
return(PE_Oudin_D)
-
+
}
diff --git a/R/RunModel.R b/R/RunModel.R
index c8ef3f53687aad7f96accf43e0f679200b86c028..a123e366705dd0de3b2cba80d5a3c70eef49e85e 100644
--- a/R/RunModel.R
+++ b/R/RunModel.R
@@ -2,6 +2,20 @@ RunModel <- function(InputsModel, RunOptions, Param, FUN_MOD) {
FUN_MOD <- match.fun(FUN_MOD)
- return(FUN_MOD(InputsModel = InputsModel, RunOptions = RunOptions, Param = Param))
+ if (inherits(InputsModel, "SD")) {
+ # LAG Model take one parameter at the beginning of the vector
+ iFirstParamRunOffModel <- 2
+ } else {
+ # All parameters
+ iFirstParamRunOffModel <- 1
+ }
-}
+ OutputsModel <- FUN_MOD(InputsModel = InputsModel, RunOptions = RunOptions,
+ Param = Param[iFirstParamRunOffModel:length(Param)])
+
+ if (inherits(InputsModel, "SD")) {
+ InputsModel$OutputsModel <- OutputsModel
+ OutputsModel <- RunModel_Lag(InputsModel, RunOptions, Param[1])
+ }
+ return(OutputsModel)
+}
\ No newline at end of file
diff --git a/R/RunModel_CemaNeige.R b/R/RunModel_CemaNeige.R
index e1dbbf659969732b8fbeca38246e7db2d8aa8bf2..a9f35e0e189465dd24e23bb0b4904216e98b6766 100644
--- a/R/RunModel_CemaNeige.R
+++ b/R/RunModel_CemaNeige.R
@@ -8,7 +8,7 @@ RunModel_CemaNeige <- function(InputsModel, RunOptions, Param) {
FortranOutputsCemaNeige <- .FortranOutputs(GR = NULL, isCN = TRUE)$CN
- ## Arguments_check
+ ## Arguments check
if (!inherits(InputsModel, "InputsModel")) {
stop("'InputsModel' must be of class 'InputsModel'")
}
@@ -39,7 +39,7 @@ RunModel_CemaNeige <- function(InputsModel, RunOptions, Param) {
time_mult <- 24
}
- ## Input_data_preparation
+ ## Input data preparation
if (identical(RunOptions$IndPeriod_WarmUp, as.integer(0))) {
RunOptions$IndPeriod_WarmUp <- NULL
}
@@ -52,7 +52,7 @@ RunModel_CemaNeige <- function(InputsModel, RunOptions, Param) {
- ## SNOW_MODULE________________________________________________________________________________
+ ## CemaNeige________________________________________________________________________________
ParamCemaNeige <- Param
NLayers <- length(InputsModel$LayerPrecip)
@@ -71,7 +71,7 @@ RunModel_CemaNeige <- function(InputsModel, RunOptions, Param) {
NameCemaNeigeLayers <- "CemaNeigeLayers"
- ## Call_DLL_CemaNeige_________________________
+ ## Call CemaNeige Fortran_________________________
for (iLayer in 1:NLayers) {
if (!IsHyst) {
@@ -105,7 +105,7 @@ RunModel_CemaNeige <- function(InputsModel, RunOptions, Param) {
- ## Data_storage
+ ## Data storage
CemaNeigeLayers[[iLayer]] <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i])
names(CemaNeigeLayers[[iLayer]]) <- FortranOutputsCemaNeige[IndOutputsCemaNeige]
if (ExportStateEnd) {
@@ -113,7 +113,7 @@ RunModel_CemaNeige <- function(InputsModel, RunOptions, Param) {
}
rm(RESULTS)
- } ### ENDFOR_iLayer
+ } ### ENDFOR iLayer
names(CemaNeigeLayers) <- sprintf("Layer%02i", seq_len(NLayers))
@@ -129,7 +129,7 @@ RunModel_CemaNeige <- function(InputsModel, RunOptions, Param) {
verbose = FALSE)
}
- ## Output_data_preparation
+ ## Output data preparation
if (!ExportDatesR & !ExportStateEnd) {
OutputsModel <- list(CemaNeigeLayers)
names(OutputsModel) <- NameCemaNeigeLayers
diff --git a/R/RunModel_CemaNeigeGR4H.R b/R/RunModel_CemaNeigeGR4H.R
index 7aecbaf11c5f7e0e7b701069f7f618ca5119a4a1..fe29e9096e863e14283b54635006c341d13ab9dd 100644
--- a/R/RunModel_CemaNeigeGR4H.R
+++ b/R/RunModel_CemaNeigeGR4H.R
@@ -1,5 +1,5 @@
-RunModel_CemaNeigeGR4H <- function(InputsModel,RunOptions,Param){
-
+RunModel_CemaNeigeGR4H <- function(InputsModel, RunOptions, Param) {
+
## Initialization of variables
IsHyst <- inherits(RunOptions, "hysteresis")
@@ -7,177 +7,221 @@ RunModel_CemaNeigeGR4H <- function(InputsModel,RunOptions,Param){
NParamCN <- NParam - 4L
NStates <- 4L
FortranOutputs <- .FortranOutputs(GR = "GR4H", isCN = TRUE)
-
+
+
+ ## Arguments check
+ if (!inherits(InputsModel, "InputsModel")) {
+ stop("'InputsModel' must be of class 'InputsModel'")
+ }
+ if (!inherits(InputsModel, "hourly")) {
+ stop("'InputsModel' must be of class 'hourly'")
+ }
+ if (!inherits(InputsModel, "GR")) {
+ stop("'InputsModel' must be of class 'GR'")
+ }
+ if (!inherits(InputsModel, "CemaNeige")) {
+ stop("'InputsModel' must be of class 'CemaNeige'")
+ }
+ if (!inherits(RunOptions, "RunOptions")) {
+ stop("'RunOptions' must be of class 'RunOptions'")
+ }
+ if (!inherits(RunOptions, "GR")) {
+ stop("'RunOptions' must be of class 'GR'")
+ }
+ if (!inherits(RunOptions, "CemaNeige")) {
+ stop("'RunOptions' must be of class 'CemaNeige'")
+ }
+ if (!is.vector(Param) | !is.numeric(Param)) {
+ stop("'Param' must be a numeric vector")
+ }
+ if (sum(!is.na(Param)) != NParam) {
+ stop(paste("'Param' must be a vector of length", NParam, "and contain no NA"))
+ }
+ Param <- as.double(Param)
+
+
+ Param_X1X3_threshold <- 1e-2
+ Param_X4_threshold <- 0.5
+ if (Param[1L] < Param_X1X3_threshold) {
+ warning(sprintf("Param[1] (X1: production store capacity [mm]) < %.2f\n X1 set to %.2f", Param_X1X3_threshold, Param_X1X3_threshold))
+ Param[1L] <- Param_X1X3_threshold
+ }
+ if (Param[3L] < Param_X1X3_threshold) {
+ warning(sprintf("Param[3] (X3: routing store capacity [mm]) < %.2f\n X3 set to %.2f", Param_X1X3_threshold, Param_X1X3_threshold))
+ Param[3L] <- Param_X1X3_threshold
+ }
+ if (Param[4L] < Param_X4_threshold) {
+ warning(sprintf("Param[4] (X4: unit hydrograph time constant [hour]) < %.2f\n X4 set to %.2f", Param_X4_threshold, Param_X4_threshold))
+ Param[4L] <- Param_X4_threshold
+ }
+
+ ## Input data preparation
+ if (identical(RunOptions$IndPeriod_WarmUp, 0L)) {
+ RunOptions$IndPeriod_WarmUp <- NULL
+ }
+ IndPeriod1 <- c(RunOptions$IndPeriod_WarmUp, RunOptions$IndPeriod_Run)
+ LInputSeries <- as.integer(length(IndPeriod1))
+ IndPeriod2 <- (length(RunOptions$IndPeriod_WarmUp) + 1):LInputSeries
+ ParamCemaNeige <- Param[(length(Param)-1 - 2 * as.integer(IsHyst)):length(Param)]
+ NParamMod <- as.integer(length(Param) - (2 + 2 * as.integer(IsHyst)))
+ ParamMod <- Param[1:NParamMod]
+ NLayers <- length(InputsModel$LayerPrecip)
+ NStatesMod <- as.integer(length(RunOptions$IniStates) - NStates * NLayers)
+ ExportDatesR <- "DatesR" %in% RunOptions$Outputs_Sim
+ ExportStateEnd <- "StateEnd" %in% RunOptions$Outputs_Sim
+
+
+ ## CemaNeige________________________________________________________________________________
+ if (inherits(RunOptions, "CemaNeige")) {
+ if ("all" %in% RunOptions$Outputs_Sim) {
+ IndOutputsCemaNeige <- as.integer(1:length(FortranOutputs$CN))
+ } else {
+ IndOutputsCemaNeige <- which(FortranOutputs$CN %in% RunOptions$Outputs_Sim)
+ }
+ CemaNeigeLayers <- list()
+ CemaNeigeStateEnd <- NULL
+ NameCemaNeigeLayers <- "CemaNeigeLayers"
- ##Arguments_check
- if(!inherits(InputsModel,"InputsModel")){ stop("'InputsModel' must be of class 'InputsModel'") }
- if(!inherits(InputsModel,"hourly" )){ stop("'InputsModel' must be of class 'hourly' ") }
- if(!inherits(InputsModel,"GR" )){ stop("'InputsModel' must be of class 'GR' ") }
- if(!inherits(InputsModel,"CemaNeige" )){ stop("'InputsModel' must be of class 'CemaNeige' ") }
- if(!inherits(RunOptions,"RunOptions" )){ stop("'RunOptions' must be of class 'RunOptions' ") }
- if(!inherits(RunOptions,"GR" )){ stop("'RunOptions' must be of class 'GR' ") }
- if(!inherits(RunOptions,"CemaNeige" )){ stop("'RunOptions' must be of class 'CemaNeige' ") }
- if(!is.vector(Param) | !is.numeric(Param)){ stop("'Param' must be a numeric vector") }
- if(sum(!is.na(Param))!=NParam){ stop(paste("'Param' must be a vector of length ",NParam," and contain no NA",sep="")) }
- Param <- as.double(Param);
-
- Param_X1X3_threshold <- 1e-2
- Param_X4_threshold <- 0.5
- if (Param[1L] < Param_X1X3_threshold) {
- warning(sprintf("Param[1] (X1: production store capacity [mm]) < %.2f\n X1 set to %.2f", Param_X1X3_threshold, Param_X1X3_threshold))
- Param[1L] <- Param_X1X3_threshold
- }
- if (Param[3L] < Param_X1X3_threshold) {
- warning(sprintf("Param[3] (X3: routing store capacity [mm]) < %.2f\n X3 set to %.2f", Param_X1X3_threshold, Param_X1X3_threshold))
- Param[3L] <- Param_X1X3_threshold
- }
- if (Param[4L] < Param_X4_threshold) {
- warning(sprintf("Param[4] (X4: unit hydrograph time constant [hour]) < %.2f\n X4 set to %.2f", Param_X4_threshold, Param_X4_threshold))
- Param[4L] <- Param_X4_threshold
- }
+
+ ## Call CemaNeige Fortran_________________________
+ for (iLayer in 1:NLayers) {
- ##Input_data_preparation
- if(identical(RunOptions$IndPeriod_WarmUp,as.integer(0))){ RunOptions$IndPeriod_WarmUp <- NULL; }
- IndPeriod1 <- c(RunOptions$IndPeriod_WarmUp,RunOptions$IndPeriod_Run);
- LInputSeries <- as.integer(length(IndPeriod1))
- IndPeriod2 <- (length(RunOptions$IndPeriod_WarmUp)+1):LInputSeries;
- ParamCemaNeige <- Param[(length(Param)-1-2*as.integer(IsHyst)):length(Param)];
- NParamMod <- as.integer(length(Param)-(2+2*as.integer(IsHyst)));
- ParamMod <- Param[1:NParamMod];
- NLayers <- length(InputsModel$LayerPrecip);
- NStatesMod <- as.integer(length(RunOptions$IniStates)-NStates*NLayers);
- ExportDatesR <- "DatesR" %in% RunOptions$Outputs_Sim;
- ExportStateEnd <- "StateEnd" %in% RunOptions$Outputs_Sim;
-
+ if (!IsHyst) {
+ StateStartCemaNeige <- RunOptions$IniStates[(7 + 20*24 + 40*24) + c(iLayer, iLayer+NLayers)]
+ } else {
+ StateStartCemaNeige <- RunOptions$IniStates[(7 + 20*24 + 40*24) + c(iLayer, iLayer+NLayers, iLayer+2*NLayers, iLayer+3*NLayers)]
+ }
+ RESULTS <- .Fortran("frun_cemaneige", PACKAGE = "airGR",
+ ## inputs
+ LInputs = LInputSeries, ### length of input and output series
+ InputsPrecip = InputsModel$LayerPrecip[[iLayer]][IndPeriod1], ### input series of total precipitation [mm/h]
+ InputsFracSolidPrecip = InputsModel$LayerFracSolidPrecip[[iLayer]][IndPeriod1], ### input series of fraction of solid precipitation [0-1]
+ InputsTemp = InputsModel$LayerTemp[[iLayer]][IndPeriod1], ### input series of air mean temperature [degC]
+ MeanAnSolidPrecip = RunOptions$MeanAnSolidPrecip[iLayer], ### value of annual mean solid precip [mm/y]
+ NParam = as.integer(NParamCN), ### number of model parameters = 2 or 4
+ Param = as.double(ParamCemaNeige), ### parameter set
+ NStates = as.integer(NStates), ### number of state variables used for model initialisation = 4
+ StateStart = StateStartCemaNeige, ### state variables used when the model run starts
+ IsHyst = as.integer(IsHyst), ### use of hysteresis
+ NOutputs = as.integer(length(IndOutputsCemaNeige)), ### number of output series
+ IndOutputs = IndOutputsCemaNeige, ### indices of output series
+ ## outputs
+ Outputs = matrix(as.double(-999.999), nrow = LInputSeries, ncol = length(IndOutputsCemaNeige)), ### output series [mm]
+ StateEnd = rep(as.double(-999.999), as.integer(NStates)) ### state variables at the end of the model run
+ )
+ RESULTS$Outputs[ round(RESULTS$Outputs , 3) == -999.999] <- NA
+ RESULTS$StateEnd[round(RESULTS$StateEnd, 3) == -999.999] <- NA
- ##SNOW_MODULE________________________________________________________________________________##
- if(inherits(RunOptions,"CemaNeige")){
- if("all" %in% RunOptions$Outputs_Sim){ IndOutputsCemaNeige <- as.integer(1:length(FortranOutputs$CN));
- } else { IndOutputsCemaNeige <- which(FortranOutputs$CN %in% RunOptions$Outputs_Sim); }
- CemaNeigeLayers <- list(); CemaNeigeStateEnd <- NULL; NameCemaNeigeLayers <- "CemaNeigeLayers";
-
-
- ##Call_DLL_CemaNeige_________________________
- for(iLayer in 1:NLayers){
- if (!IsHyst) {
- StateStartCemaNeige <- RunOptions$IniStates[(7 + 20*24 + 40*24) + c(iLayer, iLayer+NLayers)]
- } else {
- StateStartCemaNeige <- RunOptions$IniStates[(7 + 20*24 + 40*24) + c(iLayer, iLayer+NLayers, iLayer+2*NLayers, iLayer+3*NLayers)]
- }
- RESULTS <- .Fortran("frun_cemaneige",PACKAGE="airGR",
- ##inputs
- LInputs=LInputSeries, ### length of input and output series
- InputsPrecip=InputsModel$LayerPrecip[[iLayer]][IndPeriod1], ### input series of total precipitation [mm/h]
- InputsFracSolidPrecip=InputsModel$LayerFracSolidPrecip[[iLayer]][IndPeriod1], ### input series of fraction of solid precipitation [0-1]
- InputsTemp=InputsModel$LayerTemp[[iLayer]][IndPeriod1], ### input series of air mean temperature [degC]
- MeanAnSolidPrecip=RunOptions$MeanAnSolidPrecip[iLayer], ### value of annual mean solid precip [mm/y]
- NParam=as.integer(NParamCN), ### number of model parameters = 2 or 4
- Param=as.double(ParamCemaNeige), ### parameter set
- NStates=as.integer(NStates), ### number of state variables used for model initialisation = 4
- StateStart=StateStartCemaNeige, ### state variables used when the model run starts
- IsHyst = as.integer(IsHyst), ### use of hysteresis
- NOutputs=as.integer(length(IndOutputsCemaNeige)), ### number of output series
- IndOutputs=IndOutputsCemaNeige, ### indices of output series
- ##outputs
- Outputs=matrix(as.double(-999.999),nrow=LInputSeries,ncol=length(IndOutputsCemaNeige)), ### output series [mm]
- StateEnd=rep(as.double(-999.999),as.integer(NStates)) ### state variables at the end of the model run
- )
- RESULTS$Outputs[ round(RESULTS$Outputs ,3)==(-999.999)] <- NA;
- RESULTS$StateEnd[round(RESULTS$StateEnd,3)==(-999.999)] <- NA;
-
- ##Data_storage
- CemaNeigeLayers[[iLayer]] <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]);
- names(CemaNeigeLayers[[iLayer]]) <- FortranOutputs$CN[IndOutputsCemaNeige];
- IndPliqAndMelt <- which(names(CemaNeigeLayers[[iLayer]]) == "PliqAndMelt");
- if(iLayer==1){ CatchMeltAndPliq <- RESULTS$Outputs[,IndPliqAndMelt]/NLayers; }
- if(iLayer >1){ CatchMeltAndPliq <- CatchMeltAndPliq + RESULTS$Outputs[,IndPliqAndMelt]/NLayers; }
- if(ExportStateEnd){ CemaNeigeStateEnd <- c(CemaNeigeStateEnd,RESULTS$StateEnd); }
- rm(RESULTS);
- } ###ENDFOR_iLayer
- names(CemaNeigeLayers) <- sprintf("Layer%02i", seq_len(NLayers))
- } ###ENDIF_RunSnowModule
- if(!inherits(RunOptions,"CemaNeige")){
- CemaNeigeLayers <- list(); CemaNeigeStateEnd <- NULL; NameCemaNeigeLayers <- NULL;
- CatchMeltAndPliq <- InputsModel$Precip[IndPeriod1]; }
-
-
-
- ##MODEL______________________________________________________________________________________##
- if("all" %in% RunOptions$Outputs_Sim){ IndOutputsMod <- as.integer(1:length(FortranOutputs$GR));
- } else { IndOutputsMod <- which(FortranOutputs$GR %in% RunOptions$Outputs_Sim); }
-
- ##Use_of_IniResLevels
- if(!is.null(RunOptions$IniResLevels)){
- RunOptions$IniStates[1] <- RunOptions$IniResLevels[1]*ParamMod[1]; ### production store level (mm)
- RunOptions$IniStates[2] <- RunOptions$IniResLevels[2]*ParamMod[3]; ### routing store level (mm)
+ ## Data storage
+ CemaNeigeLayers[[iLayer]] <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i])
+ names(CemaNeigeLayers[[iLayer]]) <- FortranOutputs$CN[IndOutputsCemaNeige]
+ IndPliqAndMelt <- which(names(CemaNeigeLayers[[iLayer]]) == "PliqAndMelt")
+ if (iLayer == 1) {
+ CatchMeltAndPliq <- RESULTS$Outputs[, IndPliqAndMelt] / NLayers
}
-
- ##Call_fortan
- RESULTS <- .Fortran("frun_gr4h",PACKAGE="airGR",
- ##inputs
- LInputs=LInputSeries, ### length of input and output series
- InputsPrecip=CatchMeltAndPliq, ### input series of total precipitation [mm/h]
- InputsPE=InputsModel$PotEvap[IndPeriod1], ### input series potential evapotranspiration [mm/h]
- NParam=NParamMod, ### number of model parameter
- Param=ParamMod, ### parameter set
- NStates=NStatesMod, ### number of state variables used for model initialising
- StateStart=RunOptions$IniStates[1:NStatesMod], ### state variables used when the model run starts
- NOutputs=as.integer(length(IndOutputsMod)), ### number of output series
- IndOutputs=IndOutputsMod, ### indices of output series
- ##outputs
- Outputs=matrix(as.double(-999.999),nrow=LInputSeries,ncol=length(IndOutputsMod)), ### output series [mm]
- StateEnd=rep(as.double(-999.999),NStatesMod) ### state variables at the end of the model run
- )
- RESULTS$Outputs[ round(RESULTS$Outputs ,3)==(-999.999)] <- NA;
- RESULTS$StateEnd[round(RESULTS$StateEnd,3)==(-999.999)] <- NA;
- if (ExportStateEnd) {
- RESULTS$StateEnd[-3L] <- ifelse(RESULTS$StateEnd[-3L] < 0, 0, RESULTS$StateEnd[-3L]) ### remove negative values except for the ExpStore location
- idNStates <- seq_len(NStates*NLayers) %% NStates
- RESULTS$StateEnd <- CreateIniStates(FUN_MOD = RunModel_CemaNeigeGR4H, InputsModel = InputsModel, IsHyst = IsHyst,
- ProdStore = RESULTS$StateEnd[1L], RoutStore = RESULTS$StateEnd[2L], ExpStore = NULL,
- UH1 = RESULTS$StateEnd[(1:(20*24))+7], UH2 = RESULTS$StateEnd[(1:(40*24))+(7+20*24)],
- GCemaNeigeLayers = CemaNeigeStateEnd[seq_len(NStates*NLayers)[idNStates == 1]],
- eTGCemaNeigeLayers = CemaNeigeStateEnd[seq_len(NStates*NLayers)[idNStates == 2]],
- GthrCemaNeigeLayers = CemaNeigeStateEnd[seq_len(NStates*NLayers)[idNStates == 3]],
- GlocmaxCemaNeigeLayers = CemaNeigeStateEnd[seq_len(NStates*NLayers)[idNStates == 0]],
- verbose = FALSE)
+ if (iLayer > 1) {
+ CatchMeltAndPliq <- CatchMeltAndPliq + RESULTS$Outputs[, IndPliqAndMelt] / NLayers
}
-
- if(inherits(RunOptions,"CemaNeige") & "Precip" %in% RunOptions$Outputs_Sim){ RESULTS$Outputs[,which(FortranOutputs$GR[IndOutputsMod]=="Precip")] <- InputsModel$Precip[IndPeriod1]; }
-
- ##Output_data_preparation
- ##OutputsModel_only
- if(!ExportDatesR & !ExportStateEnd){
- OutputsModel <- c( lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]),
- list(CemaNeigeLayers) );
- names(OutputsModel) <- c(FortranOutputs$GR[IndOutputsMod],NameCemaNeigeLayers); }
- ##DatesR_and_OutputsModel_only
- if( ExportDatesR & !ExportStateEnd){
- OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]),
- list(CemaNeigeLayers) );
- names(OutputsModel) <- c("DatesR",FortranOutputs$GR[IndOutputsMod],NameCemaNeigeLayers); }
- ##OutputsModel_and_SateEnd_only
- if(!ExportDatesR & ExportStateEnd){
- OutputsModel <- c( lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]),
- list(CemaNeigeLayers),
- list(RESULTS$StateEnd) );
- names(OutputsModel) <- c(FortranOutputs$GR[IndOutputsMod],NameCemaNeigeLayers,"StateEnd"); }
- ##DatesR_and_OutputsModel_and_SateEnd
- if( ExportDatesR & ExportStateEnd){
- OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]),
- list(CemaNeigeLayers),
- list(RESULTS$StateEnd) );
- names(OutputsModel) <- c("DatesR",FortranOutputs$GR[IndOutputsMod],NameCemaNeigeLayers,"StateEnd"); }
-
- ##End
- rm(RESULTS);
-
- class(OutputsModel) <- c("OutputsModel","hourly","GR","CemaNeige");
- if(IsHyst) {
- class(OutputsModel) <- c(class(OutputsModel), "hysteresis")
+ if (ExportStateEnd) {
+ CemaNeigeStateEnd <- c(CemaNeigeStateEnd, RESULTS$StateEnd)
}
- return(OutputsModel);
-
+ rm(RESULTS)
+ } ### ENDFOR iLayer
+ names(CemaNeigeLayers) <- sprintf("Layer%02i", seq_len(NLayers))
+ } ### ENDIF RunSnowModule
+ if (!inherits(RunOptions, "CemaNeige")) {
+ CemaNeigeLayers <- list()
+ CemaNeigeStateEnd <- NULL
+ NameCemaNeigeLayers <- NULL
+ CatchMeltAndPliq <- InputsModel$Precip[IndPeriod1]
+ }
+
+
+
+ ## GR model
+ if ("all" %in% RunOptions$Outputs_Sim) {
+ IndOutputsMod <- as.integer(1:length(FortranOutputs$GR))
+ } else {
+ IndOutputsMod <- which(FortranOutputs$GR %in% RunOptions$Outputs_Sim)
+ }
+
+ ## Use of IniResLevels
+ if (!is.null(RunOptions$IniResLevels)) {
+ RunOptions$IniStates[1] <- RunOptions$IniResLevels[1] * ParamMod[1] ### production store level (mm)
+ RunOptions$IniStates[2] <- RunOptions$IniResLevels[2] * ParamMod[3] ### routing store level (mm)
+ }
+
+ ## Call GR model Fortan
+ RESULTS <- .Fortran("frun_gr4h", PACKAGE = "airGR",
+ ## inputs
+ LInputs = LInputSeries, ### length of input and output series
+ InputsPrecip = CatchMeltAndPliq, ### input series of total precipitation [mm/h]
+ InputsPE = InputsModel$PotEvap[IndPeriod1], ### input series potential evapotranspiration [mm/h]
+ NParam = NParamMod, ### number of model parameter
+ Param = ParamMod, ### parameter set
+ NStates = NStatesMod, ### number of state variables used for model initialising
+ StateStart = RunOptions$IniStates[1:NStatesMod], ### state variables used when the model run starts
+ NOutputs = as.integer(length(IndOutputsMod)), ### number of output series
+ IndOutputs = IndOutputsMod, ### indices of output series
+ ## outputs
+ Outputs = matrix(as.double(-999.999), nrow = LInputSeries, ncol = length(IndOutputsMod)), ### output series [mm]
+ StateEnd = rep(as.double(-999.999), NStatesMod) ### state variables at the end of the model run
+ )
+ RESULTS$Outputs[ round(RESULTS$Outputs , 3) == -999.999] <- NA
+ RESULTS$StateEnd[round(RESULTS$StateEnd, 3) == -999.999] <- NA
+ if (ExportStateEnd) {
+ RESULTS$StateEnd[-3L] <- ifelse(RESULTS$StateEnd[-3L] < 0, 0, RESULTS$StateEnd[-3L]) ### remove negative values except for the ExpStore location
+ idNStates <- seq_len(NStates*NLayers) %% NStates
+ RESULTS$StateEnd <- CreateIniStates(FUN_MOD = RunModel_CemaNeigeGR4H, InputsModel = InputsModel, IsHyst = IsHyst,
+ ProdStore = RESULTS$StateEnd[1L], RoutStore = RESULTS$StateEnd[2L], ExpStore = NULL,
+ UH1 = RESULTS$StateEnd[(1:(20*24))+7], UH2 = RESULTS$StateEnd[(1:(40*24))+(7+20*24)],
+ GCemaNeigeLayers = CemaNeigeStateEnd[seq_len(NStates*NLayers)[idNStates == 1]],
+ eTGCemaNeigeLayers = CemaNeigeStateEnd[seq_len(NStates*NLayers)[idNStates == 2]],
+ GthrCemaNeigeLayers = CemaNeigeStateEnd[seq_len(NStates*NLayers)[idNStates == 3]],
+ GlocmaxCemaNeigeLayers = CemaNeigeStateEnd[seq_len(NStates*NLayers)[idNStates == 0]],
+ verbose = FALSE)
+ }
+
+ if (inherits(RunOptions, "CemaNeige") & "Precip" %in% RunOptions$Outputs_Sim) {
+ RESULTS$Outputs[, which(FortranOutputs$GR[IndOutputsMod] == "Precip")] <- InputsModel$Precip[IndPeriod1]
+ }
+
+ ## Output data preparation
+ ## OutputsModel only
+ if (!ExportDatesR & !ExportStateEnd) {
+ OutputsModel <- c(lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
+ list(CemaNeigeLayers))
+ names(OutputsModel) <- c(FortranOutputs$GR[IndOutputsMod], NameCemaNeigeLayers)
+ }
+ ## DatesR and OutputsModel only
+ if ( ExportDatesR & !ExportStateEnd) {
+ OutputsModel <- c(list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
+ lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
+ list(CemaNeigeLayers))
+ names(OutputsModel) <- c("DatesR", FortranOutputs$GR[IndOutputsMod], NameCemaNeigeLayers)
+ }
+ ## OutputsModel and SateEnd only
+ if (!ExportDatesR & ExportStateEnd) {
+ OutputsModel <- c(lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
+ list(CemaNeigeLayers),
+ list(RESULTS$StateEnd))
+ names(OutputsModel) <- c(FortranOutputs$GR[IndOutputsMod], NameCemaNeigeLayers, "StateEnd")
+ }
+ ## DatesR and OutputsModel and SateEnd
+ if ( ExportDatesR & ExportStateEnd) {
+ OutputsModel <- c(list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
+ lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
+ list(CemaNeigeLayers),
+ list(RESULTS$StateEnd))
+ names(OutputsModel) <- c("DatesR", FortranOutputs$GR[IndOutputsMod], NameCemaNeigeLayers, "StateEnd")
+ }
+
+ ## End
+ rm(RESULTS)
+ class(OutputsModel) <- c("OutputsModel", "hourly", "GR", "CemaNeige")
+ if (IsHyst) {
+ class(OutputsModel) <- c(class(OutputsModel), "hysteresis")
+ }
+ return(OutputsModel)
+
}
diff --git a/R/RunModel_CemaNeigeGR4J.R b/R/RunModel_CemaNeigeGR4J.R
index f3a7f8226511264f189df5346a32e29b8a8528d7..9156165856ae34a26358c231d9466c8174823bee 100644
--- a/R/RunModel_CemaNeigeGR4J.R
+++ b/R/RunModel_CemaNeigeGR4J.R
@@ -1,5 +1,5 @@
-RunModel_CemaNeigeGR4J <- function(InputsModel,RunOptions,Param){
-
+RunModel_CemaNeigeGR4J <- function(InputsModel, RunOptions, Param) {
+
## Initialization of variables
IsHyst <- inherits(RunOptions, "hysteresis")
@@ -7,177 +7,219 @@ RunModel_CemaNeigeGR4J <- function(InputsModel,RunOptions,Param){
NParamCN <- NParam - 4L
NStates <- 4L
FortranOutputs <- .FortranOutputs(GR = "GR4J", isCN = TRUE)
-
+
+
+ ## Arguments check
+ if (!inherits(InputsModel, "InputsModel")) {
+ stop("'InputsModel' must be of class 'InputsModel'")
+ }
+ if (!inherits(InputsModel, "daily")) {
+ stop("'InputsModel' must be of class 'daily'")
+ }
+ if (!inherits(InputsModel, "GR")) {
+ stop("'InputsModel' must be of class 'GR'")
+ }
+ if (!inherits(InputsModel, "CemaNeige")) {
+ stop("'InputsModel' must be of class 'CemaNeige'")
+ }
+ if (!inherits(RunOptions, "RunOptions")) {
+ stop("'RunOptions' must be of class 'RunOptions'")
+ }
+ if (!inherits(RunOptions, "GR")) {
+ stop("'RunOptions' must be of class 'GR'")
+ }
+ if (!inherits(RunOptions, "CemaNeige")) {
+ stop("'RunOptions' must be of class 'CemaNeige'")
+ }
+ if (!is.vector(Param) | !is.numeric(Param)) {
+ stop("'Param' must be a numeric vector")
+ }
+ if (sum(!is.na(Param)) != NParam) {
+ stop(paste("'Param' must be a vector of length", NParam, "and contain no NA"))
+ }
+ Param <- as.double(Param)
+
+ Param_X1X3_threshold <- 1e-2
+ Param_X4_threshold <- 0.5
+ if (Param[1L] < Param_X1X3_threshold) {
+ warning(sprintf("Param[1] (X1: production store capacity [mm]) < %.2f\n X1 set to %.2f", Param_X1X3_threshold, Param_X1X3_threshold))
+ Param[1L] <- Param_X1X3_threshold
+ }
+ if (Param[3L] < Param_X1X3_threshold) {
+ warning(sprintf("Param[3] (X3: routing store capacity [mm]) < %.2f\n X3 set to %.2f", Param_X1X3_threshold, Param_X1X3_threshold))
+ Param[3L] <- Param_X1X3_threshold
+ }
+ if (Param[4L] < Param_X4_threshold) {
+ warning(sprintf("Param[4] (X4: unit hydrograph time constant [d]) < %.2f\n X4 set to %.2f", Param_X4_threshold, Param_X4_threshold))
+ Param[4L] <- Param_X4_threshold
+ }
+
+ ## Input data preparation
+ if (identical(RunOptions$IndPeriod_WarmUp, 0L)) {
+ RunOptions$IndPeriod_WarmUp <- NULL
+ }
+ IndPeriod1 <- c(RunOptions$IndPeriod_WarmUp, RunOptions$IndPeriod_Run)
+ LInputSeries <- as.integer(length(IndPeriod1))
+ IndPeriod2 <- (length(RunOptions$IndPeriod_WarmUp) + 1):LInputSeries
+ ParamCemaNeige <- Param[(length(Param)- 1 - 2 * as.integer(IsHyst)):length(Param)]
+ NParamMod <- as.integer(length(Param) - (2 + 2*as.integer(IsHyst)))
+ ParamMod <- Param[1:NParamMod]
+ NLayers <- length(InputsModel$LayerPrecip)
+ NStatesMod <- as.integer(length(RunOptions$IniStates) - NStates * NLayers)
+ ExportDatesR <- "DatesR" %in% RunOptions$Outputs_Sim
+ ExportStateEnd <- "StateEnd" %in% RunOptions$Outputs_Sim
+
+
+ ## CemaNeige________________________________________________________________________________
+ if (inherits(RunOptions, "CemaNeige")) {
+ if ("all" %in% RunOptions$Outputs_Sim) {
+ IndOutputsCemaNeige <- as.integer(1:length(FortranOutputs$CN))
+ } else {
+ IndOutputsCemaNeige <- which(FortranOutputs$CN %in% RunOptions$Outputs_Sim)
+ }
+ CemaNeigeLayers <- list()
+ CemaNeigeStateEnd <- NULL
+ NameCemaNeigeLayers <- "CemaNeigeLayers"
- ##Arguments_check
- if(!inherits(InputsModel,"InputsModel")){ stop("'InputsModel' must be of class 'InputsModel'") }
- if(!inherits(InputsModel,"daily" )){ stop("'InputsModel' must be of class 'daily' ") }
- if(!inherits(InputsModel,"GR" )){ stop("'InputsModel' must be of class 'GR' ") }
- if(!inherits(InputsModel,"CemaNeige" )){ stop("'InputsModel' must be of class 'CemaNeige' ") }
- if(!inherits(RunOptions,"RunOptions" )){ stop("'RunOptions' must be of class 'RunOptions' ") }
- if(!inherits(RunOptions,"GR" )){ stop("'RunOptions' must be of class 'GR' ") }
- if(!inherits(RunOptions,"CemaNeige" )){ stop("'RunOptions' must be of class 'CemaNeige' ") }
- if(!is.vector(Param) | !is.numeric(Param)){ stop("'Param' must be a numeric vector") }
- if(sum(!is.na(Param))!=NParam){ stop(paste("'Param' must be a vector of length ",NParam," and contain no NA",sep="")) }
- Param <- as.double(Param);
-
- Param_X1X3_threshold <- 1e-2
- Param_X4_threshold <- 0.5
- if (Param[1L] < Param_X1X3_threshold) {
- warning(sprintf("Param[1] (X1: production store capacity [mm]) < %.2f\n X1 set to %.2f", Param_X1X3_threshold, Param_X1X3_threshold))
- Param[1L] <- Param_X1X3_threshold
- }
- if (Param[3L] < Param_X1X3_threshold) {
- warning(sprintf("Param[3] (X3: routing store capacity [mm]) < %.2f\n X3 set to %.2f", Param_X1X3_threshold, Param_X1X3_threshold))
- Param[3L] <- Param_X1X3_threshold
+
+ ## Call CemaNeige Fortran_________________________
+ for(iLayer in 1:NLayers) {
+ if (!IsHyst) {
+ StateStartCemaNeige <- RunOptions$IniStates[(7 + 20 + 40) + c(iLayer, iLayer+NLayers)]
+ } else {
+ StateStartCemaNeige <- RunOptions$IniStates[(7 + 20 + 40) + c(iLayer, iLayer+NLayers, iLayer+2*NLayers, iLayer+3*NLayers)]
}
- if (Param[4L] < Param_X4_threshold) {
- warning(sprintf("Param[4] (X4: unit hydrograph time constant [d]) < %.2f\n X4 set to %.2f", Param_X4_threshold, Param_X4_threshold))
- Param[4L] <- Param_X4_threshold
- }
+ RESULTS <- .Fortran("frun_cemaneige", PACKAGE = "airGR",
+ ## inputs
+ LInputs = LInputSeries, ### length of input and output series
+ InputsPrecip = InputsModel$LayerPrecip[[iLayer]][IndPeriod1], ### input series of total precipitation [mm/d]
+ InputsFracSolidPrecip = InputsModel$LayerFracSolidPrecip[[iLayer]][IndPeriod1], ### input series of fraction of solid precipitation [0-1]
+ InputsTemp = InputsModel$LayerTemp[[iLayer]][IndPeriod1], ### input series of air mean temperature [degC]
+ MeanAnSolidPrecip = RunOptions$MeanAnSolidPrecip[iLayer], ### value of annual mean solid precip [mm/y]
+ NParam = as.integer(NParamCN), ### number of model parameters = 2 or 4
+ Param = as.double(ParamCemaNeige), ### parameter set
+ NStates = as.integer(NStates), ### number of state variables used for model initialising = 4
+ StateStart = StateStartCemaNeige, ### state variables used when the model run starts
+ IsHyst = as.integer(IsHyst), ### use of hysteresis
+ NOutputs = as.integer(length(IndOutputsCemaNeige)), ### number of output series
+ IndOutputs = IndOutputsCemaNeige, ### indices of output series
+ ## outputs
+ Outputs = matrix(as.double(-999.999), nrow = LInputSeries, ncol = length(IndOutputsCemaNeige)), ### output series [mm]
+ StateEnd = rep(as.double(-999.999), as.integer(NStates)) ### state variables at the end of the model run
+ )
+ RESULTS$Outputs[ round(RESULTS$Outputs , 3) == -999.999] <- NA
+ RESULTS$StateEnd[round(RESULTS$StateEnd, 3) == -999.999] <- NA
- ##Input_data_preparation
- if(identical(RunOptions$IndPeriod_WarmUp,as.integer(0))){ RunOptions$IndPeriod_WarmUp <- NULL; }
- IndPeriod1 <- c(RunOptions$IndPeriod_WarmUp,RunOptions$IndPeriod_Run);
- LInputSeries <- as.integer(length(IndPeriod1))
- IndPeriod2 <- (length(RunOptions$IndPeriod_WarmUp)+1):LInputSeries;
- ParamCemaNeige <- Param[(length(Param)-1-2*as.integer(IsHyst)):length(Param)];
- NParamMod <- as.integer(length(Param)-(2+2*as.integer(IsHyst)));
- ParamMod <- Param[1:NParamMod];
- NLayers <- length(InputsModel$LayerPrecip);
- NStatesMod <- as.integer(length(RunOptions$IniStates)-NStates*NLayers);
- ExportDatesR <- "DatesR" %in% RunOptions$Outputs_Sim;
- ExportStateEnd <- "StateEnd" %in% RunOptions$Outputs_Sim;
-
-
- ##SNOW_MODULE________________________________________________________________________________##
- if(inherits(RunOptions,"CemaNeige")){
- if("all" %in% RunOptions$Outputs_Sim){ IndOutputsCemaNeige <- as.integer(1:length(FortranOutputs$CN));
- } else { IndOutputsCemaNeige <- which(FortranOutputs$CN %in% RunOptions$Outputs_Sim); }
- CemaNeigeLayers <- list(); CemaNeigeStateEnd <- NULL; NameCemaNeigeLayers <- "CemaNeigeLayers";
-
-
- ##Call_DLL_CemaNeige_________________________
- for(iLayer in 1:NLayers){
- if (!IsHyst) {
- StateStartCemaNeige <- RunOptions$IniStates[(7 + 20 + 40) + c(iLayer, iLayer+NLayers)]
- } else {
- StateStartCemaNeige <- RunOptions$IniStates[(7 + 20 + 40) + c(iLayer, iLayer+NLayers, iLayer+2*NLayers, iLayer+3*NLayers)]
- }
- RESULTS <- .Fortran("frun_cemaneige",PACKAGE="airGR",
- ##inputs
- LInputs=LInputSeries, ### length of input and output series
- InputsPrecip=InputsModel$LayerPrecip[[iLayer]][IndPeriod1], ### input series of total precipitation [mm/d]
- InputsFracSolidPrecip=InputsModel$LayerFracSolidPrecip[[iLayer]][IndPeriod1], ### input series of fraction of solid precipitation [0-1]
- InputsTemp=InputsModel$LayerTemp[[iLayer]][IndPeriod1], ### input series of air mean temperature [degC]
- MeanAnSolidPrecip=RunOptions$MeanAnSolidPrecip[iLayer], ### value of annual mean solid precip [mm/y]
- NParam=as.integer(NParamCN), ### number of model parameters = 2 or 4
- Param=as.double(ParamCemaNeige), ### parameter set
- NStates=as.integer(NStates), ### number of state variables used for model initialising = 4
- StateStart=StateStartCemaNeige, ### state variables used when the model run starts
- IsHyst = as.integer(IsHyst), ### use of hysteresis
- NOutputs=as.integer(length(IndOutputsCemaNeige)), ### number of output series
- IndOutputs=IndOutputsCemaNeige, ### indices of output series
- ##outputs
- Outputs=matrix(as.double(-999.999),nrow=LInputSeries,ncol=length(IndOutputsCemaNeige)), ### output series [mm]
- StateEnd=rep(as.double(-999.999),as.integer(NStates)) ### state variables at the end of the model run
- )
- RESULTS$Outputs[ round(RESULTS$Outputs ,3)==(-999.999)] <- NA;
- RESULTS$StateEnd[round(RESULTS$StateEnd,3)==(-999.999)] <- NA;
-
- ##Data_storage
- CemaNeigeLayers[[iLayer]] <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]);
- names(CemaNeigeLayers[[iLayer]]) <- FortranOutputs$CN[IndOutputsCemaNeige];
- IndPliqAndMelt <- which(names(CemaNeigeLayers[[iLayer]]) == "PliqAndMelt");
- if(iLayer==1){ CatchMeltAndPliq <- RESULTS$Outputs[,IndPliqAndMelt]/NLayers; }
- if(iLayer >1){ CatchMeltAndPliq <- CatchMeltAndPliq + RESULTS$Outputs[,IndPliqAndMelt]/NLayers; }
- if(ExportStateEnd){ CemaNeigeStateEnd <- c(CemaNeigeStateEnd,RESULTS$StateEnd); }
- rm(RESULTS);
- } ###ENDFOR_iLayer
- names(CemaNeigeLayers) <- sprintf("Layer%02i", seq_len(NLayers))
- } ###ENDIF_RunSnowModule
- if(!inherits(RunOptions,"CemaNeige")){
- CemaNeigeLayers <- list(); CemaNeigeStateEnd <- NULL; NameCemaNeigeLayers <- NULL;
- CatchMeltAndPliq <- InputsModel$Precip[IndPeriod1]; }
-
-
-
- ##MODEL______________________________________________________________________________________##
- if("all" %in% RunOptions$Outputs_Sim){ IndOutputsMod <- as.integer(1:length(FortranOutputs$GR));
- } else { IndOutputsMod <- which(FortranOutputs$GR %in% RunOptions$Outputs_Sim); }
-
- ##Use_of_IniResLevels
- if(!is.null(RunOptions$IniResLevels)){
- RunOptions$IniStates[1] <- RunOptions$IniResLevels[1]*ParamMod[1]; ### production store level (mm)
- RunOptions$IniStates[2] <- RunOptions$IniResLevels[2]*ParamMod[3]; ### routing store level (mm)
+ ## Data storage
+ CemaNeigeLayers[[iLayer]] <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i])
+ names(CemaNeigeLayers[[iLayer]]) <- FortranOutputs$CN[IndOutputsCemaNeige]
+ IndPliqAndMelt <- which(names(CemaNeigeLayers[[iLayer]]) == "PliqAndMelt")
+ if (iLayer == 1) {
+ CatchMeltAndPliq <- RESULTS$Outputs[, IndPliqAndMelt] / NLayers
}
-
- ##Call_fortan
- RESULTS <- .Fortran("frun_gr4j",PACKAGE="airGR",
- ##inputs
- LInputs=LInputSeries, ### length of input and output series
- InputsPrecip=CatchMeltAndPliq, ### input series of total precipitation [mm/d]
- InputsPE=InputsModel$PotEvap[IndPeriod1], ### input series potential evapotranspiration [mm/d]
- NParam=NParamMod, ### number of model parameter
- Param=ParamMod, ### parameter set
- NStates=NStatesMod, ### number of state variables used for model initialising
- StateStart=RunOptions$IniStates[1:NStatesMod], ### state variables used when the model run starts
- NOutputs=as.integer(length(IndOutputsMod)), ### number of output series
- IndOutputs=IndOutputsMod, ### indices of output series
- ##outputs
- Outputs=matrix(as.double(-999.999),nrow=LInputSeries,ncol=length(IndOutputsMod)), ### output series [mm]
- StateEnd=rep(as.double(-999.999),NStatesMod) ### state variables at the end of the model run
- )
- RESULTS$Outputs[ round(RESULTS$Outputs ,3)==(-999.999)] <- NA;
- RESULTS$StateEnd[round(RESULTS$StateEnd,3)==(-999.999)] <- NA;
- if (ExportStateEnd) {
- RESULTS$StateEnd[-3L] <- ifelse(RESULTS$StateEnd[-3L] < 0, 0, RESULTS$StateEnd[-3L]) ### remove negative values except for the ExpStore location
- idNStates <- seq_len(NStates*NLayers) %% NStates
- RESULTS$StateEnd <- CreateIniStates(FUN_MOD = RunModel_CemaNeigeGR4J, InputsModel = InputsModel, IsHyst = IsHyst,
- ProdStore = RESULTS$StateEnd[1L], RoutStore = RESULTS$StateEnd[2L], ExpStore = NULL,
- UH1 = RESULTS$StateEnd[(1:20)+7], UH2 = RESULTS$StateEnd[(1:40)+(7+20)],
- GCemaNeigeLayers = CemaNeigeStateEnd[seq_len(NStates*NLayers)[idNStates == 1]],
- eTGCemaNeigeLayers = CemaNeigeStateEnd[seq_len(NStates*NLayers)[idNStates == 2]],
- GthrCemaNeigeLayers = CemaNeigeStateEnd[seq_len(NStates*NLayers)[idNStates == 3]],
- GlocmaxCemaNeigeLayers = CemaNeigeStateEnd[seq_len(NStates*NLayers)[idNStates == 0]],
- verbose = FALSE)
+ if (iLayer >1) {
+ CatchMeltAndPliq <- CatchMeltAndPliq + RESULTS$Outputs[, IndPliqAndMelt] / NLayers
}
-
- if(inherits(RunOptions,"CemaNeige") & "Precip" %in% RunOptions$Outputs_Sim){ RESULTS$Outputs[,which(FortranOutputs$GR[IndOutputsMod]=="Precip")] <- InputsModel$Precip[IndPeriod1]; }
-
- ##Output_data_preparation
- ##OutputsModel_only
- if(!ExportDatesR & !ExportStateEnd){
- OutputsModel <- c( lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]),
- list(CemaNeigeLayers) );
- names(OutputsModel) <- c(FortranOutputs$GR[IndOutputsMod],NameCemaNeigeLayers); }
- ##DatesR_and_OutputsModel_only
- if( ExportDatesR & !ExportStateEnd){
- OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]),
- list(CemaNeigeLayers) );
- names(OutputsModel) <- c("DatesR",FortranOutputs$GR[IndOutputsMod],NameCemaNeigeLayers); }
- ##OutputsModel_and_SateEnd_only
- if(!ExportDatesR & ExportStateEnd){
- OutputsModel <- c( lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]),
- list(CemaNeigeLayers),
- list(RESULTS$StateEnd) );
- names(OutputsModel) <- c(FortranOutputs$GR[IndOutputsMod],NameCemaNeigeLayers,"StateEnd"); }
- ##DatesR_and_OutputsModel_and_SateEnd
- if( ExportDatesR & ExportStateEnd){
- OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]),
- list(CemaNeigeLayers),
- list(RESULTS$StateEnd) );
- names(OutputsModel) <- c("DatesR",FortranOutputs$GR[IndOutputsMod],NameCemaNeigeLayers,"StateEnd"); }
-
- ##End
- rm(RESULTS);
-
- class(OutputsModel) <- c("OutputsModel","daily","GR","CemaNeige");
- if(IsHyst) {
- class(OutputsModel) <- c(class(OutputsModel), "hysteresis")
+ if (ExportStateEnd) {
+ CemaNeigeStateEnd <- c(CemaNeigeStateEnd, RESULTS$StateEnd)
}
- return(OutputsModel);
-
+ rm(RESULTS)
+ } ### ENDFOR iLayer
+ names(CemaNeigeLayers) <- sprintf("Layer%02i", seq_len(NLayers))
+ } ### ENDIF RunSnowModule
+ if (!inherits(RunOptions, "CemaNeige")) {
+ CemaNeigeLayers <- list()
+ CemaNeigeStateEnd <- NULL
+ NameCemaNeigeLayers <- NULL
+ CatchMeltAndPliq <- InputsModel$Precip[IndPeriod1]
+ }
+
+
+
+ ## GR model______________________________________________________________________________________
+ if ("all" %in% RunOptions$Outputs_Sim) {
+ IndOutputsMod <- as.integer(1:length(FortranOutputs$GR))
+ } else {
+ IndOutputsMod <- which(FortranOutputs$GR %in% RunOptions$Outputs_Sim)
+ }
+
+ ## Use of IniResLevels
+ if (!is.null(RunOptions$IniResLevels)) {
+ RunOptions$IniStates[1] <- RunOptions$IniResLevels[1] * ParamMod[1] ### production store level (mm)
+ RunOptions$IniStates[2] <- RunOptions$IniResLevels[2] * ParamMod[3] ### routing store level (mm)
+ }
+
+ ## Call GR model Fortan
+ RESULTS <- .Fortran("frun_gr4j", PACKAGE = "airGR",
+ ## inputs
+ LInputs = LInputSeries, ### length of input and output series
+ InputsPrecip = CatchMeltAndPliq, ### input series of total precipitation [mm/d]
+ InputsPE = InputsModel$PotEvap[IndPeriod1], ### input series potential evapotranspiration [mm/d]
+ NParam = NParamMod, ### number of model parameter
+ Param = ParamMod, ### parameter set
+ NStates = NStatesMod, ### number of state variables used for model initialising
+ StateStart = RunOptions$IniStates[1:NStatesMod], ### state variables used when the model run starts
+ NOutputs = as.integer(length(IndOutputsMod)), ### number of output series
+ IndOutputs = IndOutputsMod, ### indices of output series
+ ## outputs
+ Outputs = matrix(as.double(-999.999), nrow = LInputSeries, ncol = length(IndOutputsMod)), ### output series [mm]
+ StateEnd = rep(as.double(-999.999), NStatesMod) ### state variables at the end of the model run
+ )
+ RESULTS$Outputs[ round(RESULTS$Outputs , 3) == -999.999] <- NA
+ RESULTS$StateEnd[round(RESULTS$StateEnd, 3) == -999.999] <- NA
+ if (ExportStateEnd) {
+ RESULTS$StateEnd[-3L] <- ifelse(RESULTS$StateEnd[-3L] < 0, 0, RESULTS$StateEnd[-3L]) ### remove negative values except for the ExpStore location
+ idNStates <- seq_len(NStates*NLayers) %% NStates
+ RESULTS$StateEnd <- CreateIniStates(FUN_MOD = RunModel_CemaNeigeGR4J, InputsModel = InputsModel, IsHyst = IsHyst,
+ ProdStore = RESULTS$StateEnd[1L], RoutStore = RESULTS$StateEnd[2L], ExpStore = NULL,
+ UH1 = RESULTS$StateEnd[(1:20)+7], UH2 = RESULTS$StateEnd[(1:40)+(7+20)],
+ GCemaNeigeLayers = CemaNeigeStateEnd[seq_len(NStates*NLayers)[idNStates == 1]],
+ eTGCemaNeigeLayers = CemaNeigeStateEnd[seq_len(NStates*NLayers)[idNStates == 2]],
+ GthrCemaNeigeLayers = CemaNeigeStateEnd[seq_len(NStates*NLayers)[idNStates == 3]],
+ GlocmaxCemaNeigeLayers = CemaNeigeStateEnd[seq_len(NStates*NLayers)[idNStates == 0]],
+ verbose = FALSE)
+ }
+
+ if (inherits(RunOptions, "CemaNeige") & "Precip" %in% RunOptions$Outputs_Sim) {
+ RESULTS$Outputs[, which(FortranOutputs$GR[IndOutputsMod] == "Precip")] <- InputsModel$Precip[IndPeriod1]
+ }
+
+ ## Output data preparation
+ ## OutputsModel only
+ if (!ExportDatesR & !ExportStateEnd) {
+ OutputsModel <- c(lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
+ list(CemaNeigeLayers))
+ names(OutputsModel) <- c(FortranOutputs$GR[IndOutputsMod], NameCemaNeigeLayers)
+ }
+ ## DatesR and OutputsModel only
+ if ( ExportDatesR & !ExportStateEnd) {
+ OutputsModel <- c(list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
+ lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
+ list(CemaNeigeLayers))
+ names(OutputsModel) <- c("DatesR", FortranOutputs$GR[IndOutputsMod], NameCemaNeigeLayers)
+ }
+ ## OutputsModel and SateEnd only
+ if (!ExportDatesR & ExportStateEnd) {
+ OutputsModel <- c(lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
+ list(CemaNeigeLayers),
+ list(RESULTS$StateEnd))
+ names(OutputsModel) <- c(FortranOutputs$GR[IndOutputsMod], NameCemaNeigeLayers, "StateEnd")
+ }
+ ## DatesR and OutputsModel and Sate
+ if ( ExportDatesR & ExportStateEnd) {
+ OutputsModel <- c(list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
+ lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
+ list(CemaNeigeLayers),
+ list(RESULTS$StateEnd))
+ names(OutputsModel) <- c("DatesR", FortranOutputs$GR[IndOutputsMod], NameCemaNeigeLayers, "StateEnd")
+ }
+
+ ## End
+ rm(RESULTS)
+ class(OutputsModel) <- c("OutputsModel", "daily", "GR", "CemaNeige")
+ if (IsHyst) {
+ class(OutputsModel) <- c(class(OutputsModel), "hysteresis")
+ }
+ return(OutputsModel)
+
}
diff --git a/R/RunModel_CemaNeigeGR5H.R b/R/RunModel_CemaNeigeGR5H.R
index c8639d71338d8bd5ef4d204959258c2098160236..6cfcc4180c93eb3fa361830d55b0f382df949b57 100644
--- a/R/RunModel_CemaNeigeGR5H.R
+++ b/R/RunModel_CemaNeigeGR5H.R
@@ -1,28 +1,50 @@
-RunModel_CemaNeigeGR5H <- function(InputsModel,RunOptions,Param){
+RunModel_CemaNeigeGR5H <- function(InputsModel, RunOptions, Param) {
+
+ ## Initialization of variables
IsHyst <- inherits(RunOptions, "hysteresis")
NParam <- ifelse(test = IsHyst, yes = 9L, no = 7L)
NParamCN <- NParam - 5L
NStates <- 4L
FortranOutputs <- .FortranOutputs(GR = "GR5H", isCN = TRUE)
IsIntStore <- inherits(RunOptions, "interception")
- if(IsIntStore) {
+ if (IsIntStore) {
Imax <- RunOptions$Imax
} else {
Imax <- -99
}
- ##Arguments_check
- if(!inherits(InputsModel,"InputsModel")){ stop("'InputsModel' must be of class 'InputsModel'") }
- if(!inherits(InputsModel,"hourly" )){ stop("'InputsModel' must be of class 'hourly' ") }
- if(!inherits(InputsModel,"GR" )){ stop("'InputsModel' must be of class 'GR' ") }
- if(!inherits(InputsModel,"CemaNeige" )){ stop("'InputsModel' must be of class 'CemaNeige' ") }
- if(!inherits(RunOptions,"RunOptions" )){ stop("'RunOptions' must be of class 'RunOptions' ") }
- if(!inherits(RunOptions,"GR" )){ stop("'RunOptions' must be of class 'GR' ") }
- if(!inherits(RunOptions,"CemaNeige" )){ stop("'RunOptions' must be of class 'CemaNeige' ") }
- if(!is.vector(Param) | !is.numeric(Param)){ stop("'Param' must be a numeric vector") }
- if(sum(!is.na(Param))!=NParam){ stop(paste("'Param' must be a vector of length ",NParam," and contain no NA",sep="")) }
- Param <- as.double(Param);
+
+ ## Arguments check
+ if (!inherits(InputsModel, "InputsModel")) {
+ stop("'InputsModel' must be of class 'InputsModel'")
+ }
+ if (!inherits(InputsModel, "hourly")) {
+ stop("'InputsModel' must be of class 'hourly'")
+ }
+ if (!inherits(InputsModel, "GR")) {
+ stop("'InputsModel' must be of class 'GR'")
+ }
+ if (!inherits(InputsModel, "CemaNeige")) {
+ stop("'InputsModel' must be of class 'CemaNeige'")
+ }
+ if (!inherits(RunOptions, "RunOptions")) {
+ stop("'RunOptions' must be of class 'RunOptions'")
+ }
+ if (!inherits(RunOptions, "GR")) {
+ stop("'RunOptions' must be of class 'GR'")
+ }
+ if (!inherits(RunOptions, "CemaNeige")) {
+ stop("'RunOptions' must be of class 'CemaNeige'")
+ }
+ if (!is.vector(Param) | !is.numeric(Param)) {
+ stop("'Param' must be a numeric vector")
+ }
+ if (sum(!is.na(Param)) != NParam) {
+ stop(paste("'Param' must be a vector of length", NParam, "and contain no NA"))
+ }
+ Param <- as.double(Param)
+
Param_X1X3_threshold <- 1e-2
Param_X4_threshold <- 0.5
@@ -39,108 +61,132 @@ RunModel_CemaNeigeGR5H <- function(InputsModel,RunOptions,Param){
Param[4L] <- Param_X4_threshold
}
- ##Input_data_preparation
- if(identical(RunOptions$IndPeriod_WarmUp,as.integer(0))){ RunOptions$IndPeriod_WarmUp <- NULL; }
- IndPeriod1 <- c(RunOptions$IndPeriod_WarmUp,RunOptions$IndPeriod_Run);
+ ## Input data preparation
+ if (identical(RunOptions$IndPeriod_WarmUp, 0L)) {
+ RunOptions$IndPeriod_WarmUp <- NULL
+ }
+ IndPeriod1 <- c(RunOptions$IndPeriod_WarmUp, RunOptions$IndPeriod_Run)
+
LInputSeries <- as.integer(length(IndPeriod1))
- if("all" %in% RunOptions$Outputs_Sim){ IndOutputsMod <- as.integer(1:length(FortranOutputs));
- } else { IndOutputsMod <- which(FortranOutputs %in% RunOptions$Outputs_Sim); }
-
- ParamCemaNeige <- Param[(length(Param)-1-2*as.integer(IsHyst)):length(Param)];
- NParamMod <- as.integer(length(Param)-(2+2*as.integer(IsHyst)));
- ParamMod <- Param[1:NParamMod];
- NLayers <- length(InputsModel$LayerPrecip);
- NStatesMod <- as.integer(length(RunOptions$IniStates)-NStates*NLayers);
-
- ##Output_data_preparation
- IndPeriod2 <- (length(RunOptions$IndPeriod_WarmUp)+1):LInputSeries;
- ExportDatesR <- "DatesR" %in% RunOptions$Outputs_Sim;
- ExportStateEnd <- "StateEnd" %in% RunOptions$Outputs_Sim;
-
- ##SNOW_MODULE________________________________________________________________________________##
- if(inherits(RunOptions,"CemaNeige")){
- if("all" %in% RunOptions$Outputs_Sim){ IndOutputsCemaNeige <- as.integer(1:length(FortranOutputs$CN));
- } else { IndOutputsCemaNeige <- which(FortranOutputs$CN %in% RunOptions$Outputs_Sim); }
- CemaNeigeLayers <- list(); CemaNeigeStateEnd <- NULL; NameCemaNeigeLayers <- "CemaNeigeLayers";
+ if ("all" %in% RunOptions$Outputs_Sim) {
+ IndOutputsMod <- as.integer(1:length(FortranOutputs))
+ } else {
+ IndOutputsMod <- which(FortranOutputs %in% RunOptions$Outputs_Sim)
+ }
+
+ ParamCemaNeige <- Param[(length(Param) - 1 - 2 * as.integer(IsHyst)):length(Param)]
+ NParamMod <- as.integer(length(Param) - (2 + 2 * as.integer(IsHyst)))
+ ParamMod <- Param[1:NParamMod]
+ NLayers <- length(InputsModel$LayerPrecip)
+ NStatesMod <- as.integer(length(RunOptions$IniStates) - NStates * NLayers)
+
+
+ ## Output data preparation
+ IndPeriod2 <- (length(RunOptions$IndPeriod_WarmUp)+1):LInputSeries
+ ExportDatesR <- "DatesR" %in% RunOptions$Outputs_Sim
+ ExportStateEnd <- "StateEnd" %in% RunOptions$Outputs_Sim
+
+ ## CemaNeige________________________________________________________________________________
+ if (inherits(RunOptions, "CemaNeige")) {
+ if ("all" %in% RunOptions$Outputs_Sim) {
+ IndOutputsCemaNeige <- as.integer(1:length(FortranOutputs$CN))
+ } else {
+ IndOutputsCemaNeige <- which(FortranOutputs$CN %in% RunOptions$Outputs_Sim)
+ }
+ CemaNeigeLayers <- list()
+ CemaNeigeStateEnd <- NULL
+ NameCemaNeigeLayers <- "CemaNeigeLayers"
- ##Call_DLL_CemaNeige_________________________
- for(iLayer in 1:NLayers){
+ ## Call CemaNeige Fortran_________________________
+ for(iLayer in 1:NLayers) {
if (!IsHyst) {
StateStartCemaNeige <- RunOptions$IniStates[(7 + 20*24 + 40*24) + c(iLayer, iLayer+NLayers)]
} else {
StateStartCemaNeige <- RunOptions$IniStates[(7 + 20*24 + 40*24) + c(iLayer, iLayer+NLayers, iLayer+2*NLayers, iLayer+3*NLayers)]
}
RESULTS <- .Fortran("frun_cemaneige",PACKAGE="airGR",
- ##inputs
- LInputs=LInputSeries, ### length of input and output series
- InputsPrecip=InputsModel$LayerPrecip[[iLayer]][IndPeriod1], ### input series of total precipitation [mm/h]
- InputsFracSolidPrecip=InputsModel$LayerFracSolidPrecip[[iLayer]][IndPeriod1], ### input series of fraction of solid precipitation [0-1]
- InputsTemp=InputsModel$LayerTemp[[iLayer]][IndPeriod1], ### input series of air mean temperature [degC]
- MeanAnSolidPrecip=RunOptions$MeanAnSolidPrecip[iLayer], ### value of annual mean solid precip [mm/y]
- NParam=as.integer(NParamCN), ### number of model parameters = 2 or 4
- Param=as.double(ParamCemaNeige), ### parameter set
- NStates=as.integer(NStates), ### number of state variables used for model initialisation = 4
- StateStart=StateStartCemaNeige, ### state variables used when the model run starts
- IsHyst = as.integer(IsHyst), ### use of hysteresis
- NOutputs=as.integer(length(IndOutputsCemaNeige)), ### number of output series
- IndOutputs=IndOutputsCemaNeige, ### indices of output series
- ##outputs
- Outputs=matrix(as.double(-999.999),nrow=LInputSeries,ncol=length(IndOutputsCemaNeige)), ### output series [mm]
- StateEnd=rep(as.double(-999.999),as.integer(NStates)) ### state variables at the end of the model run
+ ## inputs
+ LInputs = LInputSeries, ### length of input and output series
+ InputsPrecip = InputsModel$LayerPrecip[[iLayer]][IndPeriod1], ### input series of total precipitation [mm/h]
+ InputsFracSolidPrecip = InputsModel$LayerFracSolidPrecip[[iLayer]][IndPeriod1], ### input series of fraction of solid precipitation [0-1]
+ InputsTemp = InputsModel$LayerTemp[[iLayer]][IndPeriod1], ### input series of air mean temperature [degC]
+ MeanAnSolidPrecip = RunOptions$MeanAnSolidPrecip[iLayer], ### value of annual mean solid precip [mm/y]
+ NParam = as.integer(NParamCN), ### number of model parameters = 2 or 4
+ Param = as.double(ParamCemaNeige), ### parameter set
+ NStates = as.integer(NStates), ### number of state variables used for model initialisation = 4
+ StateStart = StateStartCemaNeige, ### state variables used when the model run starts
+ IsHyst = as.integer(IsHyst), ### use of hysteresis
+ NOutputs = as.integer(length(IndOutputsCemaNeige)), ### number of output series
+ IndOutputs = IndOutputsCemaNeige, ### indices of output series
+ ## outputs
+ Outputs = matrix(as.double(-999.999), nrow = LInputSeries, ncol = length(IndOutputsCemaNeige)), ### output series [mm]
+ StateEnd = rep(as.double(-999.999), as.integer(NStates)) ### state variables at the end of the model run
)
- RESULTS$Outputs[ round(RESULTS$Outputs ,3)==(-999.999)] <- NA;
- RESULTS$StateEnd[round(RESULTS$StateEnd,3)==(-999.999)] <- NA;
+ RESULTS$Outputs[ round(RESULTS$Outputs , 3) == -999.999] <- NA
+ RESULTS$StateEnd[round(RESULTS$StateEnd, 3) == -999.999] <- NA
- ##Data_storage
- CemaNeigeLayers[[iLayer]] <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]);
- names(CemaNeigeLayers[[iLayer]]) <- FortranOutputs$CN[IndOutputsCemaNeige];
- IndPliqAndMelt <- which(names(CemaNeigeLayers[[iLayer]]) == "PliqAndMelt");
- if(iLayer==1){ CatchMeltAndPliq <- RESULTS$Outputs[,IndPliqAndMelt]/NLayers; }
- if(iLayer >1){ CatchMeltAndPliq <- CatchMeltAndPliq + RESULTS$Outputs[,IndPliqAndMelt]/NLayers; }
- if(ExportStateEnd){ CemaNeigeStateEnd <- c(CemaNeigeStateEnd,RESULTS$StateEnd); }
- rm(RESULTS);
- } ###ENDFOR_iLayer
+ ## Data storage
+ CemaNeigeLayers[[iLayer]] <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i])
+ names(CemaNeigeLayers[[iLayer]]) <- FortranOutputs$CN[IndOutputsCemaNeige]
+ IndPliqAndMelt <- which(names(CemaNeigeLayers[[iLayer]]) == "PliqAndMelt")
+ if (iLayer == 1) {
+ CatchMeltAndPliq <- RESULTS$Outputs[, IndPliqAndMelt] / NLayers
+ }
+ if (iLayer > 1) {
+ CatchMeltAndPliq <- CatchMeltAndPliq + RESULTS$Outputs[, IndPliqAndMelt] / NLayers
+ }
+ if (ExportStateEnd) {
+ CemaNeigeStateEnd <- c(CemaNeigeStateEnd, RESULTS$StateEnd)
+ }
+ rm(RESULTS)
+ } ### ENDFOR iLayer
names(CemaNeigeLayers) <- sprintf("Layer%02i", seq_len(NLayers))
- } ###ENDIF_RunSnowModule
- if(!inherits(RunOptions,"CemaNeige")){
- CemaNeigeLayers <- list(); CemaNeigeStateEnd <- NULL; NameCemaNeigeLayers <- NULL;
- CatchMeltAndPliq <- InputsModel$Precip[IndPeriod1]; }
+ } ### ENDIF RunSnowModule
+ if (!inherits(RunOptions, "CemaNeige")) {
+ CemaNeigeLayers <- list()
+ CemaNeigeStateEnd <- NULL
+ NameCemaNeigeLayers <- NULL
+ CatchMeltAndPliq <- InputsModel$Precip[IndPeriod1]
+ }
- ##MODEL______________________________________________________________________________________##
- if("all" %in% RunOptions$Outputs_Sim){ IndOutputsMod <- as.integer(1:length(FortranOutputs$GR));
- } else { IndOutputsMod <- which(FortranOutputs$GR %in% RunOptions$Outputs_Sim); }
+ ## GR model______________________________________________________________________________________
+ if ("all" %in% RunOptions$Outputs_Sim) {
+ IndOutputsMod <- as.integer(1:length(FortranOutputs$GR))
+ } else {
+ IndOutputsMod <- which(FortranOutputs$GR %in% RunOptions$Outputs_Sim)
+ }
- ##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)
- if(IsIntStore) {
- RunOptions$IniStates[4] <- RunOptions$IniResLevels[4] * Imax; ### interception store level (mm)
+ ## 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)
+ if (IsIntStore) {
+ RunOptions$IniStates[4] <- RunOptions$IniResLevels[4] * Imax ### interception store level (mm)
}
}
- ##Call_fortan
+ ## Call GR model Fortan
RESULTS <- .Fortran("frun_gr5h",PACKAGE="airGR",
- ##inputs
- LInputs=LInputSeries, ### length of input and output series
- InputsPrecip=InputsModel$Precip[IndPeriod1], ### input series of total precipitation [mm/h]
- InputsPE=InputsModel$PotEvap[IndPeriod1], ### input series potential evapotranspiration [mm/h]
- NParam=as.integer(length(Param)), ### number of model parameter
- Param=Param, ### parameter set
- NStates=as.integer(length(RunOptions$IniStates)), ### number of state variables used for model initialising
- StateStart=RunOptions$IniStates, ### state variables used when the model run starts
- Imax=Imax, ### maximal capacity of interception store
- NOutputs=as.integer(length(IndOutputsMod)), ### number of output series
- IndOutputs=IndOutputsMod, ### indices of output series
- ##outputs
- Outputs=matrix(as.double(-999.999),nrow=LInputSeries,ncol=length(IndOutputsMod)), ### output series [mm or mm/h]
- StateEnd=rep(as.double(-999.999),length(RunOptions$IniStates)) ### state variables at the end of the model run
+ ## inputs
+ LInputs = LInputSeries, ### length of input and output series
+ InputsPrecip = InputsModel$Precip[IndPeriod1], ### input series of total precipitation [mm/h]
+ InputsPE = InputsModel$PotEvap[IndPeriod1], ### input series potential evapotranspiration [mm/h]
+ NParam = as.integer(length(Param)), ### number of model parameter
+ Param = Param, ### parameter set
+ NStates = as.integer(length(RunOptions$IniStates)), ### number of state variables used for model initialising
+ StateStart = RunOptions$IniStates, ### state variables used when the model run starts
+ Imax = Imax, ### maximal capacity of interception store
+ NOutputs = as.integer(length(IndOutputsMod)), ### number of output series
+ IndOutputs = IndOutputsMod, ### indices of output series
+ ## outputs
+ Outputs = matrix(as.double(-999.999), nrow = LInputSeries, ncol = length(IndOutputsMod)), ### output series [mm or mm/h]
+ StateEnd = rep(as.double(-999.999), length(RunOptions$IniStates)) ### state variables at the end of the model run
)
- RESULTS$Outputs[ round(RESULTS$Outputs ,3)==(-999.999)] <- NA;
- RESULTS$StateEnd[round(RESULTS$StateEnd,3)==(-999.999)] <- NA;
+ RESULTS$Outputs[ round(RESULTS$Outputs , 3) == -999.999] <- NA
+ RESULTS$StateEnd[round(RESULTS$StateEnd, 3) == -999.999] <- NA
if (ExportStateEnd) {
RESULTS$StateEnd[-3L] <- ifelse(RESULTS$StateEnd[-3L] < 0, 0, RESULTS$StateEnd[-3L]) ### remove negative values except for the ExpStore location
idNStates <- seq_len(NStates*NLayers) %% NStates
@@ -154,45 +200,51 @@ RunModel_CemaNeigeGR5H <- function(InputsModel,RunOptions,Param){
GlocmaxCemaNeigeLayers = CemaNeigeStateEnd[seq_len(NStates*NLayers)[idNStates == 0]],
verbose = FALSE)
}
-
- if(inherits(RunOptions,"CemaNeige") & "Precip" %in% RunOptions$Outputs_Sim){ RESULTS$Outputs[,which(FortranOutputs$GR[IndOutputsMod]=="Precip")] <- InputsModel$Precip[IndPeriod1]; }
-
- ##Output_data_preparation
- ##OutputsModel_only
- ##OutputsModel_only
- if(!ExportDatesR & !ExportStateEnd){
- OutputsModel <- c( lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]),
- list(CemaNeigeLayers) );
- names(OutputsModel) <- c(FortranOutputs$GR[IndOutputsMod],NameCemaNeigeLayers); }
- ##DatesR_and_OutputsModel_only
- if( ExportDatesR & !ExportStateEnd){
- OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]),
- list(CemaNeigeLayers) );
- names(OutputsModel) <- c("DatesR",FortranOutputs$GR[IndOutputsMod],NameCemaNeigeLayers); }
- ##OutputsModel_and_SateEnd_only
- if(!ExportDatesR & ExportStateEnd){
- OutputsModel <- c( lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]),
- list(CemaNeigeLayers),
- list(RESULTS$StateEnd) );
- names(OutputsModel) <- c(FortranOutputs$GR[IndOutputsMod],NameCemaNeigeLayers,"StateEnd"); }
- ##DatesR_and_OutputsModel_and_SateEnd
- if( ExportDatesR & ExportStateEnd){
+
+ if (inherits(RunOptions, "CemaNeige") & "Precip" %in% RunOptions$Outputs_Sim) {
+ RESULTS$Outputs[,which(FortranOutputs$GR[IndOutputsMod]=="Precip")] <- InputsModel$Precip[IndPeriod1]
+ }
+
+ ## Output data preparation
+ ## OutputsModel only
+ ## OutputsModel only
+ if (!ExportDatesR & !ExportStateEnd) {
+ OutputsModel <- c(lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
+ list(CemaNeigeLayers))
+ names(OutputsModel) <- c(FortranOutputs$GR[IndOutputsMod], NameCemaNeigeLayers)
+ }
+ ## DatesR and OutputsModel only
+ if ( ExportDatesR & !ExportStateEnd) {
+ OutputsModel <- c(list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
+ lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
+ list(CemaNeigeLayers))
+ names(OutputsModel) <- c("DatesR", FortranOutputs$GR[IndOutputsMod], NameCemaNeigeLayers)
+ }
+ ## OutputsModel and SateEnd only
+ if (!ExportDatesR & ExportStateEnd) {
+ OutputsModel <- c(lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
+ list(CemaNeigeLayers),
+ list(RESULTS$StateEnd))
+ names(OutputsModel) <- c(FortranOutputs$GR[IndOutputsMod], NameCemaNeigeLayers, "StateEnd")
+ }
+ ## DatesR and OutputsModel and SateEnd
+ if ( ExportDatesR & ExportStateEnd) {
OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]),
+ lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
list(CemaNeigeLayers),
- list(RESULTS$StateEnd) );
- names(OutputsModel) <- c("DatesR",FortranOutputs$GR[IndOutputsMod],NameCemaNeigeLayers,"StateEnd"); }
+ list(RESULTS$StateEnd))
+ names(OutputsModel) <- c("DatesR", FortranOutputs$GR[IndOutputsMod], NameCemaNeigeLayers, "StateEnd")
+ }
- ##End
- rm(RESULTS);
- class(OutputsModel) <- c("OutputsModel","hourly","GR","CemaNeige");
- if(IsHyst) {
+ ## End
+ rm(RESULTS)
+ class(OutputsModel) <- c("OutputsModel", "hourly", "GR", "CemaNeige")
+ if (IsHyst) {
class(OutputsModel) <- c(class(OutputsModel), "hysteresis")
}
- if(IsIntStore) {
+ if (IsIntStore) {
class(OutputsModel) <- c(class(OutputsModel), "interception")
}
- return(OutputsModel);
+ return(OutputsModel)
}
diff --git a/R/RunModel_CemaNeigeGR5J.R b/R/RunModel_CemaNeigeGR5J.R
index 2d41be506a20dd5cebe5ef3e0ca5006aa5ada343..3e3344d5e3b589bb310d15e075a528e86a2b91b2 100644
--- a/R/RunModel_CemaNeigeGR5J.R
+++ b/R/RunModel_CemaNeigeGR5J.R
@@ -1,180 +1,226 @@
-RunModel_CemaNeigeGR5J <- function(InputsModel,RunOptions,Param){
-
+RunModel_CemaNeigeGR5J <- function(InputsModel, RunOptions, Param) {
+
+ ## Initialization of variables
IsHyst <- inherits(RunOptions, "hysteresis")
NParam <- ifelse(test = IsHyst, yes = 9L, no = 7L)
NParamCN <- NParam - 5L
NStates <- 4L
FortranOutputs <- .FortranOutputs(GR = "GR5J", isCN = TRUE)
-
- ##Arguments_check
- if(inherits(InputsModel,"InputsModel")==FALSE){ stop("'InputsModel' must be of class 'InputsModel'") }
- if(inherits(InputsModel,"daily" )==FALSE){ stop("'InputsModel' must be of class 'daily' ") }
- if(inherits(InputsModel,"GR" )==FALSE){ stop("'InputsModel' must be of class 'GR' ") }
- if(inherits(InputsModel,"CemaNeige" )==FALSE){ stop("'InputsModel' must be of class 'CemaNeige' ") }
- if(inherits(RunOptions,"RunOptions" )==FALSE){ stop("'RunOptions' must be of class 'RunOptions' ") }
- if(inherits(RunOptions,"GR" )==FALSE){ stop("'RunOptions' must be of class 'GR' ") }
- if(inherits(RunOptions,"CemaNeige" )==FALSE){ stop("'RunOptions' must be of class 'CemaNeige' ") }
- if(!is.vector(Param) | !is.numeric(Param)){ stop("'Param' must be a numeric vector") }
- if(sum(!is.na(Param))!=NParam){ stop(paste("'Param' must be a vector of length ",NParam," and contain no NA",sep="")) }
- Param <- as.double(Param);
-
- Param_X1X3_threshold <- 1e-2
- Param_X4_threshold <- 0.5
- if (Param[1L] < Param_X1X3_threshold) {
- warning(sprintf("Param[1] (X1: production store capacity [mm]) < %.2f\n X1 set to %.2f", Param_X1X3_threshold, Param_X1X3_threshold))
- Param[1L] <- Param_X1X3_threshold
- }
- if (Param[3L] < Param_X1X3_threshold) {
- warning(sprintf("Param[3] (X3: routing store capacity [mm]) < %.2f\n X3 set to %.2f", Param_X1X3_threshold, Param_X1X3_threshold))
- Param[3L] <- Param_X1X3_threshold
+
+
+ ## Arguments check
+ if (!inherits(InputsModel, "InputsModel")) {
+ stop("'InputsModel' must be of class 'InputsModel'")
+ }
+ if (!inherits(InputsModel, "daily")) {
+ stop("'InputsModel' must be of class 'daily'")
+ }
+ if (!inherits(InputsModel, "GR")) {
+ stop("'InputsModel' must be of class 'GR'")
+ }
+ if (!inherits(InputsModel, "CemaNeige")) {
+ stop("'InputsModel' must be of class 'CemaNeige'")
+ }
+ if (!inherits(RunOptions, "RunOptions")) {
+ stop("'RunOptions' must be of class 'RunOptions'")
+ }
+ if (!inherits(RunOptions, "GR")) {
+ stop("'RunOptions' must be of class 'GR'")
+ }
+ if (!inherits(RunOptions, "CemaNeige")) {
+ stop("'RunOptions' must be of class 'CemaNeige'")
+ }
+ if (!is.vector(Param) | !is.numeric(Param)) {
+ stop("'Param' must be a numeric vector")
+ }
+ if (sum(!is.na(Param)) != NParam) {
+ stop(paste("'Param' must be a vector of length", NParam, "and contain no NA"))
+ }
+ Param <- as.double(Param)
+
+
+ Param_X1X3_threshold <- 1e-2
+ Param_X4_threshold <- 0.5
+ if (Param[1L] < Param_X1X3_threshold) {
+ warning(sprintf("Param[1] (X1: production store capacity [mm]) < %.2f\n X1 set to %.2f", Param_X1X3_threshold, Param_X1X3_threshold))
+ Param[1L] <- Param_X1X3_threshold
+ }
+ if (Param[3L] < Param_X1X3_threshold) {
+ warning(sprintf("Param[3] (X3: routing store capacity [mm]) < %.2f\n X3 set to %.2f", Param_X1X3_threshold, Param_X1X3_threshold))
+ Param[3L] <- Param_X1X3_threshold
+ }
+ if (Param[4L] < Param_X4_threshold) {
+ warning(sprintf("Param[4] (X4: unit hydrograph time constant [d]) < %.2f\n X4 set to %.2f", Param_X4_threshold, Param_X4_threshold))
+ Param[4L] <- Param_X4_threshold
+ }
+
+ ## Input data preparation
+ if (identical(RunOptions$IndPeriod_WarmUp, 0L)) {
+ RunOptions$IndPeriod_WarmUp <- NULL
+ }
+ IndPeriod1 <- c(RunOptions$IndPeriod_WarmUp,RunOptions$IndPeriod_Run)
+ LInputSeries <- as.integer(length(IndPeriod1))
+ IndPeriod2 <- (length(RunOptions$IndPeriod_WarmUp) + 1):LInputSeries
+ ParamCemaNeige <- Param[(length(Param) - 1 - 2 * as.integer(IsHyst)):length(Param)]
+ NParamMod <- as.integer(length(Param) - (2 + 2 * as.integer(IsHyst)))
+ ParamMod <- Param[1:NParamMod]
+ NLayers <- length(InputsModel$LayerPrecip)
+ NStatesMod <- as.integer(length(RunOptions$IniStates) - NStates * NLayers)
+ ExportDatesR <- "DatesR" %in% RunOptions$Outputs_Sim
+ ExportStateEnd <- "StateEnd" %in% RunOptions$Outputs_Sim
+
+
+ ## CemaNeige________________________________________________________________________________
+ if (inherits(RunOptions, "CemaNeige")) {
+ if ("all" %in% RunOptions$Outputs_Sim) {
+ IndOutputsCemaNeige <- as.integer(1:length(FortranOutputs$CN))
+ } else {
+ IndOutputsCemaNeige <- which(FortranOutputs$CN %in% RunOptions$Outputs_Sim)
+ }
+ CemaNeigeLayers <- list()
+ CemaNeigeStateEnd <- NULL
+ NameCemaNeigeLayers <- "CemaNeigeLayers"
+
+
+ ## Call CemaNeige Fortran_________________________
+ for(iLayer in 1:NLayers) {
+ if (!IsHyst) {
+ StateStartCemaNeige <- RunOptions$IniStates[(7 + 20 + 40) + c(iLayer, iLayer+NLayers)]
+ } else {
+ StateStartCemaNeige <- RunOptions$IniStates[(7 + 20 + 40) + c(iLayer, iLayer+NLayers, iLayer+2*NLayers, iLayer+3*NLayers)]
}
- if (Param[4L] < Param_X4_threshold) {
- warning(sprintf("Param[4] (X4: unit hydrograph time constant [d]) < %.2f\n X4 set to %.2f", Param_X4_threshold, Param_X4_threshold))
- Param[4L] <- Param_X4_threshold
- }
-
- ##Input_data_preparation
- if(identical(RunOptions$IndPeriod_WarmUp,as.integer(0))){ RunOptions$IndPeriod_WarmUp <- NULL; }
- IndPeriod1 <- c(RunOptions$IndPeriod_WarmUp,RunOptions$IndPeriod_Run);
- LInputSeries <- as.integer(length(IndPeriod1))
- IndPeriod2 <- (length(RunOptions$IndPeriod_WarmUp)+1):LInputSeries;
- ParamCemaNeige <- Param[(length(Param)-1-2*as.integer(IsHyst)):length(Param)];
- NParamMod <- as.integer(length(Param)-(2+2*as.integer(IsHyst)));
- ParamMod <- Param[1:NParamMod];
- NLayers <- length(InputsModel$LayerPrecip);
- NStatesMod <- as.integer(length(RunOptions$IniStates)-NStates*NLayers);
- ExportDatesR <- "DatesR" %in% RunOptions$Outputs_Sim;
- ExportStateEnd <- "StateEnd" %in% RunOptions$Outputs_Sim;
-
-
- ##SNOW_MODULE________________________________________________________________________________##
- if(inherits(RunOptions,"CemaNeige")==TRUE){
- if("all" %in% RunOptions$Outputs_Sim){ IndOutputsCemaNeige <- as.integer(1:length(FortranOutputs$CN));
- } else { IndOutputsCemaNeige <- which(FortranOutputs$CN %in% RunOptions$Outputs_Sim); }
- CemaNeigeLayers <- list(); CemaNeigeStateEnd <- NULL; NameCemaNeigeLayers <- "CemaNeigeLayers";
-
+ RESULTS <- .Fortran("frun_cemaneige", PACKAGE="airGR",
+ ## inputs
+ LInputs = LInputSeries, ### length of input and output series
+ InputsPrecip = InputsModel$LayerPrecip[[iLayer]][IndPeriod1], ### input series of total precipitation [mm/d]
+ InputsFracSolidPrecip = InputsModel$LayerFracSolidPrecip[[iLayer]][IndPeriod1], ### input series of fraction of solid precipitation [0-1]
+ InputsTemp = InputsModel$LayerTemp[[iLayer]][IndPeriod1], ### input series of air mean temperature [degC]
+ MeanAnSolidPrecip = RunOptions$MeanAnSolidPrecip[iLayer], ### value of annual mean solid precip [mm/y]
+ NParam = as.integer(NParamCN), ### number of model parameters = 2 or 4
+ Param = as.double(ParamCemaNeige), ### parameter set
+ NStates = as.integer(NStates), ### number of state variables used for model initialising = 4
+ StateStart = StateStartCemaNeige, ### state variables used when the model run starts
+ IsHyst = as.integer(IsHyst), ### use of hysteresis
+ NOutputs = as.integer(length(IndOutputsCemaNeige)), ### number of output series
+ IndOutputs = IndOutputsCemaNeige, ### indices of output series
+ ## outputs
+ Outputs = matrix(as.double(-999.999), nrow = LInputSeries, ncol = length(IndOutputsCemaNeige)), ### output series [mm]
+ StateEnd = rep(as.double(-999.999), as.integer(NStates)) ### state variables at the end of the model run
+ )
+ RESULTS$Outputs[ round(RESULTS$Outputs , 3) == -999.999] <- NA
+ RESULTS$StateEnd[round(RESULTS$StateEnd, 3) == -999.999] <- NA
- ##Call_DLL_CemaNeige_________________________
- for(iLayer in 1:NLayers){
- if (!IsHyst) {
- StateStartCemaNeige <- RunOptions$IniStates[(7 + 20 + 40) + c(iLayer, iLayer+NLayers)]
- } else {
- StateStartCemaNeige <- RunOptions$IniStates[(7 + 20 + 40) + c(iLayer, iLayer+NLayers, iLayer+2*NLayers, iLayer+3*NLayers)]
+ ## Data storage
+ CemaNeigeLayers[[iLayer]] <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i])
+ names(CemaNeigeLayers[[iLayer]]) <- FortranOutputs$CN[IndOutputsCemaNeige]
+ IndPliqAndMelt <- which(names(CemaNeigeLayers[[iLayer]]) == "PliqAndMelt")
+ if (iLayer == 1) {
+ CatchMeltAndPliq <- RESULTS$Outputs[, IndPliqAndMelt] / NLayers
}
- RESULTS <- .Fortran("frun_cemaneige",PACKAGE="airGR",
- ##inputs
- LInputs=LInputSeries, ### length of input and output series
- InputsPrecip=InputsModel$LayerPrecip[[iLayer]][IndPeriod1], ### input series of total precipitation [mm/d]
- InputsFracSolidPrecip=InputsModel$LayerFracSolidPrecip[[iLayer]][IndPeriod1], ### input series of fraction of solid precipitation [0-1]
- InputsTemp=InputsModel$LayerTemp[[iLayer]][IndPeriod1], ### input series of air mean temperature [degC]
- MeanAnSolidPrecip=RunOptions$MeanAnSolidPrecip[iLayer], ### value of annual mean solid precip [mm/y]
- NParam=as.integer(NParamCN), ### number of model parameters = 2 or 4
- Param=as.double(ParamCemaNeige), ### parameter set
- NStates=as.integer(NStates), ### number of state variables used for model initialising = 4
- StateStart=StateStartCemaNeige, ### state variables used when the model run starts
- IsHyst = as.integer(IsHyst), ### use of hysteresis
- NOutputs=as.integer(length(IndOutputsCemaNeige)), ### number of output series
- IndOutputs=IndOutputsCemaNeige, ### indices of output series
- ##outputs
- Outputs=matrix(as.double(-999.999),nrow=LInputSeries,ncol=length(IndOutputsCemaNeige)), ### output series [mm]
- StateEnd=rep(as.double(-999.999),as.integer(NStates)) ### state variables at the end of the model run
- )
- RESULTS$Outputs[ round(RESULTS$Outputs ,3)==(-999.999)] <- NA;
- RESULTS$StateEnd[round(RESULTS$StateEnd,3)==(-999.999)] <- NA;
-
- ##Data_storage
- CemaNeigeLayers[[iLayer]] <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]);
- names(CemaNeigeLayers[[iLayer]]) <- FortranOutputs$CN[IndOutputsCemaNeige];
- IndPliqAndMelt <- which(names(CemaNeigeLayers[[iLayer]]) == "PliqAndMelt");
- if(iLayer==1){ CatchMeltAndPliq <- RESULTS$Outputs[,IndPliqAndMelt]/NLayers; }
- if(iLayer >1){ CatchMeltAndPliq <- CatchMeltAndPliq + RESULTS$Outputs[,IndPliqAndMelt]/NLayers; }
- if(ExportStateEnd){ CemaNeigeStateEnd <- c(CemaNeigeStateEnd,RESULTS$StateEnd); }
- rm(RESULTS);
- } ###ENDFOR_iLayer
- names(CemaNeigeLayers) <- sprintf("Layer%02i", seq_len(NLayers))
- } ###ENDIF_RunSnowModule
- if(inherits(RunOptions,"CemaNeige")==FALSE){
- CemaNeigeLayers <- list(); CemaNeigeStateEnd <- NULL; NameCemaNeigeLayers <- NULL;
- CatchMeltAndPliq <- InputsModel$Precip[IndPeriod1]; }
-
-
-
- ##MODEL______________________________________________________________________________________##
- if("all" %in% RunOptions$Outputs_Sim){ IndOutputsMod <- as.integer(1:length(FortranOutputs$GR));
- } else { IndOutputsMod <- which(FortranOutputs$GR %in% RunOptions$Outputs_Sim); }
-
- ##Use_of_IniResLevels
- if(!is.null(RunOptions$IniResLevels)){
- RunOptions$IniStates[1] <- RunOptions$IniResLevels[1]*ParamMod[1]; ### production store level (mm)
- RunOptions$IniStates[2] <- RunOptions$IniResLevels[2]*ParamMod[3]; ### routing store level (mm)
+ if (iLayer > 1) {
+ CatchMeltAndPliq <- CatchMeltAndPliq + RESULTS$Outputs[, IndPliqAndMelt] / NLayers
}
-
- ##Call_fortan
- RESULTS <- .Fortran("frun_gr5j",PACKAGE="airGR",
- ##inputs
- LInputs=LInputSeries, ### length of input and output series
- InputsPrecip=CatchMeltAndPliq, ### input series of total precipitation [mm/d]
- InputsPE=InputsModel$PotEvap[IndPeriod1], ### input series potential evapotranspiration [mm/d]
- NParam=NParamMod, ### number of model parameter
- Param=ParamMod, ### parameter set
- NStates=NStatesMod, ### number of state variables used for model initialising
- StateStart=RunOptions$IniStates[1:NStatesMod], ### state variables used when the model run starts
- NOutputs=as.integer(length(IndOutputsMod)), ### number of output series
- IndOutputs=IndOutputsMod, ### indices of output series
- ##outputs
- Outputs=matrix(as.double(-999.999),nrow=LInputSeries,ncol=length(IndOutputsMod)), ### output series [mm]
- StateEnd=rep(as.double(-999.999),NStatesMod) ### state variables at the end of the model run
- )
- RESULTS$Outputs[ round(RESULTS$Outputs ,3)==(-999.999)] <- NA;
- RESULTS$StateEnd[round(RESULTS$StateEnd,3)==(-999.999)] <- NA;
if (ExportStateEnd) {
- RESULTS$StateEnd[-3L] <- ifelse(RESULTS$StateEnd[-3L] < 0, 0, RESULTS$StateEnd[-3L]) ### remove negative values except for the ExpStore location
- idNStates <- seq_len(NStates*NLayers) %% NStates
- RESULTS$StateEnd <- CreateIniStates(FUN_MOD = RunModel_CemaNeigeGR5J, InputsModel = InputsModel, IsHyst = IsHyst,
- ProdStore = RESULTS$StateEnd[1L], RoutStore = RESULTS$StateEnd[2L], ExpStore = NULL,
- UH1 = NULL, UH2 = RESULTS$StateEnd[(1:40)+(7+20)],
- GCemaNeigeLayers = CemaNeigeStateEnd[seq_len(NStates*NLayers)[idNStates == 1]],
- eTGCemaNeigeLayers = CemaNeigeStateEnd[seq_len(NStates*NLayers)[idNStates == 2]],
- GthrCemaNeigeLayers = CemaNeigeStateEnd[seq_len(NStates*NLayers)[idNStates == 3]],
- GlocmaxCemaNeigeLayers = CemaNeigeStateEnd[seq_len(NStates*NLayers)[idNStates == 0]],
- verbose = FALSE)
+ CemaNeigeStateEnd <- c(CemaNeigeStateEnd, RESULTS$StateEnd)
}
-
- if(inherits(RunOptions,"CemaNeige")==TRUE & "Precip" %in% RunOptions$Outputs_Sim){ RESULTS$Outputs[,which(FortranOutputs$GR[IndOutputsMod]=="Precip")] <- InputsModel$Precip[IndPeriod1]; }
-
- ##Output_data_preparation
- ##OutputsModel_only
- if(ExportDatesR==FALSE & ExportStateEnd==FALSE){
- OutputsModel <- c( lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]),
- list(CemaNeigeLayers) );
- names(OutputsModel) <- c(FortranOutputs$GR[IndOutputsMod],NameCemaNeigeLayers); }
- ##DatesR_and_OutputsModel_only
- if(ExportDatesR==TRUE & ExportStateEnd==FALSE){
- OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]),
- list(CemaNeigeLayers) );
- names(OutputsModel) <- c("DatesR",FortranOutputs$GR[IndOutputsMod],NameCemaNeigeLayers); }
- ##OutputsModel_and_SateEnd_only
- if(ExportDatesR==FALSE & ExportStateEnd==TRUE){
- OutputsModel <- c( lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]),
- list(CemaNeigeLayers),
- list(RESULTS$StateEnd) );
- names(OutputsModel) <- c(FortranOutputs$GR[IndOutputsMod],NameCemaNeigeLayers,"StateEnd"); }
- ##DatesR_and_OutputsModel_and_SateEnd
- if(ExportDatesR==TRUE & ExportStateEnd==TRUE){
- OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]),
- list(CemaNeigeLayers),
- list(RESULTS$StateEnd) );
- names(OutputsModel) <- c("DatesR",FortranOutputs$GR[IndOutputsMod],NameCemaNeigeLayers,"StateEnd"); }
-
- ##End
- rm(RESULTS);
- class(OutputsModel) <- c("OutputsModel","daily","GR","CemaNeige");
- if(IsHyst) {
- class(OutputsModel) <- c(class(OutputsModel), "hysteresis")
- }
- return(OutputsModel);
-
+ rm(RESULTS)
+ } ### ENDFOR iLayer
+ names(CemaNeigeLayers) <- sprintf("Layer%02i", seq_len(NLayers))
+ } ### ENDIF RunSnowModule
+ if (!inherits(RunOptions, "CemaNeige")) {
+ CemaNeigeLayers <- list()
+ CemaNeigeStateEnd <- NULL
+ NameCemaNeigeLayers <- NULL
+ CatchMeltAndPliq <- InputsModel$Precip[IndPeriod1]
+ }
+
+
+
+ ## GR model______________________________________________________________________________________
+ if ("all" %in% RunOptions$Outputs_Sim) {
+ IndOutputsMod <- as.integer(1:length(FortranOutputs$GR))
+ } else {
+ IndOutputsMod <- which(FortranOutputs$GR %in% RunOptions$Outputs_Sim)
+ }
+
+ ## Use of IniResLevels
+ if (!is.null(RunOptions$IniResLevels)) {
+ RunOptions$IniStates[1] <- RunOptions$IniResLevels[1] * ParamMod[1] ### production store level (mm)
+ RunOptions$IniStates[2] <- RunOptions$IniResLevels[2] * ParamMod[3] ### routing store level (mm)
+ }
+
+ ## Call GR model Fortan
+ RESULTS <- .Fortran("frun_gr5j", PACKAGE = "airGR",
+ ## inputs
+ LInputs = LInputSeries, ### length of input and output series
+ InputsPrecip = CatchMeltAndPliq, ### input series of total precipitation [mm/d]
+ InputsPE = InputsModel$PotEvap[IndPeriod1], ### input series potential evapotranspiration [mm/d]
+ NParam = NParamMod, ### number of model parameter
+ Param = ParamMod, ### parameter set
+ NStates = NStatesMod, ### number of state variables used for model initialising
+ StateStart = RunOptions$IniStates[1:NStatesMod], ### state variables used when the model run starts
+ NOutputs = as.integer(length(IndOutputsMod)), ### number of output series
+ IndOutputs = IndOutputsMod, ### indices of output series
+ ## outputs
+ Outputs = matrix(as.double(-999.999), nrow = LInputSeries, ncol = length(IndOutputsMod)), ### output series [mm]
+ StateEnd = rep(as.double(-999.999), NStatesMod) ### state variables at the end of the model run
+ )
+ RESULTS$Outputs[ round(RESULTS$Outputs , 3) == -999.999] <- NA
+ RESULTS$StateEnd[round(RESULTS$StateEnd, 3) == -999.999] <- NA
+ if (ExportStateEnd) {
+ RESULTS$StateEnd[-3L] <- ifelse(RESULTS$StateEnd[-3L] < 0, 0, RESULTS$StateEnd[-3L]) ### remove negative values except for the ExpStore location
+ idNStates <- seq_len(NStates*NLayers) %% NStates
+ RESULTS$StateEnd <- CreateIniStates(FUN_MOD = RunModel_CemaNeigeGR5J, InputsModel = InputsModel, IsHyst = IsHyst,
+ ProdStore = RESULTS$StateEnd[1L], RoutStore = RESULTS$StateEnd[2L], ExpStore = NULL,
+ UH1 = NULL, UH2 = RESULTS$StateEnd[(1:40)+(7+20)],
+ GCemaNeigeLayers = CemaNeigeStateEnd[seq_len(NStates*NLayers)[idNStates == 1]],
+ eTGCemaNeigeLayers = CemaNeigeStateEnd[seq_len(NStates*NLayers)[idNStates == 2]],
+ GthrCemaNeigeLayers = CemaNeigeStateEnd[seq_len(NStates*NLayers)[idNStates == 3]],
+ GlocmaxCemaNeigeLayers = CemaNeigeStateEnd[seq_len(NStates*NLayers)[idNStates == 0]],
+ verbose = FALSE)
+ }
+
+ if (inherits(RunOptions, "CemaNeige") & "Precip" %in% RunOptions$Outputs_Sim) {
+ RESULTS$Outputs[,which(FortranOutputs$GR[IndOutputsMod] == "Precip")] <- InputsModel$Precip[IndPeriod1]
+ }
+
+ ## Output data preparation
+ ## OutputsModel only
+ if (!ExportDatesR & !ExportStateEnd) {
+ OutputsModel <- c(lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
+ list(CemaNeigeLayers))
+ names(OutputsModel) <- c(FortranOutputs$GR[IndOutputsMod], NameCemaNeigeLayers)
+ }
+ ## DatesR and OutputsModel only
+ if (ExportDatesR & !ExportStateEnd) {
+ OutputsModel <- c(list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
+ lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
+ list(CemaNeigeLayers))
+ names(OutputsModel) <- c("DatesR", FortranOutputs$GR[IndOutputsMod], NameCemaNeigeLayers)
+ }
+ ## OutputsModel and SateEnd only
+ if (!ExportDatesR & ExportStateEnd) {
+ OutputsModel <- c(lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
+ list(CemaNeigeLayers),
+ list(RESULTS$StateEnd))
+ names(OutputsModel) <- c(FortranOutputs$GR[IndOutputsMod], NameCemaNeigeLayers, "StateEnd")
+ }
+ ## DatesR and OutputsModel and SateEnd
+ if (ExportDatesR & ExportStateEnd) {
+ OutputsModel <- c(list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
+ lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
+ list(CemaNeigeLayers),
+ list(RESULTS$StateEnd))
+ names(OutputsModel) <- c("DatesR", FortranOutputs$GR[IndOutputsMod], NameCemaNeigeLayers, "StateEnd")
+ }
+
+ ## End
+ rm(RESULTS)
+ class(OutputsModel) <- c("OutputsModel", "daily", "GR", "CemaNeige")
+ if (IsHyst) {
+ class(OutputsModel) <- c(class(OutputsModel), "hysteresis")
+ }
+ return(OutputsModel)
+
}
diff --git a/R/RunModel_CemaNeigeGR6J.R b/R/RunModel_CemaNeigeGR6J.R
index 54b4497f6f6a989952eb6978d37f9bc1e46af026..60c32a26898d8fa164b78d46d02cce8e7267419b 100644
--- a/R/RunModel_CemaNeigeGR6J.R
+++ b/R/RunModel_CemaNeigeGR6J.R
@@ -1,186 +1,232 @@
-RunModel_CemaNeigeGR6J <- function(InputsModel,RunOptions,Param){
-
+RunModel_CemaNeigeGR6J <- function(InputsModel, RunOptions, Param) {
+
+ ## Initialization of variables
IsHyst <- inherits(RunOptions, "hysteresis")
NParam <- ifelse(test = IsHyst, yes = 10L, no = 8L)
NParamCN <- NParam - 6L
NStates <- 4L
FortranOutputs <- .FortranOutputs(GR = "GR6J", isCN = TRUE)
-
- ##Arguments_check
- if(inherits(InputsModel,"InputsModel")==FALSE){ stop("'InputsModel' must be of class 'InputsModel'") }
- if(inherits(InputsModel,"daily" )==FALSE){ stop("'InputsModel' must be of class 'daily' ") }
- if(inherits(InputsModel,"GR" )==FALSE){ stop("'InputsModel' must be of class 'GR' ") }
- if(inherits(InputsModel,"CemaNeige" )==FALSE){ stop("'InputsModel' must be of class 'CemaNeige' ") }
- if(inherits(RunOptions,"RunOptions" )==FALSE){ stop("'RunOptions' must be of class 'RunOptions' ") }
- if(inherits(RunOptions,"GR" )==FALSE){ stop("'RunOptions' must be of class 'GR' ") }
- if(inherits(RunOptions,"CemaNeige" )==FALSE){ stop("'RunOptions' must be of class 'CemaNeige' ") }
- if(!is.vector(Param) | !is.numeric(Param)){ stop("'Param' must be a numeric vector") }
- if(sum(!is.na(Param))!=NParam){ stop(paste("'Param' must be a vector of length ",NParam," and contain no NA",sep="")) }
- Param <- as.double(Param);
-
- Param_X1X3X6_threshold <- 1e-2
- Param_X4_threshold <- 0.5
- if (Param[1L] < Param_X1X3X6_threshold) {
- warning(sprintf("Param[1] (X1: production store capacity [mm]) < %.2f\n X1 set to %.2f", Param_X1X3X6_threshold, Param_X1X3X6_threshold))
- Param[1L] <- Param_X1X3X6_threshold
- }
- if (Param[3L] < Param_X1X3X6_threshold) {
- warning(sprintf("Param[3] (X3: routing store capacity [mm]) < %.2f\n X3 set to %.2f", Param_X1X3X6_threshold, Param_X1X3X6_threshold))
- Param[3L] <- Param_X1X3X6_threshold
+
+
+ ## Arguments check
+ if (!inherits(InputsModel, "InputsModel")) {
+ stop("'InputsModel' must be of class 'InputsModel'")
+ }
+ if (!inherits(InputsModel, "daily")) {
+ stop("'InputsModel' must be of class 'daily'")
+ }
+ if (!inherits(InputsModel, "GR")) {
+ stop("'InputsModel' must be of class 'GR'")
+ }
+ if (!inherits(InputsModel, "CemaNeige")) {
+ stop("'InputsModel' must be of class 'CemaNeige'")
+ }
+ if (!inherits(RunOptions, "RunOptions")) {
+ stop("'RunOptions' must be of class 'RunOptions'")
+ }
+ if (!inherits(RunOptions, "GR")) {
+ stop("'RunOptions' must be of class 'GR'")
+ }
+ if (!inherits(RunOptions, "CemaNeige")) {
+ stop("'RunOptions' must be of class 'CemaNeige'")
+ }
+ if (!is.vector(Param) | !is.numeric(Param)) {
+ stop("'Param' must be a numeric vector")
+ }
+ if (sum(!is.na(Param)) != NParam) {
+ stop(paste("'Param' must be a vector of length", NParam, "and contain no NA"))
+ }
+ Param <- as.double(Param)
+
+
+ Param_X1X3X6_threshold <- 1e-2
+ Param_X4_threshold <- 0.5
+ if (Param[1L] < Param_X1X3X6_threshold) {
+ warning(sprintf("Param[1] (X1: production store capacity [mm]) < %.2f\n X1 set to %.2f", Param_X1X3X6_threshold, Param_X1X3X6_threshold))
+ Param[1L] <- Param_X1X3X6_threshold
+ }
+ if (Param[3L] < Param_X1X3X6_threshold) {
+ warning(sprintf("Param[3] (X3: routing store capacity [mm]) < %.2f\n X3 set to %.2f", Param_X1X3X6_threshold, Param_X1X3X6_threshold))
+ Param[3L] <- Param_X1X3X6_threshold
+ }
+ if (Param[4L] < Param_X4_threshold) {
+ warning(sprintf("Param[4] (X4: unit hydrograph time constant [d]) < %.2f\n X4 set to %.2f", Param_X4_threshold, Param_X4_threshold))
+ Param[4L] <- Param_X4_threshold
+ }
+ if (Param[6L] < Param_X1X3X6_threshold) {
+ warning(sprintf("Param[6] (X6: coefficient for emptying exponential store [mm]) < %.2f\n X6 set to %.2f", Param_X1X3X6_threshold, Param_X1X3X6_threshold))
+ Param[6L] <- Param_X1X3X6_threshold
+ }
+
+ ## Input data preparation
+ if (identical(RunOptions$IndPeriod_WarmUp, 0L)) {
+ RunOptions$IndPeriod_WarmUp <- NULL
+ }
+ IndPeriod1 <- c(RunOptions$IndPeriod_WarmUp,RunOptions$IndPeriod_Run)
+ LInputSeries <- as.integer(length(IndPeriod1))
+ IndPeriod2 <- (length(RunOptions$IndPeriod_WarmUp) + 1):LInputSeries
+ ParamCemaNeige <- Param[(length(Param) - 1 - 2 * as.integer(IsHyst)):length(Param)]
+ NParamMod <- as.integer(length(Param) - (2 + 2 * as.integer(IsHyst)))
+ ParamMod <- Param[1:NParamMod]
+ NLayers <- length(InputsModel$LayerPrecip)
+ NStatesMod <- as.integer(length(RunOptions$IniStates) - NStates * NLayers)
+ ExportDatesR <- "DatesR" %in% RunOptions$Outputs_Sim
+ ExportStateEnd <- "StateEnd" %in% RunOptions$Outputs_Sim
+
+
+ ## CemaNeige________________________________________________________________________________
+ if (inherits(RunOptions, "CemaNeige")) {
+ if ("all" %in% RunOptions$Outputs_Sim) {
+ IndOutputsCemaNeige <- as.integer(1:length(FortranOutputs$CN))
+ } else {
+ IndOutputsCemaNeige <- which(FortranOutputs$CN %in% RunOptions$Outputs_Sim)
+ }
+ CemaNeigeLayers <- list()
+ CemaNeigeStateEnd <- NULL
+ NameCemaNeigeLayers <- "CemaNeigeLayers"
+
+
+ ## Call CemaNeige Fortran_________________________
+ for(iLayer in 1:NLayers) {
+ if (!IsHyst) {
+ StateStartCemaNeige <- RunOptions$IniStates[(7 + 20 + 40) + c(iLayer, iLayer+NLayers)]
+ } else {
+ StateStartCemaNeige <- RunOptions$IniStates[(7 + 20 + 40) + c(iLayer, iLayer+NLayers, iLayer+2*NLayers, iLayer+3*NLayers)]
}
- if (Param[4L] < Param_X4_threshold) {
- warning(sprintf("Param[4] (X4: unit hydrograph time constant [d]) < %.2f\n X4 set to %.2f", Param_X4_threshold, Param_X4_threshold))
- Param[4L] <- Param_X4_threshold
- }
- if (Param[6L] < Param_X1X3X6_threshold) {
- warning(sprintf("Param[6] (X6: coefficient for emptying exponential store [mm]) < %.2f\n X6 set to %.2f", Param_X1X3X6_threshold, Param_X1X3X6_threshold))
- Param[6L] <- Param_X1X3X6_threshold
- }
-
- ##Input_data_preparation
- if(identical(RunOptions$IndPeriod_WarmUp,as.integer(0))){ RunOptions$IndPeriod_WarmUp <- NULL; }
- IndPeriod1 <- c(RunOptions$IndPeriod_WarmUp,RunOptions$IndPeriod_Run);
- LInputSeries <- as.integer(length(IndPeriod1))
- IndPeriod2 <- (length(RunOptions$IndPeriod_WarmUp)+1):LInputSeries;
- ParamCemaNeige <- Param[(length(Param)-1-2*as.integer(IsHyst)):length(Param)];
- NParamMod <- as.integer(length(Param)-(2+2*as.integer(IsHyst)));
- ParamMod <- Param[1:NParamMod];
- NLayers <- length(InputsModel$LayerPrecip);
- NStatesMod <- as.integer(length(RunOptions$IniStates)-NStates*NLayers);
- ExportDatesR <- "DatesR" %in% RunOptions$Outputs_Sim;
- ExportStateEnd <- "StateEnd" %in% RunOptions$Outputs_Sim;
-
-
- ##SNOW_MODULE________________________________________________________________________________##
- if(inherits(RunOptions,"CemaNeige")==TRUE){
- if("all" %in% RunOptions$Outputs_Sim){ IndOutputsCemaNeige <- as.integer(1:length(FortranOutputs$CN));
- } else { IndOutputsCemaNeige <- which(FortranOutputs$CN %in% RunOptions$Outputs_Sim); }
- CemaNeigeLayers <- list(); CemaNeigeStateEnd <- NULL; NameCemaNeigeLayers <- "CemaNeigeLayers";
-
+ RESULTS <- .Fortran("frun_cemaneige", PACKAGE = "airGR",
+ ## inputs
+ LInputs = LInputSeries, ### length of input and output series
+ InputsPrecip = InputsModel$LayerPrecip[[iLayer]][IndPeriod1], ### input series of total precipitation [mm/d]
+ InputsFracSolidPrecip = InputsModel$LayerFracSolidPrecip[[iLayer]][IndPeriod1], ### input series of fraction of solid precipitation [0-1]
+ InputsTemp = InputsModel$LayerTemp[[iLayer]][IndPeriod1], ### input series of air mean temperature [degC]
+ MeanAnSolidPrecip = RunOptions$MeanAnSolidPrecip[iLayer], ### value of annual mean solid precip [mm/y]
+ NParam = as.integer(NParamCN), ### number of model parameters = 2 or 4
+ Param = as.double(ParamCemaNeige), ### parameter set
+ NStates = as.integer(NStates), ### number of state variables used for model initialising = 4
+ StateStart = StateStartCemaNeige, ### state variables used when the model run starts
+ IsHyst = as.integer(IsHyst), ### use of hysteresis
+ NOutputs = as.integer(length(IndOutputsCemaNeige)), ### number of output series
+ IndOutputs = IndOutputsCemaNeige, ### indices of output series
+ ## outputs
+ Outputs = matrix(as.double(-999.999), nrow = LInputSeries,ncol = length(IndOutputsCemaNeige)), ### output series [mm]
+ StateEnd = rep(as.double(-999.999), as.integer(NStates)) ### state variables at the end of the model run
+ )
+ RESULTS$Outputs[ round(RESULTS$Outputs , 3) == -999.999] <- NA
+ RESULTS$StateEnd[round(RESULTS$StateEnd, 3) == -999.999] <- NA
- ##Call_DLL_CemaNeige_________________________
- for(iLayer in 1:NLayers){
- if (!IsHyst) {
- StateStartCemaNeige <- RunOptions$IniStates[(7 + 20 + 40) + c(iLayer, iLayer+NLayers)]
- } else {
- StateStartCemaNeige <- RunOptions$IniStates[(7 + 20 + 40) + c(iLayer, iLayer+NLayers, iLayer+2*NLayers, iLayer+3*NLayers)]
- }
- RESULTS <- .Fortran("frun_cemaneige",PACKAGE="airGR",
- ##inputs
- LInputs=LInputSeries, ### length of input and output series
- InputsPrecip=InputsModel$LayerPrecip[[iLayer]][IndPeriod1], ### input series of total precipitation [mm/d]
- InputsFracSolidPrecip=InputsModel$LayerFracSolidPrecip[[iLayer]][IndPeriod1], ### input series of fraction of solid precipitation [0-1]
- InputsTemp=InputsModel$LayerTemp[[iLayer]][IndPeriod1], ### input series of air mean temperature [degC]
- MeanAnSolidPrecip=RunOptions$MeanAnSolidPrecip[iLayer], ### value of annual mean solid precip [mm/y]
- NParam=as.integer(NParamCN), ### number of model parameters = 2 or 4
- Param=as.double(ParamCemaNeige), ### parameter set
- NStates=as.integer(NStates), ### number of state variables used for model initialising = 4
- StateStart=StateStartCemaNeige, ### state variables used when the model run starts
- IsHyst = as.integer(IsHyst), ### use of hysteresis
- NOutputs=as.integer(length(IndOutputsCemaNeige)), ### number of output series
- IndOutputs=IndOutputsCemaNeige, ### indices of output series
- ##outputs
- Outputs=matrix(as.double(-999.999),nrow=LInputSeries,ncol=length(IndOutputsCemaNeige)), ### output series [mm]
- StateEnd=rep(as.double(-999.999),as.integer(NStates)) ### state variables at the end of the model run
- )
- RESULTS$Outputs[ round(RESULTS$Outputs ,3)==(-999.999)] <- NA;
- RESULTS$StateEnd[round(RESULTS$StateEnd,3)==(-999.999)] <- NA;
-
- ##Data_storage
- CemaNeigeLayers[[iLayer]] <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]);
- names(CemaNeigeLayers[[iLayer]]) <- FortranOutputs$CN[IndOutputsCemaNeige];
- IndPliqAndMelt <- which(names(CemaNeigeLayers[[iLayer]]) == "PliqAndMelt");
- if(iLayer==1){ CatchMeltAndPliq <- RESULTS$Outputs[,IndPliqAndMelt]/NLayers; }
- if(iLayer >1){ CatchMeltAndPliq <- CatchMeltAndPliq + RESULTS$Outputs[,IndPliqAndMelt]/NLayers; }
- if(ExportStateEnd){ CemaNeigeStateEnd <- c(CemaNeigeStateEnd,RESULTS$StateEnd); }
- rm(RESULTS);
- } ###ENDFOR_iLayer
- names(CemaNeigeLayers) <- sprintf("Layer%02i", seq_len(NLayers))
- } ###ENDIF_RunSnowModule
- if(inherits(RunOptions,"CemaNeige")==FALSE){
- CemaNeigeLayers <- list(); CemaNeigeStateEnd <- NULL; NameCemaNeigeLayers <- NULL;
- CatchMeltAndPliq <- InputsModel$Precip[IndPeriod1]; }
-
-
-
- ##MODEL______________________________________________________________________________________##
- if("all" %in% RunOptions$Outputs_Sim){ IndOutputsMod <- as.integer(1:length(FortranOutputs$GR));
- } else { IndOutputsMod <- which(FortranOutputs$GR %in% RunOptions$Outputs_Sim); }
-
- ##Use_of_IniResLevels
- if(!is.null(RunOptions$IniResLevels)){
- RunOptions$IniStates[1] <- RunOptions$IniResLevels[1] * ParamMod[1] ### production store level (mm)
- RunOptions$IniStates[2] <- RunOptions$IniResLevels[2] * ParamMod[3] ### routing store level (mm)
- RunOptions$IniStates[3] <- RunOptions$IniResLevels[3] ### exponential store level (mm)
+ ## Data storage
+ CemaNeigeLayers[[iLayer]] <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i])
+ names(CemaNeigeLayers[[iLayer]]) <- FortranOutputs$CN[IndOutputsCemaNeige]
+ IndPliqAndMelt <- which(names(CemaNeigeLayers[[iLayer]]) == "PliqAndMelt")
+ if (iLayer == 1) {
+ CatchMeltAndPliq <- RESULTS$Outputs[, IndPliqAndMelt] / NLayers
}
-
- ##Call_fortan
- RESULTS <- .Fortran("frun_gr6j",PACKAGE="airGR",
- ##inputs
- LInputs=LInputSeries, ### length of input and output series
- InputsPrecip=CatchMeltAndPliq, ### input series of total precipitation [mm/d]
- InputsPE=InputsModel$PotEvap[IndPeriod1], ### input series potential evapotranspiration [mm/d]
- NParam=NParamMod, ### number of model parameter
- Param=ParamMod, ### parameter set
- NStates=NStatesMod, ### number of state variables used for model initialising
- StateStart=RunOptions$IniStates[1:NStatesMod], ### state variables used when the model run starts
- NOutputs=as.integer(length(IndOutputsMod)), ### number of output series
- IndOutputs=IndOutputsMod, ### indices of output series
- ##outputs
- Outputs=matrix(as.double(-999.999),nrow=LInputSeries,ncol=length(IndOutputsMod)), ### output series [mm]
- StateEnd=rep(as.double(-999.999),NStatesMod) ### state variables at the end of the model run
- )
- RESULTS$Outputs[ round(RESULTS$Outputs ,3)==(-999.999)] <- NA;
- RESULTS$StateEnd[round(RESULTS$StateEnd,3)==(-999.999)] <- NA;
- if (ExportStateEnd) {
- RESULTS$StateEnd[-3L] <- ifelse(RESULTS$StateEnd[-3L] < 0, 0, RESULTS$StateEnd[-3L]) ### remove negative values except for the ExpStore location
- idNStates <- seq_len(NStates*NLayers) %% NStates
- RESULTS$StateEnd <- CreateIniStates(FUN_MOD = RunModel_CemaNeigeGR6J, InputsModel = InputsModel, IsHyst = IsHyst,
- ProdStore = RESULTS$StateEnd[1L], RoutStore = RESULTS$StateEnd[2L], ExpStore = RESULTS$StateEnd[3L],
- UH1 = RESULTS$StateEnd[(1:20)+7], UH2 = RESULTS$StateEnd[(1:40)+(7+20)],
- GCemaNeigeLayers = CemaNeigeStateEnd[seq_len(NStates*NLayers)[idNStates == 1]],
- eTGCemaNeigeLayers = CemaNeigeStateEnd[seq_len(NStates*NLayers)[idNStates == 2]],
- GthrCemaNeigeLayers = CemaNeigeStateEnd[seq_len(NStates*NLayers)[idNStates == 3]],
- GlocmaxCemaNeigeLayers = CemaNeigeStateEnd[seq_len(NStates*NLayers)[idNStates == 0]],
- verbose = FALSE)
+ if (iLayer >1 ) {
+ CatchMeltAndPliq <- CatchMeltAndPliq + RESULTS$Outputs[, IndPliqAndMelt] / NLayers
}
-
- if(inherits(RunOptions,"CemaNeige")==TRUE & "Precip" %in% RunOptions$Outputs_Sim){ RESULTS$Outputs[,which(FortranOutputs$GR[IndOutputsMod]=="Precip")] <- InputsModel$Precip[IndPeriod1]; }
-
- ##Output_data_preparation
- ##OutputsModel_only
- if(ExportDatesR==FALSE & ExportStateEnd==FALSE){
- OutputsModel <- c( lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]),
- list(CemaNeigeLayers) );
- names(OutputsModel) <- c(FortranOutputs$GR[IndOutputsMod],NameCemaNeigeLayers); }
- ##DatesR_and_OutputsModel_only
- if(ExportDatesR==TRUE & ExportStateEnd==FALSE){
- OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]),
- list(CemaNeigeLayers) );
- names(OutputsModel) <- c("DatesR",FortranOutputs$GR[IndOutputsMod],NameCemaNeigeLayers); }
- ##OutputsModel_and_SateEnd_only
- if(ExportDatesR==FALSE & ExportStateEnd==TRUE){
- OutputsModel <- c( lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]),
- list(CemaNeigeLayers),
- list(RESULTS$StateEnd) );
- names(OutputsModel) <- c(FortranOutputs$GR[IndOutputsMod],NameCemaNeigeLayers,"StateEnd"); }
- ##DatesR_and_OutputsModel_and_SateEnd
- if(ExportDatesR==TRUE & ExportStateEnd==TRUE){
- OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]),
- list(CemaNeigeLayers),
- list(RESULTS$StateEnd) );
- names(OutputsModel) <- c("DatesR",FortranOutputs$GR[IndOutputsMod],NameCemaNeigeLayers,"StateEnd"); }
-
- ##End
- rm(RESULTS);
- class(OutputsModel) <- c("OutputsModel","daily","GR","CemaNeige");
- if(IsHyst) {
- class(OutputsModel) <- c(class(OutputsModel), "hysteresis")
+ if (ExportStateEnd) {
+ CemaNeigeStateEnd <- c(CemaNeigeStateEnd,RESULTS$StateEnd)
}
- return(OutputsModel);
-
+ rm(RESULTS)
+ } ### ENDFOR iLayer
+ names(CemaNeigeLayers) <- sprintf("Layer%02i", seq_len(NLayers))
+ } ### ENDIF RunSnowModule
+ if (!inherits(RunOptions, "CemaNeige")) {
+ CemaNeigeLayers <- list()
+ CemaNeigeStateEnd <- NULL
+ NameCemaNeigeLayers <- NULL
+ CatchMeltAndPliq <- InputsModel$Precip[IndPeriod1]
+ }
+
+
+
+ ## GR model______________________________________________________________________________________
+ if ("all" %in% RunOptions$Outputs_Sim) {
+ IndOutputsMod <- as.integer(1:length(FortranOutputs$GR))
+ } else {
+ IndOutputsMod <- which(FortranOutputs$GR %in% RunOptions$Outputs_Sim)
+ }
+
+ ## Use of IniResLevels
+ if (!is.null(RunOptions$IniResLevels)) {
+ RunOptions$IniStates[1] <- RunOptions$IniResLevels[1] * ParamMod[1] ### production store level (mm)
+ RunOptions$IniStates[2] <- RunOptions$IniResLevels[2] * ParamMod[3] ### routing store level (mm)
+ RunOptions$IniStates[3] <- RunOptions$IniResLevels[3] ### exponential store level (mm)
+ }
+
+ ## Call GR model Fortan
+ RESULTS <- .Fortran("frun_gr6j", PACKAGE = "airGR",
+ ## inputs
+ LInputs = LInputSeries, ### length of input and output series
+ InputsPrecip = CatchMeltAndPliq, ### input series of total precipitation [mm/d]
+ InputsPE = InputsModel$PotEvap[IndPeriod1], ### input series potential evapotranspiration [mm/d]
+ NParam = NParamMod, ### number of model parameter
+ Param = ParamMod, ### parameter set
+ NStates = NStatesMod, ### number of state variables used for model initialising
+ StateStart = RunOptions$IniStates[1:NStatesMod], ### state variables used when the model run starts
+ NOutputs = as.integer(length(IndOutputsMod)), ### number of output series
+ IndOutputs = IndOutputsMod, ### indices of output series
+ ## outputs
+ Outputs = matrix(as.double(-999.999), nrow = LInputSeries,ncol = length(IndOutputsMod)), ### output series [mm]
+ StateEnd = rep(as.double(-999.999), NStatesMod) ### state variables at the end of the model run
+ )
+ RESULTS$Outputs[ round(RESULTS$Outputs , 3) == -999.999] <- NA
+ RESULTS$StateEnd[round(RESULTS$StateEnd, 3) == -999.999] <- NA
+ if (ExportStateEnd) {
+ RESULTS$StateEnd[-3L] <- ifelse(RESULTS$StateEnd[-3L] < 0, 0, RESULTS$StateEnd[-3L]) ## remove negative values except for the ExpStore location
+ idNStates <- seq_len(NStates*NLayers) %% NStates
+ RESULTS$StateEnd <- CreateIniStates(FUN_MOD = RunModel_CemaNeigeGR6J, InputsModel = InputsModel, IsHyst = IsHyst,
+ ProdStore = RESULTS$StateEnd[1L], RoutStore = RESULTS$StateEnd[2L], ExpStore = RESULTS$StateEnd[3L],
+ UH1 = RESULTS$StateEnd[(1:20)+7], UH2 = RESULTS$StateEnd[(1:40)+(7+20)],
+ GCemaNeigeLayers = CemaNeigeStateEnd[seq_len(NStates*NLayers)[idNStates == 1]],
+ eTGCemaNeigeLayers = CemaNeigeStateEnd[seq_len(NStates*NLayers)[idNStates == 2]],
+ GthrCemaNeigeLayers = CemaNeigeStateEnd[seq_len(NStates*NLayers)[idNStates == 3]],
+ GlocmaxCemaNeigeLayers = CemaNeigeStateEnd[seq_len(NStates*NLayers)[idNStates == 0]],
+ verbose = FALSE)
+ }
+
+ if (inherits(RunOptions, "CemaNeige") & "Precip" %in% RunOptions$Outputs_Sim) {
+ RESULTS$Outputs[,which(FortranOutputs$GR[IndOutputsMod] == "Precip")] <- InputsModel$Precip[IndPeriod1]
+ }
+
+ ## Output data preparation
+ ## OutputsModel only
+ if (!ExportDatesR & !ExportStateEnd) {
+ OutputsModel <- c(lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
+ list(CemaNeigeLayers))
+ names(OutputsModel) <- c(FortranOutputs$GR[IndOutputsMod], NameCemaNeigeLayers)
+ }
+ ## DatesR and OutputsModel only
+ if (!ExportDatesR & ExportStateEnd) {
+ OutputsModel <- c(list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
+ lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
+ list(CemaNeigeLayers))
+ names(OutputsModel) <- c("DatesR", FortranOutputs$GR[IndOutputsMod], NameCemaNeigeLayers)
+ }
+ ## OutputsModel and SateEnd only
+ if (!ExportDatesR & ExportStateEnd) {
+ OutputsModel <- c(lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
+ list(CemaNeigeLayers),
+ list(RESULTS$StateEnd))
+ names(OutputsModel) <- c(FortranOutputs$GR[IndOutputsMod], NameCemaNeigeLayers, "StateEnd")
+ }
+ ## DatesR and OutputsModel and SateEnd
+ if (ExportDatesR & ExportStateEnd) {
+ OutputsModel <- c(list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
+ lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
+ list(CemaNeigeLayers),
+ list(RESULTS$StateEnd))
+ names(OutputsModel) <- c("DatesR", FortranOutputs$GR[IndOutputsMod], NameCemaNeigeLayers, "StateEnd")
+ }
+
+ ## End
+ rm(RESULTS)
+ class(OutputsModel) <- c("OutputsModel", "daily", "GR", "CemaNeige")
+ if (IsHyst) {
+ class(OutputsModel) <- c(class(OutputsModel), "hysteresis")
+ }
+ return(OutputsModel)
+
}
diff --git a/R/RunModel_GR1A.R b/R/RunModel_GR1A.R
index d636ab4d2ab7e04e73a47d6334965c1614c563ef..58bca283713067eb4ebc0547671b0fc61303b790 100644
--- a/R/RunModel_GR1A.R
+++ b/R/RunModel_GR1A.R
@@ -1,91 +1,105 @@
-RunModel_GR1A <- function(InputsModel,RunOptions,Param){
-
- NParam <- 1;
- FortranOutputs <- .FortranOutputs(GR = "GR1A")$GR
-
- ##Arguments_check
- if(inherits(InputsModel,"InputsModel")==FALSE){ stop("'InputsModel' must be of class 'InputsModel'") }
- if(inherits(InputsModel,"yearly" )==FALSE){ stop("'InputsModel' must be of class 'yearly' ") }
- if(inherits(InputsModel,"GR" )==FALSE){ stop("'InputsModel' must be of class 'GR' ") }
- if(inherits(RunOptions,"RunOptions" )==FALSE){ stop("'RunOptions' must be of class 'RunOptions' ") }
- if(inherits(RunOptions,"GR" )==FALSE){ stop("'RunOptions' must be of class 'GR' ") }
- if(!is.vector(Param) | !is.numeric(Param)){ stop("'Param' must be a numeric vector") }
- if(sum(!is.na(Param))!=NParam){ stop(paste("'Param' must be a vector of length ",NParam," and contain no NA",sep="")) }
- Param <- as.double(Param);
-
- ##Input_data_preparation
- if(identical(RunOptions$IndPeriod_WarmUp,as.integer(0))){ RunOptions$IndPeriod_WarmUp <- NULL; }
- IndPeriod1 <- c(RunOptions$IndPeriod_WarmUp,RunOptions$IndPeriod_Run);
- LInputSeries <- as.integer(length(IndPeriod1))
- if("all" %in% RunOptions$Outputs_Sim){ IndOutputs <- as.integer(1:length(FortranOutputs));
- } else { IndOutputs <- which(FortranOutputs %in% RunOptions$Outputs_Sim); }
-
- ##Output_data_preparation
- IndPeriod2 <- (length(RunOptions$IndPeriod_WarmUp)+1):LInputSeries;
- ExportDatesR <- "DatesR" %in% RunOptions$Outputs_Sim;
- ExportStateEnd <- "StateEnd" %in% RunOptions$Outputs_Sim;
-
- BOOL_Fortran <- FALSE; if(BOOL_Fortran){
- ##Call_fortan
- RESULTS <- .Fortran("frun_gr1a",PACKAGE="airGR",
- ##inputs
- LInputs=LInputSeries, ### length of input and output series
- InputsPrecip=InputsModel$Precip[IndPeriod1], ### input series of total precipitation [mm/y]
- InputsPE=InputsModel$PotEvap[IndPeriod1], ### input series potential evapotranspiration [mm/y]
- NParam=as.integer(length(Param)), ### number of model parameter
- Param=Param, ### parameter set
- NStates=as.integer(length(RunOptions$IniStates)), ### number of state variables used for model initialising
- StateStart=RunOptions$IniStates, ### state variables used when the model run starts
- NOutputs=as.integer(length(IndOutputs)), ### number of output series
- IndOutputs=IndOutputs, ### indices of output series
- ##outputs
- Outputs=matrix(as.double(-999.999),nrow=LInputSeries,ncol=length(IndOutputs)), ### output series [mm]
- StateEnd=rep(as.double(-999.999),length(RunOptions$IniStates)) ### state variables at the end of the model run
- )
- RESULTS$Outputs[ round(RESULTS$Outputs ,3)==(-999.999)] <- NA;
- RESULTS$StateEnd[round(RESULTS$StateEnd,3)==(-999.999)] <- NA;
-
- } else {
- ##R_version
- L <- length(IndPeriod1)
- P0 <- InputsModel$Precip[ IndPeriod1][1:(L-1)]
- P1 <- InputsModel$Precip[ IndPeriod1][2: L ]
- E1 <- InputsModel$PotEvap[IndPeriod1][2: L ]
- Q1 <- P1*(1.-1./(1.+((0.7*P1+0.3*P0)/Param[1]/E1)^2.0)^0.5)
- PEQ <- rbind(c(NA,NA,NA),cbind(P1,E1,Q1))
- Outputs <- PEQ[,IndOutputs]
- if(is.vector(Outputs)){ Outputs <- cbind(Outputs); }
- RESULTS <- list(NOutputs=length(IndOutputs),IndOutputs=IndOutputs,Outputs=Outputs,StatesEnd=NA)
- }
-
-
- ##Output_data_preparation
- ##OutputsModel_only
- if(ExportDatesR==FALSE & ExportStateEnd==FALSE){
- OutputsModel <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]);
- names(OutputsModel) <- FortranOutputs[IndOutputs]; }
- ##DatesR_and_OutputsModel_only
- if(ExportDatesR==TRUE & ExportStateEnd==FALSE){
- OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]) );
- names(OutputsModel) <- c("DatesR",FortranOutputs[IndOutputs]); }
- ##OutputsModel_and_SateEnd_only
- if(ExportDatesR==FALSE & ExportStateEnd==TRUE){
- OutputsModel <- c( lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]),
- list(RESULTS$StateEnd) );
- names(OutputsModel) <- c(FortranOutputs[IndOutputs],"StateEnd"); }
- ##DatesR_and_OutputsModel_and_SateEnd
- if((ExportDatesR==TRUE & ExportStateEnd==TRUE) | "all" %in% RunOptions$Outputs_Sim){
- OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]),
- list(RESULTS$StateEnd) );
- names(OutputsModel) <- c("DatesR",FortranOutputs[IndOutputs],"StateEnd"); }
-
-
- ##End
- rm(RESULTS);
- class(OutputsModel) <- c("OutputsModel","yearly","GR");
- return(OutputsModel);
-
+RunModel_GR1A <- function(InputsModel, RunOptions, Param) {
+
+
+ ## Initialization of variables
+ NParam <- 1
+ FortranOutputs <- .FortranOutputs(GR = "GR1A")$GR
+
+
+ ## Arguments check
+ if (!inherits(InputsModel, "InputsModel")) {
+ stop("'InputsModel' must be of class 'InputsModel'")
+ }
+ if (!inherits(InputsModel, "yearly")) {
+ stop("'InputsModel' must be of class 'yearly'")
+ }
+ if (!inherits(InputsModel, "GR")) {
+ stop("'InputsModel' must be of class 'GR'")
+ }
+ if (!inherits(RunOptions, "RunOptions")) {
+ stop("'RunOptions' must be of class 'RunOptions'")
+ }
+ if (!inherits(RunOptions, "GR")) {
+ stop("'RunOptions' must be of class 'GR'")
+ }
+ if (!is.vector(Param) | !is.numeric(Param)) {
+ stop("'Param' must be a numeric vector")
+ }
+ if (sum(!is.na(Param)) != NParam) {
+ stop(paste("'Param' must be a vector of length", NParam, "and contain no NA"))
+ }
+ Param <- as.double(Param)
+
+
+ ## Input data preparation
+ if (identical(RunOptions$IndPeriod_WarmUp, 0L)) {
+ RunOptions$IndPeriod_WarmUp <- NULL
+ }
+ IndPeriod1 <- c(RunOptions$IndPeriod_WarmUp, RunOptions$IndPeriod_Run)
+ LInputSeries <- as.integer(length(IndPeriod1))
+ if ("all" %in% RunOptions$Outputs_Sim) {
+ IndOutputs <- as.integer(1:length(FortranOutputs))
+ } else {
+ IndOutputs <- which(FortranOutputs %in% RunOptions$Outputs_Sim)
+ }
+
+
+ ## Output data preparation
+ IndPeriod2 <- (length(RunOptions$IndPeriod_WarmUp) + 1):LInputSeries
+ ExportDatesR <- "DatesR" %in% RunOptions$Outputs_Sim
+ ExportStateEnd <- "StateEnd" %in% RunOptions$Outputs_Sim
+
+
+ ## Call GR model Fortan
+ RESULTS <- .Fortran("frun_gr1a", PACKAGE = "airGR",
+ ## inputs
+ LInputs = LInputSeries, ### length of input and output series
+ InputsPrecip = InputsModel$Precip[IndPeriod1], ### input series of total precipitation [mm/y]
+ InputsPE = InputsModel$PotEvap[IndPeriod1], ### input series potential evapotranspiration [mm/y]
+ NParam = as.integer(length(Param)), ### number of model parameter
+ Param = Param, ### parameter set
+ NStates = as.integer(length(RunOptions$IniStates)), ### number of state variables used for model initialising
+ StateStart = RunOptions$IniStates, ### state variables used when the model run starts
+ NOutputs = as.integer(length(IndOutputs)), ### number of output series
+ IndOutputs = IndOutputs, ### indices of output series
+ ## outputs
+ Outputs = matrix(as.double(-999.999), nrow = LInputSeries, ncol=length(IndOutputs)), ### output series [mm]
+ StateEnd = rep(as.double(-999.999), length(RunOptions$IniStates)) ### state variables at the end of the model run
+ )
+ RESULTS$Outputs[ round(RESULTS$Outputs , 3) == -999.999] <- NA
+ RESULTS$StateEnd[round(RESULTS$StateEnd, 3) == -999.999] <- NA
+
+
+ ## Output data preparation
+ ## OutputsModel only
+ if (!ExportDatesR & !ExportStateEnd) {
+ OutputsModel <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i])
+ names(OutputsModel) <- FortranOutputs[IndOutputs]
+ }
+ ## DatesR and OutputsModel only
+ if (ExportDatesR & !ExportStateEnd) {
+ OutputsModel <- c(list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
+ lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]))
+ names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs])
+ }
+ ## OutputsModel and SateEnd only
+ if (!ExportDatesR & ExportStateEnd) {
+ OutputsModel <- c(lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
+ list(RESULTS$StateEnd))
+ names(OutputsModel) <- c(FortranOutputs[IndOutputs], "StateEnd")
+ }
+ ## DatesR and OutputsModel and SateEnd
+ if ((ExportDatesR & ExportStateEnd) | "all" %in% RunOptions$Outputs_Sim) {
+ OutputsModel <- c(list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
+ lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
+ list(RESULTS$StateEnd))
+ names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs], "StateEnd")
+ }
+
+
+ ## End
+ class(OutputsModel) <- c("OutputsModel", "yearly", "GR")
+ return(OutputsModel)
+
}
diff --git a/R/RunModel_GR2M.R b/R/RunModel_GR2M.R
index 59c3e9d414e0692c91384e676e3f0671c1cce20b..385c5f1a798de5ea4ac460fd3fb0d516c7c6430b 100644
--- a/R/RunModel_GR2M.R
+++ b/R/RunModel_GR2M.R
@@ -1,98 +1,124 @@
-RunModel_GR2M <- function(InputsModel,RunOptions,Param){
-
- NParam <- 2;
- FortranOutputs <- .FortranOutputs(GR = "GR2M")$GR
-
- ##Arguments_check
- if(inherits(InputsModel,"InputsModel")==FALSE){ stop("'InputsModel' must be of class 'InputsModel'") }
- if(inherits(InputsModel,"monthly" )==FALSE){ stop("'InputsModel' must be of class 'monthly' ") }
- if(inherits(InputsModel,"GR" )==FALSE){ stop("'InputsModel' must be of class 'GR' ") }
- if(inherits(RunOptions,"RunOptions" )==FALSE){ stop("'RunOptions' must be of class 'RunOptions' ") }
- if(inherits(RunOptions,"GR" )==FALSE){ stop("'RunOptions' must be of class 'GR' ") }
- if(!is.vector(Param) | !is.numeric(Param)){ stop("'Param' must be a numeric vector") }
- if(sum(!is.na(Param))!=NParam){ stop(paste("'Param' must be a vector of length ",NParam," and contain no NA",sep="")) }
- Param <- as.double(Param);
-
- Param_X1X2_threshold <- 1e-2
- if (Param[1L] < Param_X1X2_threshold) {
- warning(sprintf("Param[1] (X1: production store capacity [mm]) < %.2f\n X1 set to %.2f", Param_X1X2_threshold, Param_X1X2_threshold))
- Param[1L] <- Param_X1X2_threshold
- }
- if (Param[2L] < Param_X1X2_threshold) {
- warning(sprintf("Param[2] (X2: routing store capacity [mm]) < %.2f\n X2 set to %.2f", Param_X1X2_threshold, Param_X1X2_threshold))
- Param[2L] <- Param_X1X2_threshold
- }
-
- ##Input_data_preparation
- if(identical(RunOptions$IndPeriod_WarmUp,as.integer(0))){ RunOptions$IndPeriod_WarmUp <- NULL; }
- IndPeriod1 <- c(RunOptions$IndPeriod_WarmUp,RunOptions$IndPeriod_Run);
- LInputSeries <- as.integer(length(IndPeriod1))
- if("all" %in% RunOptions$Outputs_Sim){ IndOutputs <- as.integer(1:length(FortranOutputs));
- } else { IndOutputs <- which(FortranOutputs %in% RunOptions$Outputs_Sim); }
-
- ##Output_data_preparation
- IndPeriod2 <- (length(RunOptions$IndPeriod_WarmUp)+1):LInputSeries;
- ExportDatesR <- "DatesR" %in% RunOptions$Outputs_Sim;
- ExportStateEnd <- "StateEnd" %in% RunOptions$Outputs_Sim;
-
- ##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)
- }
-
- ##Call_fortan
- RESULTS <- .Fortran("frun_gr2M",PACKAGE="airGR",
- ##inputs
- LInputs=LInputSeries, ### length of input and output series
- InputsPrecip=InputsModel$Precip[IndPeriod1], ### input series of total precipitation [mm/month]
- InputsPE=InputsModel$PotEvap[IndPeriod1], ### input series potential evapotranspiration [mm/month]
- NParam=as.integer(length(Param)), ### number of model parameter
- Param=Param, ### parameter set
- NStates=as.integer(length(RunOptions$IniStates)), ### number of state variables used for model initialising
- StateStart=RunOptions$IniStates, ### state variables used when the model run starts
- NOutputs=as.integer(length(IndOutputs)), ### number of output series
- IndOutputs=IndOutputs, ### indices of output series
- ##outputs
- Outputs=matrix(as.double(-999.999),nrow=LInputSeries,ncol=length(IndOutputs)), ### output series [mm]
- StateEnd=rep(as.double(-999.999),length(RunOptions$IniStates)) ### state variables at the end of the model run
- )
- RESULTS$Outputs [round(RESULTS$Outputs ,3)==(-999.999)] <- NA;
- RESULTS$StateEnd[round(RESULTS$StateEnd,3)==(-999.999)] <- NA;
- if (ExportStateEnd) {
- RESULTS$StateEnd <- CreateIniStates(FUN_MOD = RunModel_GR2M, InputsModel = InputsModel,
- ProdStore = RESULTS$StateEnd[1L], RoutStore = RESULTS$StateEnd[2L], ExpStore = NULL,
- UH1 = NULL, UH2 = NULL,
- GCemaNeigeLayers = NULL, eTGCemaNeigeLayers = NULL,
- verbose = FALSE)
- }
-
-
- ##Output_data_preparation
- ##OutputsModel_only
- if(ExportDatesR==FALSE & ExportStateEnd==FALSE){
- OutputsModel <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]);
- names(OutputsModel) <- FortranOutputs[IndOutputs]; }
- ##DatesR_and_OutputsModel_only
- if(ExportDatesR==TRUE & ExportStateEnd==FALSE){
- OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]) );
- names(OutputsModel) <- c("DatesR",FortranOutputs[IndOutputs]); }
- ##OutputsModel_and_SateEnd_only
- if(ExportDatesR==FALSE & ExportStateEnd==TRUE){
- OutputsModel <- c( lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]),
- list(RESULTS$StateEnd) );
- names(OutputsModel) <- c(FortranOutputs[IndOutputs],"StateEnd"); }
- ##DatesR_and_OutputsModel_and_SateEnd
- if((ExportDatesR==TRUE & ExportStateEnd==TRUE) | "all" %in% RunOptions$Outputs_Sim){
- OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]),
- list(RESULTS$StateEnd) );
- names(OutputsModel) <- c("DatesR",FortranOutputs[IndOutputs],"StateEnd"); }
-
- ##End
- rm(RESULTS);
- class(OutputsModel) <- c("OutputsModel","monthly","GR");
- return(OutputsModel);
-
+RunModel_GR2M <- function(InputsModel, RunOptions, Param) {
+
+
+ ## Initialization of variables
+ NParam <- 2
+ FortranOutputs <- .FortranOutputs(GR = "GR2M")$GR
+
+
+ ## Arguments check
+ if (!inherits(InputsModel, "InputsModel")) {
+ stop("'InputsModel' must be of class 'InputsModel'")
+ }
+ if (!inherits(InputsModel, "monthly" )) {
+ stop("'InputsModel' must be of class 'monthly' ")
+ }
+ if (!inherits(InputsModel, "GR" )) {
+ stop("'InputsModel' must be of class 'GR' ")
+ }
+ if (!inherits(RunOptions, "RunOptions" )) {
+ stop("'RunOptions' must be of class 'RunOptions' ")
+ }
+ if (!inherits(RunOptions, "GR" )) {
+ stop("'RunOptions' must be of class 'GR' ")
+ }
+ if (!is.vector(Param) | !is.numeric(Param)) {
+ stop("'Param' must be a numeric vector")
+ }
+ if (sum(!is.na(Param)) != NParam) {
+ stop(paste("'Param' must be a vector of length ", NParam, " and contain no NA", sep = ""))
+ }
+ Param <- as.double(Param)
+
+ Param_X1X2_threshold <- 1e-2
+ if (Param[1L] < Param_X1X2_threshold) {
+ warning(sprintf("Param[1] (X1: production store capacity [mm]) < %.2f\n X1 set to %.2f", Param_X1X2_threshold, Param_X1X2_threshold))
+ Param[1L] <- Param_X1X2_threshold
+ }
+ if (Param[2L] < Param_X1X2_threshold) {
+ warning(sprintf("Param[2] (X2: routing store capacity [mm]) < %.2f\n X2 set to %.2f", Param_X1X2_threshold, Param_X1X2_threshold))
+ Param[2L] <- Param_X1X2_threshold
+ }
+
+ ## Input data preparation
+ if (identical(RunOptions$IndPeriod_WarmUp, 0L)) {
+ RunOptions$IndPeriod_WarmUp <- NULL
+ }
+ IndPeriod1 <- c(RunOptions$IndPeriod_WarmUp, RunOptions$IndPeriod_Run)
+ LInputSeries <- as.integer(length(IndPeriod1))
+ if ("all" %in% RunOptions$Outputs_Sim) {
+ IndOutputs <- as.integer(1:length(FortranOutputs))
+ } else {
+ IndOutputs <- which(FortranOutputs %in% RunOptions$Outputs_Sim)
+ }
+
+ ## Output data preparation
+ IndPeriod2 <- (length(RunOptions$IndPeriod_WarmUp)+1):LInputSeries
+ ExportDatesR <- "DatesR" %in% RunOptions$Outputs_Sim
+ ExportStateEnd <- "StateEnd" %in% RunOptions$Outputs_Sim
+
+ ## 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)
+ }
+
+ ## Call GR model Fortan
+ RESULTS <- .Fortran("frun_gr2M", PACKAGE = "airGR",
+ ## inputs
+ LInputs = LInputSeries, ### length of input and output series
+ InputsPrecip = InputsModel$Precip[IndPeriod1], ### input series of total precipitation [mm/month]
+ InputsPE = InputsModel$PotEvap[IndPeriod1], ### input series potential evapotranspiration [mm/month]
+ NParam = as.integer(length(Param)), ### number of model parameter
+ Param = Param, ### parameter set
+ NStates = as.integer(length(RunOptions$IniStates)), ### number of state variables used for model initialising
+ StateStart = RunOptions$IniStates, ### state variables used when the model run starts
+ NOutputs = as.integer(length(IndOutputs)), ### number of output series
+ IndOutputs = IndOutputs, ### indices of output series
+ ## outputs
+ Outputs = matrix(as.double(-999.999), nrow = LInputSeries, ncol = length(IndOutputs)), ### output series [mm]
+ StateEnd = rep(as.double(-999.999), length(RunOptions$IniStates)) ### state variables at the end of the model run
+ )
+ RESULTS$Outputs [round(RESULTS$Outputs , 3) == -999.999] <- NA
+ RESULTS$StateEnd[round(RESULTS$StateEnd, 3) == -999.999] <- NA
+ if (ExportStateEnd) {
+ RESULTS$StateEnd <- CreateIniStates(FUN_MOD = RunModel_GR2M, InputsModel = InputsModel,
+ ProdStore = RESULTS$StateEnd[1L], RoutStore = RESULTS$StateEnd[2L], ExpStore = NULL,
+ UH1 = NULL, UH2 = NULL,
+ GCemaNeigeLayers = NULL, eTGCemaNeigeLayers = NULL,
+ verbose = FALSE)
+ }
+
+
+ ## Output data preparation
+ ## OutputsModel only
+ if (!ExportDatesR & !ExportStateEnd) {
+ OutputsModel <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i])
+ names(OutputsModel) <- FortranOutputs[IndOutputs]
+ }
+ ## DatesR and OutputsModel only
+ if (ExportDatesR & !ExportStateEnd) {
+ OutputsModel <- c(list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
+ lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]))
+ names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs])
+ }
+ ## OutputsModel and SateEnd only
+ if (!ExportDatesR & ExportStateEnd) {
+ OutputsModel <- c(lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
+ list(RESULTS$StateEnd))
+ names(OutputsModel) <- c(FortranOutputs[IndOutputs], "StateEnd")
+ }
+ ## DatesR and OutputsModel and SateEnd
+ if ((ExportDatesR & ExportStateEnd) | "all" %in% RunOptions$Outputs_Sim) {
+ OutputsModel <- c(list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
+ lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
+ list(RESULTS$StateEnd))
+ names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs], "StateEnd")
+ }
+
+ ## End
+ rm(RESULTS)
+ class(OutputsModel) <- c("OutputsModel", "monthly", "GR")
+ return(OutputsModel)
+
}
diff --git a/R/RunModel_GR4H.R b/R/RunModel_GR4H.R
index 71ecde1d427433921c2ef3c5ce42d0fca660303c..47c26ff968cce41eb982f897604c7d4b843d0162 100644
--- a/R/RunModel_GR4H.R
+++ b/R/RunModel_GR4H.R
@@ -1,103 +1,129 @@
-RunModel_GR4H <- function(InputsModel,RunOptions,Param){
-
- NParam <- 4;
- FortranOutputs <- .FortranOutputs(GR = "GR4H")$GR
-
- ##Arguments_check
- if(inherits(InputsModel,"InputsModel")==FALSE){ stop("'InputsModel' must be of class 'InputsModel'") }
- if(inherits(InputsModel,"hourly" )==FALSE){ stop("'InputsModel' must be of class 'hourly' ") }
- if(inherits(InputsModel,"GR" )==FALSE){ stop("'InputsModel' must be of class 'GR' ") }
- if(inherits(RunOptions,"RunOptions" )==FALSE){ stop("'RunOptions' must be of class 'RunOptions' ") }
- if(inherits(RunOptions,"GR" )==FALSE){ stop("'RunOptions' must be of class 'GR' ") }
- if(!is.vector(Param) | !is.numeric(Param)){ stop("'Param' must be a numeric vector") }
- if(sum(!is.na(Param))!=NParam){ stop(paste("'Param' must be a vector of length ",NParam," and contain no NA",sep="")) }
- Param <- as.double(Param);
-
- Param_X1X3_threshold <- 1e-2
- Param_X4_threshold <- 0.5
- if (Param[1L] < Param_X1X3_threshold) {
- warning(sprintf("Param[1] (X1: production store capacity [mm]) < %.2f\n X1 set to %.2f", Param_X1X3_threshold, Param_X1X3_threshold))
- Param[1L] <- Param_X1X3_threshold
- }
- if (Param[3L] < Param_X1X3_threshold) {
- warning(sprintf("Param[3] (X3: routing store capacity [mm]) < %.2f\n X3 set to %.2f", Param_X1X3_threshold, Param_X1X3_threshold))
- Param[3L] <- Param_X1X3_threshold
- }
- if (Param[4L] < Param_X4_threshold) {
- warning(sprintf("Param[4] (X4: unit hydrograph time constant [h]) < %.2f\n X4 set to %.2f", Param_X4_threshold, Param_X4_threshold))
- Param[4L] <- Param_X4_threshold
- }
-
- ##Input_data_preparation
- if(identical(RunOptions$IndPeriod_WarmUp,as.integer(0))){ RunOptions$IndPeriod_WarmUp <- NULL; }
- IndPeriod1 <- c(RunOptions$IndPeriod_WarmUp,RunOptions$IndPeriod_Run);
- LInputSeries <- as.integer(length(IndPeriod1))
- if("all" %in% RunOptions$Outputs_Sim){ IndOutputs <- as.integer(1:length(FortranOutputs));
- } else { IndOutputs <- which(FortranOutputs %in% RunOptions$Outputs_Sim); }
-
- ##Output_data_preparation
- IndPeriod2 <- (length(RunOptions$IndPeriod_WarmUp)+1):LInputSeries;
- ExportDatesR <- "DatesR" %in% RunOptions$Outputs_Sim;
- ExportStateEnd <- "StateEnd" %in% RunOptions$Outputs_Sim;
-
- ##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)
- }
-
- ##Call_fortan
- RESULTS <- .Fortran("frun_gr4h",PACKAGE="airGR",
- ##inputs
- LInputs=LInputSeries, ### length of input and output series
- InputsPrecip=InputsModel$Precip[IndPeriod1], ### input series of total precipitation [mm/h]
- InputsPE=InputsModel$PotEvap[IndPeriod1], ### input series potential evapotranspiration [mm/h]
- NParam=as.integer(length(Param)), ### number of model parameter
- Param=Param, ### parameter set
- NStates=as.integer(length(RunOptions$IniStates)), ### number of state variables used for model initialising
- StateStart=RunOptions$IniStates, ### state variables used when the model run starts
- NOutputs=as.integer(length(IndOutputs)), ### number of output series
- IndOutputs=IndOutputs, ### indices of output series
- ##outputs
- Outputs=matrix(as.double(-999.999),nrow=LInputSeries,ncol=length(IndOutputs)), ### output series [mm]
- StateEnd=rep(as.double(-999.999),length(RunOptions$IniStates)) ### state variables at the end of the model run
- )
- RESULTS$Outputs[ round(RESULTS$Outputs ,3)==(-999.999)] <- NA;
- RESULTS$StateEnd[round(RESULTS$StateEnd,3)==(-999.999)] <- NA;
- if (ExportStateEnd) {
- RESULTS$StateEnd[-3L] <- ifelse(RESULTS$StateEnd[-3L] < 0, 0, RESULTS$StateEnd[-3L]) ### remove negative values except for the ExpStore location
- RESULTS$StateEnd <- CreateIniStates(FUN_MOD = RunModel_GR4H, InputsModel = InputsModel,
- ProdStore = RESULTS$StateEnd[1L], RoutStore = RESULTS$StateEnd[2L], ExpStore = NULL,
- UH1 = RESULTS$StateEnd[(1:(20*24))+7], UH2 = RESULTS$StateEnd[(1:(40*24))+(7+20*24)],
- GCemaNeigeLayers = NULL, eTGCemaNeigeLayers = NULL,
- verbose = FALSE)
- }
-
- ##Output_data_preparation
- ##OutputsModel_only
- if(ExportDatesR==FALSE & ExportStateEnd==FALSE){
- OutputsModel <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]);
- names(OutputsModel) <- FortranOutputs[IndOutputs]; }
- ##DatesR_and_OutputsModel_only
- if(ExportDatesR==TRUE & ExportStateEnd==FALSE){
- OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]) );
- names(OutputsModel) <- c("DatesR",FortranOutputs[IndOutputs]); }
- ##OutputsModel_and_SateEnd_only
- if(ExportDatesR==FALSE & ExportStateEnd==TRUE){
- OutputsModel <- c( lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]),
- list(RESULTS$StateEnd) );
- names(OutputsModel) <- c(FortranOutputs[IndOutputs],"StateEnd"); }
- ##DatesR_and_OutputsModel_and_SateEnd
- if((ExportDatesR==TRUE & ExportStateEnd==TRUE) | "all" %in% RunOptions$Outputs_Sim){
- OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]),
- list(RESULTS$StateEnd) );
- names(OutputsModel) <- c("DatesR",FortranOutputs[IndOutputs],"StateEnd"); }
-
- ##End
- rm(RESULTS);
- class(OutputsModel) <- c("OutputsModel","hourly","GR");
- return(OutputsModel);
-
+RunModel_GR4H <- function(InputsModel, RunOptions, Param) {
+
+
+ ## Initialization of variables
+ NParam <- 4
+ FortranOutputs <- .FortranOutputs(GR = "GR4H")$GR
+
+
+ ## Arguments check
+ if (!inherits(InputsModel, "InputsModel")) {
+ stop("'InputsModel' must be of class 'InputsModel'")
+ }
+ if (!inherits(InputsModel, "hourly" )) {
+ stop("'InputsModel' must be of class 'hourly' ")
+ }
+ if (!inherits(InputsModel, "GR" )) {
+ stop("'InputsModel' must be of class 'GR' ")
+ }
+ if (!inherits(RunOptions, "RunOptions" )) {
+ stop("'RunOptions' must be of class 'RunOptions' ")
+ }
+ if (!inherits(RunOptions, "GR" )) {
+ stop("'RunOptions' must be of class 'GR' ")
+ }
+ if (!is.vector(Param) | !is.numeric(Param)) {
+ stop("'Param' must be a numeric vector")
+ }
+ if (sum(!is.na(Param)) != NParam) {
+ stop(paste("'Param' must be a vector of length ", NParam, " and contain no NA", sep = ""))
+ }
+ Param <- as.double(Param)
+
+ Param_X1X3_threshold <- 1e-2
+ Param_X4_threshold <- 0.5
+ if (Param[1L] < Param_X1X3_threshold) {
+ warning(sprintf("Param[1] (X1: production store capacity [mm]) < %.2f\n X1 set to %.2f", Param_X1X3_threshold, Param_X1X3_threshold))
+ Param[1L] <- Param_X1X3_threshold
+ }
+ if (Param[3L] < Param_X1X3_threshold) {
+ warning(sprintf("Param[3] (X3: routing store capacity [mm]) < %.2f\n X3 set to %.2f", Param_X1X3_threshold, Param_X1X3_threshold))
+ Param[3L] <- Param_X1X3_threshold
+ }
+ if (Param[4L] < Param_X4_threshold) {
+ warning(sprintf("Param[4] (X4: unit hydrograph time constant [h]) < %.2f\n X4 set to %.2f", Param_X4_threshold, Param_X4_threshold))
+ Param[4L] <- Param_X4_threshold
+ }
+
+ ## Input data preparation
+ if (identical(RunOptions$IndPeriod_WarmUp, 0L)) {
+ RunOptions$IndPeriod_WarmUp <- NULL
+ }
+ IndPeriod1 <- c(RunOptions$IndPeriod_WarmUp, RunOptions$IndPeriod_Run)
+ LInputSeries <- as.integer(length(IndPeriod1))
+ if ("all" %in% RunOptions$Outputs_Sim) {
+ IndOutputs <- as.integer(1:length(FortranOutputs))
+ } else {
+ IndOutputs <- which(FortranOutputs %in% RunOptions$Outputs_Sim)
+ }
+
+ ## Output data preparation
+ IndPeriod2 <- (length(RunOptions$IndPeriod_WarmUp)+1):LInputSeries
+ ExportDatesR <- "DatesR" %in% RunOptions$Outputs_Sim
+ ExportStateEnd <- "StateEnd" %in% RunOptions$Outputs_Sim
+
+ ## 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)
+ }
+
+ ## Call GR model Fortan
+ RESULTS <- .Fortran("frun_gr4h", PACKAGE = "airGR",
+ ## inputs
+ LInputs = LInputSeries, ### length of input and output series
+ InputsPrecip = InputsModel$Precip[IndPeriod1], ### input series of total precipitation [mm/h]
+ InputsPE = InputsModel$PotEvap[IndPeriod1], ### input series potential evapotranspiration [mm/h]
+ NParam = as.integer(length(Param)), ### number of model parameter
+ Param = Param, ### parameter set
+ NStates = as.integer(length(RunOptions$IniStates)), ### number of state variables used for model initialising
+ StateStart = RunOptions$IniStates, ### state variables used when the model run starts
+ NOutputs = as.integer(length(IndOutputs)), ### number of output series
+ IndOutputs = IndOutputs, ### indices of output series
+ ## outputs
+ Outputs = matrix(as.double(-999.999), nrow = LInputSeries, ncol = length(IndOutputs)), ### output series [mm]
+ StateEnd = rep(as.double(-999.999), length(RunOptions$IniStates)) ### state variables at the end of the model run
+ )
+ RESULTS$Outputs[ round(RESULTS$Outputs , 3) == -999.999] <- NA
+ RESULTS$StateEnd[round(RESULTS$StateEnd, 3) == -999.999] <- NA
+ if (ExportStateEnd) {
+ RESULTS$StateEnd[-3L] <- ifelse(RESULTS$StateEnd[-3L] < 0, 0, RESULTS$StateEnd[-3L]) ### remove negative values except for the ExpStore location
+ RESULTS$StateEnd <- CreateIniStates(FUN_MOD = RunModel_GR4H, InputsModel = InputsModel,
+ ProdStore = RESULTS$StateEnd[1L], RoutStore = RESULTS$StateEnd[2L], ExpStore = NULL,
+ UH1 = RESULTS$StateEnd[(1:(20*24))+7], UH2 = RESULTS$StateEnd[(1:(40*24))+(7+20*24)],
+ GCemaNeigeLayers = NULL, eTGCemaNeigeLayers = NULL,
+ verbose = FALSE)
+ }
+
+ ## Output data preparation
+ ## OutputsModel only
+ if (!ExportDatesR & !ExportStateEnd) {
+ OutputsModel <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i])
+ names(OutputsModel) <- FortranOutputs[IndOutputs]
+ }
+ ## DatesR and OutputsModel only
+ if (ExportDatesR & !ExportStateEnd) {
+ OutputsModel <- c(list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
+ lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]))
+ names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs])
+ }
+ ## OutputsModel and SateEnd only
+ if (!ExportDatesR & ExportStateEnd) {
+ OutputsModel <- c(lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
+ list(RESULTS$StateEnd))
+ names(OutputsModel) <- c(FortranOutputs[IndOutputs], "StateEnd")
+ }
+ ## DatesR and OutputsModel and SateEnd
+ if ((ExportDatesR & ExportStateEnd) | "all" %in% RunOptions$Outputs_Sim) {
+ OutputsModel <- c(list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
+ lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
+ list(RESULTS$StateEnd))
+ names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs], "StateEnd")
+ }
+
+ ## End
+ rm(RESULTS)
+ class(OutputsModel) <- c("OutputsModel", "hourly", "GR")
+ return(OutputsModel)
+
}
diff --git a/R/RunModel_GR4J.R b/R/RunModel_GR4J.R
index 8d383a18a17e16f0ee3aac77e952ebc96727b47f..fc647035051dc0f05fb741f0f43ae1f1945ded08 100644
--- a/R/RunModel_GR4J.R
+++ b/R/RunModel_GR4J.R
@@ -1,102 +1,128 @@
-RunModel_GR4J <- function(InputsModel,RunOptions,Param){
-
- NParam <- 4;
- FortranOutputs <- .FortranOutputs(GR = "GR4J")$GR
-
- ##Arguments_check
- if(inherits(InputsModel,"InputsModel")==FALSE){ stop("'InputsModel' must be of class 'InputsModel'") }
- if(inherits(InputsModel,"daily" )==FALSE){ stop("'InputsModel' must be of class 'daily' ") }
- if(inherits(InputsModel,"GR" )==FALSE){ stop("'InputsModel' must be of class 'GR' ") }
- if(inherits(RunOptions,"RunOptions" )==FALSE){ stop("'RunOptions' must be of class 'RunOptions' ") }
- if(inherits(RunOptions,"GR" )==FALSE){ stop("'RunOptions' must be of class 'GR' ") }
- if(!is.vector(Param) | !is.numeric(Param)){ stop("'Param' must be a numeric vector") }
- if(sum(!is.na(Param))!=NParam){ stop(paste("'Param' must be a vector of length ",NParam," and contain no NA",sep="")) }
- Param <- as.double(Param);
-
- Param_X1X3_threshold <- 1e-2
- Param_X4_threshold <- 0.5
- if (Param[1L] < Param_X1X3_threshold) {
- warning(sprintf("Param[1] (X1: production store capacity [mm]) < %.2f\n X1 set to %.2f", Param_X1X3_threshold, Param_X1X3_threshold))
- Param[1L] <- Param_X1X3_threshold
- }
- if (Param[3L] < Param_X1X3_threshold) {
- warning(sprintf("Param[3] (X3: routing store capacity [mm]) < %.2f\n X3 set to %.2f", Param_X1X3_threshold, Param_X1X3_threshold))
- Param[3L] <- Param_X1X3_threshold
- }
- if (Param[4L] < Param_X4_threshold) {
- warning(sprintf("Param[4] (X4: unit hydrograph time constant [d]) < %.2f\n X4 set to %.2f", Param_X4_threshold, Param_X4_threshold))
- Param[4L] <- Param_X4_threshold
- }
-
- ##Input_data_preparation
- if(identical(RunOptions$IndPeriod_WarmUp,as.integer(0))){ RunOptions$IndPeriod_WarmUp <- NULL; }
- IndPeriod1 <- c(RunOptions$IndPeriod_WarmUp,RunOptions$IndPeriod_Run);
- LInputSeries <- as.integer(length(IndPeriod1))
- if("all" %in% RunOptions$Outputs_Sim){ IndOutputs <- as.integer(1:length(FortranOutputs));
- } else { IndOutputs <- which(FortranOutputs %in% RunOptions$Outputs_Sim); }
- ##Input_data_preparation
- IndPeriod2 <- (length(RunOptions$IndPeriod_WarmUp)+1):LInputSeries;
- ExportDatesR <- "DatesR" %in% RunOptions$Outputs_Sim;
- ExportStateEnd <- "StateEnd" %in% RunOptions$Outputs_Sim;
-
- ##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)
- }
-
- ##Call_fortan
- RESULTS <- .Fortran("frun_gr4j",PACKAGE="airGR",
- ##inputs
- LInputs=LInputSeries, ### length of input and output series
- InputsPrecip=InputsModel$Precip[IndPeriod1], ### input series of total precipitation [mm/d]
- InputsPE=InputsModel$PotEvap[IndPeriod1], ### input series potential evapotranspiration [mm/d]
- NParam=as.integer(length(Param)), ### number of model parameter
- Param=Param, ### parameter set
- NStates=as.integer(length(RunOptions$IniStates)), ### number of state variables used for model initialising
- StateStart=RunOptions$IniStates, ### state variables used when the model run starts
- NOutputs=as.integer(length(IndOutputs)), ### number of output series
- IndOutputs=IndOutputs, ### indices of output series
- ##outputs
- Outputs=matrix(as.double(-999.999),nrow=LInputSeries,ncol=length(IndOutputs)), ### output series [mm]
- StateEnd=rep(as.double(-999.999),length(RunOptions$IniStates)) ### state variables at the end of the model run
- )
- RESULTS$Outputs[ round(RESULTS$Outputs ,3)==(-999.999)] <- NA;
- RESULTS$StateEnd[round(RESULTS$StateEnd,3)==(-999.999)] <- NA;
- if (ExportStateEnd) {
- RESULTS$StateEnd[-3L] <- ifelse(RESULTS$StateEnd[-3L] < 0, 0, RESULTS$StateEnd[-3L]) ### remove negative values except for the ExpStore location
- RESULTS$StateEnd <- CreateIniStates(FUN_MOD = RunModel_GR4J, InputsModel = InputsModel,
- ProdStore = RESULTS$StateEnd[1L], RoutStore = RESULTS$StateEnd[2L], ExpStore = NULL,
- UH1 = RESULTS$StateEnd[(1:20)+7], UH2 = RESULTS$StateEnd[(1:40)+(7+20)],
- GCemaNeigeLayers = NULL, eTGCemaNeigeLayers = NULL,
- verbose = FALSE)
- }
-
- ##Output_data_preparation
- ##OutputsModel_only
- if(ExportDatesR==FALSE & ExportStateEnd==FALSE){
- OutputsModel <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]);
- names(OutputsModel) <- FortranOutputs[IndOutputs]; }
- ##DatesR_and_OutputsModel_only
- if(ExportDatesR==TRUE & ExportStateEnd==FALSE){
- OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]) );
- names(OutputsModel) <- c("DatesR",FortranOutputs[IndOutputs]); }
- ##OutputsModel_and_StateEnd_only
- if(ExportDatesR==FALSE & ExportStateEnd==TRUE){
- OutputsModel <- c( lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]),
- list(RESULTS$StateEnd) );
- names(OutputsModel) <- c(FortranOutputs[IndOutputs],"StateEnd"); }
- ##DatesR_and_OutputsModel_and_StateEnd
- if((ExportDatesR==TRUE & ExportStateEnd==TRUE) | "all" %in% RunOptions$Outputs_Sim){
- OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]),
- list(RESULTS$StateEnd) );
- names(OutputsModel) <- c("DatesR",FortranOutputs[IndOutputs],"StateEnd"); }
-
- ##End
- rm(RESULTS);
- class(OutputsModel) <- c("OutputsModel","daily","GR");
- return(OutputsModel);
-
+RunModel_GR4J <- function(InputsModel, RunOptions, Param) {
+
+
+ ## Initialization of variables
+ NParam <- 4
+ FortranOutputs <- .FortranOutputs(GR = "GR4J")$GR
+
+
+ ## Arguments check
+ if (!inherits(InputsModel, "InputsModel")) {
+ stop("'InputsModel' must be of class 'InputsModel'")
+ }
+ if (!inherits(InputsModel, "daily" )) {
+ stop("'InputsModel' must be of class 'daily' ")
+ }
+ if (!inherits(InputsModel, "GR" )) {
+ stop("'InputsModel' must be of class 'GR' ")
+ }
+ if (!inherits(RunOptions, "RunOptions" )) {
+ stop("'RunOptions' must be of class 'RunOptions' ")
+ }
+ if (!inherits(RunOptions, "GR" )) {
+ stop("'RunOptions' must be of class 'GR' ")
+ }
+ if (!is.vector(Param) | !is.numeric(Param)) {
+ stop("'Param' must be a numeric vector")
+ }
+ if (sum(!is.na(Param)) != NParam) {
+ stop(paste("'Param' must be a vector of length ", NParam, " and contain no NA", sep = ""))
+ }
+ Param <- as.double(Param)
+
+ Param_X1X3_threshold <- 1e-2
+ Param_X4_threshold <- 0.5
+ if (Param[1L] < Param_X1X3_threshold) {
+ warning(sprintf("Param[1] (X1: production store capacity [mm]) < %.2f\n X1 set to %.2f", Param_X1X3_threshold, Param_X1X3_threshold))
+ Param[1L] <- Param_X1X3_threshold
+ }
+ if (Param[3L] < Param_X1X3_threshold) {
+ warning(sprintf("Param[3] (X3: routing store capacity [mm]) < %.2f\n X3 set to %.2f", Param_X1X3_threshold, Param_X1X3_threshold))
+ Param[3L] <- Param_X1X3_threshold
+ }
+ if (Param[4L] < Param_X4_threshold) {
+ warning(sprintf("Param[4] (X4: unit hydrograph time constant [d]) < %.2f\n X4 set to %.2f", Param_X4_threshold, Param_X4_threshold))
+ Param[4L] <- Param_X4_threshold
+ }
+
+ ## Input data preparation
+ if (identical(RunOptions$IndPeriod_WarmUp, 0L)) {
+ RunOptions$IndPeriod_WarmUp <- NULL
+ }
+ IndPeriod1 <- c(RunOptions$IndPeriod_WarmUp, RunOptions$IndPeriod_Run)
+ LInputSeries <- as.integer(length(IndPeriod1))
+ if ("all" %in% RunOptions$Outputs_Sim) {
+ IndOutputs <- as.integer(1:length(FortranOutputs))
+ } else {
+ IndOutputs <- which(FortranOutputs %in% RunOptions$Outputs_Sim)
+ }
+ ## Input data preparation
+ IndPeriod2 <- (length(RunOptions$IndPeriod_WarmUp)+1):LInputSeries
+ ExportDatesR <- "DatesR" %in% RunOptions$Outputs_Sim
+ ExportStateEnd <- "StateEnd" %in% RunOptions$Outputs_Sim
+
+ ## 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)
+ }
+
+ ## Call GR model Fortan
+ RESULTS <- .Fortran("frun_gr4j", PACKAGE = "airGR",
+ ## inputs
+ LInputs = LInputSeries, ### length of input and output series
+ InputsPrecip = InputsModel$Precip[IndPeriod1], ### input series of total precipitation [mm/d]
+ InputsPE = InputsModel$PotEvap[IndPeriod1], ### input series potential evapotranspiration [mm/d]
+ NParam = as.integer(length(Param)), ### number of model parameter
+ Param = Param, ### parameter set
+ NStates = as.integer(length(RunOptions$IniStates)), ### number of state variables used for model initialising
+ StateStart = RunOptions$IniStates, ### state variables used when the model run starts
+ NOutputs = as.integer(length(IndOutputs)), ### number of output series
+ IndOutputs = IndOutputs, ### indices of output series
+ ## outputs
+ Outputs = matrix(as.double(-999.999), nrow = LInputSeries, ncol = length(IndOutputs)), ### output series [mm]
+ StateEnd = rep(as.double(-999.999), length(RunOptions$IniStates)) ### state variables at the end of the model run
+ )
+ RESULTS$Outputs[ round(RESULTS$Outputs , 3) == -999.999] <- NA
+ RESULTS$StateEnd[round(RESULTS$StateEnd, 3) == -999.999] <- NA
+ if (ExportStateEnd) {
+ RESULTS$StateEnd[-3L] <- ifelse(RESULTS$StateEnd[-3L] < 0, 0, RESULTS$StateEnd[-3L]) ### remove negative values except for the ExpStore location
+ RESULTS$StateEnd <- CreateIniStates(FUN_MOD = RunModel_GR4J, InputsModel = InputsModel,
+ ProdStore = RESULTS$StateEnd[1L], RoutStore = RESULTS$StateEnd[2L], ExpStore = NULL,
+ UH1 = RESULTS$StateEnd[(1:20)+7], UH2 = RESULTS$StateEnd[(1:40)+(7+20)],
+ GCemaNeigeLayers = NULL, eTGCemaNeigeLayers = NULL,
+ verbose = FALSE)
+ }
+
+ ## Output data preparation
+ ## OutputsModel only
+ if (!ExportDatesR & !ExportStateEnd) {
+ OutputsModel <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i])
+ names(OutputsModel) <- FortranOutputs[IndOutputs]
+ }
+ ## DatesR and OutputsModel only
+ if (ExportDatesR & !ExportStateEnd) {
+ OutputsModel <- c(list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
+ lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]))
+ names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs])
+ }
+ ## OutputsModel and StateEnd only
+ if (!ExportDatesR & ExportStateEnd) {
+ OutputsModel <- c(lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
+ list(RESULTS$StateEnd))
+ names(OutputsModel) <- c(FortranOutputs[IndOutputs], "StateEnd")
+ }
+ ## DatesR and OutputsModel and StateEnd
+ if ((ExportDatesR & ExportStateEnd) | "all" %in% RunOptions$Outputs_Sim) {
+ OutputsModel <- c(list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
+ lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
+ list(RESULTS$StateEnd))
+ names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs], "StateEnd")
+ }
+
+ ## End
+ rm(RESULTS)
+ class(OutputsModel) <- c("OutputsModel", "daily", "GR")
+ return(OutputsModel)
+
}
diff --git a/R/RunModel_GR5H.R b/R/RunModel_GR5H.R
index a36613d6aad5038fe134199a4a36fe85df3e382f..590a103291d3ea8e99f26681cd3eb1774ef05edb 100644
--- a/R/RunModel_GR5H.R
+++ b/R/RunModel_GR5H.R
@@ -1,117 +1,142 @@
-RunModel_GR5H <- function(InputsModel,RunOptions,Param){
-
- NParam <- 5;
- FortranOutputs <- .FortranOutputs(GR = "GR5H")$GR
- IsIntStore <- inherits(RunOptions, "interception")
- if(IsIntStore) {
- Imax <- RunOptions$Imax
- } else {
- Imax <- -99
+RunModel_GR5H <- function(InputsModel, RunOptions, Param) {
+
+
+ ## Initialization of variables
+ NParam <- 5
+ FortranOutputs <- .FortranOutputs(GR = "GR5H")$GR
+ IsIntStore <- inherits(RunOptions, "interception")
+ if (IsIntStore) {
+ Imax <- RunOptions$Imax
+ } else {
+ Imax <- -99
+ }
+
+
+ ## Arguments check
+ if (!inherits(InputsModel, "InputsModel")) {
+ stop("'InputsModel' must be of class 'InputsModel'")
+ }
+ if (!inherits(InputsModel, "hourly" )) {
+ stop("'InputsModel' must be of class 'hourly' ")
+ }
+ if (!inherits(InputsModel, "GR" )) {
+ stop("'InputsModel' must be of class 'GR' ")
+ }
+ if (!inherits(RunOptions, "RunOptions" )) {
+ stop("'RunOptions' must be of class 'RunOptions' ")
+ }
+ if (!inherits(RunOptions, "GR" )) {
+ stop("'RunOptions' must be of class 'GR' ")
+ }
+ if (!is.vector(Param) | !is.numeric(Param)) {
+ stop("'Param' must be a numeric vector")
+ }
+ if (sum(!is.na(Param)) != NParam) {
+ stop(paste("'Param' must be a vector of length ", NParam, " and contain no NA", sep = ""))
+ }
+ Param <- as.double(Param)
+
+ Param_X1X3_threshold <- 1e-2
+ Param_X4_threshold <- 0.5
+ if (Param[1L] < Param_X1X3_threshold) {
+ warning(sprintf("Param[1] (X1: production store capacity [mm]) < %.2f\n X1 set to %.2f", Param_X1X3_threshold, Param_X1X3_threshold))
+ Param[1L] <- Param_X1X3_threshold
+ }
+ if (Param[3L] < Param_X1X3_threshold) {
+ warning(sprintf("Param[3] (X3: routing store capacity [mm]) < %.2f\n X3 set to %.2f", Param_X1X3_threshold, Param_X1X3_threshold))
+ Param[3L] <- Param_X1X3_threshold
+ }
+ if (Param[4L] < Param_X4_threshold) {
+ warning(sprintf("Param[4] (X4: unit hydrograph time constant [h]) < %.2f\n X4 set to %.2f", Param_X4_threshold, Param_X4_threshold))
+ Param[4L] <- Param_X4_threshold
+ }
+
+ ## Input data preparation
+ if (identical(RunOptions$IndPeriod_WarmUp, 0L)) {
+ RunOptions$IndPeriod_WarmUp <- NULL
+ }
+ IndPeriod1 <- c(RunOptions$IndPeriod_WarmUp, RunOptions$IndPeriod_Run)
+ LInputSeries <- as.integer(length(IndPeriod1))
+ if ("all" %in% RunOptions$Outputs_Sim) { IndOutputs <- as.integer(1:length(FortranOutputs))
+ } else {
+ IndOutputs <- which(FortranOutputs %in% RunOptions$Outputs_Sim)
+ }
+
+ ## Output data preparation
+ IndPeriod2 <- (length(RunOptions$IndPeriod_WarmUp)+1):LInputSeries
+ ExportDatesR <- "DatesR" %in% RunOptions$Outputs_Sim
+ ExportStateEnd <- "StateEnd" %in% RunOptions$Outputs_Sim
+
+ ## 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)
+ if (IsIntStore) {
+ RunOptions$IniStates[4] <- RunOptions$IniResLevels[4] * Imax ### interception store level (mm)
}
-
- ##Arguments_check
- if(inherits(InputsModel,"InputsModel")==FALSE){ stop("'InputsModel' must be of class 'InputsModel'") }
- if(inherits(InputsModel,"hourly" )==FALSE){ stop("'InputsModel' must be of class 'hourly' ") }
- if(inherits(InputsModel,"GR" )==FALSE){ stop("'InputsModel' must be of class 'GR' ") }
- if(inherits(RunOptions,"RunOptions" )==FALSE){ stop("'RunOptions' must be of class 'RunOptions' ") }
- if(inherits(RunOptions,"GR" )==FALSE){ stop("'RunOptions' must be of class 'GR' ") }
- if(!is.vector(Param) | !is.numeric(Param)){ stop("'Param' must be a numeric vector") }
- if(sum(!is.na(Param))!=NParam){ stop(paste("'Param' must be a vector of length ",NParam," and contain no NA",sep="")) }
- Param <- as.double(Param);
-
- Param_X1X3_threshold <- 1e-2
- Param_X4_threshold <- 0.5
- if (Param[1L] < Param_X1X3_threshold) {
- warning(sprintf("Param[1] (X1: production store capacity [mm]) < %.2f\n X1 set to %.2f", Param_X1X3_threshold, Param_X1X3_threshold))
- Param[1L] <- Param_X1X3_threshold
- }
- if (Param[3L] < Param_X1X3_threshold) {
- warning(sprintf("Param[3] (X3: routing store capacity [mm]) < %.2f\n X3 set to %.2f", Param_X1X3_threshold, Param_X1X3_threshold))
- Param[3L] <- Param_X1X3_threshold
- }
- if (Param[4L] < Param_X4_threshold) {
- warning(sprintf("Param[4] (X4: unit hydrograph time constant [h]) < %.2f\n X4 set to %.2f", Param_X4_threshold, Param_X4_threshold))
- Param[4L] <- Param_X4_threshold
- }
-
- ##Input_data_preparation
- if(identical(RunOptions$IndPeriod_WarmUp,as.integer(0))){ RunOptions$IndPeriod_WarmUp <- NULL; }
- IndPeriod1 <- c(RunOptions$IndPeriod_WarmUp,RunOptions$IndPeriod_Run);
- LInputSeries <- as.integer(length(IndPeriod1))
- if("all" %in% RunOptions$Outputs_Sim){ IndOutputs <- as.integer(1:length(FortranOutputs));
- } else { IndOutputs <- which(FortranOutputs %in% RunOptions$Outputs_Sim); }
-
- ##Output_data_preparation
- IndPeriod2 <- (length(RunOptions$IndPeriod_WarmUp)+1):LInputSeries;
- ExportDatesR <- "DatesR" %in% RunOptions$Outputs_Sim;
- ExportStateEnd <- "StateEnd" %in% RunOptions$Outputs_Sim;
-
- ##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)
- if(IsIntStore) {
- RunOptions$IniStates[4] <- RunOptions$IniResLevels[4] * Imax; ### interception store level (mm)
- }
- }
-
- ##Call_fortan
- RESULTS <- .Fortran("frun_gr5h",PACKAGE="airGR",
- ##inputs
- LInputs=LInputSeries, ### length of input and output series
- InputsPrecip=InputsModel$Precip[IndPeriod1], ### input series of total precipitation [mm/h]
- InputsPE=InputsModel$PotEvap[IndPeriod1], ### input series potential evapotranspiration [mm/h]
- NParam=as.integer(length(Param)), ### number of model parameter
- Param=Param, ### parameter set
- NStates=as.integer(length(RunOptions$IniStates)), ### number of state variables used for model initialising
- StateStart=RunOptions$IniStates, ### state variables used when the model run starts
- Imax=Imax, ### maximal capacity of interception store
- NOutputs=as.integer(length(IndOutputs)), ### number of output series
- IndOutputs=IndOutputs, ### indices of output series
- ##outputs
- Outputs=matrix(as.double(-999.999),nrow=LInputSeries,ncol=length(IndOutputs)), ### output series [mm or mm/h]
- StateEnd=rep(as.double(-999.999),length(RunOptions$IniStates)) ### state variables at the end of the model run
- )
- RESULTS$Outputs[ round(RESULTS$Outputs ,3)==(-999.999)] <- NA;
- RESULTS$StateEnd[round(RESULTS$StateEnd,3)==(-999.999)] <- NA;
- if (ExportStateEnd) {
- RESULTS$StateEnd[-3L] <- ifelse(RESULTS$StateEnd[-3L] < 0, 0, RESULTS$StateEnd[-3L]) ### remove negative values except for the ExpStore location
- RESULTS$StateEnd <- CreateIniStates(FUN_MOD = RunModel_GR5H, InputsModel = InputsModel,
- ProdStore = RESULTS$StateEnd[1L], RoutStore = RESULTS$StateEnd[2L], ExpStore = NULL,
- IntStore = RESULTS$StateEnd[4L],
- UH1 = NULL, UH2 = RESULTS$StateEnd[(1:(40*24))+(7+20*24)],
- GCemaNeigeLayers = NULL, eTGCemaNeigeLayers = NULL,
- verbose = FALSE)
- }
-
- ##Output_data_preparation
- ##OutputsModel_only
- if(ExportDatesR==FALSE & ExportStateEnd==FALSE){
- OutputsModel <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]);
- names(OutputsModel) <- FortranOutputs[IndOutputs]; }
- ##DatesR_and_OutputsModel_only
- if(ExportDatesR==TRUE & ExportStateEnd==FALSE){
- OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]) );
- names(OutputsModel) <- c("DatesR",FortranOutputs[IndOutputs]); }
- ##OutputsModel_and_StateEnd_only
- if(ExportDatesR==FALSE & ExportStateEnd==TRUE){
- OutputsModel <- c( lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]),
- list(RESULTS$StateEnd) );
- names(OutputsModel) <- c(FortranOutputs[IndOutputs],"StateEnd"); }
- ##DatesR_and_OutputsModel_and_StateEnd
- if((ExportDatesR==TRUE & ExportStateEnd==TRUE) | "all" %in% RunOptions$Outputs_Sim){
- OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]),
- list(RESULTS$StateEnd) );
- names(OutputsModel) <- c("DatesR",FortranOutputs[IndOutputs],"StateEnd"); }
-
- ##End
- rm(RESULTS);
- class(OutputsModel) <- c("OutputsModel","hourly","GR");
- if(IsIntStore) {
- class(OutputsModel) <- c(class(OutputsModel), "interception")
- }
- return(OutputsModel);
-
+ }
+
+ ## Call GR model Fortan
+ RESULTS <- .Fortran("frun_gr5h", PACKAGE = "airGR",
+ ## inputs
+ LInputs = LInputSeries, ### length of input and output series
+ InputsPrecip = InputsModel$Precip[IndPeriod1], ### input series of total precipitation [mm/h]
+ InputsPE = InputsModel$PotEvap[IndPeriod1], ### input series potential evapotranspiration [mm/h]
+ NParam = as.integer(length(Param)), ### number of model parameter
+ Param = Param, ### parameter set
+ NStates = as.integer(length(RunOptions$IniStates)), ### number of state variables used for model initialising
+ StateStart = RunOptions$IniStates, ### state variables used when the model run starts
+ Imax = Imax, ### maximal capacity of interception store
+ NOutputs = as.integer(length(IndOutputs)), ### number of output series
+ IndOutputs = IndOutputs, ### indices of output series
+ ## outputs
+ Outputs = matrix(as.double(-999.999), nrow = LInputSeries, ncol = length(IndOutputs)), ### output series [mm or mm/h]
+ StateEnd = rep(as.double(-999.999), length(RunOptions$IniStates)) ### state variables at the end of the model run
+ )
+ RESULTS$Outputs[ round(RESULTS$Outputs , 3) == -999.999] <- NA
+ RESULTS$StateEnd[round(RESULTS$StateEnd, 3) == -999.999] <- NA
+ if (ExportStateEnd) {
+ RESULTS$StateEnd[-3L] <- ifelse(RESULTS$StateEnd[-3L] < 0, 0, RESULTS$StateEnd[-3L]) ### remove negative values except for the ExpStore location
+ RESULTS$StateEnd <- CreateIniStates(FUN_MOD = RunModel_GR5H, InputsModel = InputsModel,
+ ProdStore = RESULTS$StateEnd[1L], RoutStore = RESULTS$StateEnd[2L], ExpStore = NULL,
+ IntStore = RESULTS$StateEnd[4L],
+ UH1 = NULL, UH2 = RESULTS$StateEnd[(1:(40*24))+(7+20*24)],
+ GCemaNeigeLayers = NULL, eTGCemaNeigeLayers = NULL,
+ verbose = FALSE)
+ }
+
+ ## Output data preparation
+ ## OutputsModel only
+ if (!ExportDatesR & !ExportStateEnd) {
+ OutputsModel <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i])
+ names(OutputsModel) <- FortranOutputs[IndOutputs]
+ }
+ ## DatesR and OutputsModel only
+ if (ExportDatesR & !ExportStateEnd) {
+ OutputsModel <- c(list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
+ lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]))
+ names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs])
+ }
+ ## OutputsModel and StateEnd only
+ if (!ExportDatesR & ExportStateEnd) {
+ OutputsModel <- c(lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
+ list(RESULTS$StateEnd))
+ names(OutputsModel) <- c(FortranOutputs[IndOutputs], "StateEnd")
+ }
+ ## DatesR and OutputsModel and StateEnd
+ if ((ExportDatesR & ExportStateEnd) | "all" %in% RunOptions$Outputs_Sim) {
+ OutputsModel <- c(list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
+ lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
+ list(RESULTS$StateEnd))
+ names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs], "StateEnd")
+ }
+
+ ## End
+ rm(RESULTS)
+ class(OutputsModel) <- c("OutputsModel", "hourly", "GR")
+ if (IsIntStore) {
+ class(OutputsModel) <- c(class(OutputsModel), "interception")
+ }
+ return(OutputsModel)
+
}
diff --git a/R/RunModel_GR5J.R b/R/RunModel_GR5J.R
index 56e750ae73aef1affd9762460837d445f3dc1b5a..33210729deffa802b0e51732e0659e27ee7802be 100644
--- a/R/RunModel_GR5J.R
+++ b/R/RunModel_GR5J.R
@@ -1,103 +1,129 @@
-RunModel_GR5J <- function(InputsModel,RunOptions,Param){
-
- NParam <- 5;
- FortranOutputs <- .FortranOutputs(GR = "GR5J")$GR
-
- ##Arguments_check
- if(inherits(InputsModel,"InputsModel")==FALSE){ stop("'InputsModel' must be of class 'InputsModel'") }
- if(inherits(InputsModel,"daily" )==FALSE){ stop("'InputsModel' must be of class 'daily' ") }
- if(inherits(InputsModel,"GR" )==FALSE){ stop("'InputsModel' must be of class 'GR' ") }
- if(inherits(RunOptions,"RunOptions" )==FALSE){ stop("'RunOptions' must be of class 'RunOptions' ") }
- if(inherits(RunOptions,"GR" )==FALSE){ stop("'RunOptions' must be of class 'GR' ") }
- if(!is.vector(Param) | !is.numeric(Param)){ stop("'Param' must be a numeric vector") }
- if(sum(!is.na(Param))!=NParam){ stop(paste("'Param' must be a vector of length ",NParam," and contain no NA",sep="")) }
- Param <- as.double(Param);
-
- Param_X1X3_threshold <- 1e-2
- Param_X4_threshold <- 0.5
- if (Param[1L] < Param_X1X3_threshold) {
- warning(sprintf("Param[1] (X1: production store capacity [mm]) < %.2f\n X1 set to %.2f", Param_X1X3_threshold, Param_X1X3_threshold))
- Param[1L] <- Param_X1X3_threshold
- }
- if (Param[3L] < Param_X1X3_threshold) {
- warning(sprintf("Param[3] (X3: routing store capacity [mm]) < %.2f\n X3 set to %.2f", Param_X1X3_threshold, Param_X1X3_threshold))
- Param[3L] <- Param_X1X3_threshold
- }
- if (Param[4L] < Param_X4_threshold) {
- warning(sprintf("Param[4] (X4: unit hydrograph time constant [d]) < %.2f\n X4 set to %.2f", Param_X4_threshold, Param_X4_threshold))
- Param[4L] <- Param_X4_threshold
- }
-
- ##Input_data_preparation
- if(identical(RunOptions$IndPeriod_WarmUp,as.integer(0))){ RunOptions$IndPeriod_WarmUp <- NULL; }
- IndPeriod1 <- c(RunOptions$IndPeriod_WarmUp,RunOptions$IndPeriod_Run);
- LInputSeries <- as.integer(length(IndPeriod1))
- if("all" %in% RunOptions$Outputs_Sim){ IndOutputs <- as.integer(1:length(FortranOutputs));
- } else { IndOutputs <- which(FortranOutputs %in% RunOptions$Outputs_Sim); }
-
- ##Output_data_preparation
- IndPeriod2 <- (length(RunOptions$IndPeriod_WarmUp)+1):LInputSeries;
- ExportDatesR <- "DatesR" %in% RunOptions$Outputs_Sim;
- ExportStateEnd <- "StateEnd" %in% RunOptions$Outputs_Sim;
-
- ##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)
- }
-
- ##Call_fortan
- RESULTS <- .Fortran("frun_gr5j",PACKAGE="airGR",
- ##inputs
- LInputs=LInputSeries, ### length of input and output series
- InputsPrecip=InputsModel$Precip[IndPeriod1], ### input series of total precipitation [mm/d]
- InputsPE=InputsModel$PotEvap[IndPeriod1], ### input series potential evapotranspiration [mm/d]
- NParam=as.integer(length(Param)), ### number of model parameter
- Param=Param, ### parameter set
- NStates=as.integer(length(RunOptions$IniStates)), ### number of state variables used for model initialising
- StateStart=RunOptions$IniStates, ### state variables used when the model run starts
- NOutputs=as.integer(length(IndOutputs)), ### number of output series
- IndOutputs=IndOutputs, ### indices of output series
- ##outputs
- Outputs=matrix(as.double(-999.999),nrow=LInputSeries,ncol=length(IndOutputs)), ### output series [mm]
- StateEnd=rep(as.double(-999.999),length(RunOptions$IniStates)) ### state variables at the end of the model run
- )
- RESULTS$Outputs[ round(RESULTS$Outputs ,3)==(-999.999)] <- NA;
- RESULTS$StateEnd[round(RESULTS$StateEnd,3)==(-999.999)] <- NA;
- if (ExportStateEnd) {
- RESULTS$StateEnd[-3L] <- ifelse(RESULTS$StateEnd[-3L] < 0, 0, RESULTS$StateEnd[-3L]) ### remove negative values except for the ExpStore location
- RESULTS$StateEnd <- CreateIniStates(FUN_MOD = RunModel_GR5J, InputsModel = InputsModel,
- ProdStore = RESULTS$StateEnd[1L], RoutStore = RESULTS$StateEnd[2L], ExpStore = NULL,
- UH1 = NULL, UH2 = RESULTS$StateEnd[(1:40)+(7+20)],
- GCemaNeigeLayers = NULL, eTGCemaNeigeLayers = NULL,
- verbose = FALSE)
- }
-
- ##Output_data_preparation
- ##OutputsModel_only
- if(ExportDatesR==FALSE & ExportStateEnd==FALSE){
- OutputsModel <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]);
- names(OutputsModel) <- FortranOutputs[IndOutputs]; }
- ##DatesR_and_OutputsModel_only
- if(ExportDatesR==TRUE & ExportStateEnd==FALSE){
- OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]) );
- names(OutputsModel) <- c("DatesR",FortranOutputs[IndOutputs]); }
- ##OutputsModel_and_SateEnd_only
- if(ExportDatesR==FALSE & ExportStateEnd==TRUE){
- OutputsModel <- c( lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]),
- list(RESULTS$StateEnd) );
- names(OutputsModel) <- c(FortranOutputs[IndOutputs],"StateEnd"); }
- ##DatesR_and_OutputsModel_and_SateEnd
- if((ExportDatesR==TRUE & ExportStateEnd==TRUE) | "all" %in% RunOptions$Outputs_Sim){
- OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]),
- list(RESULTS$StateEnd) );
- names(OutputsModel) <- c("DatesR",FortranOutputs[IndOutputs],"StateEnd"); }
-
- ##End
- rm(RESULTS);
- class(OutputsModel) <- c("OutputsModel","daily","GR");
- return(OutputsModel);
-
+RunModel_GR5J <- function(InputsModel, RunOptions, Param) {
+
+
+ ## Initialization of variables
+ NParam <- 5
+ FortranOutputs <- .FortranOutputs(GR = "GR5J")$GR
+
+
+ ## Arguments check
+ if (!inherits(InputsModel, "InputsModel")) {
+ stop("'InputsModel' must be of class 'InputsModel'")
+ }
+ if (!inherits(InputsModel, "daily" )) {
+ stop("'InputsModel' must be of class 'daily' ")
+ }
+ if (!inherits(InputsModel, "GR" )) {
+ stop("'InputsModel' must be of class 'GR' ")
+ }
+ if (!inherits(RunOptions, "RunOptions" )) {
+ stop("'RunOptions' must be of class 'RunOptions' ")
+ }
+ if (!inherits(RunOptions, "GR" )) {
+ stop("'RunOptions' must be of class 'GR' ")
+ }
+ if (!is.vector(Param) | !is.numeric(Param)) {
+ stop("'Param' must be a numeric vector")
+ }
+ if (sum(!is.na(Param)) != NParam) {
+ stop(paste("'Param' must be a vector of length ", NParam, " and contain no NA", sep = ""))
+ }
+ Param <- as.double(Param)
+
+ Param_X1X3_threshold <- 1e-2
+ Param_X4_threshold <- 0.5
+ if (Param[1L] < Param_X1X3_threshold) {
+ warning(sprintf("Param[1] (X1: production store capacity [mm]) < %.2f\n X1 set to %.2f", Param_X1X3_threshold, Param_X1X3_threshold))
+ Param[1L] <- Param_X1X3_threshold
+ }
+ if (Param[3L] < Param_X1X3_threshold) {
+ warning(sprintf("Param[3] (X3: routing store capacity [mm]) < %.2f\n X3 set to %.2f", Param_X1X3_threshold, Param_X1X3_threshold))
+ Param[3L] <- Param_X1X3_threshold
+ }
+ if (Param[4L] < Param_X4_threshold) {
+ warning(sprintf("Param[4] (X4: unit hydrograph time constant [d]) < %.2f\n X4 set to %.2f", Param_X4_threshold, Param_X4_threshold))
+ Param[4L] <- Param_X4_threshold
+ }
+
+ ## Input data preparation
+ if (identical(RunOptions$IndPeriod_WarmUp, 0L)) {
+ RunOptions$IndPeriod_WarmUp <- NULL
+ }
+ IndPeriod1 <- c(RunOptions$IndPeriod_WarmUp, RunOptions$IndPeriod_Run)
+ LInputSeries <- as.integer(length(IndPeriod1))
+ if ("all" %in% RunOptions$Outputs_Sim) {
+ IndOutputs <- as.integer(1:length(FortranOutputs))
+ } else {
+ IndOutputs <- which(FortranOutputs %in% RunOptions$Outputs_Sim)
+ }
+
+ ## Output data preparation
+ IndPeriod2 <- (length(RunOptions$IndPeriod_WarmUp)+1):LInputSeries
+ ExportDatesR <- "DatesR" %in% RunOptions$Outputs_Sim
+ ExportStateEnd <- "StateEnd" %in% RunOptions$Outputs_Sim
+
+ ## 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)
+ }
+
+ ## Call GR model Fortan
+ RESULTS <- .Fortran("frun_gr5j", PACKAGE = "airGR",
+ ## inputs
+ LInputs = LInputSeries, ### length of input and output series
+ InputsPrecip = InputsModel$Precip[IndPeriod1], ### input series of total precipitation [mm/d]
+ InputsPE = InputsModel$PotEvap[IndPeriod1], ### input series potential evapotranspiration [mm/d]
+ NParam = as.integer(length(Param)), ### number of model parameter
+ Param = Param, ### parameter set
+ NStates = as.integer(length(RunOptions$IniStates)), ### number of state variables used for model initialising
+ StateStart = RunOptions$IniStates, ### state variables used when the model run starts
+ NOutputs = as.integer(length(IndOutputs)), ### number of output series
+ IndOutputs = IndOutputs, ### indices of output series
+ ## outputs
+ Outputs = matrix(as.double(-999.999), nrow = LInputSeries, ncol = length(IndOutputs)), ### output series [mm]
+ StateEnd = rep(as.double(-999.999), length(RunOptions$IniStates)) ### state variables at the end of the model run
+ )
+ RESULTS$Outputs[ round(RESULTS$Outputs , 3) == -999.999] <- NA
+ RESULTS$StateEnd[round(RESULTS$StateEnd, 3) == -999.999] <- NA
+ if (ExportStateEnd) {
+ RESULTS$StateEnd[-3L] <- ifelse(RESULTS$StateEnd[-3L] < 0, 0, RESULTS$StateEnd[-3L]) ### remove negative values except for the ExpStore location
+ RESULTS$StateEnd <- CreateIniStates(FUN_MOD = RunModel_GR5J, InputsModel = InputsModel,
+ ProdStore = RESULTS$StateEnd[1L], RoutStore = RESULTS$StateEnd[2L], ExpStore = NULL,
+ UH1 = NULL, UH2 = RESULTS$StateEnd[(1:40)+(7+20)],
+ GCemaNeigeLayers = NULL, eTGCemaNeigeLayers = NULL,
+ verbose = FALSE)
+ }
+
+ ## Output data preparation
+ ## OutputsModel only
+ if (!ExportDatesR & !ExportStateEnd) {
+ OutputsModel <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i])
+ names(OutputsModel) <- FortranOutputs[IndOutputs]
+ }
+ ## DatesR and OutputsModel only
+ if (ExportDatesR & !ExportStateEnd) {
+ OutputsModel <- c(list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
+ lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]))
+ names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs])
+ }
+ ## OutputsModel and SateEnd only
+ if (!ExportDatesR & ExportStateEnd) {
+ OutputsModel <- c(lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
+ list(RESULTS$StateEnd))
+ names(OutputsModel) <- c(FortranOutputs[IndOutputs], "StateEnd")
+ }
+ ## DatesR and OutputsModel and SateEnd
+ if ((ExportDatesR & ExportStateEnd) | "all" %in% RunOptions$Outputs_Sim) {
+ OutputsModel <- c(list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
+ lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
+ list(RESULTS$StateEnd))
+ names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs], "StateEnd")
+ }
+
+ ## End
+ rm(RESULTS)
+ class(OutputsModel) <- c("OutputsModel", "daily", "GR")
+ return(OutputsModel)
+
}
diff --git a/R/RunModel_GR6J.R b/R/RunModel_GR6J.R
index 15bd28423f7efa46e2962b9aa47dea9fddce0813..c971056fbd21f4fd423a0b98abe0065d62c5090b 100644
--- a/R/RunModel_GR6J.R
+++ b/R/RunModel_GR6J.R
@@ -1,109 +1,134 @@
-RunModel_GR6J <- function(InputsModel,RunOptions,Param){
-
- NParam <- 6;
- FortranOutputs <- .FortranOutputs(GR = "GR6J")$GR
-
- ##Arguments_check
- if(inherits(InputsModel,"InputsModel")==FALSE){ stop("'InputsModel' must be of class 'InputsModel'") }
- if(inherits(InputsModel,"daily" )==FALSE){ stop("'InputsModel' must be of class 'daily' ") }
- if(inherits(InputsModel,"GR" )==FALSE){ stop("'InputsModel' must be of class 'GR' ") }
- if(inherits(RunOptions,"RunOptions" )==FALSE){ stop("'RunOptions' must be of class 'RunOptions' ") }
- if(inherits(RunOptions,"GR" )==FALSE){ stop("'RunOptions' must be of class 'GR' ") }
- if(!is.vector(Param) | !is.numeric(Param)){ stop("'Param' must be a numeric vector") }
- if(sum(!is.na(Param))!=NParam){ stop(paste("'Param' must be a vector of length ",NParam," and contain no NA",sep="")) }
- Param <- as.double(Param);
-
- Param_X1X3X6_threshold <- 1e-2
- Param_X4_threshold <- 0.5
- if (Param[1L] < Param_X1X3X6_threshold) {
- warning(sprintf("Param[1] (X1: production store capacity [mm]) < %.2f\n X1 set to %.2f", Param_X1X3X6_threshold, Param_X1X3X6_threshold))
- Param[1L] <- Param_X1X3X6_threshold
- }
- if (Param[3L] < Param_X1X3X6_threshold) {
- warning(sprintf("Param[3] (X3: routing store capacity [mm]) < %.2f\n X3 set to %.2f", Param_X1X3X6_threshold, Param_X1X3X6_threshold))
- Param[3L] <- Param_X1X3X6_threshold
- }
- if (Param[4L] < Param_X4_threshold) {
- warning(sprintf("Param[4] (X4: unit hydrograph time constant [d]) < %.2f\n X4 set to %.2f", Param_X4_threshold, Param_X4_threshold))
- Param[4L] <- Param_X4_threshold
- }
- if (Param[6L] < Param_X1X3X6_threshold) {
- warning(sprintf("Param[6] (X6: coefficient for emptying exponential store [mm]) < %.2f\n X6 set to %.2f", Param_X1X3X6_threshold, Param_X1X3X6_threshold))
- Param[6L] <- Param_X1X3X6_threshold
- }
-
- ##Input_data_preparation
- if(identical(RunOptions$IndPeriod_WarmUp,as.integer(0))){ RunOptions$IndPeriod_WarmUp <- NULL; }
- IndPeriod1 <- c(RunOptions$IndPeriod_WarmUp,RunOptions$IndPeriod_Run);
- LInputSeries <- as.integer(length(IndPeriod1))
- if("all" %in% RunOptions$Outputs_Sim){ IndOutputs <- as.integer(1:length(FortranOutputs));
- } else { IndOutputs <- which(FortranOutputs %in% RunOptions$Outputs_Sim); }
-
- ##Output_data_preparation
- IndPeriod2 <- (length(RunOptions$IndPeriod_WarmUp)+1):LInputSeries;
- ExportDatesR <- "DatesR" %in% RunOptions$Outputs_Sim;
- ExportStateEnd <- "StateEnd" %in% RunOptions$Outputs_Sim;
-
- ##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[3] <- RunOptions$IniResLevels[3] ### exponential store level (mm)
- }
-
- ##Call_fortan
- RESULTS <- .Fortran("frun_gr6j",PACKAGE="airGR",
- ##inputs
- LInputs=LInputSeries, ### length of input and output series
- InputsPrecip=InputsModel$Precip[IndPeriod1], ### input series of total precipitation [mm/d]
- InputsPE=InputsModel$PotEvap[IndPeriod1], ### input series potential evapotranspiration [mm/d]
- NParam=as.integer(length(Param)), ### number of model parameter
- Param=Param, ### parameter set
- NStates=as.integer(length(RunOptions$IniStates)), ### number of state variables used for model initialising
- StateStart=RunOptions$IniStates, ### state variables used when the model run starts
- NOutputs=as.integer(length(IndOutputs)), ### number of output series
- IndOutputs=IndOutputs, ### indices of output series
- ##outputs
- Outputs=matrix(as.double(-999.999),nrow=LInputSeries,ncol=length(IndOutputs)), ### output series [mm]
- StateEnd=rep(as.double(-999.999),length(RunOptions$IniStates)) ### state variables at the end of the model run
- )
- RESULTS$Outputs[ round(RESULTS$Outputs ,3)==(-999.999)] <- NA;
- RESULTS$StateEnd[round(RESULTS$StateEnd,3)==(-999.999)] <- NA;
- if (ExportStateEnd) {
- RESULTS$StateEnd[-3L] <- ifelse(RESULTS$StateEnd[-3L] < 0, 0, RESULTS$StateEnd[-3L]) ### remove negative values except for the ExpStore location
- RESULTS$StateEnd <- CreateIniStates(FUN_MOD = RunModel_GR6J, InputsModel = InputsModel,
- ProdStore = RESULTS$StateEnd[1L], RoutStore = RESULTS$StateEnd[2L], ExpStore = RESULTS$StateEnd[3L],
- UH1 = RESULTS$StateEnd[(1:20)+7], UH2 = RESULTS$StateEnd[(1:40)+(7+20)],
- GCemaNeigeLayers = NULL, eTGCemaNeigeLayers = NULL,
- verbose = FALSE)
- }
-
- ##Output_data_preparation
- ##OutputsModel_only
- if(ExportDatesR==FALSE & ExportStateEnd==FALSE){
- OutputsModel <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]);
- names(OutputsModel) <- FortranOutputs[IndOutputs]; }
- ##DatesR_and_OutputsModel_only
- if(ExportDatesR==TRUE & ExportStateEnd==FALSE){
- OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]) );
- names(OutputsModel) <- c("DatesR",FortranOutputs[IndOutputs]); }
- ##OutputsModel_and_SateEnd_only
- if(ExportDatesR==FALSE & ExportStateEnd==TRUE){
- OutputsModel <- c( lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]),
- list(RESULTS$StateEnd) );
- names(OutputsModel) <- c(FortranOutputs[IndOutputs],"StateEnd"); }
- ##DatesR_and_OutputsModel_and_SateEnd
- if((ExportDatesR==TRUE & ExportStateEnd==TRUE) | "all" %in% RunOptions$Outputs_Sim){
- OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]),
- list(RESULTS$StateEnd) );
- names(OutputsModel) <- c("DatesR",FortranOutputs[IndOutputs],"StateEnd"); }
-
- ##End
- rm(RESULTS);
- class(OutputsModel) <- c("OutputsModel","daily","GR");
- return(OutputsModel);
-
+RunModel_GR6J <- function(InputsModel, RunOptions, Param) {
+
+
+ ## Initialization of variables
+ NParam <- 6
+ FortranOutputs <- .FortranOutputs(GR = "GR6J")$GR
+
+
+ ## Arguments check
+ if (!inherits(InputsModel, "InputsModel")) {
+ stop("'InputsModel' must be of class 'InputsModel'")
+ }
+ if (!inherits(InputsModel, "daily" )) {
+ stop("'InputsModel' must be of class 'daily' ")
+ }
+ if (!inherits(InputsModel, "GR" )) {
+ stop("'InputsModel' must be of class 'GR' ")
+ }
+ if (!inherits(RunOptions, "RunOptions" )) {
+ stop("'RunOptions' must be of class 'RunOptions' ")
+ }
+ if (!inherits(RunOptions, "GR" )) {
+ stop("'RunOptions' must be of class 'GR' ")
+ }
+ if (!is.vector(Param) | !is.numeric(Param)) {
+ stop("'Param' must be a numeric vector")
+ }
+ if (sum(!is.na(Param)) != NParam) {
+ stop(paste("'Param' must be a vector of length ", NParam, " and contain no NA", sep = ""))
+ }
+ Param <- as.double(Param)
+
+ Param_X1X3X6_threshold <- 1e-2
+ Param_X4_threshold <- 0.5
+ if (Param[1L] < Param_X1X3X6_threshold) {
+ warning(sprintf("Param[1] (X1: production store capacity [mm]) < %.2f\n X1 set to %.2f", Param_X1X3X6_threshold, Param_X1X3X6_threshold))
+ Param[1L] <- Param_X1X3X6_threshold
+ }
+ if (Param[3L] < Param_X1X3X6_threshold) {
+ warning(sprintf("Param[3] (X3: routing store capacity [mm]) < %.2f\n X3 set to %.2f", Param_X1X3X6_threshold, Param_X1X3X6_threshold))
+ Param[3L] <- Param_X1X3X6_threshold
+ }
+ if (Param[4L] < Param_X4_threshold) {
+ warning(sprintf("Param[4] (X4: unit hydrograph time constant [d]) < %.2f\n X4 set to %.2f", Param_X4_threshold, Param_X4_threshold))
+ Param[4L] <- Param_X4_threshold
+ }
+ if (Param[6L] < Param_X1X3X6_threshold) {
+ warning(sprintf("Param[6] (X6: coefficient for emptying exponential store [mm]) < %.2f\n X6 set to %.2f", Param_X1X3X6_threshold, Param_X1X3X6_threshold))
+ Param[6L] <- Param_X1X3X6_threshold
+ }
+
+ ## Input data preparation
+ if (identical(RunOptions$IndPeriod_WarmUp, 0L)) {
+ RunOptions$IndPeriod_WarmUp <- NULL
+ }
+ IndPeriod1 <- c(RunOptions$IndPeriod_WarmUp, RunOptions$IndPeriod_Run)
+ LInputSeries <- as.integer(length(IndPeriod1))
+ if ("all" %in% RunOptions$Outputs_Sim) {
+ IndOutputs <- as.integer(1:length(FortranOutputs))
+ } else {
+ IndOutputs <- which(FortranOutputs %in% RunOptions$Outputs_Sim)
+ }
+
+ ## Output data preparation
+ IndPeriod2 <- (length(RunOptions$IndPeriod_WarmUp)+1):LInputSeries
+ ExportDatesR <- "DatesR" %in% RunOptions$Outputs_Sim
+ ExportStateEnd <- "StateEnd" %in% RunOptions$Outputs_Sim
+
+ ## 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[3] <- RunOptions$IniResLevels[3] ### exponential store level (mm)
+ }
+
+ ## Call GR model Fortan
+ RESULTS <- .Fortran("frun_gr6j", PACKAGE = "airGR",
+ ## inputs
+ LInputs = LInputSeries, ### length of input and output series
+ InputsPrecip = InputsModel$Precip[IndPeriod1], ### input series of total precipitation [mm/d]
+ InputsPE = InputsModel$PotEvap[IndPeriod1], ### input series potential evapotranspiration [mm/d]
+ NParam = as.integer(length(Param)), ### number of model parameter
+ Param = Param, ### parameter set
+ NStates = as.integer(length(RunOptions$IniStates)), ### number of state variables used for model initialising
+ StateStart = RunOptions$IniStates, ### state variables used when the model run starts
+ NOutputs = as.integer(length(IndOutputs)), ### number of output series
+ IndOutputs = IndOutputs, ### indices of output series
+ ## outputs
+ Outputs = matrix(as.double(-999.999), nrow = LInputSeries, ncol = length(IndOutputs)), ### output series [mm]
+ StateEnd = rep(as.double(-999.999), length(RunOptions$IniStates)) ### state variables at the end of the model run
+ )
+ RESULTS$Outputs[ round(RESULTS$Outputs , 3) == -999.999] <- NA
+ RESULTS$StateEnd[round(RESULTS$StateEnd, 3) == -999.999] <- NA
+ if (ExportStateEnd) {
+ RESULTS$StateEnd[-3L] <- ifelse(RESULTS$StateEnd[-3L] < 0, 0, RESULTS$StateEnd[-3L]) ### remove negative values except for the ExpStore location
+ RESULTS$StateEnd <- CreateIniStates(FUN_MOD = RunModel_GR6J, InputsModel = InputsModel,
+ ProdStore = RESULTS$StateEnd[1L], RoutStore = RESULTS$StateEnd[2L], ExpStore = RESULTS$StateEnd[3L],
+ UH1 = RESULTS$StateEnd[(1:20)+7], UH2 = RESULTS$StateEnd[(1:40)+(7+20)],
+ GCemaNeigeLayers = NULL, eTGCemaNeigeLayers = NULL,
+ verbose = FALSE)
+ }
+
+ ## Output data preparation
+ ## OutputsModel only
+ if (!ExportDatesR & !ExportStateEnd) {
+ OutputsModel <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i])
+ names(OutputsModel) <- FortranOutputs[IndOutputs]
+ }
+ ## DatesR and OutputsModel only
+ if (ExportDatesR & !ExportStateEnd) {
+ OutputsModel <- c(list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
+ lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]))
+ names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs])
+ }
+ ## OutputsModel and SateEnd only
+ if (!ExportDatesR & ExportStateEnd) {
+ OutputsModel <- c(lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
+ list(RESULTS$StateEnd))
+ names(OutputsModel) <- c(FortranOutputs[IndOutputs], "StateEnd")
+ }
+ ## DatesR and OutputsModel and SateEnd
+ if ((ExportDatesR & ExportStateEnd) | "all" %in% RunOptions$Outputs_Sim) {
+ OutputsModel <- c(list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
+ lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
+ list(RESULTS$StateEnd))
+ names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs], "StateEnd")
+ }
+
+ ## End
+ rm(RESULTS)
+ class(OutputsModel) <- c("OutputsModel", "daily", "GR")
+ return(OutputsModel)
+
}
-
\ No newline at end of file
diff --git a/R/RunModel_Lag.R b/R/RunModel_Lag.R
new file mode 100644
index 0000000000000000000000000000000000000000..8bfd1f568e73a5a259545047926aaa151a52cfc9
--- /dev/null
+++ b/R/RunModel_Lag.R
@@ -0,0 +1,111 @@
+RunModel_Lag <- function(InputsModel, RunOptions, Param) {
+ NParam <- 1
+
+ ##Arguments_check
+ if (!inherits(InputsModel, "InputsModel")) {
+ stop("'InputsModel' must be of class 'InputsModel'")
+ }
+ if (!inherits(InputsModel, "SD")) {
+ stop("'InputsModel' must be of class 'SD'")
+ }
+ if (!inherits(RunOptions, "RunOptions")) {
+ stop("'RunOptions' must be of class 'RunOptions'")
+ }
+ if (!is.vector(Param) | !is.numeric(Param)) {
+ stop("'Param' must be a numeric vector")
+ }
+ if (sum(!is.na(Param)) != NParam) {
+ stop(paste("'Param' must be a vector of length", NParam, "and contain no NA"))
+ }
+ if (is.null(InputsModel$OutputsModel)) {
+ stop(
+ "'InputsModel' should contain an 'OutputsModel' key containing the output of the runoff of the downstream subcatchment"
+ )
+ }
+ if (is.null(InputsModel$OutputsModel$Qsim)) {
+ stop(
+ "'InputsModel$OutputsModel' should contain a key 'Qsim' containing the output of the runoff of the downstream subcatchment"
+ )
+ }
+ if (sum(!is.na(InputsModel$OutputsModel$Qsim)) != length(RunOptions$IndPeriod_Run)) {
+ stop(
+ "'InputsModel$OutputsModel$Qim' should have the same lenght as 'RunOptions$IndPeriod_Run' and contain no NA"
+ )
+ }
+
+ OutputsModel <- InputsModel$OutputsModel
+ OutputsModel$QsimDown <- OutputsModel$Qsim
+
+ if (inherits(InputsModel, "hourly")) {
+ TimeStep <- 60 * 60
+ } else if (inherits(InputsModel, "daily")) {
+ TimeStep <- 60 * 60 * 24
+ } else {
+ stop("'InputsModel' should be of class \"daily\" or \"hourly\"")
+ }
+
+ # propagation time from upstream meshes to outlet
+ PT <- InputsModel$LengthHydro / Param[1L] / TimeStep
+ HUTRANS <- rbind(1 - (PT - floor(PT)), PT - floor(PT))
+
+ NbUpBasins <- length(InputsModel$LengthHydro)
+ LengthTs <- length(OutputsModel$QsimDown)
+ OutputsModel$Qsim <-
+ OutputsModel$QsimDown * InputsModel$BasinAreas[length(InputsModel$BasinAreas)] * 1e3
+
+ IniSD <- RunOptions$IniStates[grep("SD", names(RunOptions$IniStates))]
+ if (length(IniSD) > 0) {
+ if (sum(floor(PT)) + NbUpBasins != length(IniSD)) {
+ stop(
+ sprintf(
+ "SD initial states has a length of %i and a length of %i is required",
+ length(IniSD),
+ sum(floor(PT)) + NbUpBasins
+ )
+ )
+ }
+ IniStates <- lapply(seq_len(NbUpBasins), function(x) {
+ iStart <- 1
+ if (x > 1) {
+ iStart <- iStart + sum(floor(PT[1:x - 1]) + 1)
+ }
+ IniSD[iStart:(iStart + PT[x])]
+ })
+ } else {
+ IniStates <- lapply(seq_len(NbUpBasins), function(x) {
+ rep(0, floor(PT[x] + 1))
+ })
+ }
+
+ for (upstream_basin in seq_len(NbUpBasins)) {
+ Qupstream <-
+ InputsModel$Qupstream[RunOptions$IndPeriod_Run, upstream_basin]
+ if (!is.na(InputsModel$BasinAreas[upstream_basin])) {
+ # Upstream flow with area needs to be converted to m3 by time step
+ Qupstream <-
+ Qupstream * InputsModel$BasinAreas[upstream_basin] * 1e3
+ }
+ OutputsModel$Qsim <- OutputsModel$Qsim +
+ c(IniStates[[upstream_basin]][-length(IniStates[[upstream_basin]])],
+ Qupstream[1:(LengthTs - floor(PT[upstream_basin]))]) *
+ HUTRANS[1, upstream_basin] +
+ c(IniStates[[upstream_basin]],
+ Qupstream[1:(LengthTs - floor(PT[upstream_basin]) - 1)]) *
+ HUTRANS[2, upstream_basin]
+ }
+ # Warning for negative flows
+ if (any(OutputsModel$Qsim < 0)) {
+ warning(length(which(OutputsModel$Qsim < 0)), " time steps with negative flow, set to zero.")
+ OutputsModel$Qsim[OutputsModel$Qsim < 0] <- 0
+ }
+ # Convert back Qsim to mm
+ OutputsModel$Qsim <- OutputsModel$Qsim / sum(InputsModel$BasinAreas, na.rm = TRUE) / 1e3
+
+ if ("StateEnd" %in% RunOptions$Outputs_Sim) {
+ OutputsModel$StateEnd$SD <- lapply(seq(NbUpBasins), function(x) {
+ Qupstream[(LengthTs - floor(PT[x])):LengthTs]
+ })
+ }
+
+ return(OutputsModel)
+}
diff --git a/R/SeriesAggreg.InputsModel.R b/R/SeriesAggreg.InputsModel.R
new file mode 100644
index 0000000000000000000000000000000000000000..37513f46d1a15322f5e9955c682a41b33904f8ba
--- /dev/null
+++ b/R/SeriesAggreg.InputsModel.R
@@ -0,0 +1,7 @@
+SeriesAggreg.InputsModel <- function(x, Format, ...) {
+ SeriesAggreg.list(x,
+ Format,
+ ConvertFun = NA,
+ except = c("ZLayers", "LengthHydro", "BasinAreas"),
+ ...)
+}
diff --git a/R/SeriesAggreg.OutputsModel.R b/R/SeriesAggreg.OutputsModel.R
new file mode 100644
index 0000000000000000000000000000000000000000..3bf0d8aefd24f930c4d6c0ba36fd9786d11e640f
--- /dev/null
+++ b/R/SeriesAggreg.OutputsModel.R
@@ -0,0 +1,7 @@
+SeriesAggreg.OutputsModel <- function(x, Format, ...) {
+ SeriesAggreg.list(x,
+ Format,
+ ConvertFun = NA,
+ except = "StateEnd",
+ ...)
+}
diff --git a/R/SeriesAggreg.R b/R/SeriesAggreg.R
index a1c3434ffb2876e2017ac75c1408a93a504b91cf..737ce62eb7840cc38b59fad260c1d07bf150fc45 100644
--- a/R/SeriesAggreg.R
+++ b/R/SeriesAggreg.R
@@ -1,216 +1,3 @@
-SeriesAggreg <- function(TabSeries,
- TimeFormat, NewTimeFormat,
- ConvertFun,
- YearFirstMonth = 1, TimeLag = 0,
- verbose = TRUE) {
-
-
- ##_Arguments_check
-
- ##check_TabSeries
- if (is.null(TabSeries) ) {
- stop("'TabSeries' must be a data.frame containing the dates and data to be converted")
- }
- if (!is.data.frame(TabSeries)) {
- stop("'TabSeries' must be a data.frame containing the dates and data to be converted")
- }
- if (ncol(TabSeries) < 2) {
- stop("'TabSeries' must contain at least two columns (including the coulmn of dates")
- }
- ##check_TimeFormat
- if (!any(class(TabSeries[, 1]) %in% "POSIXt")) {
- stop("'TabSeries' first column must be a vector of class 'POSIXlt' or 'POSIXct'")
- }
- if (any(class(TabSeries[, 1]) %in% "POSIXlt")) {
- TabSeries[, 1] <- as.POSIXct(TabSeries[, 1])
- }
- for (iCol in 2:ncol(TabSeries)) {
- if (!is.numeric(TabSeries[,iCol])) {
- stop("'TabSeries' columns (other than the first one) be of numeric class")
- }
- }
- if (is.null(TimeFormat)) {
- stop("'TimeFormat' must be one of 'hourly', 'daily', 'monthly' or 'yearly'")
- }
- if (!is.vector(TimeFormat)) {
- stop("'TimeFormat' must be one of 'hourly', 'daily', 'monthly' or 'yearly'")
- }
- if (!is.character(TimeFormat)) {
- stop("'TimeFormat' must be one of 'hourly', 'daily', 'monthly' or 'yearly'")
- }
- if (length(TimeFormat) != 1) {
- stop("'TimeFormat' must be one of 'hourly', 'daily', 'monthly' or 'yearly'")
- }
- if (! TimeFormat %in% c("hourly", "daily", "monthly", "yearly")) {
- stop("'TimeFormat' must be one of 'hourly', 'daily', 'monthly' or 'yearly'")
- }
- ##check_NewTimeFormat
- if (is.null(NewTimeFormat)) {
- stop("'NewTimeFormat' must be one of 'hourly', 'daily', 'monthly' or 'yearly'")
- }
- if (!is.vector(NewTimeFormat)) {
- stop("'NewTimeFormat' must be one of 'hourly', 'daily', 'monthly' or 'yearly'")
- }
- if (!is.character(NewTimeFormat)) {
- stop("'NewTimeFormat' must be one of 'hourly', 'daily', 'monthly' or 'yearly'")
- }
- if (length(NewTimeFormat) != 1) {
- stop("'NewTimeFormat' must be one of 'hourly', 'daily', 'monthly' or 'yearly'")
- }
- if (! NewTimeFormat %in% c("hourly", "daily", "monthly", "yearly")) {
- stop("'NewTimeFormat' must be one of 'hourly', 'daily', 'monthly' or 'yearly'")
- }
- ##check_ConvertFun
- if (is.null(ConvertFun)) {
- stop("'ConvertFun' must be a vector of character")
- }
- if (!is.vector(ConvertFun)) {
- stop("'ConvertFun' must be a vector of character")
- }
- if (!is.character(ConvertFun)) {
- stop("'ConvertFun' must be a vector of character")
- }
- if (length(ConvertFun) != (ncol(TabSeries) - 1)) {
- stop(
- paste("'ConvertFun' must be of length", ncol(TabSeries) - 1, "(length=ncol(TabSeries)-1)")
- )
- }
- if (sum(ConvertFun %in% c("sum", "mean") == FALSE) != 0) {
- stop("'ConvertFun' elements must be one of 'sum' or 'mean'")
- }
- ##check_YearFirstMonth
- if (is.null(YearFirstMonth)) {
- stop("'YearFirstMonth' must be an integer between 1 and 12")
- }
- if (!is.vector(YearFirstMonth)) {
- stop("'YearFirstMonth' must be an integer between 1 and 12")
- }
- if (!is.numeric(YearFirstMonth)) {
- stop("'YearFirstMonth' must be an integer between 1 and 12")
- }
- YearFirstMonth <- as.integer(YearFirstMonth)
- if (length(YearFirstMonth) != 1) {
- stop("'YearFirstMonth' must be only one integer between 1 and 12")
- }
- if (YearFirstMonth %in% (1:12) == FALSE) {
- stop("'YearFirstMonth' must be only one integer between 1 and 12")
- }
- ##check_DatesR_integrity
- if (TimeFormat == "hourly") {
- by <- "hours"
- }
- if (TimeFormat == "daily") {
- by <- "days"
- }
- if (TimeFormat == "monthly") {
- by <- "months"
- }
- if (TimeFormat == "yearly") {
- by <- "years"
- }
- TmpDatesR <- seq(from = TabSeries[1, 1], to = tail(TabSeries[, 1], 1), by = by)
- if (!identical(TabSeries[, 1], TmpDatesR)) {
- stop("some dates might not be ordered or are missing in 'TabSeries'")
- }
- ##check_conversion_direction
- if ((TimeFormat == "daily" & NewTimeFormat %in% c("hourly") ) |
- (TimeFormat == "monthly" & NewTimeFormat %in% c("hourly","daily") ) |
- (TimeFormat == "yearly" & NewTimeFormat %in% c("hourly","daily","monthly"))) {
- stop("only time aggregation can be performed")
- }
- ##check_if_conversion_not_needed
- if ((TimeFormat == "hourly" & NewTimeFormat == "hourly" ) |
- (TimeFormat == "daily" & NewTimeFormat == "daily" ) |
- (TimeFormat == "monthly" & NewTimeFormat == "monthly") |
- (TimeFormat == "yearly" & NewTimeFormat == "yearly" )) {
- if (verbose) {
- warning("the old and new format are identical \n\t -> no time-step conversion was performed")
- return(TabSeries)
- }
- }
-
-
- ##_Time_step_conversion
-
- ##_Handle_conventional_difference_between_hourly_series_and_others
- TmpDatesR <- TabSeries[, 1]
- #if (TimeFormat=="hourly") { TmpDatesR <- TmpDatesR - 60*60; }
- TmpDatesR <- TmpDatesR + TimeLag
- Hmax <- "00"
- if (TimeFormat == "hourly") {
- Hmax <- "23"
- }
-
- ##_Identify_the_part_of_the_series_to_be_aggregated
- NDaysInMonth <- list("31", c("28", "29"), "31", "30", "31", "30", "31", "31", "30", "31", "30", "31")
- YearLastMonth <- YearFirstMonth + 11
- if (YearLastMonth > 12) {
- YearLastMonth <- YearLastMonth - 12
- }
- YearFirstMonthTxt <- formatC(YearFirstMonth, format = "d", width = 2, flag = "0")
- YearLastMonthTxt <- formatC(YearLastMonth , format = "d", width = 2, flag = "0")
- if (NewTimeFormat == "daily") {
- Ind1 <- which(format(TmpDatesR, "%H") == "00")
- Ind2 <- which(format(TmpDatesR, "%H") == Hmax)
- if (Ind2[1] < Ind1[1]) {
- Ind2 <- Ind2[2:length(Ind2)]
- }
- if (tail(Ind1, 1) > tail(Ind2, 1)) {
- Ind1 <- Ind1[1:(length(Ind1) - 1)]
- }
- ### Aggr <- NULL; iii <- 0; for(kkk in 1:length(Ind1)) {
- ### iii <- iii+1; Aggr <- c(Aggr,rep(iii,length(Ind1[kkk]:Ind2[kkk]))); }
- Aggr <- as.numeric(format(TmpDatesR[min(Ind1):max(Ind2)], "%Y%m%d"))
- ### more efficient
- NewDatesR <- data.frame(seq(from = TmpDatesR[min(Ind1)], to = TmpDatesR[max(Ind2)], by = "days"))
- }
- if (NewTimeFormat=="monthly") {
- Ind1 <- which(format(TmpDatesR, "%d%H") == "0100")
- Ind2 <- which(format(TmpDatesR,"%m%d%H") %in% paste0(c("0131", "0228", "0229", "0331", "0430", "0531", "0630", "0731", "0831", "0930", "1031", "1130", "1231"), Hmax))
- Ind2[1:(length(Ind2) - 1)][diff(Ind2) == 1] <- NA
- Ind2 <- Ind2[!is.na(Ind2)] ### to keep only feb 29 if both feb 28 and feb 29 exists
- if (Ind2[1] < Ind1[1]) {
- Ind2 <- Ind2[2:length(Ind2)]
- }
- if (tail(Ind1, 1) > tail(Ind2, 1)) {
- Ind1 <- Ind1[1:(length(Ind1) - 1)]
- }
- ### Aggr <- NULL; iii <- 0; for(kkk in 1:length(Ind1)) {
- ### iii <- iii+1; Aggr <- c(Aggr,rep(iii,length(Ind1[kkk]:Ind2[kkk]))); }
- Aggr <- as.numeric(format(TmpDatesR[min(Ind1):max(Ind2)],"%Y%m")); ### more efficient
- NewDatesR <- data.frame(seq(from=TmpDatesR[min(Ind1)],to=TmpDatesR[max(Ind2)],by="months"))
- }
- if (NewTimeFormat == "yearly") {
- Ind1 <- which(format(TmpDatesR, "%m%d%H") %in% paste0(YearFirstMonthTxt, "0100"))
- Ind2 <- which(format(TmpDatesR, "%m%d%H") %in% paste0(YearLastMonthTxt, NDaysInMonth[[YearLastMonth]], Hmax))
- Ind2[1:(length(Ind2) - 1)][diff(Ind2) == 1] <- NA
- Ind2 <- Ind2[!is.na(Ind2)]
- ### to keep only feb 29 if both feb 28 and feb 29 exists
- if (Ind2[1] < Ind1[1]) {
- Ind2 <- Ind2[2:length(Ind2)]
- }
- if (tail(Ind1, 1) > tail(Ind2, 1)) {
- Ind1 <- Ind1[1:(length(Ind1) - 1)]
- }
- Aggr <- NULL
- iii <- 0
- for (kkk in 1:length(Ind1)) {
- iii <- iii + 1
- Aggr <- c(Aggr, rep(iii, length(Ind1[kkk]:Ind2[kkk])))
- }
- ### Aggr <- as.numeric(format(TmpDatesR[min(Ind1):max(Ind2)],"%Y")); ### not working if YearFirstMonth != 01
- NewDatesR <- data.frame(seq(from = TmpDatesR[min(Ind1)], to = TmpDatesR[max(Ind2)], by = "years"))
- }
- ##_Aggreation_and_export
- NewTabSeries <- data.frame(NewDatesR)
- for (iCol in 2:ncol(TabSeries)) {
- AggregData <- aggregate(TabSeries[min(Ind1):max(Ind2), iCol],
- by = list(Aggr),
- FUN = ConvertFun[iCol - 1], na.rm = FALSE)[, 2]
- NewTabSeries <- data.frame(NewTabSeries, AggregData)
- }
- names(NewTabSeries) <- names(TabSeries)
- return(NewTabSeries)
-
-
-}
\ No newline at end of file
+SeriesAggreg <- function(x, Format, ...) {
+ UseMethod("SeriesAggreg")
+}
diff --git a/R/SeriesAggreg.data.frame.R b/R/SeriesAggreg.data.frame.R
new file mode 100644
index 0000000000000000000000000000000000000000..f963a0540325f30772829a6ad1c67a0aa9fbcd9d
--- /dev/null
+++ b/R/SeriesAggreg.data.frame.R
@@ -0,0 +1,189 @@
+SeriesAggreg.data.frame <- function(x,
+ Format,
+ ConvertFun,
+ TimeFormat = NULL, # deprecated
+ NewTimeFormat = NULL, # deprecated
+ YearFirstMonth = 1,
+ TimeLag = 0,
+ ...) {
+ ## Arguments checks
+ if (!is.null(TimeFormat)) {
+ warning("deprecated 'TimeFormat' argument", call. = FALSE)
+ }
+ if (missing(Format)) {
+ Format <- .GetSeriesAggregFormat(NewTimeFormat)
+ } else if (!is.null(NewTimeFormat)) {
+ warning("deprecated 'NewTimeFormat' argument: 'Format' argument is used instead",
+ call. = FALSE)
+ }
+ if (is.null(Format)) {
+ stop("argument 'Format' is missing")
+ }
+
+ ## check x
+ if (!is.data.frame(x)) {
+ stop("'x' must be a data.frame containing the dates and data to be aggregated")
+ }
+ if (ncol(x) < 2) {
+ stop("'x' must contain at least two columns (including the column of dates)")
+ }
+ ## check x date column
+ if (!inherits(x[[1L]], "POSIXt")) {
+ stop("'x' first column must be a vector of class 'POSIXlt' or 'POSIXct'")
+ }
+ if (inherits(x[[1L]], "POSIXlt")) {
+ x[[1L]] <- as.POSIXct(x[[1L]])
+ }
+ ## check x other columns (boolean converted to numeric)
+ apply(x[, -1L, drop = FALSE],
+ MARGIN = 2,
+ FUN = function(iCol) {
+ if (!is.numeric(iCol)) {
+ stop("'x' columns (other than the first one) must be of numeric class")
+ }
+ })
+ ## check Format
+ listFormat <- c("%Y%m%d", "%Y%m", "%Y", "%m", "%d")
+ Format <- gsub(pattern = "[[:punct:]]+", replacement = "%", Format)
+ Format <- match.arg(Format, choices = listFormat)
+
+ ## check ConvertFun
+ if (length(ConvertFun) != (ncol(x) - 1)) {
+ stop(sprintf("'ConvertFun' must be of length %i (ncol(x)-1)", ncol(x) - 1))
+ }
+ listConvertFun <- lapply(unique(ConvertFun), function(y) {
+ if (!grepl("^q\\d+$", y, ignore.case = TRUE)) {
+ return(match.fun(y))
+ }
+ })
+ names(listConvertFun) <- unique(ConvertFun)
+ lapply(ConvertFun, function(y) {
+ if (!grepl("^q\\d+$", y, ignore.case = TRUE)) {
+ TestOutput <- listConvertFun[[y]](1:10)
+ if(!is.numeric(TestOutput)) {
+ stop(sprintf("Returned value of '%s' function should be numeric", y))
+ }
+ if(length(TestOutput) != 1) {
+ stop(sprintf("Returned value of '%s' function should be of length 1", y))
+ }
+ }
+ })
+
+ ## check YearFirstMonth
+ msgYearFirstMonth <- "'YearFirstMonth' should be a single vector of numeric value between 1 and 12"
+ YearFirstMonth <- match(YearFirstMonth, 1:12)
+ if (anyNA(YearFirstMonth)) {
+ stop(msgYearFirstMonth)
+ }
+ if (length(YearFirstMonth) != 1) {
+ stop(msgYearFirstMonth)
+ }
+ if (YearFirstMonth != 1 & Format != "%Y") {
+ warning("'YearFirstMonth' is ignored because Format != '%Y'")
+ }
+ ## check TimeLag
+ msgTimeLag <- "'TimeLag' should be a single vector of a positive numeric value"
+ if (!is.vector(TimeLag)) {
+ stop(msgTimeLag)
+ }
+ if (!is.numeric(TimeLag)) {
+ stop(msgTimeLag)
+ }
+ if (length(TimeLag) != 1 | !any(TimeLag >= 0)) {
+ stop(msgTimeLag)
+ }
+
+ TabSeries0 <- x
+ colnames(TabSeries0)[1L] <- "DatesR"
+ TabSeries0$DatesR <- TabSeries0$DatesR + TimeLag
+
+ TabSeries2 <- TabSeries0
+
+ if (!Format %in% c("%d", "%m")) {
+ start <- sprintf("%i-01-01 00:00:00",
+ as.numeric(format(TabSeries2$DatesR[1L], format = "%Y")) - 1)
+ stop <- sprintf("%i-12-31 00:00:00",
+ as.numeric(format(TabSeries2$DatesR[nrow(TabSeries2)], format = "%Y")) + 1)
+ unitTs <- format(diff(x[1:2, 1]))
+ if (gsub("[0-9]+ ", "", unitTs) == "hours") {
+ byTs <- "hours"
+ } else {
+ if (gsub(" days$", "", unitTs) == "1") {
+ byTs <- "days"
+ } else {
+ byTs <- "months"
+ }
+ }
+ fakeTs <- data.frame(DatesR = seq(from = as.POSIXct(start, tz = "UTC"),
+ to = as.POSIXct(stop , tz = "UTC"),
+ by = byTs) + TimeLag)
+ TabSeries2 <- merge(fakeTs, TabSeries2, by = "DatesR", all.x = TRUE)
+ }
+ TabSeries2$DatesRini <- TabSeries2$DatesR %in% TabSeries0$DatesR
+
+
+ TabSeries2$Selec2 <- format(TabSeries2$DatesR, Format)
+
+ if (nchar(Format) > 2 | Format == "%Y") {
+ # Compute aggregation
+ TabSeries2$Selec <- !duplicated(TabSeries2$Selec2)
+ if (all(TabSeries2$Selec)) {
+ warning("the requested time 'Format' is the same as the one in 'x'. No time-step conversion was performed")
+ return(x)
+ }
+ if (Format == "%Y") {
+ yfm <- sprintf("%02.f", YearFirstMonth)
+ spF1 <- "%m"
+ spF2 <- "%Y-%m"
+ TabSeries2$Selec1 <- format(TabSeries2$DatesR, spF1)
+ TabSeries2$Selec2 <- format(TabSeries2$DatesR, spF2)
+ TabSeries2$Selec <- !duplicated(TabSeries2$Selec2) & TabSeries2$Selec1 == yfm
+ }
+ TabSeries2$Fac2 <- cumsum(TabSeries2$Selec)
+ } else {
+ # Compute regime
+ if (Format == "%d") {
+ spF2 <- "%m-%d"
+ TabSeries2$Selec2 <- format(TabSeries2$DatesR, spF2)
+ }
+ TabSeries2$Fac2 <- TabSeries2$Selec2
+ TabSeries2$Selec <- !duplicated(TabSeries2$Selec2)
+ }
+ listTsAggreg <- lapply(names(listConvertFun), function(y) {
+ if (any(ConvertFun == y)) {
+ colTsAggreg <- c("Fac2", colnames(x)[-1L][ConvertFun == y])
+ if (grepl("^q\\d+$", y, ignore.case = TRUE)) {
+ probs <- as.numeric(gsub("^q", "", y, ignore.case = TRUE)) / 100
+ if (probs < 0 || probs > 1) {
+ stop("'Q...' format of argument 'ConvertFun' must be an integer between 0 and 100")
+ }
+ aggregate(. ~ Fac2,
+ data = TabSeries2[, colTsAggreg],
+ FUN = quantile,
+ na.action = na.pass,
+ probs = probs,
+ type = 8,
+ na.rm = TRUE)
+ } else {
+ aggregate(. ~ Fac2,
+ data = TabSeries2[, colTsAggreg],
+ FUN = listConvertFun[[y]],
+ na.action = na.pass)
+ }
+ } else {
+ NULL
+ }
+ })
+ listTsAggreg <- listTsAggreg[!sapply(listTsAggreg, is.null)]
+ tsAggreg <- do.call(cbind, listTsAggreg)
+ tsAggreg <- tsAggreg[, !duplicated(colnames(tsAggreg))]
+ tsAggreg <- merge(tsAggreg,
+ TabSeries2[, c("Fac2", "DatesR", "DatesRini", "Selec")],
+ by = "Fac2",
+ all.x = TRUE,
+ all.y = FALSE)
+ tsAggreg <- tsAggreg[tsAggreg$Selec & tsAggreg$DatesRini, ]
+ tsAggreg <- tsAggreg[, colnames(TabSeries0)]
+ return(tsAggreg)
+
+}
diff --git a/R/SeriesAggreg.list.R b/R/SeriesAggreg.list.R
new file mode 100644
index 0000000000000000000000000000000000000000..55f054b9c37a7bfaf3e8d6e1f8b9bc7419e9c39a
--- /dev/null
+++ b/R/SeriesAggreg.list.R
@@ -0,0 +1,176 @@
+SeriesAggreg.list <- function(x,
+ Format,
+ ConvertFun,
+ NewTimeFormat = NULL,
+ simplify = FALSE,
+ except = NULL,
+ recursive = TRUE,
+ ...) {
+
+ classIni <- class(x)
+ class(x) <- "list" # in order to avoid the use of '['.InputsModel' or '['.OutputsModel' when x[i] is used
+
+ if (missing(Format)) {
+ Format <- .GetSeriesAggregFormat(NewTimeFormat)
+ } else if (!is.null(NewTimeFormat)) {
+ warning("deprecated 'NewTimeFormat' argument: 'Format' argument is used instead",
+ call. = FALSE)
+ }
+ # Check ConvertFun
+ if (any(classIni %in% c("InputsModel", "OutputsModel"))) {
+ if (!all(is.na(ConvertFun))) {
+ warning("Argument 'ConvertFun' is ignored on 'InputsModel' and 'OutputsModel' objects")
+ }
+ } else if (length(ConvertFun) != 1) {
+ stop("Argument 'ConvertFun' must be of length 1 with 'list' object")
+ } else if (!is.character(ConvertFun)) {
+ stop("Argument 'ConvertFun' must be a character")
+ }
+
+ # Determination of DatesR
+ if (!is.null(x$DatesR)) {
+ if (!inherits(x$DatesR, "POSIXt")) {
+ stop("'x$DatesR' should be of class 'POSIXt'")
+ }
+ DatesR <- x$DatesR
+ } else {
+ # Auto-detection of POSIXt item in Tabseries
+ itemPOSIXt <- which(sapply(x, function(x) {
+ inherits(x, "POSIXt")
+ }, simplify = TRUE))[1]
+ if (is.na(itemPOSIXt)) {
+ stop("At least one item of argument 'x' should be of class 'POSIXt'")
+ }
+ warning("Item 'DatesR' not found in 'x' argument: the item ",
+ names(x)[itemPOSIXt],
+ " has been automatically chosen")
+ DatesR <- x[[names(x)[itemPOSIXt]]]
+ }
+
+ # Selection of numeric items for aggregation
+ numericCols <- names(which(sapply(x, inherits, "numeric")))
+ arrayCols <- names(which(sapply(x, inherits, "array")))
+ numericCols <- setdiff(numericCols, arrayCols)
+ if (!is.null(except)) {
+ if (!inherits(except, "character")) {
+ stop("Argument 'except' should be a 'character'")
+ }
+ numericCols <- setdiff(numericCols, except)
+ }
+
+ cols <- x[numericCols]
+ lengthCols <- sapply(cols, length, simplify = TRUE)
+ if (any(lengthCols != length(DatesR))) {
+ sErr <- paste0(names(lengthCols)[lengthCols != length(DatesR)],
+ " (", lengthCols[lengthCols != length(DatesR)], ")",
+ collapse = ", ")
+ warning("The length of the following `numeric` items in 'x' ",
+ "is different than the length of 'DatesR (",
+ length(DatesR),
+ ")': they will be ignored in the aggregation: ",
+ sErr)
+ cols <- cols[lengthCols == length(DatesR)]
+ }
+ dfOut <- NULL
+ if (length(cols)) {
+ # Treating aggregation at root level
+ if (is.na(ConvertFun)) {
+ ConvertFun2 <- .GetAggregConvertFun(names(cols), Format)
+ } else {
+ ConvertFun2 <- rep(ConvertFun, length(cols))
+ }
+ dfOut <- SeriesAggreg(cbind(DatesR, as.data.frame(cols)),
+ Format,
+ ...,
+ ConvertFun = ConvertFun2)
+ }
+
+ if (simplify) {
+ # Returns data.frame of numeric found in the first level of the list
+ return(dfOut)
+
+ } else {
+ res <- list()
+ # Convert aggregated data.frame into list
+ if (!is.null(dfOut)) {
+ res <- as.list(dfOut)
+ ## To be consistent with InputsModel class and because plot.OutputsModel use the POSIXlt class
+ res$DatesR <- as.POSIXlt(res$DatesR)
+ }
+
+ # Exploration of embedded lists and data.frames
+ if (is.null(recursive) || recursive) {
+ listCols <- x[sapply(x, inherits, "list")]
+ dfCols <- x[sapply(x, inherits, "data.frame")]
+ dfCols <- c(dfCols, x[sapply(x, inherits, "matrix")])
+ listCols <- listCols[setdiff(names(listCols), names(dfCols))]
+ if (length(listCols) > 0) {
+ if (is.na(ConvertFun)) {
+ # Check for predefined ConvertFun for all sub-elements
+ listConvertFun <- .GetAggregConvertFun(names(listCols), Format)
+ }
+ # Run SeriesAggreg for each embedded list
+ listRes <- lapply(names(listCols), function(y) {
+ listCols[[y]]$DatesR <- DatesR
+ if (is.na(ConvertFun)) {
+ SeriesAggreg.list(listCols[[y]],
+ Format = Format,
+ recursive = NULL,
+ ...,
+ ConvertFun = listConvertFun[y])
+ } else {
+ SeriesAggreg.list(listCols[[y]],
+ Format = Format,
+ recursive = NULL,
+ ...)
+ }
+ })
+ names(listRes) <- names(listCols)
+ if (is.null(res$DatesR)) {
+ # Copy DatesR in top level list
+ res$DatesR <- listRes[[1]]$DatesR
+ }
+ # Remove DatesR in embedded lists
+ lapply(names(listRes), function(x) {
+ listRes[[x]]$DatesR <<- NULL
+ })
+ res <- c(res, listRes)
+ }
+ if (length(dfCols) > 0) {
+ # Processing matrix and dataframes
+ for (i in length(dfCols)) {
+ key <- names(dfCols)[i]
+ m <- dfCols[[i]]
+ if (nrow(m) != length(DatesR)) {
+ warning(
+ "The number of rows of the 'matrix' item ",
+ key, " (", nrow(m),
+ ") is different than the length of 'DatesR ('", length(DatesR),
+ "), it will be ignored in the aggregation"
+ )
+ } else {
+ if (is.na(ConvertFun)) {
+ ConvertFun2 <- rep(.GetAggregConvertFun(key, Format), ncol(m))
+ } else {
+ ConvertFun2 <- rep(ConvertFun, ncol(m))
+ }
+ res[[key]] <- SeriesAggreg.data.frame(data.frame(DatesR, m),
+ Format = Format,
+ ConvertFun = ConvertFun2)
+ }
+ }
+ }
+ }
+
+ # Store elements that are not aggregated
+ res <- c(res, x[setdiff(names(x), names(res))])
+
+ class(res) <- gsub("hourly|daily|monthly|yearly",
+ .GetSeriesAggregClass(Format),
+ classIni)
+
+ return(res)
+
+ }
+
+}
diff --git a/R/TransfoParam_Lag.R b/R/TransfoParam_Lag.R
new file mode 100644
index 0000000000000000000000000000000000000000..2294d0ab2442c860d8b6078580cc42583bc37130
--- /dev/null
+++ b/R/TransfoParam_Lag.R
@@ -0,0 +1,39 @@
+TransfoParam_Lag <- function(ParamIn, Direction) {
+
+ ## number of model parameters
+ NParam <- 1L
+
+
+ ## 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 LAG model requires %i parameters", NParam))
+ }
+
+
+ ## transformation
+ if (Direction == "TR") {
+ ParamOut <- 20 * (ParamIn + 10) / 20.0
+ }
+ if (Direction == "RT") {
+ ParamOut <- ParamIn * 20.0 / 20 - 10
+ }
+
+
+ ## check output
+ if (isVecParamIn) {
+ ParamOut <- as.vector(ParamOut)
+ }
+
+ return(ParamOut)
+
+}
diff --git a/R/Utils.R b/R/Utils.R
index c65980e0c6203be7583b25ea123318e955624eca..ddbdd449f404170f171d4a07872f27eb6de3fa31 100644
--- a/R/Utils.R
+++ b/R/Utils.R
@@ -12,15 +12,16 @@
# }
+
## =================================================================================
## function to manage Fortran outputs
## =================================================================================
.FortranOutputs <- function(GR = NULL, isCN = FALSE) {
-
+
outGR <- NULL
outCN <- NULL
-
+
if (is.null(GR)) {
GR <- ""
}
@@ -28,17 +29,18 @@
outGR <- c("PotEvap", "Precip",
"Qsim")
} else if (GR == "GR2M") {
- outGR <- c("PotEvap", "Precip", "Prod", "Pn",
+ outGR <- c("PotEvap", "Precip", "Prod", "Pn", "Ps",
"AE",
"Perc", "PR",
- "Rout", "Exch",
+ "Rout",
+ "AExch",
"Qsim")
} else if (GR == "GR5H") {
outGR <- c("PotEvap", "Precip", "Interc", "Prod", "Pn", "Ps",
"AE", "EI", "ES",
"Perc", "PR",
"Q9", "Q1",
- "Rout", "Exch",
+ "Rout", "Exch",
"AExch1", "AExch2",
"AExch", "QR",
"QD",
@@ -48,7 +50,7 @@
"AE",
"Perc", "PR",
"Q9", "Q1",
- "Rout", "Exch",
+ "Rout", "Exch",
"AExch1", "AExch2",
"AExch", "QR",
"QD",
@@ -66,163 +68,102 @@
"Qsim")
}
if (isCN) {
- outCN <- c("Pliq", "Psol",
- "SnowPack", "ThermalState", "Gratio",
- "PotMelt", "Melt", "PliqAndMelt", "Temp",
+ outCN <- c("Pliq", "Psol",
+ "SnowPack", "ThermalState", "Gratio",
+ "PotMelt", "Melt", "PliqAndMelt", "Temp",
"Gthreshold", "Glocalmax")
}
-
+
res <- list(GR = outGR, CN = outCN)
-
+
}
## =================================================================================
-## function to manage inputs of specific ErrorCrit_*() functions
+## functions to extract parts of InputsModel or OutputsModel objects
## =================================================================================
-.ErrorCrit <- function(InputsCrit, Crit, OutputsModel, warnings) {
-
- ## Arguments check
- if (!inherits(InputsCrit, "InputsCrit")) {
- stop("'InputsCrit' must be of class 'InputsCrit'", call. = FALSE)
- }
- if (inherits(InputsCrit, "Multi") | inherits(InputsCrit, "Compo")) {
- if (Crit == "RMSE") {
- stop("'InputsCrit' must be of class 'Single'. Use the 'ErrorCrit' function on objects of class 'Multi' with RMSE", call. = FALSE)
- } else {
- stop(paste0("'InputsCrit' must be of class 'Single'. Use the 'ErrorCrit' function on objects of class 'Multi' or 'Compo' with ", Crit), call. = FALSE)
+## InputsModel
+
+.ExtractInputsModel <- function(x, i) {
+ res <- lapply(x, function(x) {
+ if (is.matrix(x)) {
+ res0 <- x[i, , drop = FALSE]
}
- }
-
-
- ## Initialisation
- CritName <- NA
- CritVar <- InputsCrit$VarObs
- if (InputsCrit$transfo == "") {
- CritName <- paste0(Crit, "[CritVar]")
- }
- if (InputsCrit$transfo %in% c("sqrt", "log", "sort", "boxcox")) {
- CritName <- paste0(Crit, "[", InputsCrit$transfo, "(CritVar)]")
- }
- if (InputsCrit$transfo == "inv") {
- CritName <- paste0(Crit, "[1/CritVar]")
- }
- if (grepl("\\^", InputsCrit$transfo)) {
- transfoPow <- suppressWarnings(as.numeric(gsub("\\^", "", InputsCrit$transfo)))
- CritName <- paste0(Crit, "[CritVar^", transfoPow, "]")
- }
- CritName <- gsub(pattern = "CritVar", replacement = CritVar, x = CritName)
- CritValue <- NA
- if (Crit %in% c("RMSE")) {
- CritBestValue <- +1
- Multiplier <- +1
- }
- if (Crit %in% c("NSE", "KGE", "KGE2")) {
- CritBestValue <- +1
- Multiplier <- -1
- }
-
-
- ## Data preparation
- VarObs <- InputsCrit$Obs
- VarObs[!InputsCrit$BoolCrit] <- NA
- if (InputsCrit$VarObs == "Q") {
- VarSim <- OutputsModel$Qsim
- }
- if (InputsCrit$VarObs == "SCA") {
- VarSim <- rowMeans(sapply(OutputsModel$CemaNeigeLayers[InputsCrit$idLayer], FUN = "[[", "Gratio"))
- }
- if (InputsCrit$VarObs == "SWE") {
- VarSim <- rowMeans(sapply(OutputsModel$CemaNeigeLayers[InputsCrit$idLayer], FUN = "[[", "SnowPack"))
- }
- VarSim[!InputsCrit$BoolCrit] <- NA
-
-
- ## Data transformation
- if (InputsCrit$transfo %in% c("log", "inv") & is.null(InputsCrit$epsilon) & warnings) {
- if (any(VarObs %in% 0)) {
- warning("zeroes detected in 'Qobs': the corresponding time-steps will be excluded from the criteria computation if the epsilon argument of 'CreateInputsCrit' = NULL", call. = FALSE)
+ if (is.vector(x) | inherits(x, "POSIXt")) {
+ res0 <- x[i]
}
- if (any(VarSim %in% 0)) {
- warning("zeroes detected in 'Qsim': the corresponding time-steps will be excluded from the criteria computation if the epsilon argument of 'CreateInputsCrit' = NULL", call. = FALSE)
- }
- }
- if ("epsilon" %in% names(InputsCrit) & !is.null(InputsCrit$epsilon) & !(InputsCrit$transfo == "boxcox")) {
- VarObs <- VarObs + InputsCrit$epsilon
- VarSim <- VarSim + InputsCrit$epsilon
- }
- if (InputsCrit$transfo == "sqrt") {
- VarObs <- sqrt(VarObs)
- VarSim <- sqrt(VarSim)
- }
- if (InputsCrit$transfo == "log") {
- VarObs <- log(VarObs)
- VarSim <- log(VarSim)
- VarSim[VarSim < -1e100] <- NA
- }
- if (InputsCrit$transfo == "inv") {
- VarObs <- 1 / VarObs
- VarSim <- 1 / VarSim
- VarSim[abs(VarSim) > 1e+100] <- NA
- }
- if (InputsCrit$transfo == "sort") {
- VarSim[is.na(VarObs)] <- NA
- VarSim <- sort(VarSim, na.last = TRUE)
- VarObs <- sort(VarObs, na.last = TRUE)
- InputsCrit$BoolCrit <- sort(InputsCrit$BoolCrit, decreasing = TRUE)
+ if (is.list(x) & !inherits(x, "POSIXt")) {
+ if (inherits(x, "OutputsModel")) {
+ res0 <- .ExtractOutputsModel(x = x, i = i)
+ } else {
+ res0 <- .ExtractInputsModel(x = x, i = i)
+ }
+ }
+ return(res0)
+ })
+ if (!is.null(x$ZLayers)) {
+ res$ZLayers <- x$ZLayers
}
- if (InputsCrit$transfo == "boxcox") {
- muTransfoVarObs <- (0.01 * mean(VarObs, na.rm = TRUE))^0.25
- VarSim <- (VarSim^0.25 - muTransfoVarObs) / 0.25
- VarObs <- (VarObs^0.25 - muTransfoVarObs) / 0.25
+ if (inherits(x, "SD")) {
+ res$LengthHydro <- x$LengthHydro
+ res$BasinAreas <- x$BasinAreas
}
- if (grepl("\\^", InputsCrit$transfo)) {
- VarObs <- VarObs^transfoPow
- VarSim <- VarSim^transfoPow
+ class(res) <- class(x)
+ res
+}
+
+'[.InputsModel' <- function(x, i) {
+ if (!inherits(x, "InputsModel")) {
+ stop("'x' must be of class 'InputsModel'")
}
-
-
- ## TS_ignore
- TS_ignore <- !is.finite(VarObs) | !is.finite(VarSim) | !InputsCrit$BoolCrit
- Ind_TS_ignore <- which(TS_ignore)
- if (length(Ind_TS_ignore) == 0) {
- Ind_TS_ignore <- NULL
+ if (is.factor(i)) {
+ i <- as.character(i)
}
- if (sum(!TS_ignore) == 0 | (sum(!TS_ignore) == 1 & Crit %in% c("KGE", "KGE2"))) {
- CritCompute <- FALSE
+ if (is.numeric(i)) {
+ .ExtractInputsModel(x, i)
} else {
- CritCompute <- TRUE
- }
- if (inherits(OutputsModel, "hourly")) {
- WarningTS <- 365
+ NextMethod()
}
- if (inherits(OutputsModel, "daily")) {
- WarningTS <- 365
+}
+
+
+## InputsModel
+
+.ExtractOutputsModel <- function(x, i) {
+ res <- lapply(x, function(x) {
+ if (is.matrix(x) && length(dim(x)) == 2L) {
+ res0 <- x[i, ]
+ }
+ if (is.array(x) && length(dim(x)) == 3L) {
+ res0 <- x[i, , ]
+ }
+ if (is.vector(x) | inherits(x, "POSIXt")) {
+ res0 <- x[i]
+ }
+ if (is.list(x) & !inherits(x, "POSIXt")) {
+ res0 <- .ExtractOutputsModel(x = x, i = i)
+ }
+ return(res0)
+ })
+ if (!is.null(x$StateEnd)) {
+ res$StateEnd <- x$StateEnd
}
- if (inherits(OutputsModel, "monthly")) {
- WarningTS <- 12
+ class(res) <- class(x)
+ res
+}
+
+'[.OutputsModel' <- function(x, i) {
+ if (!inherits(x, "OutputsModel")) {
+ stop("'x' must be of class 'OutputsModel'")
}
- if (inherits(OutputsModel, "yearly")) {
- WarningTS <- 3
+ if (is.factor(i)) {
+ i <- as.character(i)
}
- if (sum(!TS_ignore) < WarningTS & warnings) {
- warning("\t criterion computed on less than ", WarningTS, " time-steps", call. = FALSE)
+ if (is.numeric(i)) {
+ .ExtractOutputsModel(x, i)
+ } else {
+ NextMethod()
}
-
-
- ## Outputs
- OutputsCritCheck <- list(WarningTS = WarningTS,
- VarObs = VarObs,
- VarSim = VarSim,
- CritBestValue = CritBestValue,
- Multiplier = Multiplier,
- CritName = CritName,
- CritVar = CritVar,
- CritCompute = CritCompute,
- TS_ignore = TS_ignore,
- Ind_TS_ignore = Ind_TS_ignore)
}
-
-
diff --git a/R/UtilsErrorCrit.R b/R/UtilsErrorCrit.R
new file mode 100644
index 0000000000000000000000000000000000000000..95ca18fce0ec8bbd7bd9aa9ddf807a5250c4bb52
--- /dev/null
+++ b/R/UtilsErrorCrit.R
@@ -0,0 +1,136 @@
+## =================================================================================
+## function to manage inputs of specific ErrorCrit_*() functions
+## =================================================================================
+
+.ErrorCrit <- function(InputsCrit, Crit, OutputsModel, warnings) {
+
+ ## Arguments check
+ if (!inherits(InputsCrit, "InputsCrit")) {
+ stop("'InputsCrit' must be of class 'InputsCrit'", call. = FALSE)
+ }
+ if (inherits(InputsCrit, "Multi") | inherits(InputsCrit, "Compo")) {
+ if (Crit == "RMSE") {
+ stop("'InputsCrit' must be of class 'Single'. Use the 'ErrorCrit' function on objects of class 'Multi' with RMSE", call. = FALSE)
+ } else {
+ stop(paste0("'InputsCrit' must be of class 'Single'. Use the 'ErrorCrit' function on objects of class 'Multi' or 'Compo' with ", Crit), call. = FALSE)
+ }
+ }
+
+
+ ## Initialisation
+ CritName <- NA
+ CritVar <- InputsCrit$VarObs
+ if (InputsCrit$transfo == "") {
+ CritName <- paste0(Crit, "[CritVar]")
+ }
+ if (InputsCrit$transfo %in% c("sqrt", "log", "sort", "boxcox")) {
+ CritName <- paste0(Crit, "[", InputsCrit$transfo, "(CritVar)]")
+ }
+ if (InputsCrit$transfo == "inv") {
+ CritName <- paste0(Crit, "[1/CritVar]")
+ }
+ if (grepl("\\^", InputsCrit$transfo)) {
+ transfoPow <- suppressWarnings(as.numeric(gsub("\\^", "", InputsCrit$transfo)))
+ CritName <- paste0(Crit, "[CritVar^", transfoPow, "]")
+ }
+ CritName <- gsub(pattern = "CritVar", replacement = CritVar, x = CritName)
+ CritValue <- NA
+ if (Crit %in% c("RMSE")) {
+ CritBestValue <- +1
+ Multiplier <- +1
+ }
+ if (Crit %in% c("NSE", "KGE", "KGE2")) {
+ CritBestValue <- +1
+ Multiplier <- -1
+ }
+
+
+ ## Data preparation
+ VarObs <- InputsCrit$Obs
+ VarObs[!InputsCrit$BoolCrit] <- NA
+ if (InputsCrit$VarObs == "Q") {
+ VarSim <- OutputsModel$Qsim
+ }
+ if (InputsCrit$VarObs == "SCA") {
+ VarSim <- rowMeans(sapply(OutputsModel$CemaNeigeLayers[InputsCrit$idLayer], FUN = "[[", "Gratio"))
+ }
+ if (InputsCrit$VarObs == "SWE") {
+ VarSim <- rowMeans(sapply(OutputsModel$CemaNeigeLayers[InputsCrit$idLayer], FUN = "[[", "SnowPack"))
+ }
+ VarSim[!InputsCrit$BoolCrit] <- NA
+
+
+ ## Data transformation
+ if (InputsCrit$transfo %in% c("log", "inv") & is.null(InputsCrit$epsilon) & warnings) {
+ if (any(VarObs %in% 0)) {
+ warning("zeroes detected in 'Qobs': the corresponding time-steps will be excluded from the criteria computation if the epsilon argument of 'CreateInputsCrit' = NULL", call. = FALSE)
+ }
+ if (any(VarSim %in% 0)) {
+ warning("zeroes detected in 'Qsim': the corresponding time-steps will be excluded from the criteria computation if the epsilon argument of 'CreateInputsCrit' = NULL", call. = FALSE)
+ }
+ }
+ if ("epsilon" %in% names(InputsCrit) & !is.null(InputsCrit$epsilon) & !(InputsCrit$transfo == "boxcox")) {
+ VarObs <- VarObs + InputsCrit$epsilon
+ VarSim <- VarSim + InputsCrit$epsilon
+ }
+ if (InputsCrit$transfo == "sqrt") {
+ VarObs <- sqrt(VarObs)
+ VarSim <- sqrt(VarSim)
+ }
+ if (InputsCrit$transfo == "log") {
+ VarObs <- log(VarObs)
+ VarSim <- log(VarSim)
+ VarSim[VarSim < -1e100] <- NA
+ }
+ if (InputsCrit$transfo == "inv") {
+ VarObs <- 1 / VarObs
+ VarSim <- 1 / VarSim
+ VarSim[abs(VarSim) > 1e+100] <- NA
+ }
+ if (InputsCrit$transfo == "sort") {
+ VarSim[is.na(VarObs)] <- NA
+ VarSim <- sort(VarSim, na.last = TRUE)
+ VarObs <- sort(VarObs, na.last = TRUE)
+ InputsCrit$BoolCrit <- sort(InputsCrit$BoolCrit, decreasing = TRUE)
+ }
+ if (InputsCrit$transfo == "boxcox") {
+ muTransfoVarObs <- (0.01 * mean(VarObs, na.rm = TRUE))^0.25
+ VarSim <- (VarSim^0.25 - muTransfoVarObs) / 0.25
+ VarObs <- (VarObs^0.25 - muTransfoVarObs) / 0.25
+ }
+ if (grepl("\\^", InputsCrit$transfo)) {
+ VarObs <- VarObs^transfoPow
+ VarSim <- VarSim^transfoPow
+ }
+
+
+ ## TS_ignore
+ TS_ignore <- !is.finite(VarObs) | !is.finite(VarSim) | !InputsCrit$BoolCrit
+ Ind_TS_ignore <- which(TS_ignore)
+ if (length(Ind_TS_ignore) == 0) {
+ Ind_TS_ignore <- NULL
+ }
+ if (sum(!TS_ignore) == 0 | (sum(!TS_ignore) == 1 & Crit %in% c("KGE", "KGE2"))) {
+ CritCompute <- FALSE
+ } else {
+ CritCompute <- TRUE
+ }
+ WarningTS <- 10
+ if (sum(!TS_ignore) < WarningTS & warnings) {
+ warning("\t criterion computed on less than ", WarningTS, " time-steps", call. = FALSE)
+ }
+
+
+ ## Outputs
+ OutputsCritCheck <- list(WarningTS = WarningTS,
+ VarObs = VarObs,
+ VarSim = VarSim,
+ CritBestValue = CritBestValue,
+ Multiplier = Multiplier,
+ CritName = CritName,
+ CritVar = CritVar,
+ CritCompute = CritCompute,
+ TS_ignore = TS_ignore,
+ Ind_TS_ignore = Ind_TS_ignore)
+}
+
diff --git a/R/UtilsSeriesAggreg.R b/R/UtilsSeriesAggreg.R
new file mode 100644
index 0000000000000000000000000000000000000000..9b47efac0bdc70bd1cabbf3cf6db3e6ed1c0603e
--- /dev/null
+++ b/R/UtilsSeriesAggreg.R
@@ -0,0 +1,60 @@
+.GetSeriesAggregFormat <- function(NewTimeFormat) {
+ errNewTimeFormat <- FALSE
+ if (missing(NewTimeFormat)) {
+ errNewTimeFormat <- TRUE
+ } else if (is.null(NewTimeFormat)) {
+ errNewTimeFormat <- TRUE
+ }
+ if (errNewTimeFormat) {
+ stop("Argument `Format` is missing")
+ }
+ if (!is.null(NewTimeFormat)) {
+ TimeStep <- c("hourly", "daily", "monthly", "yearly")
+ NewTimeFormat <- match.arg(NewTimeFormat, choices = TimeStep)
+ Format <- switch(NewTimeFormat,
+ hourly = "%Y%m%d%h",
+ daily = "%Y%m%d",
+ monthly = "%Y%m",
+ yearly = "%Y")
+ msgNewTimeFormat <- sprintf("'Format' automatically set to %s", sQuote(Format))
+ warning("deprecated 'NewTimeFormat' argument: please use 'Format' instead.",
+ msgNewTimeFormat,
+ call. = FALSE)
+ return(Format)
+ }
+ return(NULL)
+}
+
+.GetSeriesAggregClass <- function(Format) {
+ Format <- substr(Format,
+ start = nchar(Format),
+ stop = nchar(Format))
+ switch(Format,
+ h = "hourly",
+ d = "daily",
+ m = "monthly",
+ Y = "yearly")
+}
+
+.GetAggregConvertFun <- function(x, Format) {
+ AggregConvertFunTable <- rbind(
+ data.frame(ConvertFun = "mean",
+ x = c("Prod", "Rout", "Exp", "SnowPack", "ThermalState",
+ "Gratio", "Temp", "Gthreshold", "Glocalmax", "LayerTempMean", "T"),
+ stringsAsFactors = FALSE), # R < 4.0 compatibility: avoids mixing numeric and factor into numeric
+ data.frame(ConvertFun = "sum",
+ x = c("PotEvap", "Precip", "Pn", "Ps", "AE", "Perc", "PR", "Q9",
+ "Q1", "Exch", "AExch1", "AExch2", "AExch", "QR", "QRExp",
+ "QD", "Qsim", "Pliq", "Psol", "PotMelt", "Melt", "PliqAndMelt",
+ "LayerPrecip", "LayerFracSolidPrecip", "Qmm", "Qls", "E", "P", "Qupstream"),
+ stringsAsFactors = FALSE) # R < 4.0 compatibility: avoids mixing numeric and factor into numeric
+ )
+ res <- sapply(x, function(iX) {
+ iRes <- AggregConvertFunTable$ConvertFun[AggregConvertFunTable$x == iX]
+ iRes <- ifelse(test = any(is.na(iRes)), yes = NA, no = iRes) # R < 4.0 compatibility
+ })
+ if(Format %in% c("%d", "%m")) {
+ res <- rep("mean", length(res))
+ }
+ return(res)
+}
diff --git a/R/plot.OutputsModel.R b/R/plot.OutputsModel.R
index 85d2418e740c4b762e2119dcd5ebcfefb9cfa10a..619e5ea9618613258f6f2d0928361468b89a29bd 100644
--- a/R/plot.OutputsModel.R
+++ b/R/plot.OutputsModel.R
@@ -149,33 +149,29 @@ plot.OutputsModel <- function(x, Qobs = NULL, IndPeriod_Plot = NULL, BasinArea =
}
if (BOOL_Dates) {
- MyRollMean1 <- function(x, n) {
- return(filter(x, rep(1 / n, n), sides = 2))
- }
- MyRollMean2 <- function(x, n) {
- return(filter(c(tail(x, n %/% 2), x, x[1:(n %/% 2)]), rep(1 / n, n), sides = 2)[(n %/% 2 + 1):(length(x) + n %/% 2)])
- }
+ # MyRollMean1 <- function(x, n) {
+ # return(filter(x, rep(1 / n, n), sides = 2))
+ # }
+ # MyRollMean2 <- function(x, n) {
+ # return(filter(c(tail(x, n %/% 2), x, x[1:(n %/% 2)]), rep(1 / n, n), sides = 2)[(n %/% 2 + 1):(length(x) + n %/% 2)])
+ # }
MyRollMean3 <- function(x, n) {
return(filter(x, filter = rep(1 / n, n), sides = 2, circular = TRUE))
}
BOOL_TS <- FALSE
- TimeStep <- difftime(tail(OutputsModel$DatesR, 1), tail(OutputsModel$DatesR, 2), units = "secs")[[1]]
- if (inherits(OutputsModel, "hourly") &
- TimeStep %in% (60 * 60)) {
+ if (inherits(OutputsModel, "hourly")) {
BOOL_TS <- TRUE
NameTS <- "hour"
plotunit <- "[mm/h]"
formatAxis <- "%m/%Y"
}
- if (inherits(OutputsModel, "daily") &
- TimeStep %in% (24 * 60 * 60)) {
+ if (inherits(OutputsModel, "daily")) {
BOOL_TS <- TRUE
NameTS <- "day"
plotunit <- "[mm/d]"
formatAxis <- "%m/%Y"
}
- if (inherits(OutputsModel, "monthly") &
- TimeStep %in% (c(28, 29, 30, 31) * 24 * 60 * 60)) {
+ if (inherits(OutputsModel, "monthly")) {
BOOL_TS <- TRUE
NameTS <- "month"
plotunit <- "[mm/month]"
@@ -184,16 +180,15 @@ plot.OutputsModel <- function(x, Qobs = NULL, IndPeriod_Plot = NULL, BasinArea =
OutputsModel$DatesR <- as.POSIXlt(format(OutputsModel$DatesR, format = "%Y-%m-01"), tz = "UTC", format = "%Y-%m-%d")
}
}
- if (inherits(OutputsModel, "yearly") &
- TimeStep %in% (c(365, 366) * 24 * 60 * 60)) {
+ if (inherits(OutputsModel, "yearly")) {
BOOL_TS <- TRUE
NameTS <- "year"
plotunit <- "[mm/y]"
formatAxis <- "%Y"
}
- if (!BOOL_TS) {
- stop("the time step of the model inputs could not be found")
- }
+ # if (!BOOL_TS) {
+ # stop("the time step of the model inputs could not be found")
+ # }
}
if (length(IndPeriod_Plot) == 0) {
IndPeriod_Plot <- 1:length(OutputsModel$DatesR)
diff --git a/README.md b/README.md
index 949c2fe8dfb106c9e8686735ef7028fafd64f9a7..de829e4aa4b85ee42495d4d968f88c60159a5aff 100644
--- a/README.md
+++ b/README.md
@@ -32,13 +32,13 @@ Six hydrological models and one snow melt and accumulation model are implemented
These models can be called within airGR using the following functions:
- `RunModel_GR4H`: four-parameter hourly lumped hydrological model (Mathevet, 2005)
- - `RunModel_GR5H`: four-parameter hourly lumped hydrological model (Ficchi, 2017; Ficchi *et al.*, 2019)
+ - `RunModel_GR5H`: five-parameter hourly lumped hydrological model (Ficchi, 2017; Ficchi *et al.*, 2019)
- `RunModel_GR4J`: four-parameter daily lumped hydrological model (Perrin *et al.*, 2003)
- `RunModel_GR5J`: five-parameter daily lumped hydrological model (Le Moine, 2008)
- `RunModel_GR6J`: six-parameter daily lumped hydrological model (Pushpalatha *et al.*, 2011)
- `RunModel_GR2M`: two-parameter monthly lumped hydrological model (Mouelhi, 2003; Mouelhi *et al.*, 2006a)
- `RunModel_GR1A`: one-parameter yearly lumped hydrological model (Mouelhi, 2003; Mouelhi *et al.*, 2006b)
- - `RunModel_CemaNeige`: two-parameter degree-day snow melt and accumulation daily model (Valéry *et al.*, 2014)
+ - `RunModel_CemaNeige`: two-parameter degree-day snow melt and accumulation daily model (Valéry *et al.*, 2014; Riboust *et al.*, 2019)
- `RunModel_CemaNeigeGR4H`: combined use of GR4H and CemaNeige
- `RunModel_CemaNeigeGR5H`: combined use of GR5H and CemaNeige
- `RunModel_CemaNeigeGR4J`: combined use of GR4J and CemaNeige
@@ -56,20 +56,21 @@ To learn how to use the functions from the airGR package, it is recommended to f
4. refer to the help for `ErrorCrit_NSE` and `CreateInputsCrit` to understand how the computation of an error criterion is prepared/made;
5. refer to the help for `Calibration_Michel`, run the provided example and then refer to the help for `CreateCalibOptions` to understand how a model calibration is prepared/made.
-For more information and to get started with the package, you can refer to the vignette (vignette("V01_get_started")`) and go on the [airGR website](https://hydrogr.github.io/airGR).
+For more information and to get started with the package, you can refer to the vignette (`vignette("V01_get_started")`) and go on the [airGR website](https://hydrogr.github.io/airGR).
## References
-- Ficchi, A. (2017). An adaptive hydrological model for multiple time-steps: Diagnostics and improvements based on fluxes consistency. PhD thesis, Irstea (Antony), GRNE (Paris), France.
-- Ficchi, A., C. Perrin and V. Andréassian (2019). Hydrological modelling at multiple sub-daily time steps: model improvement via flux-matching. Journal of Hydrology, 575, 1308-1327. doi: 10.1016/j.jhydrol.2019.05.084.
+- Ficchi, A. (2017). An adaptive hydrological model for multiple time-steps: Diagnostics and improvements based on fluxes consistency. PhD thesis, UPMC - Irstea Antony, Paris, France.
+- Ficchi, A., Perrin, C. and Andréassian, V. (2019). Hydrological modelling at multiple sub-daily time steps: model improvement via flux-matching. Journal of Hydrology, 575, 1308-1327, doi: [10.1016/j.jhydrol.2019.05.084](https://www.doi.org/10.1016/j.jhydrol.2019.05.084).
- Le Moine, N. (2008). Le bassin versant de surface vu par le souterrain : une voie d'amélioration des performances et du réalisme des modèles pluie-débit ?, PhD thesis (in French), UPMC - Cemagref Antony, Paris, France, 324 pp.
- Mathevet, T. (2005). Quels modèles pluie-débit globaux pour le pas de temps horaire ? Développement empirique et comparaison de modèles sur un large échantillon de bassins versants, PhD thesis (in French), ENGREF - Cemagref Antony, Paris, France, 463 pp.
- Mouelhi S. (2003). Vers une chaîne cohérente de modèles pluie-débit conceptuels globaux aux pas de temps pluriannuel, annuel, mensuel et journalier, PhD thesis (in French), ENGREF - Cemagref Antony, Paris, France, 323 pp.
-- Mouelhi, S., C. Michel, C. Perrin and V. Andréassian (2006a). Stepwise development of a two-parameter monthly water balance model, Journal of Hydrology, 318(1-4), 200-214, doi: 10.1016/j.jhydrol.2005.06.014.
-- Mouelhi, S., C. Michel, C. Perrin. & V. Andreassian (2006b). Linking stream flow to rainfall at the annual time step: the Manabe bucket model revisited, Journal of Hydrology, 328, 283-296, doi: 10.1016/j.jhydrol.2005.12.022.
-- Perrin, C., C. Michel and V. Andréassian (2003). Improvement of a parsimonious model for streamflow simulation, Journal of Hydrology, 279(1-4), 275-289, doi: 10.1016/S0022-1694(03)00225-7.
-- Pushpalatha, R., C. Perrin, N. Le Moine, T. Mathevet and V. Andréassian (2011). A downward structural sensitivity analysis of hydrological models to improve low-flow simulation, Journal of Hydrology, 411(1-2), 66-76, doi: 10.1016/j.jhydrol.2011.09.034.
-- Valéry, A., V. Andréassian and C. Perrin (2014). "As simple as possible but not simpler": What is useful in a temperature-based snow-accounting routine? Part 2 - Sensitivity analysis of the Cemaneige snow accounting routine on 380 catchments, Journal of Hydrology, 517(0): 1176-1187, doi: 1176-1187, doi: 10.1016/j.jhydrol.2014.04.058.
+- Mouelhi, S., Michel, C., Perrin, C. and Andréassian, V. (2006a). Stepwise development of a two-parameter monthly water balance model, Journal of Hydrology, 318(1-4), 200-214, doi: [10.1016/j.jhydrol.2005.06.014](https://www.doi.org/10.1016/j.jhydrol.2005.06.014).
+- Mouelhi, S., Michel, C., Perrin, C. and Andréassian, V. (2006b). Linking stream flow to rainfall at the annual time step: the Manabe bucket model revisited, Journal of Hydrology, 328, 283-296, doi: [10.1016/j.jhydrol.2005.12.022](https://www.doi.org/10.1016/j.jhydrol.2005.12.022).
+- Perrin, C., Michel, C. and Andréassian, V. (2003). Improvement of a parsimonious model for streamflow simulation, Journal of Hydrology, 279(1-4), 275-289, doi: [10.1016/S0022-1694(03)00225-7](https://www.doi.org/10.1016/S0022-1694(03)00225-7).
+- Pushpalatha, R., Perrin, C., Le Moine, N., Mathevet, T. and Andréassian, V. (2011). A downward structural sensitivity analysis of hydrological models to improve low-flow simulation, Journal of Hydrology, 411(1-2), 66-76, doi: [10.1016/j.jhydrol.2011.09.034](https://www.doi.org/10.1016/j.jhydrol.2011.09.034).
+- Riboust, P., Thirel, G., Le Moine, N. and Ribstein, P. (2019). Revisiting a simple degree-day model for integrating satellite data: Implementation of SWE-SCA hystereses. Journal of Hydrology and Hydromechanics, 67(1), 70–81, doi: [10.2478/johh-2018-0004](https://www.doi.org/10.2478/johh-2018-0004).
+- Valéry, A., Andréassian, V. and Perrin, C. (2014). "As simple as possible but not simpler": What is useful in a temperature-based snow-accounting routine? Part 2 - Sensitivity analysis of the Cemaneige snow accounting routine on 380 catchments, Journal of Hydrology, 517(0), 1176-1187, doi: [10.1016/j.jhydrol.2014.04.058](https://www.doi.org/10.1016/j.jhydrol.2014.04.058).
diff --git a/airGR.Rproj b/airGR.Rproj
index b1ded457422a5fb84fd0f19adb554b7b06a2a6a5..398aa1438c2c45f6eb3efd75ef2d4052d5ae7923 100644
--- a/airGR.Rproj
+++ b/airGR.Rproj
@@ -12,6 +12,9 @@ Encoding: UTF-8
RnwWeave: knitr
LaTeX: pdfLaTeX
+AutoAppendNewline: Yes
+StripTrailingWhitespace: Yes
+
BuildType: Package
PackageUseDevtools: Yes
PackageInstallArgs: --no-multiarch --with-keep.source
diff --git a/inst/vignettesData/vignetteParamMCMC.rda b/inst/vignettesData/vignetteParamMCMC.rda
index 75dd08d154db65fca5862a8afc0c677042a3761c..f2c55b6ba4febfd65c1abe42726495117fa15210 100644
Binary files a/inst/vignettesData/vignetteParamMCMC.rda and b/inst/vignettesData/vignetteParamMCMC.rda differ
diff --git a/man/BasinObs.Rd b/man/BasinObs.Rd
index 1c9e98185a18b8d8316f7f9bc5af72342a29adad..f3c09bef9b82b94214f355af7ee68bf778041b78 100644
--- a/man/BasinObs.Rd
+++ b/man/BasinObs.Rd
@@ -21,7 +21,7 @@ X0310010 contains actual data from the Durance River at Embrun [La Clapière] (H
The flows are provided by Electricity of France (EDF) and were retrieved from the Banque Hydro database (http://www.hydro.eaufrance.fr).
The meteorological forcing are derived from the SAFRAN reanalysis from Météo-France (Vidal et al., 2010).
\cr
-R-object containing the times series of precipitation, temperature, potential evapotranspiration and discharge.
+R-object containing the times series of precipitation, temperature, potential evapotranspiration and discharge.
X0310010 contains in addition MODIS snow cover area (SCA) data retrieved from the National Snow and Ice Data Center (NSIDC) repository (https://nsidc.org/). Five SCA time series are given, corresponding to 5 elevation bands of the CemaNeige model (default configuration). SCA data for days with important cloudiness (> 40 \%) were set to missing values for the sake of data representativeness. .
\cr \cr
Times series for L0123001, L0123002 and X0310010 are at the daily time step for use with daily models such as GR4J, GR5J, GR6J, CemaNeigeGR4J, CemaNeigeGR5J and CemaNeigeGR6J. \cr
@@ -38,15 +38,16 @@ Times series for L0123003 are at the hourly time step for use with hourly models
\references{
-Riboust P., Thirel G., Moine N.L. and Ribstein P. (2019).
- Revisiting a Simple Degree-Day Model for Integrating Satellite Data: Implementation of Swe-Sca Hystereses.
- Journal of Hydrology and Hydromechanics 67, 70–81. doi: 10.2478/johh-2018-0004.
+Riboust, P., Thirel, G., Le Moine, N. and Ribstein P. (2019).
+ Revisiting a simple degree-day model for integrating satellite data: Implementation of SWE-SCA hystereses.
+ Journal of Hydrology and Hydromechanics, 67(1), 70–81, \doi{10.2478/johh-2018-0004}.
\cr\cr
-Vidal J., Martin E., Franchistéguy L., Baillon M. and Soubeyroux J. (2010).
- A 50-year high-resolution atmospheric reanalysis over France with the Safran system.
- International Journal of Climatology 30, 1627–1644. doi: 10.1002/joc.2003.
+Vidal, J.-P., Martin, E., Franchistéguy, L., Baillon, M. and Soubeyroux, J. (2010).
+ A 50-year high-resolution atmospheric reanalysis over France with the Safran system.
+ International Journal of Climatology, 30, 1627–1644. \doi{10.1002/joc.2003}.
}
+
\seealso{
\code{\link{BasinInfo}}.
}
diff --git a/man/Calibration_Michel.Rd b/man/Calibration_Michel.Rd
index c9e6cfe95fb70c9c6b59b508a2f070fdd2f0fdb4..60439df643b4e82a52b8e7a59051b3fdfaa66d9b 100644
--- a/man/Calibration_Michel.Rd
+++ b/man/Calibration_Michel.Rd
@@ -11,7 +11,7 @@
\description{
Calibration algorithm that optimises the error criterion selected as objective function. \cr
\cr
-The algorithm combines a global and a local approach.
+The algorithm combines a global and a local approach.
First, a screening is performed using either a rough predefined grid or a list of parameter sets.
Then a steepest descent local search algorithm is performed, starting from the result of the screening procedure.
}
@@ -59,18 +59,18 @@ Calibration_Michel(InputsModel, RunOptions, InputsCrit, CalibOptions,
\details{
-A screening is first performed either based on a rough predefined grid (considering various initial
+A screening is first performed either based on a rough predefined grid (considering various initial
values for each parameter) or from a list of initial parameter sets. \cr
-The best set identified in this screening is then used as a starting point for the steepest
+The best set identified in this screening is then used as a starting point for the steepest
descent local search algorithm. \cr
For this search, since the ranges of parameter values can be quite different,
simple mathematical transformations are applied to parameters to make them vary
in a similar range and get a similar sensitivity to a predefined search step. This is done using the TransfoParam functions. \cr
-During the steepest descent method, at each iteration, we start from a parameter set of NParam values (NParam being the number of
-free parameters of the chosen hydrological model) and we determine the 2*NParam-1 new candidates
+During the steepest descent method, at each iteration, we start from a parameter set of NParam values (NParam being the number of
+free parameters of the chosen hydrological model) and we determine the 2*NParam-1 new candidates
by changing one by one the different parameters (+/- search step). \cr
-All these candidates are tested and the best one kept to be the starting point for the next
-iteration. At the end of each iteration, the the search step is either increased or decreased to adapt
+All these candidates are tested and the best one kept to be the starting point for the next
+iteration. At the end of each iteration, the the search step is either increased or decreased to adapt
the progression speed. A composite step can occasionally be done. \cr
The calibration algorithm stops when the search step becomes smaller than a predefined threshold.
}
@@ -83,27 +83,27 @@ library(airGR)
data(L0123001)
## preparation of InputsModel object
-InputsModel <- CreateInputsModel(FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR,
+InputsModel <- CreateInputsModel(FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR,
Precip = BasinObs$P, PotEvap = BasinObs$E)
## calibration period selection
-Ind_Run <- seq(which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1990-01-01"),
+Ind_Run <- seq(which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1990-01-01"),
which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1999-12-31"))
## preparation of RunOptions object
-RunOptions <- CreateRunOptions(FUN_MOD = RunModel_GR4J, InputsModel = InputsModel,
+RunOptions <- CreateRunOptions(FUN_MOD = RunModel_GR4J, InputsModel = InputsModel,
IndPeriod_Run = Ind_Run)
## calibration criterion: preparation of the InputsCrit object
-InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
+InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
RunOptions = RunOptions, Obs = BasinObs$Qmm[Ind_Run])
## preparation of CalibOptions object
CalibOptions <- CreateCalibOptions(FUN_MOD = RunModel_GR4J, FUN_CALIB = Calibration_Michel)
## calibration
-OutputsCalib <- Calibration_Michel(InputsModel = InputsModel, RunOptions = RunOptions,
- InputsCrit = InputsCrit, CalibOptions = CalibOptions,
+OutputsCalib <- Calibration_Michel(InputsModel = InputsModel, RunOptions = RunOptions,
+ InputsCrit = InputsCrit, CalibOptions = CalibOptions,
FUN_MOD = RunModel_GR4J)
## simulation
@@ -115,33 +115,33 @@ OutputsModel <- RunModel_GR4J(InputsModel = InputsModel,
plot(OutputsModel, Qobs = BasinObs$Qmm[Ind_Run])
## efficiency criterion: Nash-Sutcliffe Efficiency
-InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
+InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
RunOptions = RunOptions, Obs = BasinObs$Qmm[Ind_Run])
OutputsCrit <- ErrorCrit_NSE(InputsCrit = InputsCrit, OutputsModel = OutputsModel)
## efficiency criterion: Kling-Gupta Efficiency
-InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_KGE, InputsModel = InputsModel,
+InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_KGE, InputsModel = InputsModel,
RunOptions = RunOptions, Obs = BasinObs$Qmm[Ind_Run])
OutputsCrit <- ErrorCrit_KGE(InputsCrit = InputsCrit, OutputsModel = OutputsModel)
}
\author{
-Laurent Coron, Claude Michel, Charles Perrin, Thibault Mathevet, Olivier Delaigue, Guillaume Thirel
+Laurent Coron, Claude Michel, Charles Perrin, Thibault Mathevet, Olivier Delaigue, Guillaume Thirel, David Dorchies
}
\references{
Michel, C. (1991),
- Hydrologie appliquée aux petits bassins ruraux,
- Hydrology handbook (in French), Cemagref, Antony, France.
+ Hydrologie appliquée aux petits bassins ruraux.
+ Hydrology handbook (in French), Cemagref, Antony, France.
}
\seealso{
\code{\link{Calibration}},
\code{\link{RunModel_GR4J}}, \code{\link{TransfoParam}}, \code{\link{ErrorCrit_RMSE}},
-\code{\link{CreateInputsModel}}, \code{\link{CreateRunOptions}},
+\code{\link{CreateInputsModel}}, \code{\link{CreateRunOptions}},
\code{\link{CreateInputsCrit}}, \code{\link{CreateCalibOptions}}.
}
diff --git a/man/CreateCalibOptions.Rd b/man/CreateCalibOptions.Rd
index 451315191df00fdd1913485be25a5e3e49a1e4a1..b418995a04c37002f14ad8bc3bfb6332167f725f 100644
--- a/man/CreateCalibOptions.Rd
+++ b/man/CreateCalibOptions.Rd
@@ -15,7 +15,7 @@ Creation of the \emph{CalibOptions} object required by the \code{Calibration*} f
\usage{
CreateCalibOptions(FUN_MOD, FUN_CALIB = Calibration_Michel,
- FUN_TRANSFO = NULL, IsHyst = FALSE, FixedParam = NULL,
+ FUN_TRANSFO = NULL, IsHyst = FALSE, IsSD = FALSE, FixedParam = NULL,
SearchRanges = NULL, StartParamList = NULL,
StartParamDistrib = NULL)
}
@@ -30,6 +30,8 @@ CreateCalibOptions(FUN_MOD, FUN_CALIB = Calibration_Michel,
\item{IsHyst}{[boolean] boolean indicating if the hysteresis version of CemaNeige is used. See details}
+\item{IsSD}{[boolean] boolean indicating if the semi-distributed lag model is used. See details}
+
\item{FixedParam}{(optional) [numeric] vector giving the values set for the non-optimised parameter values (NParam columns, 1 line)
\cr Example:
\tabular{llllll}{
@@ -75,13 +77,15 @@ CreateCalibOptions(FUN_MOD, FUN_CALIB = Calibration_Michel,
\details{
-Users wanting to use \code{FUN_MOD}, \code{FUN_CALIB} or \code{FUN_TRANSFO} functions that are not included in
+Users wanting to use \code{FUN_MOD}, \code{FUN_CALIB} or \code{FUN_TRANSFO} functions that are not included in
the package must create their own \code{CalibOptions} object accordingly. \cr
## ---- CemaNeige version
If \code{IsHyst = FALSE}, the original CemaNeige version from Valéry et al. (2014) is used. \cr
If \code{IsHyst = TRUE}, the CemaNeige version from Riboust et al. (2019) is used. Compared to the original version, this version of CemaNeige needs two more parameters and it includes a representation of the hysteretic relationship between the Snow Cover Area (SCA) and the Snow Water Equivalent (SWE) in the catchment. The hysteresis included in airGR is the Modified Linear hysteresis (LH*); it is represented on panel b) of Fig. 3 in Riboust et al. (2019). Riboust et al. (2019) advise to use the LH* version of CemaNeige with parameters calibrated using an objective function combining 75 \% of KGE calculated on discharge simulated from a rainfall-runoff model compared to observed discharge and 5 \% of KGE calculated on SCA on 5 CemaNeige elevation bands compared to satellite (e.g. MODIS) SCA (see Eq. (18), Table 3 and Fig. 6). Riboust et al. (2019)'s tests were realized with GR4J as the chosen rainfall-runoff model. \cr
+
+If \code{InputsModel} parameter has been created for using a semi-distributed (SD) model (See \code{\link{CreateInputsModel}}), the parameter \code{isSD} should be set to \code{TRUE}.
}
@@ -92,11 +96,11 @@ library(airGR)
data(L0123001)
## preparation of InputsModel object
-InputsModel <- CreateInputsModel(FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR,
+InputsModel <- CreateInputsModel(FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR,
Precip = BasinObs$P, PotEvap = BasinObs$E)
## calibration period selection
-Ind_Run <- seq(which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1990-01-01"),
+Ind_Run <- seq(which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1990-01-01"),
which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1999-12-31"))
## preparation of RunOptions object
@@ -104,7 +108,7 @@ RunOptions <- CreateRunOptions(FUN_MOD = RunModel_GR4J,
InputsModel = InputsModel, IndPeriod_Run = Ind_Run)
## calibration criterion: preparation of the InputsCrit object
-InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
+InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
RunOptions = RunOptions, Obs = BasinObs$Qmm[Ind_Run])
## preparation of CalibOptions object
@@ -113,31 +117,31 @@ CalibOptions <- CreateCalibOptions(FUN_MOD = RunModel_GR4J, FUN_CALIB = Calibrat
## calibration
OutputsCalib <- Calibration(InputsModel = InputsModel, RunOptions = RunOptions,
InputsCrit = InputsCrit, CalibOptions = CalibOptions,
- FUN_MOD = RunModel_GR4J,
+ FUN_MOD = RunModel_GR4J,
FUN_CALIB = Calibration_Michel)
## simulation
Param <- OutputsCalib$ParamFinalR
-OutputsModel <- RunModel(InputsModel = InputsModel, RunOptions = RunOptions,
+OutputsModel <- RunModel(InputsModel = InputsModel, RunOptions = RunOptions,
Param = Param, FUN = RunModel_GR4J)
## results preview
plot(OutputsModel, Qobs = BasinObs$Qmm[Ind_Run])
## efficiency criterion: Nash-Sutcliffe Efficiency
-InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
+InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
RunOptions = RunOptions, Obs = BasinObs$Qmm[Ind_Run])
OutputsCrit <- ErrorCrit_NSE(InputsCrit = InputsCrit, OutputsModel = OutputsModel)
## efficiency criterion: Kling-Gupta Efficiency
-InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_KGE, InputsModel = InputsModel,
+InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_KGE, InputsModel = InputsModel,
RunOptions = RunOptions, Obs = BasinObs$Qmm[Ind_Run])
OutputsCrit <- ErrorCrit_KGE(InputsCrit = InputsCrit, OutputsModel = OutputsModel)
}
\author{
-Laurent Coron, Olivier Delaigue, Guillaume Thirel
+Laurent Coron, Olivier Delaigue, Guillaume Thirel, David Dorchies
}
diff --git a/man/CreateIniStates.Rd b/man/CreateIniStates.Rd
index 5e2fed8357751f995973ab695373951c5a90d669..76a5d9f3b760ac97e5e0fb729c756973c429baef 100644
--- a/man/CreateIniStates.Rd
+++ b/man/CreateIniStates.Rd
@@ -19,7 +19,7 @@ CreateIniStates(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = FALSE,
UH1 = NULL, UH2 = NULL,
GCemaNeigeLayers = NULL, eTGCemaNeigeLayers = NULL,
GthrCemaNeigeLayers = NULL, GlocmaxCemaNeigeLayers = NULL,
- verbose = TRUE)
+ SD = NULL, verbose = TRUE)
}
@@ -52,6 +52,8 @@ CreateIniStates(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = FALSE,
\item{GlocmaxCemaNeigeLayers}{(optional) [numeric] local melt threshold for hysteresis [mm], possibly used to create the CemaNeige model initial state in case the Linear Hysteresis version is used}
+\item{SD}{(optional) [list] of [numeric] states of delayed upstream flows for semi-distributed models, the nature of the state and the unit depend on the model and the unit of the upstream flow}
+
\item{verbose}{(optional) [boolean] boolean indicating if the function is run in verbose mode or not, default = \code{TRUE}}
}
diff --git a/man/CreateInputsCrit.Rd b/man/CreateInputsCrit.Rd
index 8e74569082bf7071658cd9d1cb05d89032b9b43a..848a35fd1d0a01e5eb3b3c4ed64008671e080d00 100644
--- a/man/CreateInputsCrit.Rd
+++ b/man/CreateInputsCrit.Rd
@@ -35,9 +35,9 @@ CreateInputsCrit(FUN_CRIT, InputsModel, RunOptions,
\item{VarObs}{(optional) [character (atomic or list)] names of the observed variable (\code{"Q"} by default, or one of \code{"SCA"}, \code{"SWE"}])}
-\item{BoolCrit}{(optional) [boolean (atomic or list)] boolean (the same length as \code{Obs}) giving the time steps to consider in the computation (all time steps are considered by default)}
+\item{BoolCrit}{(optional) [boolean (atomic or list)] boolean (the same length as \code{Obs}) giving the time steps to consider in the computation (all time steps are considered by default. See details)}
-\item{transfo}{(optional) [character (atomic or list)] name of the transformation applied to the variables (e.g. \code{""}, \code{"sqrt"}, \code{"log"}, \code{"inv"}, \code{"sort"}, \code{"boxcox"} or a numeric value for power transformation (see details))}
+\item{transfo}{(optional) [character (atomic or list)] name of the transformation applied to the variables (e.g. \code{""}, \code{"sqrt"}, \code{"log"}, \code{"inv"}, \code{"sort"}, \code{"boxcox"} or a numeric value for power transformation . See details)}
\item{Weights}{(optional) [numeric (atomic or list)] vector of weights necessary to calculate a composite criterion (the same length as \code{FUN_CRIT}) giving the weights to use for elements of \code{FUN_CRIT} [-]. See details}
@@ -73,6 +73,10 @@ To calculate composite or multiple criteria, it is necessary to use the \code{Er
\details{
Users wanting to use \code{FUN_CRIT} functions that are not included in the package must create their own InputsCrit object accordingly. \cr \cr
+## ---- Period of calculation
+
+Criteria can be calculated over discontinuous periods (i.e. only over winter periods, or when observed discharge is below a certain threshold). To do so, please indicate in \code{Bool_Crit} which indices must be used for calcullation. Discontinuous periods are allowed in the \code{Bool_Crit} argument.
+
## ---- Transformations
Transformations are simple functions applied to the observed and simulated variables used in order to change their distribution. Transformations are often used in hydrology for modifying the weight put on errors made for high flows or low flows. The following transformations are available: \cr \cr
@@ -163,11 +167,11 @@ Olivier Delaigue, Laurent Coron, Guillaume Thirel
\references{
Pushpalatha, R., Perrin, C., Le Moine, N. and Andréassian, V. (2012).
A review of efficiency criteria suitable for evaluating low-flow simulations.
- Journal of Hydrology, 420-421: 171-182. doi: 10.1016/j.jhydrol.2011.11.055.
+ Journal of Hydrology, 420-421, 171-182, doi: 10.1016/j.jhydrol.2011.11.055.
\cr\cr
Santos, L., Thirel, G. and Perrin, C. (2018).
Technical note: Pitfalls in using log-transformed flows within the KGE criterion.
- Hydrol. Earth Syst. Sci., 22, 4583-4591. doi: 10.5194/hess-22-4583-2018.
+ Hydrol. Earth Syst. Sci., 22, 4583-4591, doi: 10.5194/hess-22-4583-2018.
}
diff --git a/man/CreateInputsModel.Rd b/man/CreateInputsModel.Rd
index 466d9d995d5357cc95a5a957e79db5d6c8b496ef..958f9e7eec4e2216912acb52c567a6636c443232 100644
--- a/man/CreateInputsModel.Rd
+++ b/man/CreateInputsModel.Rd
@@ -3,6 +3,7 @@
\name{CreateInputsModel}
\alias{CreateInputsModel}
+\alias{[.InputsModel}
\title{Creation of the InputsModel object required to the RunModel functions}
@@ -16,7 +17,11 @@ Creation of the \emph{InputsModel} object required to the \code{RunModel*} funct
\usage{
CreateInputsModel(FUN_MOD, DatesR, Precip, PrecipScale = TRUE, PotEvap = NULL,
TempMean = NULL, TempMin = NULL, TempMax = NULL,
- ZInputs = NULL, HypsoData = NULL, NLayers = 5, verbose = TRUE)
+ ZInputs = NULL, HypsoData = NULL, NLayers = 5,
+ Qupstream = NULL, LengthHydro = NULL, BasinAreas = NULL,
+ verbose = TRUE)
+
+\method{[}{InputsModel}(x, i)
}
@@ -44,6 +49,16 @@ CreateInputsModel(FUN_MOD, DatesR, Precip, PrecipScale = TRUE, PotEvap = NULL,
\item{NLayers}{(optional) [numeric] integer giving the number of elevation layers requested [-], required to create CemaNeige module inputs, default=5}
\item{verbose}{(optional) [boolean] boolean indicating if the function is run in verbose mode or not, default = \code{TRUE}}
+
+\item{Qupstream}{(optional) [numerical matrix] time series of upstream flows (catchment average) [mm/time step or m3/time step, see details], required to create the SD model inputs . See details}
+
+\item{LengthHydro}{(optional) [numeric] real giving the distance between the downstream outlet and each upstream inlet of the sub-catchment [m], required to create the SD model inputs . See details}
+
+\item{BasinAreas}{(optional) [numeric] real giving the area of each upstream sub-catchment [km2] and the area of the downstream sub-catchment in the last item, required to create the SD model inputs . See details}
+
+\item{x}{[InputsModel] object of class InputsModel}
+
+\item{i}{[integer] of the indices to subset a time series or [character] names of the elements to extract}
}
@@ -61,11 +76,15 @@ CreateInputsModel(FUN_MOD, DatesR, Precip, PrecipScale = TRUE, PotEvap = NULL,
\details{
-Users wanting to use \code{FUN_MOD} functions that are not included in
+Users wanting to use \code{FUN_MOD} functions that are not included in
the package must create their own InputsModel object accordingly. \cr
Please note that if CemaNeige is used, and \code{ZInputs} is different than \code{HypsoData}, then precipitation and temperature are interpolated with the \code{DataAltiExtrapolation_Valery} function.
-}
+Users wanting to use a semi-distributed (SD) lag model should provide valid \code{Qupstream}, \code{LengthHydro}, and \code{BasinAreas} parameters. Each upstream sub-catchment is described by an upstream flow time series (one column in \code{Qupstream} matrix), a distance between the downstream outlet and the upstream inlet (one item in \code{LengthHydro}) and an area (one item in \code{BasinAreas}).
+The order of the columns or of the items should be consistent for all these parameters. \code{BasinAreas} should contain one extra information (stored in the last item) which is the area of the downstream sub-catchment.
+Upstream flows that are not related to a sub-catchment such as a release or withdraw spot are identified by an area equal to \code{NA} and an upstream flow expressed in m3/time step instead of mm/time step.
+Please note that the use of SD lag model require to use the \code{\link{RunModel}} function instead of \code{\link{RunModel_GR4J}} or the other \code{RunModel_*} functions.
+}
\examples{
library(airGR)
@@ -74,11 +93,11 @@ library(airGR)
data(L0123001)
## preparation of the InputsModel object
-InputsModel <- CreateInputsModel(FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR,
+InputsModel <- CreateInputsModel(FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR,
Precip = BasinObs$P, PotEvap = BasinObs$E)
## run period selection
-Ind_Run <- seq(which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1990-01-01"),
+Ind_Run <- seq(which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1990-01-01"),
which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1999-12-31"))
## preparation of the RunOptions object
@@ -87,14 +106,14 @@ RunOptions <- CreateRunOptions(FUN_MOD = RunModel_GR4J,
## simulation
Param <- c(X1 = 734.568, X2 = -0.840, X3 = 109.809, X4 = 1.971)
-OutputsModel <- RunModel(InputsModel = InputsModel, RunOptions = RunOptions, Param = Param,
+OutputsModel <- RunModel(InputsModel = InputsModel, RunOptions = RunOptions, Param = Param,
FUN_MOD = RunModel_GR4J)
## results preview
plot(OutputsModel, Qobs = BasinObs$Qmm[Ind_Run])
## efficiency criterion: Nash-Sutcliffe Efficiency
-InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
+InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
RunOptions = RunOptions, Obs = BasinObs$Qmm[Ind_Run])
OutputsCrit <- ErrorCrit_NSE(InputsCrit = InputsCrit, OutputsModel = OutputsModel)
}
diff --git a/man/CreateRunOptions.Rd b/man/CreateRunOptions.Rd
index eaa414c722ac889f9d703c122d70a864c865d3cb..6ed188c4670de2f1944cf2dc00ae4af3b979ce2b 100644
--- a/man/CreateRunOptions.Rd
+++ b/man/CreateRunOptions.Rd
@@ -18,8 +18,7 @@ CreateRunOptions(FUN_MOD, InputsModel,
IndPeriod_WarmUp = NULL, IndPeriod_Run,
IniStates = NULL, IniResLevels = NULL, Imax = NULL,
Outputs_Cal = NULL, Outputs_Sim = "all",
- RunSnowModule, MeanAnSolidPrecip = NULL,
- IsHyst = FALSE,
+ MeanAnSolidPrecip = NULL, IsHyst = FALSE,
warnings = TRUE, verbose = TRUE)
}
@@ -29,24 +28,20 @@ CreateRunOptions(FUN_MOD, InputsModel,
\item{InputsModel}{[object of class \emph{InputsModel}] see \code{\link{CreateInputsModel}} for details}
-\item{IndPeriod_WarmUp}{(optional) [numeric] index of period to be used for the model warm-up [-]}
+\item{IndPeriod_WarmUp}{(optional) [numeric] index of period to be used for the model warm-up [-]. See details}
-\item{IndPeriod_Run}{[numeric] index of period to be used for the model run [-]}
+\item{IndPeriod_Run}{[numeric] index of period to be used for the model run [-]. See details}
\item{IniStates}{(optional) [numeric] object of class \code{IniStates} [mm and °C], see \code{\link{CreateIniStates}} for details}
-\item{IniResLevels}{(optional) [numeric] vector of initial fillings for the GR stores (2 or 3 values according to the model) [- and/or mm]; see details}
+\item{IniResLevels}{(optional) [numeric] vector of initial fillings for the GR stores (2 or 3 values according to the model) [- and/or mm]. See details}
\item{Imax}{(optional) [numeric] an atomic vector of the maximum capacity of the GR5H interception store [mm]; see \code{\link{RunModel_GR5H}}}
-
\item{Outputs_Cal}{(optional) [character] vector giving the outputs needed for the calibration \cr (e.g. c("Qsim")), the fewer outputs
the faster the calibration}
\item{Outputs_Sim}{(optional) [character] vector giving the requested outputs \cr (e.g. c(\code{"DatesR"}, \code{"Qsim"}, \code{"SnowPack"})), default = \code{"all"}}
-
-\item{RunSnowModule}{(deprecated) [boolean] option indicating whether CemaNeige should be activated. Please adapt \code{FUN_MOD} instead}
-
\item{MeanAnSolidPrecip}{(optional) [numeric] vector giving the annual mean of average solid precipitation for each layer (computed from InputsModel if not defined) [mm/y]}
@@ -77,6 +72,10 @@ CreateRunOptions(FUN_MOD, InputsModel,
Users wanting to use \code{FUN_MOD} functions that are not included in
the package must create their own \code{RunOptions} object accordingly.
+## ---- IndPeriod_WarmUp and IndPeriod_Run
+
+Since the hydrological models included in airGR are continuous models, meaning that internal states of the models are propagated to the next time step, \code{IndPeriod_WarmUp} and \code{IndPeriod_Run} must be continuous periods, represented by continuous indices values; no gaps are allowed. To calculate criteria or to calibrate a model over discontinuous periods, please see the \code{Bool_Crit} argument of the \code{\link{CreateInputsCrit}} function.
+
## ---- Initialisation options
The model initialisation options can either be set to a default configuration or be defined by the user.
diff --git a/man/DataAltiExtrapolation_Valery.Rd b/man/DataAltiExtrapolation_Valery.Rd
index b9c0da5776fb9bee1da37799624ff954465752d1..7e063b9031e3020d94edda941b635f86d74d1fde 100644
--- a/man/DataAltiExtrapolation_Valery.Rd
+++ b/man/DataAltiExtrapolation_Valery.Rd
@@ -43,7 +43,7 @@ DataAltiExtrapolation_Valery(DatesR, Precip, PrecipScale = TRUE,
}
\value{
list containing the extrapolated series of precip. and air temp. on each elevation layer
- \tabular{ll}{
+ \tabular{ll}{
\emph{$LayerPrecip } \tab [list] list of time series of daily precipitation (layer average) [mm/time step] \cr
\emph{$LayerTempMean } \tab [list] list of time series of daily mean air temperature (layer average) [°C] \cr
\emph{$LayerTempMin } \tab [list] list of time series of daily min air temperature (layer average) [°C] \cr
@@ -55,7 +55,7 @@ list containing the extrapolated series of precip. and air temp. on each elevati
\details{
-Elevation layers of equal surface are created the 101 elevation quantiles (\code{HypsoData})
+Elevation layers of equal surface are created the 101 elevation quantiles (\code{HypsoData})
and the number requested elevation layers (\code{NLayers}). \cr
Forcing data (precipitation and air temperature) are extrapolated using gradients from Valery (2010).
(e.g. gradP = 0.0004 [m-1] for France and gradT = 0.434 [°C/100m] for January, 1st). \cr
@@ -69,16 +69,16 @@ Laurent Coron, Audrey Valéry, Olivier Delaigue, Pierre Brigode, Guillaume Thire
\references{
-Turcotte, R., L.-G. Fortin, V. Fortin, J.-P. Fortin and J.-P. Villeneuve (2007).
- Operational analysis of the spatial distribution and the temporal evolution of the snowpack water equivalent in southern Quebec, Canada,
- Nordic Hydrology, 38(3), 211. doi: 10.2166/nh.2007.009.
+Turcotte, R., Fortin, L.-G., Fortin, V., Fortin, J.-P. and Villeneuve, J.-P. (2007).
+ Operational analysis of the spatial distribution and the temporal evolution of the snowpack water equivalent in southern Quebec, Canada.
+ Nordic Hydrology, 38(3), 211, \doi{10.2166/nh.2007.009}.
\cr\cr
Valéry, A. (2010),
- Modélisation précipitations-débit sous influence nivale ? : Elaboration d'un module neige et évaluation sur 380 bassins versants.
- PhD thesis (in french), AgroParisTech, Paris, France.
+ Modélisation précipitations-débit sous influence nivale ? : Elaboration d'un module neige et évaluation sur 380 bassins versants.
+ PhD thesis (in French), AgroParisTech - Cemagref Antony, Paris, France.
\cr\cr
USACE (1956),
- Snow Hydrology, pp. 437.
+ Snow Hydrology, pp. 437.
U.S. Army Coprs of Engineers (USACE) North Pacific Division, Portland, Oregon, USA.
}
diff --git a/man/ErrorCrit_KGE.Rd b/man/ErrorCrit_KGE.Rd
index 05beb6e1f088e349a0ee7d5f236fe48628af3e76..2c17cb549d016d197647d9f6a15a95a429f179b0 100644
--- a/man/ErrorCrit_KGE.Rd
+++ b/man/ErrorCrit_KGE.Rd
@@ -44,7 +44,7 @@ ErrorCrit_KGE(InputsCrit, OutputsModel, warnings = TRUE, verbose = TRUE)
\details{
-In addition to the criterion value, the function outputs include a multiplier (-1 or +1) which allows
+In addition to the criterion value, the function outputs include a multiplier (-1 or +1) which allows
the use of the function for model calibration: the product CritValue * Multiplier is the criterion to be minimised (Multiplier = -1 for KGE).\cr\cr
The KGE formula is
\deqn{KGE = 1 - \sqrt{(r - 1)^2 + (\alpha - 1)^2 + (\beta - 1)^2}}{KGE = 1 - sqrt((r - 1)² + (\alpha - 1)² + (\beta - 1)²)}
@@ -62,11 +62,11 @@ library(airGR)
data(L0123001)
## preparation of the InputsModel object
-InputsModel <- CreateInputsModel(FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR,
+InputsModel <- CreateInputsModel(FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR,
Precip = BasinObs$P, PotEvap = BasinObs$E)
## run period selection
-Ind_Run <- seq(which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1990-01-01"),
+Ind_Run <- seq(which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1990-01-01"),
which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1999-12-31"))
## preparation of the RunOptions object
@@ -75,24 +75,24 @@ RunOptions <- CreateRunOptions(FUN_MOD = RunModel_GR4J,
## simulation
Param <- c(X1 = 734.568, X2 = -0.840, X3 = 109.809, X4 = 1.971)
-OutputsModel <- RunModel(InputsModel = InputsModel, RunOptions = RunOptions,
+OutputsModel <- RunModel(InputsModel = InputsModel, RunOptions = RunOptions,
Param = Param, FUN = RunModel_GR4J)
## efficiency criterion: Kling-Gupta Efficiency
-InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_KGE, InputsModel = InputsModel,
+InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_KGE, InputsModel = InputsModel,
RunOptions = RunOptions, Obs = BasinObs$Qmm[Ind_Run])
OutputsCrit <- ErrorCrit_KGE(InputsCrit = InputsCrit, OutputsModel = OutputsModel)
## efficiency criterion: Kling-Gupta Efficiency on square-root-transformed flows
transfo <- "sqrt"
-InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_KGE, InputsModel = InputsModel,
+InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_KGE, InputsModel = InputsModel,
RunOptions = RunOptions, Obs = BasinObs$Qmm[Ind_Run],
transfo = transfo)
OutputsCrit <- ErrorCrit_KGE(InputsCrit = InputsCrit, OutputsModel = OutputsModel)
## efficiency criterion: Kling-Gupta Efficiency above a threshold (quant. 75 \%)
BoolCrit <- BasinObs$Qmm[Ind_Run] >= quantile(BasinObs$Qmm[Ind_Run], 0.75, na.rm = TRUE)
-InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_KGE, InputsModel = InputsModel,
+InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_KGE, InputsModel = InputsModel,
RunOptions = RunOptions, Obs = BasinObs$Qmm[Ind_Run],
BoolCrit = BoolCrit)
OutputsCrit <- ErrorCrit_KGE(InputsCrit = InputsCrit, OutputsModel = OutputsModel)
@@ -105,9 +105,9 @@ Laurent Coron, Olivier Delaigue
\references{
-Gupta, H. V., Kling, H., Yilmaz, K. K. and Martinez, G. F. (2009).
- Decomposition of the mean squared error and NSE performance criteria: Implications for improving hydrological modelling.
- Journal of Hydrology, 377(1-2), 80-91. doi: 10.1016/j.jhydrol.2009.08.003.
+Gupta, H. V., Kling, H., Yilmaz, K. K. and Martinez, G. F. (2009).
+ Decomposition of the mean squared error and NSE performance criteria: Implications for improving hydrological modelling.
+ Journal of Hydrology, 377(1-2), 80-91, \doi{10.1016/j.jhydrol.2009.08.003}.
}
diff --git a/man/ErrorCrit_KGE2.Rd b/man/ErrorCrit_KGE2.Rd
index 34571b287ed6cc1a0e05d7f52fb9a0577d944fef..98e609b7108543f8c4206ce6d5c80834305383fc 100644
--- a/man/ErrorCrit_KGE2.Rd
+++ b/man/ErrorCrit_KGE2.Rd
@@ -44,7 +44,7 @@ ErrorCrit_KGE2(InputsCrit, OutputsModel, warnings = TRUE, verbose = TRUE)
\details{
-In addition to the criterion value, the function outputs include a multiplier (-1 or +1) which allows
+In addition to the criterion value, the function outputs include a multiplier (-1 or +1) which allows
the use of the function for model calibration: the product CritValue * Multiplier is the criterion to be minimised (Multiplier = -1 for KGE2).\cr\cr
The KGE' formula is
\deqn{KGE' = 1 - \sqrt{(r - 1)^2 + (\gamma - 1)^2 + (\beta - 1)^2}}{KGE' = 1 - sqrt((r - 1)² + (\gamma - 1)² + (\beta - 1)²)}
@@ -62,11 +62,11 @@ library(airGR)
data(L0123001)
## preparation of the InputsModel object
-InputsModel <- CreateInputsModel(FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR,
+InputsModel <- CreateInputsModel(FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR,
Precip = BasinObs$P, PotEvap = BasinObs$E)
## run period selection
-Ind_Run <- seq(which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1990-01-01"),
+Ind_Run <- seq(which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1990-01-01"),
which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1999-12-31"))
## preparation of the RunOptions object
@@ -75,24 +75,24 @@ RunOptions <- CreateRunOptions(FUN_MOD = RunModel_GR4J,
## simulation
Param <- c(X1 = 734.568, X2 = -0.840, X3 = 109.809, X4 = 1.971)
-OutputsModel <- RunModel(InputsModel = InputsModel, RunOptions = RunOptions,
+OutputsModel <- RunModel(InputsModel = InputsModel, RunOptions = RunOptions,
Param = Param, FUN = RunModel_GR4J)
## efficiency criterion: Kling-Gupta Efficiency
-InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_KGE2, InputsModel = InputsModel,
+InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_KGE2, InputsModel = InputsModel,
RunOptions = RunOptions, Obs = BasinObs$Qmm[Ind_Run])
OutputsCrit <- ErrorCrit_KGE2(InputsCrit = InputsCrit, OutputsModel = OutputsModel)
## efficiency criterion: Kling-Gupta Efficiency on square-root-transformed flows
transfo <- "sqrt"
-InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_KGE2, InputsModel = InputsModel,
+InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_KGE2, InputsModel = InputsModel,
RunOptions = RunOptions, Obs = BasinObs$Qmm[Ind_Run],
transfo = transfo)
OutputsCrit <- ErrorCrit_KGE2(InputsCrit = InputsCrit, OutputsModel = OutputsModel)
## efficiency criterion: Kling-Gupta Efficiency above a threshold (quant. 75 \%)
BoolCrit <- BasinObs$Qmm[Ind_Run] >= quantile(BasinObs$Qmm[Ind_Run], 0.75, na.rm = TRUE)
-InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_KGE2, InputsModel = InputsModel,
+InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_KGE2, InputsModel = InputsModel,
RunOptions = RunOptions, Obs = BasinObs$Qmm[Ind_Run],
BoolCrit = BoolCrit)
OutputsCrit <- ErrorCrit_KGE2(InputsCrit = InputsCrit, OutputsModel = OutputsModel)
@@ -105,13 +105,13 @@ Laurent Coron, Olivier Delaigue
\references{
-Gupta, H. V., Kling, H., Yilmaz, K. K. and Martinez, G. F. (2009).
- Decomposition of the mean squared error and NSE performance criteria: Implications for improving hydrological modelling.
- Journal of Hydrology, 377(1-2), 80-91. doi: 10.1016/j.jhydrol.2009.08.003.
+Gupta, H. V., Kling, H., Yilmaz, K. K. and Martinez, G. F. (2009).
+ Decomposition of the mean squared error and NSE performance criteria: Implications for improving hydrological modelling.
+ Journal of Hydrology, 377(1-2), 80-91, \doi{10.1016/j.jhydrol.2009.08.003}.
\cr\cr
-Kling, H., Fuchs, M. and Paulin, M. (2012).
- Runoff conditions in the upper Danube basin under an ensemble of climate change scenarios.
- Journal of Hydrology, 424-425, 264-277. doi: 10.1016/j.jhydrol.2012.01.011.
+Kling, H., Fuchs, M. and Paulin, M. (2012).
+ Runoff conditions in the upper Danube basin under an ensemble of climate change scenarios.
+ Journal of Hydrology, 424-425, 264-277, \doi{10.1016/j.jhydrol.2012.01.011}.
}
diff --git a/man/ErrorCrit_NSE.Rd b/man/ErrorCrit_NSE.Rd
index 1ac5ea025b3ad2c0109fc14518efdc14fb03d7f5..47f838e24a5122981c0b927b91a7fc7cfed8ecb4 100644
--- a/man/ErrorCrit_NSE.Rd
+++ b/man/ErrorCrit_NSE.Rd
@@ -42,8 +42,8 @@ Function which computes an error criterion based on the NSE formula proposed by
\details{
-In addition to the criterion value, the function outputs include a multiplier (-1 or +1) which allows
-the use of the function for model calibration: the product CritValue * Multiplier is the criterion to be minimised
+In addition to the criterion value, the function outputs include a multiplier (-1 or +1) which allows
+the use of the function for model calibration: the product CritValue * Multiplier is the criterion to be minimised
(Multiplier = -1 for NSE).
}
@@ -55,11 +55,11 @@ library(airGR)
data(L0123001)
## preparation of the InputsModel object
-InputsModel <- CreateInputsModel(FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR,
+InputsModel <- CreateInputsModel(FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR,
Precip = BasinObs$P, PotEvap = BasinObs$E)
## run period selection
-Ind_Run <- seq(which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1990-01-01"),
+Ind_Run <- seq(which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1990-01-01"),
which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1999-12-31"))
## preparation of the RunOptions object
@@ -68,24 +68,24 @@ RunOptions <- CreateRunOptions(FUN_MOD = RunModel_GR4J,
## simulation
Param <- c(X1 = 734.568, X2 = -0.840, X3 = 109.809, X4 = 1.971)
-OutputsModel <- RunModel(InputsModel = InputsModel, RunOptions = RunOptions,
+OutputsModel <- RunModel(InputsModel = InputsModel, RunOptions = RunOptions,
Param = Param, FUN = RunModel_GR4J)
## efficiency criterion: Nash-Sutcliffe Efficiency
-InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
+InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
RunOptions = RunOptions, Obs = BasinObs$Qmm[Ind_Run])
OutputsCrit <- ErrorCrit_NSE(InputsCrit = InputsCrit, OutputsModel = OutputsModel)
## efficiency criterion: Nash-Sutcliffe Efficiency on log-transformed flows
transfo <- "log"
-InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
+InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
RunOptions = RunOptions, Obs = BasinObs$Qmm[Ind_Run],
transfo = transfo)
OutputsCrit <- ErrorCrit_NSE(InputsCrit = InputsCrit, OutputsModel = OutputsModel)
## efficiency criterion: Kling-Gupta Efficiency above a threshold (quant. 75 \%)
BoolCrit <- BasinObs$Qmm[Ind_Run] >= quantile(BasinObs$Qmm[Ind_Run], 0.75, na.rm = TRUE)
-InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
+InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
RunOptions = RunOptions, Obs = BasinObs$Qmm[Ind_Run],
BoolCrit = BoolCrit)
OutputsCrit <- ErrorCrit_NSE(InputsCrit = InputsCrit, OutputsModel = OutputsModel)
@@ -96,9 +96,10 @@ OutputsCrit <- ErrorCrit_NSE(InputsCrit = InputsCrit, OutputsModel = OutputsMode
Laurent Coron, Olivier Delaigue
}
\references{
-Nash, J.E. and Sutcliffe, J.V. (1970).
- River flow forecasting through conceptual models part 1.
- A discussion of principles, Journal of Hydrology, 10(3), 282-290. doi: 10.1016/0022-1694(70)90255-6.
+Nash, J. E. and Sutcliffe, J. V. (1970).
+ River flow forecasting through conceptual models.
+ Part 1 - A discussion of principles.
+ Journal of Hydrology, 10(3), 282-290, \doi{10.1016/0022-1694(70)90255-6}.
}
diff --git a/man/Imax.Rd b/man/Imax.Rd
index ff12b288d1aadd328505061db633507bb322e1e3..e02807f0530be377cfa9da4b1eab34eab7c96998 100644
--- a/man/Imax.Rd
+++ b/man/Imax.Rd
@@ -9,7 +9,7 @@
\description{
-Function which calculates the maximal capacity of the GR5H interception store. This function compares the interception evapotranspiration from the GR5H interception store for different maximal capacity values with the interception evapotranspiration classically used in the daily GR models (e.g. GR4J). Among all the \code{TestedValues}, the value that gives the closest interception evapotranspiration flux over the whole period is kept.
+Function which calculates the maximal capacity of the GR5H interception store. This function compares the interception evapotranspiration from the GR5H interception store for different maximal capacity values with the interception evapotranspiration classically used in the daily GR models (e.g. GR4J). Among all the \code{TestedValues}, the value that gives the closest interception evapotranspiration flux over the whole period is kept.
}
@@ -46,7 +46,7 @@ InputsModel <- CreateInputsModel(FUN_MOD = RunModel_GR5H, DatesR = BasinObs$Date
## run period selection
Ind_Run <- seq(which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d \%H:\%M")=="2006-01-01 00:00"),
which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d \%H:\%M")=="2006-12-31 23:00"))
-
+
## Imax computation
Imax <- Imax(InputsModel = InputsModel, IndPeriod_Run = Ind_Run,
TestedValues = seq(from = 0, to = 3, by = 0.2))
@@ -64,7 +64,7 @@ OutputsModel <- RunModel_GR5H(InputsModel = InputsModel,
plot(OutputsModel, Qobs = BasinObs$Qmm[Ind_Run])
## efficiency criterion: Nash-Sutcliffe Efficiency
-InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
+InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
RunOptions = RunOptions, Obs = BasinObs$Qmm[Ind_Run])
OutputsCrit <- ErrorCrit_NSE(InputsCrit = InputsCrit, OutputsModel = OutputsModel)
}
@@ -79,11 +79,11 @@ Guillaume Thirel, Olivier Delaigue
Ficchi, A. (2017).
An adaptive hydrological model for multiple time-steps:
Diagnostics and improvements based on fluxes consistency.
- PhD thesis, Irstea (Antony), GRNE (Paris), France.
+ PhD thesis, UPMC - Irstea Antony, Paris, France.
\cr\cr
-Ficchi, A., C. Perrin and V. Andréassian (2019).
+Ficchi, A., Perrin, C. and Andréassian, V. (2019).
Hydrological modelling at multiple sub-daily time steps: model improvement via flux-matching.
- Journal of Hydrology, 575, 1308-1327. doi: 10.1016/j.jhydrol.2019.05.084.
+ Journal of Hydrology, 575, 1308-1327. \doi{10.1016/j.jhydrol.2019.05.084}.
}
diff --git a/man/PE_Oudin.Rd b/man/PE_Oudin.Rd
index 56104776fc2e515af895c4bf85d2e0cfd69828f3..e5e8bb89c05e87e7ff921b52efd8bd218faa0ce1 100644
--- a/man/PE_Oudin.Rd
+++ b/man/PE_Oudin.Rd
@@ -10,8 +10,9 @@
\usage{
-PE_Oudin(JD, Temp, Lat, LatUnit,
- TimeStepIn = "daily", TimeStepOut = "daily")
+PE_Oudin(JD, Temp, Lat, LatUnit = c("rad", "deg"),
+ TimeStepIn = "daily", TimeStepOut = "daily",
+ RunFortran = FALSE)
## deprectated function
PEdaily_Oudin(JD, Temp, LatRad, Lat, LatUnit)
@@ -25,13 +26,15 @@ PEdaily_Oudin(JD, Temp, LatRad, Lat, LatUnit)
\item{LatRad}{(deprecated)[numeric] latitude of measurement for the temperature series [radians]. Please use \code{Lat} instead}
-\item{Lat}{[numeric] latitude of measurement for the temperature series [radians or degrees]}
+\item{Lat}{[numeric] latitude of measurement for the temperature series [radians or degrees]. Atomic vector, except if \code{RunFortran = TRUE}, it can be a vector of the same length as \code{Temp}}
\item{LatUnit}{[character] latitude unit (default = \code{"rad"} or \code{"deg"})}
\item{TimeStepIn}{[character] time step of inputs (e.g. \code{"daily"} or \code{"hourly"}, default = \code{"daily"})}
\item{TimeStepOut}{[character] time step of outputs (e.g. \code{"daily"} or \code{"hourly"}, default = \code{"daily"})}
+
+\item{RunFortran}{[boolean] to run the code in the Fortran mode or in the R mode (default)}
}
@@ -41,11 +44,13 @@ PEdaily_Oudin(JD, Temp, LatRad, Lat, LatUnit)
\description{
-Function which computes PE using the formula from Oudin et al. (2005). PE can be computed at the daily time step from hourly or daily temperature and at the hourly time step with hourly or daily temperature through a disaggregation of daily PE (see details).
+Function which computes PE using the formula from Oudin et al. (2005). PE can be computed at the daily time step from hourly or daily temperature and at the hourly time step with hourly or daily temperature through a disaggregation of daily PE . See details.
}
\details{
-In the \code{JD} argument, the Julian day of the year of the 1st of January is equal to 1 and the 31st of December to 365 (366 in leap years)). If the Julian day of the year is computed on an object of the \code{POSIXlt} class, the user has to add 1 to the returned value (e.g. \code{as.POSIXlt("2016-12-31")$yday + 1}).
+To calculate basin-wide Oudin potential evapotranspiration, it is advised, when possible, to use either station temperature or gridded temperature data to calculate PE and then average these PE values at the basin scale.
+
+In the \code{JD} argument, the Julian day of the year of the 1st of January is equal to 1 and the 31st of December to 365 (366 in leap years). If the Julian day of the year is computed on an object of the \code{POSIXlt} class, the user has to add 1 to the returned value (e.g. \code{as.POSIXlt("2016-12-31")$yday + 1}).
When hourly temperature is provided, all the values of the same day have to be set to the same Julian day of the year (e.g. \code{as.POSIXlt("2016-12-31 00:00:00")$yday + 1} and \code{as.POSIXlt("2016-12-31 00:01:00")$yday + 1}). Each single day must be provided 24 identical Julian day values (one for each hour).
@@ -70,18 +75,18 @@ PotEvap <- PE_Oudin(JD = as.POSIXlt(BasinObs$DatesR)$yday + 1,
\author{
-Laurent Coron, Ludovic Oudin, Olivier Delaigue, Guillaume Thirel
+Laurent Coron, Ludovic Oudin, Olivier Delaigue, Guillaume Thirel, François Bourgin
}
\references{
-Oudin, L., F. Hervieu, C. Michel, C. Perrin, V. Andréassian, F. Anctil and C. Loumagne (2005).
- Which potential evapotranspiration input for a lumped rainfall-runoff model?:
- Part 2-Towards a simple and efficient potential evapotranspiration model for rainfall-runoff modelling.
- Journal of Hydrology, 303(1-4), 290-306. doi: 10.1016/j.jhydrol.2004.08.026.
+Oudin, L., Hervieu, F., Michel, C., Perrin, C., Andréassian, V., Anctil, F. and Loumagne, C. (2005).
+ Which potential evapotranspiration input for a lumped rainfall-runoff model?
+ Part 2 - Towards a simple and efficient potential evapotranspiration model for rainfall-runoff modelling.
+ Journal of Hydrology, 303(1-4), 290-306, \doi{10.1016/j.jhydrol.2004.08.026}.
\cr\cr
Lobligeois, F. (2014).
Mieux connaitre la distribution spatiale des pluies améliore-t-il la modélisation des crues ? Diagnostic sur 181 bassins versants français.
- PhD thesis (in French), AgroParisTech (Paris), IRSTEA (Antony), France.
+ PhD thesis (in French), AgroParisTech - Irstea Antony, Paris, France.
}
diff --git a/man/Param_Sets_GR4J.Rd b/man/Param_Sets_GR4J.Rd
index 593664857e8f0e7f500ca3b62dd71653592ff2ea..7a3abb7cb111b98e0b79055443cf256aa96a8111 100644
--- a/man/Param_Sets_GR4J.Rd
+++ b/man/Param_Sets_GR4J.Rd
@@ -31,9 +31,9 @@ As shown in Andréassian et al. (2014; figure 4), only using these parameters se
\references{
-Andréassian, V., F. Bourgin, L. Oudin, T. Mathevet, C. Perrin, J. Lerat, L. Coron, L. Berthet (2014).
- Seeking genericity in the selection of parameter sets: impact on hydrological model efficiency.
- Water Resources Research, 50(10), 8356-8366. doi: 10.1002/2013WR014761.
+Andréassian, V., Bourgin, F., Oudin, L., Mathevet, T., Perrin, C., Lerat, J., Coron, L. and Berthet, L. (2014).
+ Seeking genericity in the selection of parameter sets: Impact on hydrological model efficiency.
+ Water Resources Research, 50(10), 8356-8366, \doi{10.1002/2013WR014761}.
}
@@ -53,14 +53,14 @@ Param_Sets_GR4J$X4u <- NULL
Param_Sets_GR4J <- as.matrix(Param_Sets_GR4J)
## preparation of the InputsModel object
-InputsModel <- CreateInputsModel(FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR,
+InputsModel <- CreateInputsModel(FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR,
Precip = BasinObs$P, PotEvap = BasinObs$E)
## ---- calibration step
## short calibration period selection (< 6 months)
-Ind_Cal <- seq(which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1990-01-01"),
- which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1990-02-28"))
+Ind_Cal <- seq(which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1990-01-01"),
+ which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1990-02-28"))
## preparation of the RunOptions object for the calibration period
RunOptions_Cal <- CreateRunOptions(FUN_MOD = RunModel_GR4J,
@@ -72,7 +72,7 @@ OutputsCrit_Loop <- apply(Param_Sets_GR4J, 1, function(Param) {
OutputsModel_Cal <- RunModel_GR4J(InputsModel = InputsModel,
RunOptions = RunOptions_Cal,
Param = Param)
- InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
+ InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
RunOptions = RunOptions_Cal, Obs = BasinObs$Qmm[Ind_Cal])
OutputsCrit <- ErrorCrit_NSE(InputsCrit = InputsCrit, OutputsModel = OutputsModel_Cal)
return(OutputsCrit$CritValue)
@@ -85,8 +85,8 @@ Param_Best <- unlist(Param_Sets_GR4J[which.max(OutputsCrit_Loop), ])
## ---- validation step
## validation period selection
-Ind_Val <- seq(which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1990-03-01"),
- which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1999-12-31"))
+Ind_Val <- seq(which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1990-03-01"),
+ which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1999-12-31"))
## preparation of the RunOptions object for the validation period
RunOptions_Val <- CreateRunOptions(FUN_MOD = RunModel_GR4J,
@@ -101,7 +101,7 @@ OutputsModel_Val <- RunModel_GR4J(InputsModel = InputsModel,
plot(OutputsModel_Val, Qobs = BasinObs$Qmm[Ind_Val])
## efficiency criterion (Nash-Sutcliffe Efficiency) on the validation period
-InputsCrit_Val <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
+InputsCrit_Val <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
RunOptions = RunOptions_Val, Obs = BasinObs$Qmm[Ind_Val])
OutputsCrit_Val <- ErrorCrit_NSE(InputsCrit = InputsCrit_Val, OutputsModel = OutputsModel_Val)
-}
\ No newline at end of file
+}
diff --git a/man/RunModel.Rd b/man/RunModel.Rd
index 473710d595e62e4ea64957d1f92ab95cad05bb17..efead0f00cb88c0444224b2586647b6dbb4da1ad 100644
--- a/man/RunModel.Rd
+++ b/man/RunModel.Rd
@@ -3,6 +3,7 @@
\name{RunModel}
\alias{RunModel}
+\alias{[.OutputsModel}
\title{Run with the provided hydrological model function}
@@ -15,6 +16,8 @@ Function which performs a single model run with the provided function over the s
\usage{
RunModel(InputsModel, RunOptions, Param, FUN_MOD)
+
+\method{[}{OutputsModel}(x, i)
}
@@ -23,16 +26,26 @@ RunModel(InputsModel, RunOptions, Param, FUN_MOD)
\item{RunOptions}{[object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details}
-\item{Param}{[numeric] vector of model parameters}
+\item{Param}{[numeric] vector of model parameters (See details for SD lag model)}
\item{FUN_MOD}{[function] hydrological model function (e.g. \code{\link{RunModel_GR4J}}, \code{\link{RunModel_CemaNeigeGR4J}})}
+
+\item{x}{[InputsModel] object of class InputsModel}
+
+\item{i}{[integer] of the indices to subset a time series or [character] names of the elements to extract}
}
+
\value{
-[list] see \code{\link{RunModel_GR4J}} or \code{\link{RunModel_CemaNeigeGR4J}} for details
+[list] see \code{\link{RunModel_GR4J}} or \code{\link{RunModel_CemaNeigeGR4J}} for details.
+
+If \code{InputsModel} parameter has been created for using a semi-distributed (SD) lag model (See \code{\link{CreateInputsModel}}), the list value contains an extra item named \code{QsimDown} which is a numeric series of simulated discharge [mm/time step] related to the run-off contribution of the downstream sub-catchment.
}
+\details{
+If \code{InputsModel} parameter has been created for using a semi-distributed (SD) lag model (See \code{\link{CreateInputsModel}}), the first item of \code{Param} parameter should contain a constant lag parameter expressed as a velocity in m/s, parameters for the hydrological model are then shift one position to the right.
+}
\examples{
library(airGR)
@@ -41,13 +54,13 @@ library(airGR)
data(L0123001)
## preparation of the InputsModel object
-InputsModel <- CreateInputsModel(FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR,
+InputsModel <- CreateInputsModel(FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR,
Precip = BasinObs$P, PotEvap = BasinObs$E)
## run period selection
-Ind_Run <- seq(which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1990-01-01"),
+Ind_Run <- seq(which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1990-01-01"),
which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1999-12-31"))
-
+
## preparation of the RunOptions object
RunOptions <- CreateRunOptions(FUN_MOD = RunModel_GR4J,
InputsModel = InputsModel, IndPeriod_Run = Ind_Run)
@@ -55,14 +68,14 @@ RunOptions <- CreateRunOptions(FUN_MOD = RunModel_GR4J,
## simulation
Param <- c(X1 = 734.568, X2 = -0.840, X3 = 109.809, X4 = 1.971)
OutputsModel <- RunModel(InputsModel = InputsModel,
- RunOptions = RunOptions, Param = Param,
+ RunOptions = RunOptions, Param = Param,
FUN_MOD = RunModel_GR4J)
## results preview
plot(OutputsModel, Qobs = BasinObs$Qmm[Ind_Run])
## efficiency criterion: Nash-Sutcliffe Efficiency
-InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
+InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
RunOptions = RunOptions, Obs = BasinObs$Qmm[Ind_Run])
OutputsCrit <- ErrorCrit_NSE(InputsCrit = InputsCrit, OutputsModel = OutputsModel)
}
diff --git a/man/RunModel_CemaNeige.Rd b/man/RunModel_CemaNeige.Rd
index bdc6dcfc52f6fbfc92b921cfb41591def4a393df..2fc511d5641a82f178833e331779eb2b9cb2ff2a 100644
--- a/man/RunModel_CemaNeige.Rd
+++ b/man/RunModel_CemaNeige.Rd
@@ -24,34 +24,34 @@ RunModel_CemaNeige(InputsModel, RunOptions, Param)
\item{RunOptions}{[object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details}
\item{Param}{[numeric] vector of 2 (or 4 parameters if \code{IsHyst = TRUE}, see \code{\link{CreateRunOptions}} for details)
-\tabular{ll}{
-CemaNeige X1 \tab weighting coefficient for snow pack thermal state [-] \cr
-CemaNeige X2 \tab degree-day melt coefficient [mm/°C/time step] \cr
-CemaNeige X3 \tab (optional) accumulation threshold [mm] (needed if \code{IsHyst = TRUE}) \cr
-CemaNeige X4 \tab (optional) percentage (between 0 and 1) of annual snowfall defining the melt threshold [-] (needed if \code{IsHyst = TRUE}) \cr
-}}
+ \tabular{ll}{
+ CemaNeige X1 \tab weighting coefficient for snow pack thermal state [-] \cr
+ CemaNeige X2 \tab degree-day melt coefficient [mm/°C/time step] \cr
+ CemaNeige X3 \tab (optional) accumulation threshold [mm] (needed if \code{IsHyst = TRUE}) \cr
+ CemaNeige X4 \tab (optional) percentage (between 0 and 1) of annual snowfall defining the melt threshold [-] (needed if \code{IsHyst = TRUE}) \cr
+ }}
}
\value{
-[list] list containing the function outputs organised as follows:
- \tabular{ll}{
- \emph{$DatesR} \tab [POSIXlt] series of dates \cr
- \emph{$CemaNeigeLayers} \tab [list] list of CemaNeige outputs (1 list per layer) \cr
- \emph{$CemaNeigeLayers[[iLayer]]$Pliq } \tab [numeric] series of liquid precip. [mm/time step] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$Psol } \tab [numeric] series of solid precip. [mm/time step] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$SnowPack } \tab [numeric] series of snow pack [mm] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$ThermalState} \tab [numeric] series of snow pack thermal state [°C] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$Gratio } \tab [numeric] series of Gratio [0-1] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$PotMelt } \tab [numeric] series of potential snow melt [mm/time step] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$Melt } \tab [numeric] series of actual snow melt [mm/time step] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$PliqAndMelt } \tab [numeric] series of liquid precip. + actual snow melt [mm/time step] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$Temp } \tab [numeric] series of air temperature [°C] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$Gthreshold } \tab [numeric] series of melt threshold [mm] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$Glocalmax } \tab [numeric] series of local melt threshold for hysteresis [mm] \cr
- \emph{$StateEnd} \tab [numeric] states at the end of the run: CemaNeige states [mm & °C], \cr\tab see \code{\link{CreateIniStates}} for more details \cr
- }
- (refer to the provided references or to the package source code for further details on these model outputs)
+[list] containing the function outputs organised as follows:
+ \tabular{ll}{
+ \emph{$DatesR } \tab [POSIXlt] series of dates \cr
+ \emph{$CemaNeigeLayers} \tab [list] list of CemaNeige outputs (1 list per layer) \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$Pliq } \tab [numeric] series of liquid precip. [mm/time step] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$Psol } \tab [numeric] series of solid precip. [mm/time step] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$SnowPack } \tab [numeric] series of snow pack (snow water equivalent) [mm] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$ThermalState} \tab [numeric] series of snow pack thermal state [°C] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$Gratio } \tab [numeric] series of Gratio [0-1] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$PotMelt } \tab [numeric] series of potential snow melt [mm/time step] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$Melt } \tab [numeric] series of actual snow melt [mm/time step] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$PliqAndMelt } \tab [numeric] series of liquid precip. + actual snow melt [mm/time step] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$Temp } \tab [numeric] series of air temperature [°C] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$Gthreshold } \tab [numeric] series of melt threshold [mm] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$Glocalmax } \tab [numeric] series of local melt threshold for hysteresis [mm] \cr
+ \emph{$StateEnd} \tab [numeric] states at the end of the run: CemaNeige states [mm & °C]. See \code{\link{CreateIniStates}} for more details \cr
+ }
+Refer to the provided references or to the package source code for further details on these model outputs.
}
@@ -99,8 +99,8 @@ plot(OutputsModel)
## preparation of the RunOptions object
RunOptions <- CreateRunOptions(FUN_MOD = RunModel_CemaNeige, InputsModel = InputsModel,
IndPeriod_Run = Ind_Run, IsHyst = TRUE)
-
-## simulation
+
+## simulation
Param <- c(CNX1 = 0.962, CNX2 = 2.249, CNX3 = 100, CNX4 = 0.4)
OutputsModel <- RunModel_CemaNeige(InputsModel = InputsModel,
RunOptions = RunOptions, Param = Param)
@@ -116,15 +116,19 @@ Laurent Coron, Audrey Valéry, Vazken Andréassian, Olivier Delaigue, Guillaume
\references{
-Riboust, P., G. Thirel, N. Le Moine and P. Ribstein (2019),
- Revisiting a simple degree-day model for integrating satellite data: implementation of SWE-SCA hystereses.
- Journal of Hydrology and Hydromechanics, doi: 10.2478/johh-2018-0004, 67, 1, 70–81. \cr
-Valéry, A., V. Andréassian and C. Perrin (2014),
- "As simple as possible but not simpler": what is useful in a temperature-based snow-accounting routine?
- Part 1 - Comparison of six snow accounting routines on 380 catchments, Journal of Hydrology, doi: 10.1016/j.jhydrol.2014.04.059. \cr
-Valéry, A., V. Andréassian and C. Perrin (2014),
- "As simple as possible but not simpler": What is useful in a temperature-based snow-accounting routine?
- Part 2 - Sensitivity analysis of the Cemaneige snow accounting routine on 380 catchments, Journal of Hydrology, doi: 10.1016/j.jhydrol.2014.04.058.
+Riboust, P., Thirel, G., Le Moine, N. and Ribstein, P. (2019).
+ Revisiting a simple degree-day model for integrating satellite data: Implementation of SWE-SCA hystereses.
+ Journal of Hydrology and Hydromechanics, 67(1), 70–81, \doi{10.2478/johh-2018-0004}.
+\cr\cr
+Valéry, A., Andréassian, V. and Perrin, C. (2014).
+ "As simple as possible but not simpler": What is useful in a temperature-based snow-accounting routine?
+ Part 1 - Comparison of six snow accounting routines on 380 catchments.
+ Journal of Hydrology, 517(0), 1166-1175, \doi{10.1016/j.jhydrol.2014.04.059}.
+\cr\cr
+Valéry, A., Andréassian, V. and Perrin, C. (2014).
+ "As simple as possible but not simpler": What is useful in a temperature-based snow-accounting routine?
+ Part 2 - Sensitivity analysis of the Cemaneige snow accounting routine on 380 catchments.
+ Journal of Hydrology, 517(0), 1176-1187, \doi{10.1016/j.jhydrol.2014.04.058}.
}
diff --git a/man/RunModel_CemaNeigeGR4H.Rd b/man/RunModel_CemaNeigeGR4H.Rd
index 84789061435014966e98893569d28f7ee5a50a5e..7dbe52223adbac99b1419c6f246fbe48f1cded56 100644
--- a/man/RunModel_CemaNeigeGR4H.Rd
+++ b/man/RunModel_CemaNeigeGR4H.Rd
@@ -24,56 +24,56 @@ RunModel_CemaNeigeGR4H(InputsModel, RunOptions, Param)
\item{RunOptions}{[object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details}
\item{Param}{[numeric] vector of 6 (or 8 parameters if \code{IsHyst = TRUE}, see \code{\link{CreateRunOptions}} for details)
-\tabular{ll}{
-GR4H X1 \tab production store capacity [mm] \cr
-GR4H X2 \tab intercatchment exchange coefficient [mm/h] \cr
-GR4H X3 \tab routing store capacity [mm] \cr
-GR4H X4 \tab unit hydrograph time constant [h] \cr
-CemaNeige X1 \tab weighting coefficient for snow pack thermal state [-] \cr
-CemaNeige X2 \tab degree-hour melt coefficient [mm/°C/h] \cr
-CemaNeige X3 \tab (optional) accumulation threshold [mm] (needed if \code{IsHyst = TRUE}) \cr
-CemaNeige X4 \tab (optional) percentage (between 0 and 1) of annual snowfall defining the melt threshold [-] (needed if \code{IsHyst = TRUE}) \cr
-}}
+ \tabular{ll}{
+ GR4H X1 \tab production store capacity [mm] \cr
+ GR4H X2 \tab intercatchment exchange coefficient [mm/h] \cr
+ GR4H X3 \tab routing store capacity [mm] \cr
+ GR4H X4 \tab unit hydrograph time constant [h] \cr
+ CemaNeige X1 \tab weighting coefficient for snow pack thermal state [-] \cr
+ CemaNeige X2 \tab degree-hour melt coefficient [mm/°C/h] \cr
+ CemaNeige X3 \tab (optional) accumulation threshold [mm] (needed if \code{IsHyst = TRUE}) \cr
+ CemaNeige X4 \tab (optional) percentage (between 0 and 1) of annual snowfall defining the melt threshold [-] (needed if \code{IsHyst = TRUE}) \cr
+ }}
}
\value{
-[list] list containing the function outputs organised as follows:
- \tabular{ll}{
- \emph{$DatesR } \tab [POSIXlt] series of dates \cr
- \emph{$PotEvap } \tab [numeric] series of input potential evapotranspiration [mm/h] \cr
- \emph{$Precip } \tab [numeric] series of input total precipitation [mm/h] \cr
- \emph{$Prod } \tab [numeric] series of production store level [mm] \cr
- \emph{$Pn } \tab [numeric] series of net rainfall [mm/h] \cr
- \emph{$Ps } \tab [numeric] series of the part of Pn filling the production store [mm/h] \cr
- \emph{$AE } \tab [numeric] series of actual evapotranspiration [mm/h] \cr
- \emph{$Perc } \tab [numeric] series of percolation (PERC) [mm/h] \cr
- \emph{$PR } \tab [numeric] series of PR=Pn-Ps+Perc [mm/h] \cr
- \emph{$Q9 } \tab [numeric] series of UH1 outflow (Q9) [mm/h] \cr
- \emph{$Q1 } \tab [numeric] series of UH2 outflow (Q1) [mm/h] \cr
- \emph{$Rout } \tab [numeric] series of routing store level [mm] \cr
- \emph{$Exch } \tab [numeric] series of potential semi-exchange between catchments [mm/h] \cr
- \emph{$AExch1 } \tab [numeric] series of actual exchange between catchments for branch 1 [mm/h] \cr
- \emph{$AExch2 } \tab [numeric] series of actual exchange between catchments for branch 2 [mm/h] \cr
- \emph{$AExch } \tab [numeric] series of actual exchange between catchments (1+2) [mm/h] \cr
- \emph{$QR } \tab [numeric] series of routing store outflow (QR) [mm/h] \cr
- \emph{$QD } \tab [numeric] series of direct flow from UH2 after exchange (QD) [mm/h] \cr
- \emph{$Qsim } \tab [numeric] series of simulated discharge [mm/h] \cr
- \emph{$CemaNeigeLayers} \tab [list] list of CemaNeige outputs (1 list per layer) \cr
- \emph{$CemaNeigeLayers[[iLayer]]$Pliq } \tab [numeric] series of liquid precip. [mm/h] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$Psol } \tab [numeric] series of solid precip. [mm/h] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$SnowPack } \tab [numeric] series of snow pack [mm] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$ThermalState } \tab [numeric] series of snow pack thermal state [°C] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$Gratio } \tab [numeric] series of Gratio [0-1] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$PotMelt } \tab [numeric] series of potential snow melt [mm/h] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$Melt } \tab [numeric] series of actual snow melt [mm/h] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$PliqAndMelt } \tab [numeric] series of liquid precip. + actual snow melt [mm/h] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$Temp } \tab [numeric] series of air temperature [°C] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$Gthreshold } \tab [numeric] series of melt threshold [mm] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$Glocalmax } \tab [numeric] series of local melt threshold for hysteresis [mm] \cr
- \emph{$StateEnd} \tab [numeric] states at the end of the run: \cr\tab store & unit hydrographs levels [mm], CemaNeige states [mm & °C], \cr\tab see \code{\link{CreateIniStates}} for more details \cr
- }
- (refer to the provided references or to the package source code for further details on these model outputs)
+[list] containing the function outputs organised as follows:
+ \tabular{ll}{
+ \emph{$DatesR } \tab [POSIXlt] series of dates \cr
+ \emph{$PotEvap } \tab [numeric] series of input potential evapotranspiration (E) [mm/h] \cr
+ \emph{$Precip } \tab [numeric] series of input total precipitation (P) [mm/h] \cr
+ \emph{$Prod } \tab [numeric] series of production store level [mm] (S) \cr
+ \emph{$Pn } \tab [numeric] series of net rainfall (Pn) [mm/h] \cr
+ \emph{$Ps } \tab [numeric] series of the part of Pn filling the production store (Ps) [mm/h] \cr
+ \emph{$AE } \tab [numeric] series of actual evapotranspiration [mm/h] \cr
+ \emph{$Perc } \tab [numeric] series of percolation (Perc) [mm/h] \cr
+ \emph{$PR } \tab [numeric] series of Pr=Pn-Ps+Perc (Pr) [mm/h] \cr
+ \emph{$Q9 } \tab [numeric] series of UH1 outflow (Q9) [mm/h] \cr
+ \emph{$Q1 } \tab [numeric] series of UH2 outflow (Q1) [mm/h] \cr
+ \emph{$Rout } \tab [numeric] series of routing store level (R1) [mm] \cr
+ \emph{$Exch } \tab [numeric] series of potential semi-exchange between catchments [mm/h] \cr
+ \emph{$AExch1 } \tab [numeric] series of actual exchange between catchments for branch 1 [mm/h] \cr
+ \emph{$AExch2 } \tab [numeric] series of actual exchange between catchments for branch 2 [mm/h] \cr
+ \emph{$AExch } \tab [numeric] series of actual exchange between catchments (AExch1+AExch2) [mm/h] \cr
+ \emph{$QR } \tab [numeric] series of routing store outflow (Qr) [mm/h] \cr
+ \emph{$QD } \tab [numeric] series of direct flow from UH2 after exchange (Qd) [mm/h] \cr
+ \emph{$Qsim } \tab [numeric] series of simulated discharge (Q) [mm/h] \cr
+ \emph{$CemaNeigeLayers} \tab [list] list of CemaNeige outputs (1 list per layer) \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$Pliq } \tab [numeric] series of liquid precip. [mm/h] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$Psol } \tab [numeric] series of solid precip. [mm/h] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$SnowPack } \tab [numeric] series of snow pack (snow water equivalent)[mm] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$ThermalState} \tab [numeric] series of snow pack thermal state [°C] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$Gratio } \tab [numeric] series of Gratio [0-1] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$PotMelt } \tab [numeric] series of potential snow melt [mm/h] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$Melt } \tab [numeric] series of actual snow melt [mm/h] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$PliqAndMelt } \tab [numeric] series of liquid precip. + actual snow melt [mm/h] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$Temp } \tab [numeric] series of air temperature [°C] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$Gthreshold } \tab [numeric] series of melt threshold [mm] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$Glocalmax } \tab [numeric] series of local melt threshold for hysteresis [mm] \cr
+ \emph{$StateEnd} \tab [numeric] states at the end of the run: store & unit hydrographs levels [mm], CemaNeige states [mm & °C]. See \code{\link{CreateIniStates}} for more details \cr
+ }
+Refer to the provided references or to the package source code for further details on these model outputs.
}
@@ -83,6 +83,9 @@ It is advised to run the GR5H model with an interception store (see Ficchi et al
The choice of the CemaNeige version is explained in \code{\link{CreateRunOptions}}. \cr
For further details on the model, see the references section. \cr
For further details on the argument structures and initialisation options, see \code{\link{CreateRunOptions}}.
+\cr
+\cr
+See \code{\link{RunModel_GR4J}} to look at the diagram of the hydrological model.
}
@@ -95,20 +98,20 @@ data(U2345030)
## preparation of the InputsModel object
-InputsModel <- CreateInputsModel(FUN_MOD = RunModel_CemaNeigeGR4H, DatesR = BasinObs$DatesR,
- Precip = BasinObs$P, PotEvap = BasinObs$E, TempMean = BasinObs$T,
+InputsModel <- CreateInputsModel(FUN_MOD = RunModel_CemaNeigeGR4H, DatesR = BasinObs$DatesR,
+ Precip = BasinObs$P, PotEvap = BasinObs$E, TempMean = BasinObs$T,
ZInputs = BasinInfo$ZInputs,
HypsoData = BasinInfo$HypsoData, NLayers = 5)
## run period selection
-Ind_Run <- seq(which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d \%H:\%M")=="2004-03-01 00:00"),
+Ind_Run <- seq(which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d \%H:\%M")=="2004-03-01 00:00"),
which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d \%H:\%M")=="2008-12-31 23:00"))
## ---- original version of CemaNeige
## preparation of the RunOptions object
-RunOptions <- CreateRunOptions(FUN_MOD = RunModel_CemaNeigeGR4H, InputsModel = InputsModel,
+RunOptions <- CreateRunOptions(FUN_MOD = RunModel_CemaNeigeGR4H, InputsModel = InputsModel,
IndPeriod_Run = Ind_Run)
## simulation
@@ -121,7 +124,7 @@ OutputsModel <- RunModel_CemaNeigeGR4H(InputsModel = InputsModel,
plot(OutputsModel, Qobs = BasinObs$Qmm[Ind_Run])
## efficiency criterion: Nash-Sutcliffe Efficiency
-InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
+InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
RunOptions = RunOptions, Obs = BasinObs$Qmm[Ind_Run])
OutputsCrit <- ErrorCrit_NSE(InputsCrit = InputsCrit, OutputsModel = OutputsModel)
}
@@ -134,23 +137,29 @@ Laurent Coron, Claude Michel, Charles Perrin, Thibault Mathevet, Audrey Valéry,
\references{
-Perrin, C., C. Michel and V. Andréassian (2003).
- Improvement of a parsimonious model for streamflow simulation.
- Journal of Hydrology, 279(1-4), 275-289, doi: 10.1016/S0022-1694(03)00225-7.
+Mathevet, T. (2005).
+ Quels modèles pluie-débit globaux pour le pas de temps horaire ?
+ Développement empirique et comparaison de modèles sur un large échantillon de bassins versants.
+ PhD thesis (in French), ENGREF - Cemagref Antony, Paris, France.
\cr\cr
-Riboust, P., G. Thirel, N. Le Moine and P. Ribstein (2019).
- Revisiting a simple degree-day model for integrating satellite data: implementation of SWE-SCA hystereses.
- Journal of Hydrology and Hydromechanics. doi: 10.2478/johh-2018-0004, 67, 1, 70–81.
+Le Moine, N. (2008).
+ Le bassin versant de surface vu par le souterrain :
+ une voie d'amélioration des performances et du réalisme des modèles pluie-débit ?
+ PhD thesis (in French), UPMC - Cemagref Antony, Paris, France.
\cr\cr
-Valéry, A., V. Andréassian and C. Perrin (2014).
- "As simple as possible but not simpler": what is useful in a temperature-based snow-accounting routine?
- Part 1 - Comparison of six snow accounting routines on 380 catchments.
- Journal of Hydrology. doi: 10.1016/j.jhydrol.2014.04.059.
+Riboust, P., Thirel, G., Le Moine, N. and Ribstein, P. (2019).
+ Revisiting a simple degree-day model for integrating satellite data: Implementation of SWE-SCA hystereses.
+ Journal of Hydrology and Hydromechanics, 67(1), 70–81, \doi{10.2478/johh-2018-0004}.
\cr\cr
-Valéry, A., V. Andréassian and C. Perrin (2014).
- "As simple as possible but not simpler": What is useful in a temperature-based snow-accounting routine?
- Part 2 - Sensitivity analysis of the Cemaneige snow accounting routine on 380 catchments.
- Journal of Hydrology. doi: 10.1016/j.jhydrol.2014.04.058.
+Valéry, A., Andréassian, V. and Perrin, C. (2014).
+ "As simple as possible but not simpler": What is useful in a temperature-based snow-accounting routine?
+ Part 1 - Comparison of six snow accounting routines on 380 catchments.
+ Journal of Hydrology, 517(0), 1166-1175, \doi{10.1016/j.jhydrol.2014.04.059}.
+\cr\cr
+Valéry, A., Andréassian, V. and Perrin, C. (2014).
+ "As simple as possible but not simpler": What is useful in a temperature-based snow-accounting routine?
+ Part 2 - Sensitivity analysis of the Cemaneige snow accounting routine on 380 catchments.
+ Journal of Hydrology, 517(0), 1176-1187, \doi{10.1016/j.jhydrol.2014.04.058}.
}
diff --git a/man/RunModel_CemaNeigeGR4J.Rd b/man/RunModel_CemaNeigeGR4J.Rd
index ef69110b869144fa742f79de1c441d8e4fb05128..fcc1cbd58aa25c056a657c643367f0911f9fe77c 100644
--- a/man/RunModel_CemaNeigeGR4J.Rd
+++ b/man/RunModel_CemaNeigeGR4J.Rd
@@ -24,56 +24,56 @@ RunModel_CemaNeigeGR4J(InputsModel, RunOptions, Param)
\item{RunOptions}{[object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details}
\item{Param}{[numeric] vector of 6 (or 8 parameters if \code{IsHyst = TRUE}, see \code{\link{CreateRunOptions}} for details)
-\tabular{ll}{
-GR4J X1 \tab production store capacity [mm] \cr
-GR4J X2 \tab intercatchment exchange coefficient [mm/d] \cr
-GR4J X3 \tab routing store capacity [mm] \cr
-GR4J X4 \tab unit hydrograph time constant [d] \cr
-CemaNeige X1 \tab weighting coefficient for snow pack thermal state [-] \cr
-CemaNeige X2 \tab degree-day melt coefficient [mm/°C/d] \cr
-CemaNeige X3 \tab (optional) accumulation threshold [mm] (needed if \code{IsHyst = TRUE}) \cr
-CemaNeige X4 \tab (optional) percentage (between 0 and 1) of annual snowfall defining the melt threshold [-] (needed if \code{IsHyst = TRUE}) \cr
-}}
+ \tabular{ll}{
+ GR4J X1 \tab production store capacity [mm] \cr
+ GR4J X2 \tab intercatchment exchange coefficient [mm/d] \cr
+ GR4J X3 \tab routing store capacity [mm] \cr
+ GR4J X4 \tab unit hydrograph time constant [d] \cr
+ CemaNeige X1 \tab weighting coefficient for snow pack thermal state [-] \cr
+ CemaNeige X2 \tab degree-day melt coefficient [mm/°C/d] \cr
+ CemaNeige X3 \tab (optional) accumulation threshold [mm] (needed if \code{IsHyst = TRUE}) \cr
+ CemaNeige X4 \tab (optional) percentage (between 0 and 1) of annual snowfall defining the melt threshold [-] (needed if \code{IsHyst = TRUE}) \cr
+ }}
}
\value{
-[list] list containing the function outputs organised as follows:
- \tabular{ll}{
- \emph{$DatesR } \tab [POSIXlt] series of dates \cr
- \emph{$PotEvap } \tab [numeric] series of input potential evapotranspiration [mm/d] \cr
- \emph{$Precip } \tab [numeric] series of input total precipitation [mm/d] \cr
- \emph{$Prod } \tab [numeric] series of production store level [mm] \cr
- \emph{$Pn } \tab [numeric] series of net rainfall [mm/d] \cr
- \emph{$Ps } \tab [numeric] series of the part of Pn filling the production store [mm/d] \cr
- \emph{$AE } \tab [numeric] series of actual evapotranspiration [mm/d] \cr
- \emph{$Perc } \tab [numeric] series of percolation (PERC) [mm/d] \cr
- \emph{$PR } \tab [numeric] series of PR=Pn-Ps+Perc [mm/d] \cr
- \emph{$Q9 } \tab [numeric] series of UH1 outflow (Q9) [mm/d] \cr
- \emph{$Q1 } \tab [numeric] series of UH2 outflow (Q1) [mm/d] \cr
- \emph{$Rout } \tab [numeric] series of routing store level [mm] \cr
- \emph{$Exch } \tab [numeric] series of potential semi-exchange between catchments [mm/d] \cr
- \emph{$AExch1 } \tab [numeric] series of actual exchange between catchments for branch 1 [mm/d] \cr
- \emph{$AExch2 } \tab [numeric] series of actual exchange between catchments for branch 2 [mm/d] \cr
- \emph{$AExch } \tab [numeric] series of actual exchange between catchments (1+2) [mm/d] \cr
- \emph{$QR } \tab [numeric] series of routing store outflow (QR) [mm/d] \cr
- \emph{$QD } \tab [numeric] series of direct flow from UH2 after exchange (QD) [mm/d] \cr
- \emph{$Qsim } \tab [numeric] series of simulated discharge [mm/d] \cr
- \emph{$CemaNeigeLayers} \tab [list] list of CemaNeige outputs (1 list per layer) \cr
- \emph{$CemaNeigeLayers[[iLayer]]$Pliq } \tab [numeric] series of liquid precip. [mm/d] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$Psol } \tab [numeric] series of solid precip. [mm/d] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$SnowPack } \tab [numeric] series of snow pack [mm] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$ThermalState } \tab [numeric] series of snow pack thermal state [°C] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$Gratio } \tab [numeric] series of Gratio [0-1] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$PotMelt } \tab [numeric] series of potential snow melt [mm/d] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$Melt } \tab [numeric] series of actual snow melt [mm/d] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$PliqAndMelt } \tab [numeric] series of liquid precip. + actual snow melt [mm/d] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$Temp } \tab [numeric] series of air temperature [°C] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$Gthreshold } \tab [numeric] series of melt threshold [mm] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$Glocalmax } \tab [numeric] series of local melt threshold for hysteresis [mm] \cr
- \emph{$StateEnd} \tab [numeric] states at the end of the run: \cr\tab store & unit hydrographs levels [mm], CemaNeige states [mm & °C], \cr\tab see \code{\link{CreateIniStates}} for more details \cr
- }
- (refer to the provided references or to the package source code for further details on these model outputs)
+[list] containing the function outputs organised as follows:
+ \tabular{ll}{
+ \emph{$DatesR } \tab [POSIXlt] series of dates \cr
+ \emph{$PotEvap } \tab [numeric] series of input potential evapotranspiration [mm/d] (E) \cr
+ \emph{$Precip } \tab [numeric] series of input total precipitation (P) [mm/d] \cr
+ \emph{$Prod } \tab [numeric] series of production store level (S) [mm] \cr
+ \emph{$Pn } \tab [numeric] series of net rainfall (Pn) [mm/d] \cr
+ \emph{$Ps } \tab [numeric] series of the part of Pn filling the production store (Ps) [mm/d] \cr
+ \emph{$AE } \tab [numeric] series of actual evapotranspiration [mm/d] \cr
+ \emph{$Perc } \tab [numeric] series of percolation (Perc) [mm/d] \cr
+ \emph{$PR } \tab [numeric] series of Pr=Pn-Ps+Perc (Pr) [mm/d] \cr
+ \emph{$Q9 } \tab [numeric] series of UH1 outflow (Q9) [mm/d] \cr
+ \emph{$Q1 } \tab [numeric] series of UH2 outflow (Q1) [mm/d] \cr
+ \emph{$Rout } \tab [numeric] series of routing store level (R1) [mm] \cr
+ \emph{$Exch } \tab [numeric] series of potential semi-exchange between catchments [mm/d] \cr
+ \emph{$AExch1 } \tab [numeric] series of actual exchange between catchments for branch 1 [mm/d] \cr
+ \emph{$AExch2 } \tab [numeric] series of actual exchange between catchments for branch 2 [mm/d] \cr
+ \emph{$AExch } \tab [numeric] series of actual exchange between catchments (1+2) [mm/d] \cr
+ \emph{$QR } \tab [numeric] series of routing store outflow (Qr) [mm/d] \cr
+ \emph{$QD } \tab [numeric] series of direct flow from UH2 after exchange (Qd) [mm/d] \cr
+ \emph{$Qsim } \tab [numeric] series of simulated discharge (Q) [mm/d] \cr
+ \emph{$CemaNeigeLayers} \tab [list] list of CemaNeige outputs (1 list per layer) \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$Pliq } \tab [numeric] series of liquid precip. [mm/d] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$Psol } \tab [numeric] series of solid precip. [mm/d] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$SnowPack } \tab [numeric] series of snow pack (snow water equivalent) [mm] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$ThermalState } \tab [numeric] series of snow pack thermal state [°C] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$Gratio } \tab [numeric] series of Gratio [0-1] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$PotMelt } \tab [numeric] series of potential snow melt [mm/d] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$Melt } \tab [numeric] series of actual snow melt [mm/d] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$PliqAndMelt } \tab [numeric] series of liquid precip. + actual snow melt [mm/d] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$Temp } \tab [numeric] series of air temperature [°C] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$Gthreshold } \tab [numeric] series of melt threshold [mm] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$Glocalmax } \tab [numeric] series of local melt threshold for hysteresis [mm] \cr
+ \emph{$StateEnd} \tab [numeric] states at the end of the run: store & unit hydrographs levels [mm], CemaNeige states [mm & °C]. See \code{\link{CreateIniStates}} for more details \cr
+ }
+Refer to the provided references or to the package source code for further details on these model outputs.
}
@@ -81,6 +81,9 @@ CemaNeige X4 \tab (optional) percentage (between 0 and 1) of annual snowfall def
The choice of the CemaNeige version is explained in \code{\link{CreateRunOptions}}. \cr
For further details on the model, see the references section. \cr
For further details on the argument structures and initialisation options, see \code{\link{CreateRunOptions}}.
+\cr
+\cr
+See \code{\link{RunModel_GR4J}} to look at the diagram of the hydrological model.
}
@@ -91,20 +94,20 @@ library(airGR)
data(L0123002)
## preparation of the InputsModel object
-InputsModel <- CreateInputsModel(FUN_MOD = RunModel_CemaNeigeGR4J, DatesR = BasinObs$DatesR,
- Precip = BasinObs$P, PotEvap = BasinObs$E, TempMean = BasinObs$T,
+InputsModel <- CreateInputsModel(FUN_MOD = RunModel_CemaNeigeGR4J, DatesR = BasinObs$DatesR,
+ Precip = BasinObs$P, PotEvap = BasinObs$E, TempMean = BasinObs$T,
ZInputs = median(BasinInfo$HypsoData),
HypsoData = BasinInfo$HypsoData, NLayers = 5)
## run period selection
-Ind_Run <- seq(which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1990-01-01"),
+Ind_Run <- seq(which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1990-01-01"),
which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1999-12-31"))
## ---- original version of CemaNeige
## preparation of the RunOptions object
-RunOptions <- CreateRunOptions(FUN_MOD = RunModel_CemaNeigeGR4J, InputsModel = InputsModel,
+RunOptions <- CreateRunOptions(FUN_MOD = RunModel_CemaNeigeGR4J, InputsModel = InputsModel,
IndPeriod_Run = Ind_Run)
## simulation
@@ -117,7 +120,7 @@ OutputsModel <- RunModel_CemaNeigeGR4J(InputsModel = InputsModel,
plot(OutputsModel, Qobs = BasinObs$Qmm[Ind_Run])
## efficiency criterion: Nash-Sutcliffe Efficiency
-InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
+InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
RunOptions = RunOptions, Obs = BasinObs$Qmm[Ind_Run])
OutputsCrit <- ErrorCrit_NSE(InputsCrit = InputsCrit, OutputsModel = OutputsModel)
@@ -125,10 +128,10 @@ OutputsCrit <- ErrorCrit_NSE(InputsCrit = InputsCrit, OutputsModel = OutputsMode
## ---- version of CemaNeige with the Linear Hysteresis
## preparation of the RunOptions object
-RunOptions <- CreateRunOptions(FUN_MOD = RunModel_CemaNeigeGR4J, InputsModel = InputsModel,
+RunOptions <- CreateRunOptions(FUN_MOD = RunModel_CemaNeigeGR4J, InputsModel = InputsModel,
IndPeriod_Run = Ind_Run, IsHyst = TRUE)
-## simulation
+## simulation
Param <- c(X1 = 408.774, X2 = 2.646, X3 = 131.264, X4 = 1.174,
CNX1 = 0.962, CNX2 = 2.249, CNX3 = 100, CNX4 = 0.4)
OutputsModel <- RunModel_CemaNeigeGR4J(InputsModel = InputsModel,
@@ -138,7 +141,7 @@ OutputsModel <- RunModel_CemaNeigeGR4J(InputsModel = InputsModel,
plot(OutputsModel, Qobs = BasinObs$Qmm[Ind_Run])
## efficiency criterion: Nash-Sutcliffe Efficiency
-InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
+InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
RunOptions = RunOptions, Obs = BasinObs$Qmm[Ind_Run])
OutputsCrit <- ErrorCrit_NSE(InputsCrit = InputsCrit, OutputsModel = OutputsModel)
}
@@ -150,23 +153,23 @@ Laurent Coron, Claude Michel, Charles Perrin, Audrey Valéry, Vazken Andréassia
\references{
-Perrin, C., C. Michel and V. Andréassian (2003).
- Improvement of a parsimonious model for streamflow simulation.
- Journal of Hydrology, 279(1-4), 275-289, doi: 10.1016/S0022-1694(03)00225-7.
+Perrin, C., Michel, C. and Andréassian, V. (2003).
+ Improvement of a parsimonious model for streamflow simulation.
+ Journal of Hydrology, 279(1-4), 275-289, \doi{10.1016/S0022-1694(03)00225-7}.
\cr\cr
-Riboust, P., G. Thirel, N. Le Moine and P. Ribstein (2019).
- Revisiting a simple degree-day model for integrating satellite data: implementation of SWE-SCA hystereses.
- Journal of Hydrology and Hydromechanics. doi: 10.2478/johh-2018-0004, 67, 1, 70–81.
+Riboust, P., Thirel, G., Le Moine, N. and Ribstein, P. (2019).
+ Revisiting a simple degree-day model for integrating satellite data: Implementation of SWE-SCA hystereses.
+ Journal of Hydrology and Hydromechanics, 67(1), 70–81, \doi{10.2478/johh-2018-0004}.
\cr\cr
-Valéry, A., V. Andréassian and C. Perrin (2014).
- "As simple as possible but not simpler": what is useful in a temperature-based snow-accounting routine?
- Part 1 - Comparison of six snow accounting routines on 380 catchments.
- Journal of Hydrology. doi: 10.1016/j.jhydrol.2014.04.059.
+Valéry, A., Andréassian, V. and Perrin, C. (2014).
+ "As simple as possible but not simpler": What is useful in a temperature-based snow-accounting routine?
+ Part 1 - Comparison of six snow accounting routines on 380 catchments.
+ Journal of Hydrology, 517(0), 1166-1175, \doi{10.1016/j.jhydrol.2014.04.059}.
\cr\cr
-Valéry, A., V. Andréassian and C. Perrin (2014).
- "As simple as possible but not simpler": What is useful in a temperature-based snow-accounting routine?
- Part 2 - Sensitivity analysis of the Cemaneige snow accounting routine on 380 catchments.
- Journal of Hydrology. doi: 10.1016/j.jhydrol.2014.04.058.
+Valéry, A., Andréassian, V. and Perrin, C. (2014).
+ "As simple as possible but not simpler": What is useful in a temperature-based snow-accounting routine?
+ Part 2 - Sensitivity analysis of the Cemaneige snow accounting routine on 380 catchments.
+ Journal of Hydrology, 517(0), 1176-1187, \doi{10.1016/j.jhydrol.2014.04.058}.
}
diff --git a/man/RunModel_CemaNeigeGR5H.Rd b/man/RunModel_CemaNeigeGR5H.Rd
index 7f7f8585cfcb1713210b2048037339a945e08505..88ab4c2eabd0e281ebb5eaa4b2078c93243bef85 100644
--- a/man/RunModel_CemaNeigeGR5H.Rd
+++ b/man/RunModel_CemaNeigeGR5H.Rd
@@ -24,59 +24,59 @@ RunModel_CemaNeigeGR5H(InputsModel, RunOptions, Param)
\item{RunOptions}{[object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details}
\item{Param}{[numeric] vector of 7 (or 9 parameters if \code{IsHyst = TRUE}, see \code{\link{CreateRunOptions}} for details)
-\tabular{ll}{
-GR5H X1 \tab production store capacity [mm] \cr
-GR5H X2 \tab intercatchment exchange coefficient [mm/h] \cr
-GR5H X3 \tab routing store capacity [mm] \cr
-GR5H X4 \tab unit hydrograph time constant [h] \cr
-GR5H X5 \tab intercatchment exchange threshold [-] \cr
-CemaNeige X1 \tab weighting coefficient for snow pack thermal state [-] \cr
-CemaNeige X2 \tab degree-hour melt coefficient [mm/°C/h] \cr
-CemaNeige X3 \tab (optional) accumulation threshold [mm] (needed if \code{IsHyst = TRUE}) \cr
-CemaNeige X4 \tab (optional) percentage (between 0 and 1) of annual snowfall defining the melt threshold [-] (needed if \code{IsHyst = TRUE}) \cr
-}}
+ \tabular{ll}{
+ GR5H X1 \tab production store capacity [mm] \cr
+ GR5H X2 \tab intercatchment exchange coefficient [mm/h] \cr
+ GR5H X3 \tab routing store capacity [mm] \cr
+ GR5H X4 \tab unit hydrograph time constant [h] \cr
+ GR5H X5 \tab intercatchment exchange threshold [-] \cr
+ CemaNeige X1 \tab weighting coefficient for snow pack thermal state [-] \cr
+ CemaNeige X2 \tab degree-hour melt coefficient [mm/°C/h] \cr
+ CemaNeige X3 \tab (optional) accumulation threshold [mm] (needed if \code{IsHyst = TRUE}) \cr
+ CemaNeige X4 \tab (optional) percentage (between 0 and 1) of annual snowfall defining the melt threshold [-] (needed if \code{IsHyst = TRUE}) \cr
+ }}
}
\value{
-[list] list containing the function outputs organised as follows:
- \tabular{ll}{
- \emph{$DatesR } \tab [POSIXlt] series of dates \cr
- \emph{$PotEvap } \tab [numeric] series of input potential evapotranspiration [mm/h] \cr
- \emph{$Precip } \tab [numeric] series of input total precipitation [mm/h] \cr
- \emph{$Interc } \tab [numeric] series of interception store level [mm] \cr
- \emph{$Prod } \tab [numeric] series of production store level [mm] \cr
- \emph{$Pn } \tab [numeric] series of net rainfall [mm/h] \cr
- \emph{$Ps } \tab [numeric] series of the part of Pn filling the production store [mm/h] \cr
- \emph{$AE } \tab [numeric] series of actual evapotranspiration [mm/h] \cr
- \emph{$EI } \tab [numeric] series of evapotranspiration from rainfall neutralisation or interception store [mm/h] \cr
- \emph{$ES } \tab [numeric] series of evapotranspiration from production store [mm/h] \cr
- \emph{$Perc } \tab [numeric] series of percolation (PERC) [mm/h] \cr
- \emph{$PR } \tab [numeric] series of PR=Pn-Ps+Perc [mm/h] \cr
- \emph{$Q9 } \tab [numeric] series of UH1 outflow (Q9) [mm/h] \cr
- \emph{$Q1 } \tab [numeric] series of UH2 outflow (Q1) [mm/h] \cr
- \emph{$Rout } \tab [numeric] series of routing store level [mm] \cr
- \emph{$Exch } \tab [numeric] series of potential semi-exchange between catchments [mm/h] \cr
- \emph{$AExch1 } \tab [numeric] series of actual exchange between catchments for branch 1 [mm/h] \cr
- \emph{$AExch2 } \tab [numeric] series of actual exchange between catchments for branch 2 [mm/h] \cr
- \emph{$AExch } \tab [numeric] series of actual exchange between catchments (1+2) [mm/h] \cr
- \emph{$QR } \tab [numeric] series of routing store outflow (QR) [mm/h] \cr
- \emph{$QD } \tab [numeric] series of direct flow from UH2 after exchange (QD) [mm/h] \cr
- \emph{$Qsim } \tab [numeric] series of simulated discharge [mm/h] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$Pliq } \tab [numeric] series of liquid precip. [mm/h] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$Psol } \tab [numeric] series of solid precip. [mm/h] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$SnowPack } \tab [numeric] series of snow pack [mm] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$ThermalState } \tab [numeric] series of snow pack thermal state [°C] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$Gratio } \tab [numeric] series of Gratio [0-1] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$PotMelt } \tab [numeric] series of potential snow melt [mm/h] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$Melt } \tab [numeric] series of actual snow melt [mm/h] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$PliqAndMelt } \tab [numeric] series of liquid precip. + actual snow melt [mm/h] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$Temp } \tab [numeric] series of air temperature [°C] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$Gthreshold } \tab [numeric] series of melt threshold [mm] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$Glocalmax } \tab [numeric] series of local melt threshold for hysteresis [mm] \cr
- \emph{$StateEnd} \tab [numeric] states at the end of the run: \cr\tab store & unit hydrographs levels [mm], CemaNeige states [mm & °C], \cr\tab see \code{\link{CreateIniStates}} for more details \cr
- }
- (refer to the provided references or to the package source code for further details on these model outputs)
+[list] containing the function outputs organised as follows:
+ \tabular{ll}{
+ \emph{$DatesR } \tab [POSIXlt] series of dates \cr
+ \emph{$PotEvap } \tab [numeric] series of input potential evapotranspiration (E) [mm/h] \cr
+ \emph{$Precip } \tab [numeric] series of input total precipitation (P) [mm/h] \cr
+ \emph{$Interc } \tab [numeric] series of interception store level (I) [mm] \cr
+ \emph{$Prod } \tab [numeric] series of production store level (S) [mm] \cr
+ \emph{$Pn } \tab [numeric] series of net rainfall (Pn) [mm/h] \cr
+ \emph{$Ps } \tab [numeric] series of the part of Pn filling the production store (Ps) [mm/h] \cr
+ \emph{$AE } \tab [numeric] series of actual evapotranspiration (Ei+Es) [mm/h] \cr
+ \emph{$EI } \tab [numeric] series of evapotranspiration from rainfall neutralisation or interception store (Ei) [mm/h] \cr
+ \emph{$ES } \tab [numeric] series of evapotranspiration from production store (Es) [mm/h] \cr
+ \emph{$Perc } \tab [numeric] series of percolation (Perc) [mm/h] \cr
+ \emph{$PR } \tab [numeric] series of Pr=Pn-Ps+Perc (Pr) [mm/h] \cr
+ \emph{$Q9 } \tab [numeric] series of UH outflow going into branch 9 (Q9) [mm/h] \cr
+ \emph{$Q1 } \tab [numeric] series of UH outflow going into branch 1 (Q1) [mm/h] \cr
+ \emph{$Rout } \tab [numeric] series of routing store level (R1) [mm] \cr
+ \emph{$Exch } \tab [numeric] series of potential semi-exchange between catchments [mm/h] \cr
+ \emph{$AExch1 } \tab [numeric] series of actual exchange between catchments for branch 1 [mm/h] \cr
+ \emph{$AExch2 } \tab [numeric] series of actual exchange between catchments for branch 2 [mm/h] \cr
+ \emph{$AExch } \tab [numeric] series of actual exchange between catchments (AExch1+AExch2) [mm/h] \cr
+ \emph{$QR } \tab [numeric] series of routing store outflow (Qr) [mm/h] \cr
+ \emph{$QD } \tab [numeric] series of direct flow from UH after exchange (Qd) [mm/h] \cr
+ \emph{$Qsim } \tab [numeric] series of simulated discharge (Q) [mm/h] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$Pliq } \tab [numeric] series of liquid precip. [mm/h] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$Psol } \tab [numeric] series of solid precip. [mm/h] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$SnowPack } \tab [numeric] series of snow pack (snow water equivalent) [mm] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$ThermalState } \tab [numeric] series of snow pack thermal state [°C] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$Gratio } \tab [numeric] series of Gratio [0-1] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$PotMelt } \tab [numeric] series of potential snow melt [mm/h] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$Melt } \tab [numeric] series of actual snow melt [mm/h] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$PliqAndMelt } \tab [numeric] series of liquid precip. + actual snow melt [mm/h] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$Temp } \tab [numeric] series of air temperature [°C] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$Gthreshold } \tab [numeric] series of melt threshold [mm] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$Glocalmax } \tab [numeric] series of local melt threshold for hysteresis [mm] \cr
+ \emph{$StateEnd} \tab [numeric] states at the end of the run: store & unit hydrographs levels [mm], CemaNeige states [mm & °C]. See \code{\link{CreateIniStates}} for more details \cr
+ }
+Refer to the provided references or to the package source code for further details on these model outputs.
}
@@ -84,6 +84,9 @@ CemaNeige X4 \tab (optional) percentage (between 0 and 1) of annual snowfall def
The choice of the CemaNeige version is explained in \code{\link{CreateRunOptions}}. \cr
For further details on the model, see the references section. \cr
For further details on the argument structures and initialisation options, see \code{\link{CreateRunOptions}}.
+\cr
+\cr
+See \code{\link{RunModel_GR5H}} to look at the diagram of the hydrological model.
}
@@ -96,13 +99,13 @@ data(U2345030)
## preparation of the InputsModel object
-InputsModel <- CreateInputsModel(FUN_MOD = RunModel_CemaNeigeGR5H, DatesR = BasinObs$DatesR,
- Precip = BasinObs$P, PotEvap = BasinObs$E, TempMean = BasinObs$T,
+InputsModel <- CreateInputsModel(FUN_MOD = RunModel_CemaNeigeGR5H, DatesR = BasinObs$DatesR,
+ Precip = BasinObs$P, PotEvap = BasinObs$E, TempMean = BasinObs$T,
ZInputs = BasinInfo$ZInputs,
HypsoData = BasinInfo$HypsoData, NLayers = 5)
## run period selection
-Ind_Run <- seq(which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d \%H:\%M")=="2004-03-01 00:00"),
+Ind_Run <- seq(which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d \%H:\%M")=="2004-03-01 00:00"),
which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d \%H:\%M")=="2008-12-31 23:00"))
@@ -113,7 +116,7 @@ Imax <- Imax(InputsModel = InputsModel, IndPeriod_Run = Ind_Run,
TestedValues = seq(from = 0, to = 3, by = 0.2))
## preparation of the RunOptions object
-RunOptions <- CreateRunOptions(FUN_MOD = RunModel_CemaNeigeGR5H, InputsModel = InputsModel,
+RunOptions <- CreateRunOptions(FUN_MOD = RunModel_CemaNeigeGR5H, InputsModel = InputsModel,
Imax = Imax, IndPeriod_Run = Ind_Run)
## simulation
@@ -126,7 +129,7 @@ OutputsModel <- RunModel_CemaNeigeGR5H(InputsModel = InputsModel,
plot(OutputsModel, Qobs = BasinObs$Qmm[Ind_Run])
## efficiency criterion: Nash-Sutcliffe Efficiency
-InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
+InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
RunOptions = RunOptions, Obs = BasinObs$Qmm[Ind_Run])
OutputsCrit <- ErrorCrit_NSE(InputsCrit = InputsCrit, OutputsModel = OutputsModel)
}
@@ -142,29 +145,29 @@ Laurent Coron, Guillaume Thirel, Olivier Delaigue, Audrey Valéry, Vazken André
Ficchi, A. (2017).
An adaptive hydrological model for multiple time-steps:
Diagnostics and improvements based on fluxes consistency.
- PhD thesis, Irstea (Antony), GRNE (Paris), France.
+ PhD thesis, UPMC - Irstea Antony, Paris, France.
\cr\cr
-Ficchi, A., C. Perrin and V. Andréassian (2019).
+Ficchi, A., Perrin, C. and Andréassian, V. (2019).
Hydrological modelling at multiple sub-daily time steps: model improvement via flux-matching.
- Journal of Hydrology, 575, 1308-1327. doi: 10.1016/j.jhydrol.2019.05.084.
+ Journal of Hydrology, 575, 1308-1327, \doi{10.1016/j.jhydrol.2019.05.084}.
\cr\cr
-Perrin, C., C. Michel and V. Andréassian (2003).
- Improvement of a parsimonious model for streamflow simulation.
- Journal of Hydrology, 279(1-4), 275-289, doi: 10.1016/S0022-1694(03)00225-7.
+Perrin, C., Michel, C. and Andréassian, V. (2003).
+ Improvement of a parsimonious model for streamflow simulation.
+ Journal of Hydrology, 279(1-4), 275-289, \doi{10.1016/S0022-1694(03)00225-7}.
\cr\cr
-Riboust, P., G. Thirel, N. Le Moine and P. Ribstein (2019).
- Revisiting a simple degree-day model for integrating satellite data: implementation of SWE-SCA hystereses.
- Journal of Hydrology and Hydromechanics. doi: 10.2478/johh-2018-0004, 67, 1, 70–81.
+Riboust, P., Thirel, G., Le Moine, N. and Ribstein, P. (2019).
+ Revisiting a simple degree-day model for integrating satellite data: Implementation of SWE-SCA hystereses.
+ Journal of Hydrology and Hydromechanics, 67(1), 70–81, \doi{10.2478/johh-2018-0004}.
\cr\cr
-Valéry, A., V. Andréassian and C. Perrin (2014).
- "As simple as possible but not simpler": what is useful in a temperature-based snow-accounting routine?
- Part 1 - Comparison of six snow accounting routines on 380 catchments.
- Journal of Hydrology. doi: 10.1016/j.jhydrol.2014.04.059.
+Valéry, A., Andréassian, V. and Perrin, C. (2014).
+ "As simple as possible but not simpler": What is useful in a temperature-based snow-accounting routine?
+ Part 1 - Comparison of six snow accounting routines on 380 catchments.
+ Journal of Hydrology, 517(0), 1166-1175, \doi{10.1016/j.jhydrol.2014.04.059}.
\cr\cr
-Valéry, A., V. Andréassian and C. Perrin (2014).
- "As simple as possible but not simpler": What is useful in a temperature-based snow-accounting routine?
- Part 2 - Sensitivity analysis of the Cemaneige snow accounting routine on 380 catchments.
- Journal of Hydrology. doi: 10.1016/j.jhydrol.2014.04.058.
+Valéry, A., Andréassian, V. and Perrin, C. (2014).
+ "As simple as possible but not simpler": What is useful in a temperature-based snow-accounting routine?
+ Part 2 - Sensitivity analysis of the Cemaneige snow accounting routine on 380 catchments.
+ Journal of Hydrology, 517(0), 1176-1187, \doi{10.1016/j.jhydrol.2014.04.058}.
}
diff --git a/man/RunModel_CemaNeigeGR5J.Rd b/man/RunModel_CemaNeigeGR5J.Rd
index d20d109b799cef2bd24a79a2a996ea0e29028788..4f2b77c50e6321acbd25936b86828bbd030dfa52 100644
--- a/man/RunModel_CemaNeigeGR5J.Rd
+++ b/man/RunModel_CemaNeigeGR5J.Rd
@@ -24,57 +24,57 @@ RunModel_CemaNeigeGR5J(InputsModel, RunOptions, Param)
\item{RunOptions}{[object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details}
\item{Param}{[numeric] vector of 7 (or 9 parameters if \code{IsHyst = TRUE}, see \code{\link{CreateRunOptions}} for details)
-\tabular{ll}{
-GR5J X1 \tab production store capacity [mm] \cr
-GR5J X2 \tab intercatchment exchange coefficient [mm/d] \cr
-GR5J X3 \tab routing store capacity [mm] \cr
-GR5J X4 \tab unit hydrograph time constant [d] \cr
-GR5J X5 \tab intercatchment exchange threshold [-] \cr
-CemaNeige X1 \tab weighting coefficient for snow pack thermal state [-] \cr
-CemaNeige X2 \tab degree-day melt coefficient [mm/°C/d] \cr
-CemaNeige X3 \tab (optional) accumulation threshold [mm] (needed if \code{IsHyst = TRUE}) \cr
-CemaNeige X4 \tab (optional) percentage (between 0 and 1) of annual snowfall defining the melt threshold [-] (needed if \code{IsHyst = TRUE}) \cr
-}}
+ \tabular{ll}{
+ GR5J X1 \tab production store capacity [mm] \cr
+ GR5J X2 \tab intercatchment exchange coefficient [mm/d] \cr
+ GR5J X3 \tab routing store capacity [mm] \cr
+ GR5J X4 \tab unit hydrograph time constant [d] \cr
+ GR5J X5 \tab intercatchment exchange threshold [-] \cr
+ CemaNeige X1 \tab weighting coefficient for snow pack thermal state [-] \cr
+ CemaNeige X2 \tab degree-day melt coefficient [mm/°C/d] \cr
+ CemaNeige X3 \tab (optional) accumulation threshold [mm] (needed if \code{IsHyst = TRUE}) \cr
+ CemaNeige X4 \tab (optional) percentage (between 0 and 1) of annual snowfall defining the melt threshold [-] (needed if \code{IsHyst = TRUE}) \cr
+ }}
}
\value{
-[list] list containing the function outputs organised as follows:
- \tabular{ll}{
- \emph{$DatesR } \tab [POSIXlt] series of dates \cr
- \emph{$PotEvap } \tab [numeric] series of input potential evapotranspiration [mm/d] \cr
- \emph{$Precip } \tab [numeric] series of input total precipitation [mm/d] \cr
- \emph{$Prod } \tab [numeric] series of production store level [mm] \cr
- \emph{$Pn } \tab [numeric] series of net rainfall [mm/d] \cr
- \emph{$Ps } \tab [numeric] series of the part of Pn filling the production store [mm/d] \cr
- \emph{$AE } \tab [numeric] series of actual evapotranspiration [mm/d] \cr
- \emph{$Perc } \tab [numeric] series of percolation (PERC) [mm/d] \cr
- \emph{$PR } \tab [numeric] series of PR=Pn-Ps+Perc [mm/d] \cr
- \emph{$Q9 } \tab [numeric] series of UH1 outflow (Q9) [mm/d] \cr
- \emph{$Q1 } \tab [numeric] series of UH2 outflow (Q1) [mm/d] \cr
- \emph{$Rout } \tab [numeric] series of routing store level [mm] \cr
- \emph{$Exch } \tab [numeric] series of potential semi-exchange between catchments [mm/d] \cr
- \emph{$AExch1 } \tab [numeric] series of actual exchange between catchments for branch 1 [mm/d] \cr
- \emph{$AExch2 } \tab [numeric] series of actual exchange between catchments for branch 2 [mm/d] \cr
- \emph{$AExch } \tab [numeric] series of actual exchange between catchments (1+2) [mm/d] \cr
- \emph{$QR } \tab [numeric] series of routing store outflow (QR) [mm/d] \cr
- \emph{$QD } \tab [numeric] series of direct flow from UH2 after exchange (QD) [mm/d] \cr
- \emph{$Qsim } \tab [numeric] series of simulated discharge [mm/d] \cr
- \emph{$CemaNeigeLayers} \tab [list] list of CemaNeige outputs (1 list per layer) \cr
- \emph{$CemaNeigeLayers[[iLayer]]$Pliq } \tab [numeric] series of liquid precip. [mm/d] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$Psol } \tab [numeric] series of solid precip. [mm/d] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$SnowPack } \tab [numeric] series of snow pack [mm] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$ThermalState } \tab [numeric] series of snow pack thermal state [°C] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$Gratio } \tab [numeric] series of Gratio [0-1] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$PotMelt } \tab [numeric] series of potential snow melt [mm/d] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$Melt } \tab [numeric] series of actual snow melt [mm/d] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$PliqAndMelt } \tab [numeric] series of liquid precip. + actual snow melt [mm/d] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$Temp } \tab [numeric] series of air temperature [°C] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$Gthreshold } \tab [numeric] series of melt threshold [mm] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$Glocalmax } \tab [numeric] series of local melt threshold for hysteresis [mm] \cr
- \emph{$StateEnd} \tab [numeric] states at the end of the run: \cr\tab store & unit hydrographs levels [mm], CemaNeige states [mm & °C], \cr\tab see \code{\link{CreateIniStates}} for more details \cr
+[list] containing the function outputs organised as follows:
+ \tabular{ll}{
+ \emph{$DatesR } \tab [POSIXlt] series of dates \cr
+ \emph{$PotEvap } \tab [numeric] series of input potential evapotranspiration (E) [mm/d] \cr
+ \emph{$Precip } \tab [numeric] series of input total precipitation (P) [mm/d] \cr
+ \emph{$Prod } \tab [numeric] series of production store level (S) [mm] \cr
+ \emph{$Pn } \tab [numeric] series of net rainfall (Pn) [mm/d] \cr
+ \emph{$Ps } \tab [numeric] series of the part of Pn filling the production store (Ps) [mm/d] \cr
+ \emph{$AE } \tab [numeric] series of actual evapotranspiration [mm/d] \cr
+ \emph{$Perc } \tab [numeric] series of percolation (Perc) [mm/d] \cr
+ \emph{$PR } \tab [numeric] series of Pr=Pn-Ps+Perc (Pr) [mm/d] \cr
+ \emph{$Q9 } \tab [numeric] series of UH outflow going into branch 9 (Q9) [mm/d] \cr
+ \emph{$Q1 } \tab [numeric] series of UH outflow going into branch 1 (Q1) [mm/d] \cr
+ \emph{$Rout } \tab [numeric] series of routing store level (R1) [mm] \cr
+ \emph{$Exch } \tab [numeric] series of potential semi-exchange between catchments [mm/d] \cr
+ \emph{$AExch1 } \tab [numeric] series of actual exchange between catchments for branch 1 [mm/d] \cr
+ \emph{$AExch2 } \tab [numeric] series of actual exchange between catchments for branch 2 [mm/d] \cr
+ \emph{$AExch } \tab [numeric] series of actual exchange between catchments (AExch1+AExch2) [mm/d] \cr
+ \emph{$QR } \tab [numeric] series of routing store outflow (Qr) [mm/d] \cr
+ \emph{$QD } \tab [numeric] series of direct flow from UH after exchange (Qd) [mm/d] \cr
+ \emph{$Qsim } \tab [numeric] series of simulated discharge (Q) [mm/d] \cr
+ \emph{$CemaNeigeLayers} \tab [list] list of CemaNeige outputs (1 list per layer) \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$Pliq } \tab [numeric] series of liquid precip. [mm/d] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$Psol } \tab [numeric] series of solid precip. [mm/d] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$SnowPack } \tab [numeric] series of snow pack (snow water equivalent) [mm] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$ThermalState} \tab [numeric] series of snow pack thermal state [°C] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$Gratio } \tab [numeric] series of Gratio [0-1] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$PotMelt } \tab [numeric] series of potential snow melt [mm/d] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$Melt } \tab [numeric] series of actual snow melt [mm/d] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$PliqAndMelt } \tab [numeric] series of liquid precip. + actual snow melt [mm/d] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$Temp } \tab [numeric] series of air temperature [°C] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$Gthreshold } \tab [numeric] series of melt threshold [mm] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$Glocalmax } \tab [numeric] series of local melt threshold for hysteresis [mm] \cr
+ \emph{$StateEnd} \tab [numeric] states at the end of the run: store & unit hydrographs levels [mm], CemaNeige states [mm & °C]. See \code{\link{CreateIniStates}} for more details \cr
}
- (refer to the provided references or to the package source code for further details on these model outputs)
+Refer to the provided references or to the package source code for further details on these model outputs
}
@@ -82,6 +82,9 @@ CemaNeige X4 \tab (optional) percentage (between 0 and 1) of annual snowfall def
The choice of the CemaNeige version is explained in \code{\link{CreateRunOptions}}. \cr
For further details on the model, see the references section. \cr
For further details on the argument structures and initialisation options, see \code{\link{CreateRunOptions}}.
+\cr
+\cr
+See \code{\link{RunModel_GR5J}} to look at the diagram of the hydrological model.
}
@@ -92,17 +95,17 @@ library(airGR)
data(L0123002)
## preparation of the InputsModel object
-InputsModel <- CreateInputsModel(FUN_MOD = RunModel_CemaNeigeGR5J, DatesR = BasinObs$DatesR,
- Precip = BasinObs$P, PotEvap = BasinObs$E, TempMean = BasinObs$T,
+InputsModel <- CreateInputsModel(FUN_MOD = RunModel_CemaNeigeGR5J, DatesR = BasinObs$DatesR,
+ Precip = BasinObs$P, PotEvap = BasinObs$E, TempMean = BasinObs$T,
ZInputs = median(BasinInfo$HypsoData),
HypsoData = BasinInfo$HypsoData, NLayers = 5)
## run period selection
-Ind_Run <- seq(which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1990-01-01"),
+Ind_Run <- seq(which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1990-01-01"),
which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1999-12-31"))
## preparation of the RunOptions object
-RunOptions <- CreateRunOptions(FUN_MOD = RunModel_CemaNeigeGR5J, InputsModel = InputsModel,
+RunOptions <- CreateRunOptions(FUN_MOD = RunModel_CemaNeigeGR5J, InputsModel = InputsModel,
IndPeriod_Run = Ind_Run)
## simulation
@@ -115,14 +118,14 @@ OutputsModel <- RunModel_CemaNeigeGR5J(InputsModel = InputsModel,
plot(OutputsModel, Qobs = BasinObs$Qmm[Ind_Run])
## efficiency criterion: Nash-Sutcliffe Efficiency
-InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
+InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
RunOptions = RunOptions, Obs = BasinObs$Qmm[Ind_Run])
OutputsCrit <- ErrorCrit_NSE(InputsCrit = InputsCrit, OutputsModel = OutputsModel)
## simulation with the Linear Hysteresis
## preparation of the RunOptions object
-RunOptions <- CreateRunOptions(FUN_MOD = RunModel_CemaNeigeGR5J, InputsModel = InputsModel,
+RunOptions <- CreateRunOptions(FUN_MOD = RunModel_CemaNeigeGR5J, InputsModel = InputsModel,
IndPeriod_Run = Ind_Run, IsHyst = TRUE)
Param <- c(179.139, -0.100, 203.815, 1.174, 2.478, 0.977, 2.774, 100, 0.4)
OutputsModel <- RunModel_CemaNeigeGR5J(InputsModel = InputsModel,
@@ -132,7 +135,7 @@ OutputsModel <- RunModel_CemaNeigeGR5J(InputsModel = InputsModel,
plot(OutputsModel, Qobs = BasinObs$Qmm[Ind_Run])
## efficiency criterion: Nash-Sutcliffe Efficiency
-InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
+InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
RunOptions = RunOptions, Obs = BasinObs$Qmm[Ind_Run])
OutputsCrit <- ErrorCrit_NSE(InputsCrit = InputsCrit, OutputsModel = OutputsModel)
}
@@ -144,27 +147,28 @@ Laurent Coron, Claude Michel, Nicolas Le Moine, Audrey Valéry, Vazken Andréass
\references{
-Le Moine, N. (2008).
-Le bassin versant de surface vu par le souterrain : une voie d'amélioration des performances et du réalisme des modèles pluie-débit ?
- PhD thesis (french), UPMC, Paris, France.
+Le Moine, N. (2008).
+ Le bassin versant de surface vu par le souterrain :
+ une voie d'amélioration des performances et du réalisme des modèles pluie-débit ?
+ PhD thesis (in French), UPMC - Cemagref Antony, Paris, France.
\cr\cr
-Pushpalatha, R., C. Perrin, N. Le Moine, T. Mathevet and V. Andréassian (2011).
- A downward structural sensitivity analysis of hydrological models to improve low-flow simulation.
- Journal of Hydrology, 411(1-2), 66-76. doi: 10.1016/j.jhydrol.2011.09.034.
+Pushpalatha, R., Perrin, C., Le Moine, N., Mathevet, T. and Andréassian, V. (2011).
+ A downward structural sensitivity analysis of hydrological models to improve low-flow simulation.
+ Journal of Hydrology, 411(1-2), 66-76, \doi{10.1016/j.jhydrol.2011.09.034}.
\cr\cr
-Riboust, P., G. Thirel, N. Le Moine and P. Ribstein (2019).
- Revisiting a simple degree-day model for integrating satellite data: implementation of SWE-SCA hystereses.
- Journal of Hydrology and Hydromechanics. doi: 10.2478/johh-2018-0004, 67, 1, 70–81.
+Riboust, P., Thirel, G., Le Moine, N. and Ribstein, P. (2019).
+ Revisiting a simple degree-day model for integrating satellite data: Implementation of SWE-SCA hystereses.
+ Journal of Hydrology and Hydromechanics, 67(1), 70–81, \doi{10.2478/johh-2018-0004}.
\cr\cr
-Valéry, A., V. Andréassian and C. Perrin (2014).
- "As simple as possible but not simpler": what is useful in a temperature-based snow-accounting routine?
- Part 1 - Comparison of six snow accounting routines on 380 catchments.
- Journal of Hydrology. doi: 10.1016/j.jhydrol.2014.04.059.
+Valéry, A., Andréassian, V. and Perrin, C. (2014).
+ "As simple as possible but not simpler": What is useful in a temperature-based snow-accounting routine?
+ Part 1 - Comparison of six snow accounting routines on 380 catchments.
+ Journal of Hydrology, 517(0), 1166-1175, \doi{10.1016/j.jhydrol.2014.04.059}.
\cr\cr
-Valéry, A., V. Andréassian and C. Perrin (2014).
- "As simple as possible but not simpler": What is useful in a temperature-based snow-accounting routine?
- Part 2 - Sensitivity analysis of the Cemaneige snow accounting routine on 380 catchments.
- Journal of Hydrology. doi: 10.1016/j.jhydrol.2014.04.058.
+Valéry, A., Andréassian, V. and Perrin, C. (2014).
+ "As simple as possible but not simpler": What is useful in a temperature-based snow-accounting routine?
+ Part 2 - Sensitivity analysis of the Cemaneige snow accounting routine on 380 catchments.
+ Journal of Hydrology, 517(0), 1176-1187, \doi{10.1016/j.jhydrol.2014.04.058}.
}
diff --git a/man/RunModel_CemaNeigeGR6J.Rd b/man/RunModel_CemaNeigeGR6J.Rd
index 6a4120cfeeef38684e1d53eb99884d0366dad7a9..65e9635d50cf00bc89d0421c6830654f867ddddb 100644
--- a/man/RunModel_CemaNeigeGR6J.Rd
+++ b/man/RunModel_CemaNeigeGR6J.Rd
@@ -24,60 +24,60 @@ RunModel_CemaNeigeGR6J(InputsModel, RunOptions, Param)
\item{RunOptions}{[object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details}
\item{Param}{[numeric] vector of 8 (or 10 parameters if \code{IsHyst = TRUE}, see \code{\link{CreateRunOptions}} for details)
-\tabular{ll}{
-GR6J X1 \tab production store capacity [mm] \cr
-GR6J X2 \tab intercatchment exchange coefficient [mm/d] \cr
-GR6J X3 \tab routing store capacity [mm] \cr
-GR6J X4 \tab unit hydrograph time constant [d] \cr
-GR6J X5 \tab intercatchment exchange threshold [-] \cr
-GR6J X6 \tab coefficient for emptying exponential store [mm] \cr
-CemaNeige X1 \tab weighting coefficient for snow pack thermal state [-] \cr
-CemaNeige X2 \tab degree-day melt coefficient [mm/°C/d] \cr
-CemaNeige X3 \tab (optional) accumulation threshold [mm] (needed if \code{IsHyst = TRUE}) \cr
-CemaNeige X4 \tab (optional) percentage (between 0 and 1) of annual snowfall defining the melt threshold [-] (needed if \code{IsHyst = TRUE})\cr
-}}
+ \tabular{ll}{
+ GR6J X1 \tab production store capacity [mm] \cr
+ GR6J X2 \tab intercatchment exchange coefficient [mm/d] \cr
+ GR6J X3 \tab routing store capacity [mm] \cr
+ GR6J X4 \tab unit hydrograph time constant [d] \cr
+ GR6J X5 \tab intercatchment exchange threshold [-] \cr
+ GR6J X6 \tab exponential store depletion coefficient [mm] \cr
+ CemaNeige X1 \tab weighting coefficient for snow pack thermal state [-] \cr
+ CemaNeige X2 \tab degree-day melt coefficient [mm/°C/d] \cr
+ CemaNeige X3 \tab (optional) accumulation threshold [mm] (needed if \code{IsHyst = TRUE}) \cr
+ CemaNeige X4 \tab (optional) percentage (between 0 and 1) of annual snowfall defining the melt threshold [-] (needed if \code{IsHyst = TRUE})\cr
+ }}
}
\value{
-[list] list containing the function outputs organised as follows:
- \tabular{ll}{
- \emph{$DatesR } \tab [POSIXlt] series of dates \cr
- \emph{$PotEvap} \tab [numeric] series of input potential evapotranspiration [mm/d] \cr
- \emph{$Precip } \tab [numeric] series of input total precipitation [mm/d] \cr
- \emph{$Prod } \tab [numeric] series of production store level [mm] \cr
- \emph{$Pn } \tab [numeric] series of net rainfall [mm/d] \cr
- \emph{$Ps } \tab [numeric] series of the part of Ps filling the production store [mm/d] \cr
- \emph{$AE } \tab [numeric] series of actual evapotranspiration [mm/d] \cr
- \emph{$Perc } \tab [numeric] series of percolation (PERC) [mm/d] \cr
- \emph{$PR } \tab [numeric] series of PR=PN-PS+PERC [mm/d] \cr
- \emph{$Q9 } \tab [numeric] series of UH1 outflow (Q9) [mm/d] \cr
- \emph{$Q1 } \tab [numeric] series of UH2 outflow (Q1) [mm/d] \cr
- \emph{$Rout } \tab [numeric] series of routing store level [mm] \cr
- \emph{$Exch } \tab [numeric] series of potential semi-exchange between catchments [mm/d] \cr
- \emph{$AExch1 } \tab [numeric] series of actual exchange between catchments for branch 1 [mm/d] \cr
- \emph{$AExch2 } \tab [numeric] series of actual exchange between catchments for branch 2 [mm/d] \cr
- \emph{$AExch } \tab [numeric] series of actual exchange between catchments (1+2) [mm/d] \cr
- \emph{$QR } \tab [numeric] series of routing store outflow (QR) [mm/d] \cr
- \emph{$QRExp } \tab [numeric] series of exponential store outflow (QRExp) [mm/d] \cr
- \emph{$Exp } \tab [numeric] series of exponential store level (negative) [mm] \cr
- \emph{$QD } \tab [numeric] series of direct flow from UH2 after exchange (QD) [mm/d] \cr
- \emph{$Qsim } \tab [numeric] series of Qsim [mm/d] \cr
- \emph{$CemaNeigeLayers} \tab [list] list of CemaNeige outputs (1 list per layer) \cr
- \emph{$CemaNeigeLayers[[iLayer]]$Pliq } \tab [numeric] series of liquid precip. [mm/d] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$Psol } \tab [numeric] series of solid precip. [mm/d] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$SnowPack } \tab [numeric] series of snow pack [mm] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$ThermalState } \tab [numeric] series of snow pack thermal state [°C] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$Gratio } \tab [numeric] series of Gratio [0-1] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$PotMelt } \tab [numeric] series of potential snow melt [mm/d] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$Melt } \tab [numeric] series of actual snow melt [mm/d] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$PliqAndMelt } \tab [numeric] series of liquid precip. + actual snow melt [mm/d] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$Temp } \tab [numeric] series of air temperature [°C] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$Gthreshold } \tab [numeric] series of melt threshold [mm] \cr
- \emph{$CemaNeigeLayers[[iLayer]]$Glocalmax } \tab [numeric] series of local melt threshold for hysteresis [mm] \cr
- \emph{$StateEnd} \tab [numeric] states at the end of the run: \cr\tab store & unit hydrographs levels [mm], CemaNeige states [mm & °C], \cr\tab see \code{\link{CreateIniStates}} for more details \cr
- }
- (refer to the provided references or to the package source code for further details on these model outputs)
+[list] containing the function outputs organised as follows:
+ \tabular{ll}{
+ \emph{$DatesR } \tab [POSIXlt] series of dates \cr
+ \emph{$PotEvap } \tab [numeric] series of input potential evapotranspiration (E) [mm/d] \cr
+ \emph{$Precip } \tab [numeric] series of input total precipitation (P) [mm/d] \cr
+ \emph{$Prod } \tab [numeric] series of production store level (S) [mm] \cr
+ \emph{$Pn } \tab [numeric] series of net rainfall (Pn) [mm/d] \cr
+ \emph{$Ps } \tab [numeric] series of the part of Pn filling the production store (Ps) [mm/d] \cr
+ \emph{$AE } \tab [numeric] series of actual evapotranspiration [mm/d] \cr
+ \emph{$Perc } \tab [numeric] series of percolation (Perc) [mm/d] \cr
+ \emph{$PR } \tab [numeric] series of Pr=Pn-Ps+Perc (Pr) [mm/d] \cr
+ \emph{$Q9 } \tab [numeric] series of UH1 outflow (Q9) [mm/d] \cr
+ \emph{$Q1 } \tab [numeric] series of UH2 outflow (Q1) [mm/d] \cr
+ \emph{$Rout } \tab [numeric] series of routing store level (R1) [mm] \cr
+ \emph{$Exch } \tab [numeric] series of potential semi-exchange between catchments [mm/d] \cr
+ \emph{$AExch1 } \tab [numeric] series of actual exchange between catchments for branch 1 [mm/d] \cr
+ \emph{$AExch2 } \tab [numeric] series of actual exchange between catchments for branch 2 [mm/d] \cr
+ \emph{$AExch } \tab [numeric] series of actual exchange between catchments (AExch1+AExch2) [mm/d] \cr
+ \emph{$QR } \tab [numeric] series of routing store outflow (Qr) [mm/d] \cr
+ \emph{$QRExp } \tab [numeric] series of exponential store outflow (QrExp) [mm/d] \cr
+ \emph{$Exp } \tab [numeric] series of exponential store level (negative) (R2) [mm] \cr
+ \emph{$QD } \tab [numeric] series of direct flow from UH2 after exchange (Qd) [mm/d] \cr
+ \emph{$Qsim } \tab [numeric] series of simulated discharge (Q) [mm/d] \cr
+ \emph{$CemaNeigeLayers} \tab [list] list of CemaNeige outputs (1 list per layer) \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$Pliq } \tab [numeric] series of liquid precip. [mm/d] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$Psol } \tab [numeric] series of solid precip. [mm/d] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$SnowPack } \tab [numeric] series of snow pack (snow water equivalent) [mm] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$ThermalState} \tab [numeric] series of snow pack thermal state [°C] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$Gratio } \tab [numeric] series of Gratio [0-1] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$PotMelt } \tab [numeric] series of potential snow melt [mm/d] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$Melt } \tab [numeric] series of actual snow melt [mm/d] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$PliqAndMelt } \tab [numeric] series of liquid precip. + actual snow melt [mm/d] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$Temp } \tab [numeric] series of air temperature [°C] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$Gthreshold } \tab [numeric] series of melt threshold [mm] \cr
+ \emph{$CemaNeigeLayers[[iLayer]]$Glocalmax } \tab [numeric] series of local melt threshold for hysteresis [mm] \cr
+ \emph{$StateEnd} \tab [numeric] states at the end of the run: store & unit hydrographs levels [mm], CemaNeige states [mm & °C]. See \code{\link{CreateIniStates}} for more details \cr
+ }
+Refer to the provided references or to the package source code for further details on these model outputs
}
@@ -85,6 +85,9 @@ CemaNeige X4 \tab (optional) percentage (between 0 and 1) of annual snowfall def
The choice of the CemaNeige version is explained in \code{\link{CreateRunOptions}}. \cr
For further details on the model, see the references section. \cr
For further details on the argument structures and initialisation options, see \code{\link{CreateRunOptions}}.
+\cr
+\cr
+See \code{\link{RunModel_GR6J}} to look at the diagram of the hydrological model.
}
@@ -95,20 +98,20 @@ library(airGR)
data(L0123002)
## preparation of the InputsModel object
-InputsModel <- CreateInputsModel(FUN_MOD = RunModel_CemaNeigeGR6J, DatesR = BasinObs$DatesR,
- Precip = BasinObs$P, PotEvap = BasinObs$E, TempMean = BasinObs$T,
+InputsModel <- CreateInputsModel(FUN_MOD = RunModel_CemaNeigeGR6J, DatesR = BasinObs$DatesR,
+ Precip = BasinObs$P, PotEvap = BasinObs$E, TempMean = BasinObs$T,
ZInputs = median(BasinInfo$HypsoData),
HypsoData = BasinInfo$HypsoData, NLayers = 5)
## run period selection
-Ind_Run <- seq(which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1990-01-01"),
+Ind_Run <- seq(which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1990-01-01"),
which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1999-12-31"))
## ---- original version of CemaNeige
## preparation of the RunOptions object
-RunOptions <- CreateRunOptions(FUN_MOD = RunModel_CemaNeigeGR6J, InputsModel = InputsModel,
+RunOptions <- CreateRunOptions(FUN_MOD = RunModel_CemaNeigeGR6J, InputsModel = InputsModel,
IndPeriod_Run = Ind_Run)
## simulation
@@ -121,7 +124,7 @@ OutputsModel <- RunModel_CemaNeigeGR6J(InputsModel = InputsModel,
plot(OutputsModel, Qobs = BasinObs$Qmm[Ind_Run])
## efficiency criterion: Nash-Sutcliffe Efficiency
-InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
+InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
RunOptions = RunOptions, Obs = BasinObs$Qmm[Ind_Run])
OutputsCrit <- ErrorCrit_NSE(InputsCrit = InputsCrit, OutputsModel = OutputsModel)
@@ -129,9 +132,9 @@ OutputsCrit <- ErrorCrit_NSE(InputsCrit = InputsCrit, OutputsModel = OutputsMode
## ---- version of CemaNeige with the Linear Hysteresis
## preparation of the RunOptions object
-RunOptions <- CreateRunOptions(FUN_MOD = RunModel_CemaNeigeGR6J, InputsModel = InputsModel,
+RunOptions <- CreateRunOptions(FUN_MOD = RunModel_CemaNeigeGR6J, InputsModel = InputsModel,
IndPeriod_Run = Ind_Run, IsHyst = TRUE)
-
+
## simulation
Param <- c(X1 = 116.482, X2 = 0.500, X3 = 72.733, X4 = 1.224, X5 = 0.278, X6 = 30.333,
CNX1 = 0.977, CNX2 = 2.774, CNX3 = 100, CNX4 = 0.4)
@@ -142,7 +145,7 @@ OutputsModel <- RunModel_CemaNeigeGR6J(InputsModel = InputsModel,
plot(OutputsModel, Qobs = BasinObs$Qmm[Ind_Run])
## efficiency criterion: Nash-Sutcliffe Efficiency
-InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
+InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
RunOptions = RunOptions, Obs = BasinObs$Qmm[Ind_Run])
OutputsCrit <- ErrorCrit_NSE(InputsCrit = InputsCrit, OutputsModel = OutputsModel)
}
@@ -155,29 +158,29 @@ Laurent Coron, Claude Michel, Charles Perrin, Raji Pushpalatha, Nicolas Le Moine
\references{
-Pushpalatha, R., C. Perrin, N. Le Moine, T. Mathevet and V. Andréassian (2011).
-A downward structural sensitivity analysis of hydrological models to improve low-flow simulation.
-Journal of Hydrology, 411(1-2), 66-76. doi: 10.1016/j.jhydrol.2011.09.034.
+Pushpalatha, R., Perrin, C., Le Moine, N., Mathevet, T. and Andréassian, V. (2011).
+ A downward structural sensitivity analysis of hydrological models to improve low-flow simulation.
+ Journal of Hydrology, 411(1-2), 66-76, \doi{10.1016/j.jhydrol.2011.09.034}.
\cr\cr
-Riboust, P., G. Thirel, N. Le Moine and P. Ribstein (2019).
- Revisiting a simple degree-day model for integrating satellite data: implementation of SWE-SCA hystereses.
- Journal of Hydrology and Hydromechanics. doi: 10.2478/johh-2018-0004, 67, 1, 70–81.
+Riboust, P., Thirel, G., Le Moine, N. and Ribstein, P. (2019).
+ Revisiting a simple degree-day model for integrating satellite data: Implementation of SWE-SCA hystereses.
+ Journal of Hydrology and Hydromechanics, 67(1), 70–81, \doi{10.2478/johh-2018-0004}.
\cr\cr
-Valéry, A., V. Andréassian and C. Perrin (2014).
- "As simple as possible but not simpler": what is useful in a temperature-based snow-accounting routine?
- Part 1 - Comparison of six snow accounting routines on 380 catchments.
- Journal of Hydrology. doi: 10.1016/j.jhydrol.2014.04.059.
+Valéry, A., Andréassian, V. and Perrin, C. (2014).
+ "As simple as possible but not simpler": What is useful in a temperature-based snow-accounting routine?
+ Part 1 - Comparison of six snow accounting routines on 380 catchments.
+ Journal of Hydrology, 517(0), 1166-1175, \doi{10.1016/j.jhydrol.2014.04.059}.
\cr\cr
-Valéry, A., V. Andréassian and C. Perrin (2014). *
- "As simple as possible but not simpler": What is useful in a temperature-based snow-accounting routine?
- Part 2 - Sensitivity analysis of the Cemaneige snow accounting routine on 380 catchments.
- Journal of Hydrology. doi: 10.1016/j.jhydrol.2014.04.058.
+Valéry, A., Andréassian, V. and Perrin, C. (2014).
+ "As simple as possible but not simpler": What is useful in a temperature-based snow-accounting routine?
+ Part 2 - Sensitivity analysis of the Cemaneige snow accounting routine on 380 catchments.
+ Journal of Hydrology, 517(0), 1176-1187, \doi{10.1016/j.jhydrol.2014.04.058}.
}
\seealso{
-\code{\link{RunModel_CemaNeige}}, \code{\link{RunModel_CemaNeigeGR4J}},
-\code{\link{RunModel_CemaNeigeGR5J}}, \code{\link{RunModel_GR6J}},
+\code{\link{RunModel_CemaNeige}}, \code{\link{RunModel_CemaNeigeGR4J}},
+\code{\link{RunModel_CemaNeigeGR5J}}, \code{\link{RunModel_GR6J}},
\code{\link{CreateInputsModel}}, \code{\link{CreateRunOptions}}.
}
diff --git a/man/RunModel_GR1A.Rd b/man/RunModel_GR1A.Rd
index dd9b2831a0dd1b2b281052a1f85353c99f888133..56b2bce2c475ab9ab23219ba10580efe8a2ada9d 100644
--- a/man/RunModel_GR1A.Rd
+++ b/man/RunModel_GR1A.Rd
@@ -24,14 +24,14 @@ RunModel_GR1A(InputsModel, RunOptions, Param)
\item{RunOptions}{[object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details}
\item{Param}{[numeric] vector of 1 parameter
-\tabular{ll}{
-GR1A X1 \tab model parameter [-] \cr
-}}
+ \tabular{ll}{
+ GR1A X1 \tab model parameter [-] \cr
+ }}
}
\value{
-[list] list containing the function outputs organised as follows:
+[list] containing the function outputs organised as follows:
\tabular{ll}{
\emph{$DatesR } \tab [POSIXlt] series of dates \cr
\emph{$PotEvap } \tab [numeric] series of input potential evapotranspiration [mm/y] \cr
@@ -39,12 +39,12 @@ GR1A X1 \tab model parameter [-] \cr
\emph{$Qsim } \tab [numeric] series of simulated discharge [mm/y] \cr
\emph{$StateEnd} \tab [numeric] states at the end of the run (NULL) [-] \cr
}
- (refer to the provided references or to the package source code for further details on these model outputs)
+Refer to the provided references or to the package source code for further details on these model outputs.
}
\details{
-For further details on the model, see the references section.
+For further details on the model, see the references section. \cr
For further details on the argument structures and initialisation options, see \code{\link{CreateRunOptions}}.
}
@@ -56,23 +56,21 @@ library(airGR)
data(L0123001)
## conversion of example data from daily to yearly time step
-TabSeries <- data.frame(BasinObs$DatesR, BasinObs$P, BasinObs$E, BasinObs$T, BasinObs$Qmm)
-TimeFormat <- "daily"
-NewTimeFormat <- "yearly"
-ConvertFun <- c("sum", "sum", "mean", "sum")
-YearFirstMonth <- 09;
-NewTabSeries <- SeriesAggreg(TabSeries = TabSeries, TimeFormat = TimeFormat,
- NewTimeFormat = NewTimeFormat, ConvertFun = ConvertFun,
- YearFirstMonth = YearFirstMonth)
-BasinObs <- NewTabSeries
-names(BasinObs) <- c("DatesR", "P", "E", "T", "Qmm")
+TabSeries <- data.frame(DatesR = BasinObs$DatesR,
+ P = BasinObs$P,
+ E = BasinObs$E,
+ Qmm = BasinObs$Qmm)
+TabSeries <- TabSeries[TabSeries$DatesR < "2012-09-01", ]
+BasinObs <- SeriesAggreg(TabSeries, Format = "\%Y",
+ YearFirstMonth = 09,
+ ConvertFun = c("sum", "sum", "sum"))
## preparation of the InputsModel object
-InputsModel <- CreateInputsModel(FUN_MOD = RunModel_GR1A, DatesR = BasinObs$DatesR,
+InputsModel <- CreateInputsModel(FUN_MOD = RunModel_GR1A, DatesR = BasinObs$DatesR,
Precip = BasinObs$P, PotEvap = BasinObs$E)
## run period selection
-Ind_Run <- seq(which(format(BasinObs$DatesR, format = "\%Y")=="1990"),
+Ind_Run <- seq(which(format(BasinObs$DatesR, format = "\%Y")=="1990"),
which(format(BasinObs$DatesR, format = "\%Y")=="1999"))
## preparation of the RunOptions object
@@ -87,7 +85,7 @@ OutputsModel <- RunModel_GR1A(InputsModel = InputsModel, RunOptions = RunOptions
plot(OutputsModel, Qobs = BasinObs$Qmm[Ind_Run])
## efficiency criterion: Nash-Sutcliffe Efficiency
-InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
+InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
RunOptions = RunOptions, Obs = BasinObs$Qmm[Ind_Run])
OutputsCrit <- ErrorCrit_NSE(InputsCrit = InputsCrit, OutputsModel = OutputsModel)
}
@@ -99,9 +97,9 @@ Laurent Coron, Claude Michel, Olivier Delaigue, Guillaume Thirel
\references{
-Mouelhi S. (2003).
- Vers une chaîne cohérente de modèles pluie-débit conceptuels globaux aux pas de temps pluriannuel, annuel, mensuel et journalier.
- PhD thesis (in French), ENGREF, Cemagref Antony, France.
+Mouelhi S. (2003).
+ Vers une chaîne cohérente de modèles pluie-débit conceptuels globaux aux pas de temps pluriannuel, annuel, mensuel et journalier.
+ PhD thesis (in French), ENGREF - Cemagref Antony, France.
}
diff --git a/man/RunModel_GR2M.Rd b/man/RunModel_GR2M.Rd
index cea98d90c0ccef868436118f67c9f16672119d3d..6f62fdb97608be302738577874f0d25d250f62df 100644
--- a/man/RunModel_GR2M.Rd
+++ b/man/RunModel_GR2M.Rd
@@ -24,35 +24,36 @@ RunModel_GR2M(InputsModel, RunOptions, Param)
\item{RunOptions}{[object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details}
\item{Param}{[numeric] vector of 2 parameters
-\tabular{ll}{
-GR2M X1 \tab production store capacity [mm] \cr
-GR2M X2 \tab groundwater exchange coefficient [-] \cr
-}}
+ \tabular{ll}{
+ GR2M X1 \tab production store capacity [mm] \cr
+ GR2M X2 \tab groundwater exchange coefficient [-] \cr
+ }}
}
\value{
-[list] list containing the function outputs organised as follows:
- \tabular{ll}{
- \emph{$DatesR } \tab [POSIXlt] series of dates \cr
- \emph{$PotEvap } \tab [numeric] series of input potential evapotranspiration [mm/month] \cr
- \emph{$Precip } \tab [numeric] series of input total precipitation [mm/month] \cr
- \emph{$AE } \tab [numeric] series of actual evapotranspiration [mm/month] \cr
- \emph{$Pn } \tab [numeric] series of net rainfall (P1) [mm/month] \cr
- \emph{$Perc } \tab [numeric] series of percolation (P2) [mm/month] \cr
- \emph{$PR } \tab [numeric] series of PR=Pn+Perc (P3) [mm/month] \cr
- \emph{$Exch } \tab [numeric] series of potential exchange between catchments [mm/month] \cr
- \emph{$Prod } \tab [numeric] series of production store level [mm] \cr
- \emph{$Rout } \tab [numeric] series of routing store level [mm] \cr
- \emph{$Qsim } \tab [numeric] series of simulated discharge [mm/month] \cr
- \emph{$StateEnd} \tab [numeric] states at the end of the run (production store level and routing store level) [mm], \cr\tab see \code{\link{CreateIniStates}} for more details \cr
- }
- (refer to the provided references or to the package source code for further details on these model outputs)
+[list] containing the function outputs organised as follows:
+ \tabular{ll}{
+ \emph{$DatesR } \tab [POSIXlt] series of dates \cr
+ \emph{$PotEvap } \tab [numeric] series of input potential evapotranspiration [mm/month] (E) \cr
+ \emph{$Precip } \tab [numeric] series of input total precipitation [mm/month] (P) \cr
+ \emph{$AE } \tab [numeric] series of actual evapotranspiration [mm/month] \cr
+ \emph{$Pn } \tab [numeric] series of net rainfall (P1) [mm/month] \cr
+ \emph{$Ps } \tab [numeric] series of part of P filling the production store [mm/month] \cr
+ \emph{$Perc } \tab [numeric] series of percolation (P2) [mm/month] \cr
+ \emph{$PR } \tab [numeric] series of PR=Pn+Perc (P3) [mm/month] \cr
+ \emph{$AExch } \tab [numeric] series of actual exchange between catchments [mm/month] \cr
+ \emph{$Prod } \tab [numeric] series of production store level (S) [mm] \cr
+ \emph{$Rout } \tab [numeric] series of routing store level (R1) [mm] \cr
+ \emph{$Qsim } \tab [numeric] series of simulated discharge [mm/month] (Q) \cr
+ \emph{$StateEnd} \tab [numeric] states at the end of the run (production store level and routing store level) [mm]. See \code{\link{CreateIniStates}} for more details \cr
+ }
+Refer to the provided references or to the package source code for further details on these model outputs.
}
\details{
-For further details on the model, see the references section.
+For further details on the model, see the references section. \cr
For further details on the argument structures and initialisation options, see \code{\link{CreateRunOptions}}.
\cr
\cr
@@ -67,23 +68,16 @@ library(airGR)
## loading catchment data
data(L0123001)
-## conversion of example data from daily to monthly time step
-TabSeries <- data.frame(BasinObs$DatesR, BasinObs$P, BasinObs$E, BasinObs$T, BasinObs$Qmm)
-TimeFormat <- "daily"
-NewTimeFormat <- "monthly"
-ConvertFun <- c("sum", "sum", "mean", "sum")
-NewTabSeries <- SeriesAggreg(TabSeries = TabSeries, TimeFormat = TimeFormat,
- NewTimeFormat = NewTimeFormat, ConvertFun = ConvertFun)
-BasinObs <- NewTabSeries
-names(BasinObs) <- c("DatesR", "P", "E", "T", "Qmm")
-
-## preparation of the InputsModel object
-InputsModel <- CreateInputsModel(FUN_MOD = RunModel_GR2M, DatesR = BasinObs$DatesR,
+## preparation of the InputsModel object with daily time step data
+InputsModel <- CreateInputsModel(FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR,
Precip = BasinObs$P, PotEvap = BasinObs$E)
+## conversion of InputsModel to monthly time step
+InputsModel <- SeriesAggreg(InputsModel, Format = "\%Y\%m")
+
## run period selection
-Ind_Run <- seq(which(format(BasinObs$DatesR, format = "\%Y-\%m")=="1990-01"),
- which(format(BasinObs$DatesR, format = "\%Y-\%m")=="1999-12"))
+Ind_Run <- seq(which(format(InputsModel$DatesR, format = "\%Y-\%m")=="1990-01"),
+ which(format(InputsModel$DatesR, format = "\%Y-\%m")=="1999-12"))
## preparation of the RunOptions object
RunOptions <- CreateRunOptions(FUN_MOD = RunModel_GR2M,
@@ -93,12 +87,18 @@ RunOptions <- CreateRunOptions(FUN_MOD = RunModel_GR2M,
Param <- c(X1 = 265.072, X2 = 1.040)
OutputsModel <- RunModel_GR2M(InputsModel = InputsModel, RunOptions = RunOptions, Param = Param)
+## conversion of observed discharge to monthly time step
+Qobs <- SeriesAggreg(data.frame(BasinObs$DatesR, BasinObs$Qmm),
+ Format = "\%Y\%m",
+ ConvertFun = "sum")
+Qobs <- Qobs[Ind_Run, 2]
+
## results preview
-plot(OutputsModel, Qobs = BasinObs$Qmm[Ind_Run])
+plot(OutputsModel, Qobs = Qobs)
## efficiency criterion: Nash-Sutcliffe Efficiency
-InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
- RunOptions = RunOptions, Obs = BasinObs$Qmm[Ind_Run])
+InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
+ RunOptions = RunOptions, Obs = Qobs)
OutputsCrit <- ErrorCrit_NSE(InputsCrit = InputsCrit, OutputsModel = OutputsModel)
}
@@ -109,13 +109,13 @@ Laurent Coron, Claude Michel, Safouane Mouelhi, Olivier Delaigue, Guillaume Thir
\references{
-Mouelhi S. (2003).
- Vers une chaîne cohérente de modèles pluie-débit conceptuels globaux aux pas de temps pluriannuel, annuel, mensuel et journalier.
- PhD thesis (in French), ENGREF, Cemagref Antony, France.
+Mouelhi S. (2003).
+ Vers une chaîne cohérente de modèles pluie-débit conceptuels globaux aux pas de temps pluriannuel, annuel, mensuel et journalier.
+ PhD thesis (in French), ENGREF - Cemagref Antony, France.
\cr\cr
-Mouelhi, S., C. Michel, C. Perrin and V. Andréassian (2006).
- Stepwise development of a two-parameter monthly water balance model.
- Journal of Hydrology, 318(1-4), 200-214. doi: 10.1016/j.jhydrol.2005.06.014.
+Mouelhi, S., Michel, C., Perrin, C. and Andréassian V. (2006).
+ Stepwise development of a two-parameter monthly water balance model.
+ Journal of Hydrology, 318(1-4), 200-214, \doi{10.1016/j.jhydrol.2005.06.014}.
}
diff --git a/man/RunModel_GR4H.Rd b/man/RunModel_GR4H.Rd
index 6321e5db65ebd27609f7000040b4083a9af9c98f..7f2b2885e22d37f6f3e5af708cff925f6f39701c 100644
--- a/man/RunModel_GR4H.Rd
+++ b/man/RunModel_GR4H.Rd
@@ -24,7 +24,7 @@ RunModel_GR4H(InputsModel, RunOptions, Param)
\item{RunOptions}{[object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details}
\item{Param}{[numeric] vector of 4 parameters
- \tabular{ll}{
+ \tabular{ll}{
GR4H X1 \tab production store capacity [mm] \cr
GR4H X2 \tab groundwater exchange coefficient [mm/h] \cr
GR4H X3 \tab routing store capacity [mm] \cr
@@ -34,36 +34,39 @@ RunModel_GR4H(InputsModel, RunOptions, Param)
\value{
-[list] list containing the function outputs organised as follows:
- \tabular{ll}{
- \emph{$DatesR } \tab [POSIXlt] series of dates \cr
- \emph{$PotEvap } \tab [numeric] series of input potential evapotranspiration [mm/h] \cr
- \emph{$Precip } \tab [numeric] series of input total precipitation [mm/h] \cr
- \emph{$Prod } \tab [numeric] series of production store level [mm] \cr
- \emph{$Pn } \tab [numeric] series of net rainfall [mm/h] \cr
- \emph{$Ps } \tab [numeric] series of the part of Pn filling the production store [mm/h] \cr
- \emph{$AE } \tab [numeric] series of actual evapotranspiration [mm/h] \cr
- \emph{$Perc } \tab [numeric] series of percolation (PERC) [mm/h] \cr
- \emph{$PR } \tab [numeric] series of PR=Pn-Ps+Perc [mm/h] \cr
- \emph{$Q9 } \tab [numeric] series of UH1 outflow (Q9) [mm/h] \cr
- \emph{$Q1 } \tab [numeric] series of UH2 outflow (Q1) [mm/h] \cr
- \emph{$Rout } \tab [numeric] series of routing store level [mm] \cr
- \emph{$Exch } \tab [numeric] series of potential semi-exchange between catchments [mm/h] \cr
- \emph{$AExch1 } \tab [numeric] series of actual exchange between catchments for branch 1 [mm/h]\cr
- \emph{$AExch2 } \tab [numeric] series of actual exchange between catchments for branch 2 [mm/h]\cr
- \emph{$AExch } \tab [numeric] series of actual exchange between catchments (1+2) [mm/h] \cr
- \emph{$QR } \tab [numeric] series of routing store outflow (QR) [mm/h] \cr
- \emph{$QD } \tab [numeric] series of direct flow from UH2 after exchange (QD) [mm/h] \cr
- \emph{$Qsim } \tab [numeric] series of simulated discharge [mm/h] \cr
- \emph{$StateEnd} \tab [numeric] states at the end of the run (res. levels, UH1 levels, UH2 levels) [mm], see \code{\link{CreateIniStates}} for more details \cr
- }
- (refer to the provided references or to the package source code for further details on these model outputs)
+[list] containing the function outputs organised as follows:
+ \tabular{ll}{
+ \emph{$DatesR } \tab [POSIXlt] series of dates \cr
+ \emph{$PotEvap } \tab [numeric] series of input potential evapotranspiration (E) [mm/h] \cr
+ \emph{$Precip } \tab [numeric] series of input total precipitation (P) [mm/h] \cr
+ \emph{$Prod } \tab [numeric] series of production store level [mm] (S) \cr
+ \emph{$Pn } \tab [numeric] series of net rainfall (Pn) [mm/h] \cr
+ \emph{$Ps } \tab [numeric] series of the part of Pn filling the production store (Ps) [mm/h \cr
+ \emph{$AE } \tab [numeric] series of actual evapotranspiration [mm/h] \cr
+ \emph{$Perc } \tab [numeric] series of percolation (Perc) [mm/h] \cr
+ \emph{$PR } \tab [numeric] series of Pr=Pn-Ps+Perc (Pr) [mm/h] \cr
+ \emph{$Q9 } \tab [numeric] series of UH1 outflow (Q9) [mm/h] \cr
+ \emph{$Q1 } \tab [numeric] series of UH2 outflow (Q1) [mm/h] \cr
+ \emph{$Rout } \tab [numeric] series of routing store level (R1) [mm] \cr
+ \emph{$Exch } \tab [numeric] series of potential semi-exchange between catchments [mm/h] \cr
+ \emph{$AExch1 } \tab [numeric] series of actual exchange between catchments for branch 1 [mm/h] \cr
+ \emph{$AExch2 } \tab [numeric] series of actual exchange between catchments for branch 2 [mm/h] \cr
+ \emph{$AExch } \tab [numeric] series of actual exchange between catchments (AExch1+AExch2) [mm/h] \cr
+ \emph{$QR } \tab [numeric] series of routing store outflow (Qr) [mm/h] \cr
+ \emph{$QD } \tab [numeric] series of direct flow from UH2 after exchange (Qd) [mm/h] \cr
+ \emph{$Qsim } \tab [numeric] series of simulated discharge (Q) [mm/h] \cr
+ \emph{$StateEnd} \tab [numeric] states at the end of the run (res. levels, UH1 levels, UH2 levels) [mm]. See \code{\link{CreateIniStates}} for more details \cr
+ }
+Refer to the provided references or to the package source code for further details on these model outputs.
}
\details{
-For further details on the model, see the references section.
+For further details on the model, see the references section. \cr
For further details on the argument structures and initialisation options, see \code{\link{CreateRunOptions}}.
+\cr
+\cr
+See \code{\link{RunModel_GR4J}} to look at the diagram of the hydrological model.
}
@@ -105,15 +108,15 @@ Laurent Coron, Charles Perrin, Thibaut Mathevet, Olivier Delaigue, Guillaume Thi
\references{
-Mathevet, T. (2005).
- Quels modèles pluie-débit globaux pour le pas de temps horaire ?
- Développement empirique et comparaison de modèles sur un large échantillon de bassins versants.
- PhD thesis (in French), ENGREF - Cemagref (Antony), Paris, France.
+Mathevet, T. (2005).
+ Quels modèles pluie-débit globaux pour le pas de temps horaire ?
+ Développement empirique et comparaison de modèles sur un large échantillon de bassins versants.
+ PhD thesis (in French), ENGREF - Cemagref Antony, Paris, France.
\cr\cr
-Le Moine, N. (2008).
- Le bassin versant de surface vu par le souterrain :
+Le Moine, N. (2008).
+ Le bassin versant de surface vu par le souterrain :
une voie d'amélioration des performances et du réalisme des modèles pluie-débit ?
- PhD thesis (french), UPMC, Paris, France.
+ PhD thesis (in French), UPMC - Cemagref Antony, Paris, France.
}
diff --git a/man/RunModel_GR4J.Rd b/man/RunModel_GR4J.Rd
index d03ff50f82920640c7dff30f9f6a36612ce9f1bd..0536238b05b88bb04ebea47d91f88e52dae3dcdf 100644
--- a/man/RunModel_GR4J.Rd
+++ b/man/RunModel_GR4J.Rd
@@ -24,7 +24,7 @@ RunModel_GR4J(InputsModel, RunOptions, Param)
\item{RunOptions}{[object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details}
\item{Param}{[numeric] vector of 4 parameters
- \tabular{ll}{
+ \tabular{ll}{
GR4J X1 \tab production store capacity [mm] \cr
GR4J X2 \tab intercatchment exchange coefficient [mm/d] \cr
GR4J X3 \tab routing store capacity [mm] \cr
@@ -34,35 +34,35 @@ RunModel_GR4J(InputsModel, RunOptions, Param)
\value{
-[list] list containing the function outputs organised as follows:
- \tabular{ll}{
+[list] containing the function outputs organised as follows:
+ \tabular{ll}{
\emph{$DatesR } \tab [POSIXlt] series of dates \cr
- \emph{$PotEvap } \tab [numeric] series of input potential evapotranspiration [mm/d] \cr
- \emph{$Precip } \tab [numeric] series of input total precipitation [mm/d] \cr
- \emph{$Prod } \tab [numeric] series of production store level [mm] \cr
- \emph{$Pn } \tab [numeric] series of net rainfall [mm/d] \cr
- \emph{$Ps } \tab [numeric] series of the part of Pn filling the production store [mm/d] \cr
+ \emph{$PotEvap } \tab [numeric] series of input potential evapotranspiration [mm/d] (E) \cr
+ \emph{$Precip } \tab [numeric] series of input total precipitation (P) [mm/d] \cr
+ \emph{$Prod } \tab [numeric] series of production store level (S) [mm] \cr
+ \emph{$Pn } \tab [numeric] series of net rainfall (Pn) [mm/d] \cr
+ \emph{$Ps } \tab [numeric] series of the part of Pn filling the production store (Ps) [mm/d] \cr
\emph{$AE } \tab [numeric] series of actual evapotranspiration [mm/d] \cr
- \emph{$Perc } \tab [numeric] series of percolation (PERC) [mm/d] \cr
- \emph{$PR } \tab [numeric] series of PR=Pn-Ps+Perc [mm/d] \cr
+ \emph{$Perc } \tab [numeric] series of percolation (Perc) [mm/d] \cr
+ \emph{$PR } \tab [numeric] series of Pr=Pn-Ps+Perc (Pr) [mm/d] \cr
\emph{$Q9 } \tab [numeric] series of UH1 outflow (Q9) [mm/d] \cr
\emph{$Q1 } \tab [numeric] series of UH2 outflow (Q1) [mm/d] \cr
- \emph{$Rout } \tab [numeric] series of routing store level [mm] \cr
+ \emph{$Rout } \tab [numeric] series of routing store level (R1) [mm] \cr
\emph{$Exch } \tab [numeric] series of potential semi-exchange between catchments [mm/d] \cr
\emph{$AExch1 } \tab [numeric] series of actual exchange between catchments for branch 1 [mm/d] \cr
\emph{$AExch2 } \tab [numeric] series of actual exchange between catchments for branch 2 [mm/d] \cr
\emph{$AExch } \tab [numeric] series of actual exchange between catchments (1+2) [mm/d] \cr
- \emph{$QR } \tab [numeric] series of routing store outflow (QR) [mm/d] \cr
- \emph{$QD } \tab [numeric] series of direct flow from UH2 after exchange (QD) [mm/d] \cr
- \emph{$Qsim } \tab [numeric] series of simulated discharge [mm/d] \cr
- \emph{$StateEnd} \tab [numeric] states at the end of the run (res. levels, UH1 levels, UH2 levels) [mm], \cr\tab see \code{\link{CreateIniStates}} for more details \cr
- }
- (refer to the provided references or to the package source code for further details on these model outputs)
+ \emph{$QR } \tab [numeric] series of routing store outflow (Qr) [mm/d] \cr
+ \emph{$QD } \tab [numeric] series of direct flow from UH2 after exchange (Qd) [mm/d] \cr
+ \emph{$Qsim } \tab [numeric] series of simulated discharge (Q) [mm/d] \cr
+ \emph{$StateEnd} \tab [numeric] states at the end of the run (res. levels, UH1 levels, UH2 levels) [mm]. See \code{\link{CreateIniStates}} for more details \cr
+ }
+Refer to the provided references or to the package source code for further details on these model outputs.
}
\details{
-For further details on the model, see the references section.
+For further details on the model, see the references section. \cr
For further details on the argument structures and initialisation options, see \code{\link{CreateRunOptions}}.
\cr
\cr
@@ -78,11 +78,11 @@ library(airGR)
data(L0123001)
## preparation of the InputsModel object
-InputsModel <- CreateInputsModel(FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR,
+InputsModel <- CreateInputsModel(FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR,
Precip = BasinObs$P, PotEvap = BasinObs$E)
## run period selection
-Ind_Run <- seq(which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1990-01-01"),
+Ind_Run <- seq(which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1990-01-01"),
which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1999-12-31"))
## preparation of the RunOptions object
@@ -98,7 +98,7 @@ OutputsModel <- RunModel_GR4J(InputsModel = InputsModel,
plot(OutputsModel, Qobs = BasinObs$Qmm[Ind_Run])
## efficiency criterion: Nash-Sutcliffe Efficiency
-InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
+InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
RunOptions = RunOptions, Obs = BasinObs$Qmm[Ind_Run])
OutputsCrit <- ErrorCrit_NSE(InputsCrit = InputsCrit, OutputsModel = OutputsModel)
}
@@ -110,9 +110,9 @@ Laurent Coron, Claude Michel, Charles Perrin, Olivier Delaigue
\references{
-Perrin, C., C. Michel and V. Andréassian (2003).
- Improvement of a parsimonious model for streamflow simulation.
- Journal of Hydrology, 279(1-4), 275-289. doi: 10.1016/S0022-1694(03)00225-7.
+Perrin, C., Michel, C. and Andréassian, V. (2003).
+ Improvement of a parsimonious model for streamflow simulation.
+ Journal of Hydrology, 279(1-4), 275-289, \doi{10.1016/S0022-1694(03)00225-7}.
}
diff --git a/man/RunModel_GR5H.Rd b/man/RunModel_GR5H.Rd
index ecb7acad5a57abdd660af08bf945461eb1f30a1c..6b96eba60234a631252fe34e9be97170e0d37705 100644
--- a/man/RunModel_GR5H.Rd
+++ b/man/RunModel_GR5H.Rd
@@ -24,7 +24,7 @@ RunModel_GR5H(InputsModel, RunOptions, Param)
\item{RunOptions}{[object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details}
\item{Param}{[numeric] vector of 5 parameters
- \tabular{ll}{
+ \tabular{ll}{
GR5H X1 \tab production store capacity [mm] \cr
GR5H X2 \tab intercatchment exchange coefficient [mm/h] \cr
GR5H X3 \tab routing store capacity [mm] \cr
@@ -35,33 +35,33 @@ RunModel_GR5H(InputsModel, RunOptions, Param)
\value{
-[list] list containing the function outputs organised as follows:
- \tabular{ll}{
- \emph{$DatesR } \tab [POSIXlt] series of dates \cr
- \emph{$PotEvap } \tab [numeric] series of input potential evapotranspiration [mm/h] \cr
- \emph{$Precip } \tab [numeric] series of input total precipitation [mm/h] \cr
- \emph{$Interc } \tab [numeric] series of interception store level [mm] \cr
- \emph{$Prod } \tab [numeric] series of production store level [mm] \cr
- \emph{$Pn } \tab [numeric] series of net rainfall [mm/h] \cr
- \emph{$Ps } \tab [numeric] series of the part of Pn filling the production store [mm/h] \cr
- \emph{$AE } \tab [numeric] series of actual evapotranspiration [mm/h] \cr
- \emph{$EI } \tab [numeric] series of evapotranspiration from rainfall neutralisation or interception store [mm/h] \cr
- \emph{$ES } \tab [numeric] series of evapotranspiration from production store [mm/h] \cr
- \emph{$Perc } \tab [numeric] series of percolation (PERC) [mm/h] \cr
- \emph{$PR } \tab [numeric] series of PR=Pn-Ps+Perc [mm/h] \cr
- \emph{$Q9 } \tab [numeric] series of UH1 outflow (Q9) [mm/h] \cr
- \emph{$Q1 } \tab [numeric] series of UH2 outflow (Q1) [mm/h] \cr
- \emph{$Rout } \tab [numeric] series of routing store level [mm] \cr
- \emph{$Exch } \tab [numeric] series of potential semi-exchange between catchments [mm/h] \cr
- \emph{$AExch1 } \tab [numeric] series of actual exchange between catchments for branch 1 [mm/h] \cr
- \emph{$AExch2 } \tab [numeric] series of actual exchange between catchments for branch 2 [mm/h] \cr
- \emph{$AExch } \tab [numeric] series of actual exchange between catchments (1+2) [mm/h] \cr
- \emph{$QR } \tab [numeric] series of routing store outflow (QR) [mm/h] \cr
- \emph{$QD } \tab [numeric] series of direct flow from UH2 after exchange (QD) [mm/h] \cr
- \emph{$Qsim } \tab [numeric] series of simulated discharge [mm/h] \cr
- \emph{$StateEnd} \tab [numeric] states at the end of the run (res. levels, UH1 levels, UH2 levels) [mm], see \code{\link{CreateIniStates}} for more details \cr
- }
- (refer to the provided references or to the package source code for further details on these model outputs)
+[list] containing the function outputs organised as follows:
+ \tabular{ll}{
+ \emph{$DatesR } \tab [POSIXlt] series of dates \cr
+ \emph{$PotEvap } \tab [numeric] series of input potential evapotranspiration (E) [mm/h] \cr
+ \emph{$Precip } \tab [numeric] series of input total precipitation (P) [mm/h] \cr
+ \emph{$Interc } \tab [numeric] series of interception store level (I) [mm] \cr
+ \emph{$Prod } \tab [numeric] series of production store level (S) [mm] \cr
+ \emph{$Pn } \tab [numeric] series of net rainfall (Pn) [mm/h] \cr
+ \emph{$Ps } \tab [numeric] series of the part of Pn filling the production store (Ps) [mm/h] \cr
+ \emph{$AE } \tab [numeric] series of actual evapotranspiration (Ei+Es) [mm/h] \cr
+ \emph{$EI } \tab [numeric] series of evapotranspiration from rainfall neutralisation or interception store (Ei) [mm/h] \cr
+ \emph{$ES } \tab [numeric] series of evapotranspiration from production store (Es) [mm/h] \cr
+ \emph{$Perc } \tab [numeric] series of percolation (Perc) [mm/h] \cr
+ \emph{$PR } \tab [numeric] series of Pr=Pn-Ps+Perc (Pr) [mm/h] \cr
+ \emph{$Q9 } \tab [numeric] series of UH outflow going into branch 9 (Q9) [mm/h] \cr
+ \emph{$Q1 } \tab [numeric] series of UH outflow going into branch 1 (Q1) [mm/h] \cr
+ \emph{$Rout } \tab [numeric] series of routing store level (R1) [mm] \cr
+ \emph{$Exch } \tab [numeric] series of potential semi-exchange between catchments [mm/h] \cr
+ \emph{$AExch1 } \tab [numeric] series of actual exchange between catchments for branch 1 [mm/h] \cr
+ \emph{$AExch2 } \tab [numeric] series of actual exchange between catchments for branch 2 [mm/h] \cr
+ \emph{$AExch } \tab [numeric] series of actual exchange between catchments (AExch1+AExch2) [mm/h] \cr
+ \emph{$QR } \tab [numeric] series of routing store outflow (Qr) [mm/h] \cr
+ \emph{$QD } \tab [numeric] series of direct flow from UH after exchange (Qd) [mm/h] \cr
+ \emph{$Qsim } \tab [numeric] series of simulated discharge (Q) [mm/h] \cr
+ \emph{$StateEnd} \tab [numeric] states at the end of the run (res. levels, UH levels) [mm]. See \code{\link{CreateIniStates}} for more details \cr
+ }
+Refer to the provided references or to the package source code for further details on these model outputs.
}
@@ -70,6 +70,10 @@ It is advised to run the GR5H model with an interception store (see Ficchi (2017
For further details on the model, see the references section. \cr
For further details on the argument structures and initialisation options, see \code{\link{CreateRunOptions}}.
+\cr
+\cr
+\if{html}{\figure{diagramGR5H-EN.png}{options: width="60\%" alt="Figure: diagramGR5H-EN.png"}}
+\if{latex}{\figure{diagramGR5H-EN.pdf}{options: width=6cm}}
}
@@ -118,11 +122,11 @@ Laurent Coron, Guillaume Thirel, Olivier Delaigue
Ficchi, A. (2017).
An adaptive hydrological model for multiple time-steps:
Diagnostics and improvements based on fluxes consistency.
- PhD thesis, Irstea (Antony), GRNE (Paris), France.
+ PhD thesis, UPMC - Irstea Antony, Paris, France.
\cr\cr
-Ficchi, A., C. Perrin and V. Andréassian (2019).
+Ficchi, A., Perrin, C. and Andréassian, V. (2019).
Hydrological modelling at multiple sub-daily time steps: model improvement via flux-matching.
- Journal of Hydrology, 575, 1308-1327. doi: 10.1016/j.jhydrol.2019.05.084.
+ Journal of Hydrology, 575, 1308-1327, \doi{10.1016/j.jhydrol.2019.05.084}.
}
diff --git a/man/RunModel_GR5J.Rd b/man/RunModel_GR5J.Rd
index 993dbf93439bcae897fc117c6099f8dbd92bc14a..227d86182fc22d8395352d37d636906873585f0e 100644
--- a/man/RunModel_GR5J.Rd
+++ b/man/RunModel_GR5J.Rd
@@ -24,7 +24,7 @@ RunModel_GR5J(InputsModel, RunOptions, Param)
\item{RunOptions}{[object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details}
\item{Param}{[numeric] vector of 5 parameters
- \tabular{ll}{
+ \tabular{ll}{
GR5J X1 \tab production store capacity [mm] \cr
GR5J X2 \tab intercatchment exchange coefficient [mm/d] \cr
GR5J X3 \tab routing store capacity [mm] \cr
@@ -35,35 +35,35 @@ RunModel_GR5J(InputsModel, RunOptions, Param)
\value{
-[list] list containing the function outputs organised as follows:
- \tabular{ll}{
- \emph{$DatesR } \tab [POSIXlt] series of dates \cr
- \emph{$PotEvap } \tab [numeric] series of input potential evapotranspiration [mm/d] \cr
- \emph{$Precip } \tab [numeric] series of input total precipitation [mm/d] \cr
- \emph{$Prod } \tab [numeric] series of production store level [mm] \cr
- \emph{$Pn } \tab [numeric] series of net rainfall [mm/d] \cr
- \emph{$Ps } \tab [numeric] series of the part of Pn filling the production store [mm/d] \cr
- \emph{$AE } \tab [numeric] series of actual evapotranspiration [mm/d] \cr
- \emph{$Perc } \tab [numeric] series of percolation (PERC) [mm/d] \cr
- \emph{$PR } \tab [numeric] series of PR=Pn-Ps+Perc [mm/d] \cr
- \emph{$Q9 } \tab [numeric] series of UH1 outflow (Q9) [mm/d] \cr
- \emph{$Q1 } \tab [numeric] series of UH2 outflow (Q1) [mm/d] \cr
- \emph{$Rout } \tab [numeric] series of routing store level [mm] \cr
- \emph{$Exch } \tab [numeric] series of potential semi-exchange between catchments [mm/d] \cr
- \emph{$AExch1 } \tab [numeric] series of actual exchange between catchments for branch 1 [mm/d] \cr
- \emph{$AExch2 } \tab [numeric] series of actual exchange between catchments for branch 2 [mm/d] \cr
- \emph{$AExch } \tab [numeric] series of actual exchange between catchments (1+2) [mm/d] \cr
- \emph{$QR } \tab [numeric] series of routing store outflow (QR) [mm/d] \cr
- \emph{$QD } \tab [numeric] series of direct flow from UH2 after exchange (QD) [mm/d] \cr
- \emph{$Qsim } \tab [numeric] series of simulated discharge [mm/d] \cr
- \emph{$StateEnd} \tab [numeric] states at the end of the run (res. levels, UH1 levels, UH2 levels) [mm], \cr\tab see \code{\link{CreateIniStates}} for more details \cr
- }
- (refer to the provided references or to the package source code for further details on these model outputs)
+[list] containing the function outputs organised as follows:
+ \tabular{ll}{
+ \emph{$DatesR } \tab [POSIXlt] series of dates \cr
+ \emph{$PotEvap } \tab [numeric] series of input potential evapotranspiration (E) [mm/d] \cr
+ \emph{$Precip } \tab [numeric] series of input total precipitation (P) [mm/d] \cr
+ \emph{$Prod } \tab [numeric] series of production store level (S) [mm] \cr
+ \emph{$Pn } \tab [numeric] series of net rainfall (Pn) [mm/d] \cr
+ \emph{$Ps } \tab [numeric] series of the part of Pn filling the production store (Ps) [mm/d] \cr
+ \emph{$AE } \tab [numeric] series of actual evapotranspiration [mm/d] \cr
+ \emph{$Perc } \tab [numeric] series of percolation (Perc) [mm/d] \cr
+ \emph{$PR } \tab [numeric] series of Pr=Pn-Ps+Perc (Pr) [mm/d] \cr
+ \emph{$Q9 } \tab [numeric] series of UH outflow going into branch 9 (Q9) [mm/d] \cr
+ \emph{$Q1 } \tab [numeric] series of UH outflow going into branch 1 (Q1) [mm/d] \cr
+ \emph{$Rout } \tab [numeric] series of routing store level (R1) [mm] \cr
+ \emph{$Exch } \tab [numeric] series of potential semi-exchange between catchments [mm/d] \cr
+ \emph{$AExch1 } \tab [numeric] series of actual exchange between catchments for branch 1 [mm/d] \cr
+ \emph{$AExch2 } \tab [numeric] series of actual exchange between catchments for branch 2 [mm/d] \cr
+ \emph{$AExch } \tab [numeric] series of actual exchange between catchments (AExch1+AExch2) [mm/d] \cr
+ \emph{$QR } \tab [numeric] series of routing store outflow (Qr) [mm/d] \cr
+ \emph{$QD } \tab [numeric] series of direct flow from UH after exchange (Qd) [mm/d] \cr
+ \emph{$Qsim } \tab [numeric] series of simulated discharge (Q) [mm/d] \cr
+ \emph{$StateEnd} \tab [numeric] states at the end of the run (res. levels, UH levels) [mm]. See \code{\link{CreateIniStates}} for more details \cr
+ }
+Refer to the provided references or to the package source code for further details on these model outputs.
}
\details{
-For further details on the model, see the references section.
+For further details on the model, see the references section. \cr
For further details on the argument structures and initialisation options, see \code{\link{CreateRunOptions}}.
\cr
\cr
@@ -79,11 +79,11 @@ library(airGR)
data(L0123001)
## preparation of the InputsModel object
-InputsModel <- CreateInputsModel(FUN_MOD = RunModel_GR5J, DatesR = BasinObs$DatesR,
+InputsModel <- CreateInputsModel(FUN_MOD = RunModel_GR5J, DatesR = BasinObs$DatesR,
Precip = BasinObs$P, PotEvap = BasinObs$E)
## run period selection
-Ind_Run <- seq(which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1990-01-01"),
+Ind_Run <- seq(which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1990-01-01"),
which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1999-12-31"))
## preparation of the RunOptions object
@@ -99,7 +99,7 @@ OutputsModel <- RunModel_GR5J(InputsModel = InputsModel,
plot(OutputsModel, Qobs = BasinObs$Qmm[Ind_Run])
## efficiency criterion: Nash-Sutcliffe Efficiency
-InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
+InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
RunOptions = RunOptions, Obs = BasinObs$Qmm[Ind_Run])
OutputsCrit <- ErrorCrit_NSE(InputsCrit = InputsCrit, OutputsModel = OutputsModel)
}
@@ -111,14 +111,14 @@ Laurent Coron, Claude Michel, Nicolas Le Moine, Olivier Delaigue, Guillaume Thir
\references{
-Le Moine, N. (2008).
- Le bassin versant de surface vu par le souterrain :
- une voie d'amélioration des performances et du réalisme des modèles pluie-débit ?
- PhD thesis (french), UPMC, Paris, France.
+Le Moine, N. (2008).
+ Le bassin versant de surface vu par le souterrain :
+ une voie d'amélioration des performances et du réalisme des modèles pluie-débit ?
+ PhD thesis (in French), UPMC - Cemagref Antony, Paris, France.
\cr\cr
-Pushpalatha, R., C. Perrin, N. Le Moine, T. Mathevet, and V. Andréassian (2011).
- A downward structural sensitivity analysis of hydrological models to improve low-flow simulation.
- Journal of Hydrology, 411(1-2), 66-76. doi: 10.1016/j.jhydrol.2011.09.034.
+Pushpalatha, R., Perrin, C., Le Moine, N., Mathevet, T. and Andréassian, V. (2011).
+ A downward structural sensitivity analysis of hydrological models to improve low-flow simulation.
+ Journal of Hydrology, 411(1-2), 66-76, \doi{10.1016/j.jhydrol.2011.09.034}.
}
diff --git a/man/RunModel_GR6J.Rd b/man/RunModel_GR6J.Rd
index 9974afe991d986a02f31bcd632b13f311675f6a6..7a1849b5ec58407b9c9ee01a645307c65dd4e2e7 100644
--- a/man/RunModel_GR6J.Rd
+++ b/man/RunModel_GR6J.Rd
@@ -25,48 +25,48 @@ RunModel_GR6J(InputsModel, RunOptions, Param)
\item{Param}{[numeric] vector of 6 parameters
\tabular{ll}{
- GR6J X1 \tab production store capacity [mm] \cr
- GR6J X2 \tab intercatchment exchange coefficient [mm/d] \cr
- GR6J X3 \tab routing store capacity [mm] \cr
- GR6J X4 \tab unit hydrograph time constant [d] \cr
- GR6J X5 \tab intercatchment exchange threshold [-] \cr
- GR6J X6 \tab coefficient for emptying exponential store [mm] \cr
+ GR6J X1 \tab production store capacity [mm] \cr
+ GR6J X2 \tab intercatchment exchange coefficient [mm/d] \cr
+ GR6J X3 \tab routing store capacity [mm] \cr
+ GR6J X4 \tab unit hydrograph time constant [d] \cr
+ GR6J X5 \tab intercatchment exchange threshold [-] \cr
+ GR6J X6 \tab exponential store depletion coefficient [mm] \cr
}}
}
\value{
-[list] list containing the function outputs organised as follows:
- \tabular{ll}{
- \emph{$DatesR } \tab [POSIXlt] series of dates \cr
- \emph{$PotEvap } \tab [numeric] series of input potential evapotranspiration [mm/d] \cr
- \emph{$Precip } \tab [numeric] series of input total precipitation [mm/d] \cr
- \emph{$Prod } \tab [numeric] series of production store level [mm] \cr
- \emph{$Pn } \tab [numeric] series of net rainfall [mm/d] \cr
- \emph{$Ps } \tab [numeric] series of the part of Pn filling the production store [mm/d] \cr
- \emph{$AE } \tab [numeric] series of actual evapotranspiration [mm/d] \cr
- \emph{$Perc } \tab [numeric] series of percolation (PERC) [mm/d] \cr
- \emph{$PR } \tab [numeric] series of PR=Pn-Ps+Perc [mm/d] \cr
- \emph{$Q9 } \tab [numeric] series of UH1 outflow (Q9) [mm/d] \cr
- \emph{$Q1 } \tab [numeric] series of UH2 outflow (Q1) [mm/d] \cr
- \emph{$Rout } \tab [numeric] series of routing store level [mm] \cr
- \emph{$Exch } \tab [numeric] series of potential semi-exchange between catchments [mm/d] \cr
- \emph{$AExch1 } \tab [numeric] series of actual exchange between catchments for branch 1 [mm/d] \cr
- \emph{$AExch2 } \tab [numeric] series of actual exchange between catchments for branch 2 [mm/d] \cr
- \emph{$AExch } \tab [numeric] series of actual exchange between catchments (1+2) [mm/d] \cr
- \emph{$QR } \tab [numeric] series of routing store outflow (QR) [mm/d] \cr
- \emph{$QRExp } \tab [numeric] series of exponential store outflow (QRExp) [mm/d] \cr
- \emph{$Exp } \tab [numeric] series of exponential store level (negative) [mm] \cr
- \emph{$QD } \tab [numeric] series of direct flow from UH2 after exchange (QD) [mm/d] \cr
- \emph{$Qsim } \tab [numeric] series of Qsim [mm/d] \cr
- \emph{$StateEnd} \tab [numeric] states at the end of the run (res. levels, UH1 levels, UH2 levels) [mm], \cr\tab see \code{\link{CreateIniStates}} for more details \cr
- }
- (refer to the provided references or to the package source code for further details on these model outputs)
+[list] containing the function outputs organised as follows:
+ \tabular{ll}{
+ \emph{$DatesR } \tab [POSIXlt] series of dates \cr
+ \emph{$PotEvap } \tab [numeric] series of input potential evapotranspiration (E) [mm/d] \cr
+ \emph{$Precip } \tab [numeric] series of input total precipitation (P) [mm/d] \cr
+ \emph{$Prod } \tab [numeric] series of production store level (S) [mm] \cr
+ \emph{$Pn } \tab [numeric] series of net rainfall (Pn) [mm/d] \cr
+ \emph{$Ps } \tab [numeric] series of the part of Pn filling the production store (Ps) [mm/d] \cr
+ \emph{$AE } \tab [numeric] series of actual evapotranspiration [mm/d] \cr
+ \emph{$Perc } \tab [numeric] series of percolation (Perc) [mm/d] \cr
+ \emph{$PR } \tab [numeric] series of Pr=Pn-Ps+Perc (Pr) [mm/d] \cr
+ \emph{$Q9 } \tab [numeric] series of UH1 outflow (Q9) [mm/d] \cr
+ \emph{$Q1 } \tab [numeric] series of UH2 outflow (Q1) [mm/d] \cr
+ \emph{$Rout } \tab [numeric] series of routing store level (R1) [mm] \cr
+ \emph{$Exch } \tab [numeric] series of potential semi-exchange between catchments [mm/d] \cr
+ \emph{$AExch1 } \tab [numeric] series of actual exchange between catchments for branch 1 [mm/d] \cr
+ \emph{$AExch2 } \tab [numeric] series of actual exchange between catchments for branch 2 [mm/d] \cr
+ \emph{$AExch } \tab [numeric] series of actual exchange between catchments (AExch1+AExch2) [mm/d] \cr
+ \emph{$QR } \tab [numeric] series of routing store outflow (Qr) [mm/d] \cr
+ \emph{$QRExp } \tab [numeric] series of exponential store outflow (QrExp) [mm/d] \cr
+ \emph{$Exp } \tab [numeric] series of exponential store level (negative) (R2) [mm] \cr
+ \emph{$QD } \tab [numeric] series of direct flow from UH2 after exchange (Qd) [mm/d] \cr
+ \emph{$Qsim } \tab [numeric] series of simulated discharge (Q) [mm/d] \cr
+ \emph{$StateEnd} \tab [numeric] states at the end of the run (res. levels, UH1 levels, UH2 levels) [mm]. See \code{\link{CreateIniStates}} for more details \cr
+ }
+Refer to the provided references or to the package source code for further details on these model outputs.
}
\details{
-For further details on the model, see the references section.
+For further details on the model, see the references section. \cr
For further details on the argument structures and initialisation options, see \code{\link{CreateRunOptions}}.
\cr
\cr
@@ -82,11 +82,11 @@ library(airGR)
data(L0123001)
## preparation of the InputsModel object
-InputsModel <- CreateInputsModel(FUN_MOD = RunModel_GR6J, DatesR = BasinObs$DatesR,
+InputsModel <- CreateInputsModel(FUN_MOD = RunModel_GR6J, DatesR = BasinObs$DatesR,
Precip = BasinObs$P, PotEvap = BasinObs$E)
## run period selection
-Ind_Run <- seq(which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1990-01-01"),
+Ind_Run <- seq(which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1990-01-01"),
which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1999-12-31"))
## preparation of the RunOptions object
@@ -102,7 +102,7 @@ OutputsModel <- RunModel_GR6J(InputsModel = InputsModel,
plot(OutputsModel, Qobs = BasinObs$Qmm[Ind_Run])
## efficiency criterion: Nash-Sutcliffe Efficiency
-InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
+InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
RunOptions = RunOptions, Obs = BasinObs$Qmm[Ind_Run])
OutputsCrit <- ErrorCrit_NSE(InputsCrit = InputsCrit, OutputsModel = OutputsModel)
}
@@ -114,9 +114,9 @@ Laurent Coron, Claude Michel, Charles Perrin, Raji Pushpalatha, Nicolas Le Moine
\references{
-Pushpalatha, R., C. Perrin, N. Le Moine, T. Mathevet and V. Andréassian (2011).
- A downward structural sensitivity analysis of hydrological models to improve low-flow simulation.
- Journal of Hydrology, 411(1-2), 66-76. doi: 10.1016/j.jhydrol.2011.09.034.
+Pushpalatha, R., Perrin, C., Le Moine, N., Mathevet, T. and Andréassian, V. (2011).
+ A downward structural sensitivity analysis of hydrological models to improve low-flow simulation.
+ Journal of Hydrology, 411(1-2), 66-76, \doi{10.1016/j.jhydrol.2011.09.034}.
}
diff --git a/man/RunModel_Lag.Rd b/man/RunModel_Lag.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..f2fffafb4f3af425f19a3e8d931aa91e423e890d
--- /dev/null
+++ b/man/RunModel_Lag.Rd
@@ -0,0 +1,100 @@
+\encoding{UTF-8}
+
+
+\name{RunModel_Lag}
+\alias{RunModel_Lag}
+
+
+\title{Run with the Lag model}
+
+
+\description{
+Function which performs a single run for the Lag model over the test period.
+}
+
+
+\usage{
+RunModel_Lag(InputsModel, RunOptions, Param)
+}
+
+
+\arguments{
+\item{InputsModel}{[object of class \emph{InputsModel}] created with SD model inputs, see \code{\link{CreateInputsModel}} for details. The object should also contain a key \emph{OutputsModel}] of class \code{\link{CreateInputsModel}} coming from the simulation of the downstream subcatchement runoff.}
+
+\item{RunOptions}{[object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details}
+
+\item{Param}{[numeric] vector of 1 parameter
+ \tabular{ll}{
+ Lag \tab Mean flow velocity [m/s]
+ }}
+}
+
+
+\value{
+[list] see \code{\link{RunModel_GR4J}} or \code{\link{RunModel_CemaNeigeGR4J}} for details.
+
+The list value contains an extra item named \code{QsimDown} which is a copy of InputsModel\$OutputsModel\$Qsim, a numeric series of simulated discharge [mm/time step] related to the run-off contribution of the downstream sub-catchment.
+}
+
+
+\examples{
+library(airGR)
+
+## loading catchment data
+data(L0123001)
+
+## Simulating a reservoir
+# Withdrawing 1 m3/s with an instream flow of 1 m3/s
+Qupstream <- matrix(- unlist(lapply(BasinObs$Qls / 1000 - 1, function(x) {
+ min(1, max(0,x, na.rm = TRUE))
+})), ncol = 1)
+# Except between July and November when releasing 3 m3/s
+month <- as.numeric(format(BasinObs$DatesR,"\%m"))
+Qupstream[month >= 7 & month <= 9] <- 3
+# Conversion in m3/day
+Qupstream <- Qupstream * 86400
+
+## The reservoir is not an upstream subcachment: its areas is NA
+BasinAreas <- c(NA, BasinInfo$BasinArea)
+
+## Delay time between the reservoir and the catchment outlet is 2 days and the distance is 150 km
+LenghtHydro <- 150
+Lag <- LenghtHydro / 2 / 86400 * 1000 # Conversion km/day -> m/s
+
+## preparation of the InputsModel object
+InputsModel <- CreateInputsModel(FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR,
+ Precip = BasinObs$P, PotEvap = BasinObs$E,
+ Qupstream = Qupstream, LengthHydro = LenghtHydro,
+ BasinAreas = BasinAreas)
+
+## run period selection
+Ind_Run <- seq(which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1990-01-01"),
+ which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1999-12-31"))
+
+## preparation of the RunOptions object
+RunOptions <- CreateRunOptions(FUN_MOD = RunModel_GR4J,
+ InputsModel = InputsModel, IndPeriod_Run = Ind_Run)
+
+## simulation of dowstream subcatchment
+Param <- c(X1 = 257.238, X2 = 1.012, X3 = 88.235, X4 = 2.208)
+OutputsModelDown <- RunModel_GR4J(InputsModel = InputsModel,
+ RunOptions = RunOptions, Param = Param)
+
+InputsModel$OutputsModel <- OutputsModelDown
+OutputsModel <- RunModel_Lag(InputsModel = InputsModel,
+ RunOptions = RunOptions, Param = Lag)
+
+## results preview of comparison between naturalised (observed) and influenced flow (simulated)
+plot(OutputsModel, Qobs = OutputsModel$QsimDown)
+}
+
+
+\author{
+Olivier Delaigue, David Dorchies, Guillaume Thirel
+}
+
+
+\seealso{
+\code{\link{RunModel}}, \code{\link{CreateInputsModel}}, \code{\link{CreateRunOptions}}.
+}
+
diff --git a/man/SeriesAggreg.Rd b/man/SeriesAggreg.Rd
index 4498eb6e09ef89614ef7561ff74e7e061e581363..48d5da1c4acf52f7cbd067fa0fb7bff37e28477f 100644
--- a/man/SeriesAggreg.Rd
+++ b/man/SeriesAggreg.Rd
@@ -3,41 +3,85 @@
\name{SeriesAggreg}
\alias{SeriesAggreg}
+\alias{SeriesAggreg.list}
+\alias{SeriesAggreg.data.frame}
+\alias{SeriesAggreg.InputsModel}
+\alias{SeriesAggreg.OutputsModel}
-\title{Conversion of time series to another time step (aggregation only)}
+\title{Conversion of time series to another time step (aggregation only) and regime computation}
\description{
-Conversion of time series to another time step (aggregation only). \cr
-Warning : on the aggregated outputs, the dates correspond to the beginning of the time step \cr
-(e.g. for daily time-series 2005-03-01 00:00 = value for period 2005-03-01 00:00 - 2005-03-01 23:59) \cr
-(e.g. for monthly time-series 2005-03-01 00:00 = value for period 2005-03-01 00:00 - 2005-03-31 23:59) \cr
-(e.g. for yearly time-series 2005-03-01 00:00 = value for period 2005-03-01 00:00 - 2006-02-28 23:59)
+Conversion of time series to another time step (aggregation only) and regime computation. \cr
+Warning: on the aggregated outputs, the dates correspond to the beginning of the time step \cr
+(e.g. for daily time series 2005-03-01 00:00 = value for period 2005-03-01 00:00 - 2005-03-01 23:59) \cr
+(e.g. for monthly time series 2005-03-01 00:00 = value for period 2005-03-01 00:00 - 2005-03-31 23:59) \cr
+(e.g. for yearly time series 2005-03-01 00:00 = value for period 2005-03-01 00:00 - 2006-02-28 23:59)
+}
+
+
+\details{
+ \code{\link{SeriesAggreg.InputsModel}} and \code{\link{SeriesAggreg.OutputsModel}}
+ call \code{\link{SeriesAggreg.list}} which itself calls \code{\link{SeriesAggreg.data.frame}}.
+ So, all arguments passed to any \code{\link{SeriesAggreg}} method will be passed to \code{\link{SeriesAggreg.data.frame}}.
+
+ Argument \code{ConvertFun} also supports quantile calculation by using the syntax "Q[nn]" with [nn] the requested percentile.
+ E.g. use "Q90" for calculating 90th percentile in the aggregation.
+ The formula used is: \code{quantile(x, probs = perc / 100, type = 8, na.rm = TRUE)}.
+
}
\usage{
-SeriesAggreg(TabSeries, TimeFormat, NewTimeFormat, ConvertFun,
- YearFirstMonth = 1, TimeLag = 0, verbose = TRUE)
+\method{SeriesAggreg}{data.frame}(x,
+ Format,
+ ConvertFun,
+ TimeFormat = NULL,
+ NewTimeFormat = NULL,
+ YearFirstMonth = 1,
+ TimeLag = 0,
+ \dots)
+
+\method{SeriesAggreg}{list}(x,
+ Format,
+ ConvertFun,
+ NewTimeFormat = NULL,
+ simplify = FALSE,
+ except = NULL,
+ recursive = TRUE,
+ \dots)
+
+\method{SeriesAggreg}{InputsModel}(x, Format, \dots)
+
+\method{SeriesAggreg}{OutputsModel}(x, Format, \dots)
}
\arguments{
-\item{TabSeries}{[POSIXt+numeric] data.frame containing the vector of dates (POSIXt) and the time series values numeric)}
+\item{x}{[InputsModel], [OutputsModel], [list] or [data.frame] containing the vector of dates (\emph{POSIXt}) and the time series of numeric values}
+
+\item{Format}{[character] output time step format (i.e. yearly times series: \code{"\%Y"}, monthly time series: \code{"\%Y\%m"}, daily time series: \code{"\%Y\%m\%d"}, monthly regimes: \code{"\%m"}, daily regimes: \code{"\%d"})}
-\item{TimeFormat}{[character] input time-step format (i.e. \code{"hourly"}, \code{"daily"}, \code{"monthly"} or \code{"yearly"})}
+\item{TimeFormat}{(deprecated) [character] input time step format (i.e. \code{"hourly"}, \code{"daily"}, \code{"monthly"} or \code{"yearly"}). Use the \code{x} argument instead}
-\item{NewTimeFormat}{[character] output time-step format (i.e. \code{"hourly"}, \code{"daily"}, \code{"monthly"} or \code{"yearly"})}
+\item{NewTimeFormat}{(deprecated) [character] output time step format (i.e. \code{"hourly"}, \code{"daily"}, \code{"monthly"} or \code{"yearly"}). Use the \code{Format} argument instead}
-\item{ConvertFun}{[character] names of aggregation functions (e.g. for P[mm], T[degC], Q[mm] : \code{ConvertFun = c("sum", "mean", "sum"}))}
+\item{ConvertFun}{[character] names of aggregation functions (e.g. for P[mm], T[degC], Q[mm]: \code{ConvertFun = c("sum", "mean", "sum"})) or name of aggregation function to apply to all elements if the parameter 'x' is a [list] . See details}
-\item{YearFirstMonth}{(optional) [numeric] integer used when \code{NewTimeFormat = "yearly"} to set when the starting month of the year (e.g. 01 for calendar year or 09 for hydrological year starting in September)}
+\item{YearFirstMonth}{(optional) [numeric] integer used when \code{Format = "\%Y"} to set when the starting month of the year (e.g. 01 for calendar year or 09 for hydrological year starting in September)}
-\item{TimeLag}{(optional) [numeric] numeric indicating a time lag (in seconds) for the time series aggregation (especially useful to aggregate hourly time series in daily time series)}
+\item{TimeLag}{(optional) [numeric] numeric indicating a time lag (in seconds) for the time series aggregation (especially useful to aggregate hourly time series into daily time series)}
-\item{verbose}{(optional) [boolean] boolean indicating if the function is run in verbose mode or not, default = \code{FALSE}}
+\item{simplify}{(optional) [boolean] if set to \code{TRUE}, a \code{\link{data.frame}} is returned instead of a \code{\link{list}}. Embedded lists are then ignored. (default = \code{FALSE})}
+
+\item{except}{(optional) [character] the name of the items to skip in the aggregation (default = \code{NULL})}
+
+\item{recursive}{(optional) [boolean] if set to \code{FALSE}, embedded lists and dataframes are not aggregated (default = \code{TRUE})}
+
+\item{\dots}{Arguments passed to \code{\link{SeriesAggreg.list}} and then to \code{\link{SeriesAggreg.data.frame}}}
}
+
\value{
[POSIXct+numeric] data.frame containing a vector of aggregated dates (POSIXct) and time series values numeric)
}
@@ -52,20 +96,29 @@ data(L0123002)
## preparation of the initial time series data frame at the daily time step
TabSeries <- BasinObs[, c("DatesR", "P", "E", "T", "Qmm")]
-## conversion at the monthly time step
-NewTabSeries <- SeriesAggreg(TabSeries = TabSeries,
- TimeFormat = "daily", NewTimeFormat = "monthly",
+## monthly time series
+NewTabSeries <- SeriesAggreg(TabSeries,
+ Format = "\%Y\%m",
ConvertFun = c("sum", "sum", "mean", "sum"))
+str(NewTabSeries)
-## conversion at the yearly time step
-NewTabSeries <- SeriesAggreg(TabSeries = TabSeries,
- TimeFormat = "daily", NewTimeFormat = "yearly",
+## monthly regimes
+NewTabSeries <- SeriesAggreg(TabSeries,
+ Format = "\%m",
ConvertFun = c("sum", "sum", "mean", "sum"))
+str(NewTabSeries)
+
+## conversion of InputsModel
+example("RunModel_GR2M")
+
+## monthly regimes on OutputsModel object
+SimulatedMonthlyRegime <- SeriesAggreg(OutputsModel, Format = "\%m")
+str(SimulatedMonthlyRegime)
}
\author{
-Laurent Coron
+Olivier Delaigue, David Dorchies
}
diff --git a/man/TransfoParam.Rd b/man/TransfoParam.Rd
index 0bf8485c4b1dda200e315fae53bcb1ec7977f278..de58b74b8908342e621d973d77e5e7eaef589440 100644
--- a/man/TransfoParam.Rd
+++ b/man/TransfoParam.Rd
@@ -12,6 +12,7 @@
\alias{TransfoParam_GR5H}
\alias{TransfoParam_CemaNeige}
\alias{TransfoParam_CemaNeigeHyst}
+\alias{TransfoParam_Lag}
\title{Transformation of the parameters using the provided function}
diff --git a/man/airGR.Rd b/man/airGR.Rd
index ca84f5b2f30bb8169d2e7738185da88bee195ec6..d6709cc26da980f32af45a3efe49872879b3aa3d 100644
--- a/man/airGR.Rd
+++ b/man/airGR.Rd
@@ -2,66 +2,77 @@
\alias{airGR}
\docType{package}
\encoding{UTF-8}
-\title{Suite of GR Hydrological Models for Precipitation-Runoff Modelling}
+\title{\packageTitle{airGR}}
+
+
\description{
-This package brings into R the hydrological modelling tools developed at INRAE-Antony (formerly IRSTEA, HYCAR Research Unit, France), including rainfall-runoff models (\strong{GR4H}, \strong{GR5H}, \strong{GR4J}, \strong{GR5J}, \strong{GR6J}, \strong{GR2M}, \strong{GR1A}) and a snow accumulation and melt model (\strong{CemaNeige}). Each model core is coded in Fortran to ensure low computational time. The other package functions (i.e. mainly the calibration algorithm and the computation of the efficiency criteria) are coded in R. \cr\cr
+\packageDescription{airGR}
+Each model core is coded in Fortran to ensure low computational time. The other package functions (i.e. mainly the calibration algorithm and the computation of the efficiency criteria) are coded in R. \cr\cr
-## ---- Functions and objects
+## --- Functions and objects
-The airGR package has been designed to fulfil two major requirements: facilitate the use by non-expert users and allow flexibility regarding the addition of external criteria, models or calibration algorithms. The names of the functions and their arguments were chosen to this end.
+The airGR package has been designed to fulfil two major requirements: facilitate the use by non-expert users and allow flexibility regarding the addition of external criteria, models or calibration algorithms. The names of the functions and their arguments were chosen to this end.
-The package is mostly based on three families of functions: \cr
-- the functions belonging to the \code{\link{RunModel}} family require three arguments: \emph{InputsModel}, \emph{RunOptions} and \emph{Param}; please refer to help pages \code{\link{CreateInputsModel}} and \code{\link{CreateRunOptions}} for further details and examples; \cr
-- the functions belonging to the \code{\link{ErrorCrit}} family require two arguments: \emph{InputsCrit} and \emph{OutputsModel}; please refer to help pages \code{\link{CreateInputsCrit}} and \code{\link{RunModel}} for further details and examples; \cr
-- the functions belonging to the \code{\link{Calibration}} family require four arguments: \emph{InputsModel}, \emph{RunOptions}, \emph{InputsCrit} and \emph{CalibOptions}; please refer to help pages \code{\link{CreateInputsModel}}, \code{\link{CreateRunOptions}}, \code{\link{CreateInputsCrit}} and \code{\link{CreateCalibOptions}} for further details and examples.
+The package is mostly based on three families of functions:
+\itemize{
+ \item the functions belonging to the \code{\link{RunModel}} family require three arguments: \emph{InputsModel}, \emph{RunOptions} and \emph{Param}; please refer to help pages \code{\link{CreateInputsModel}} and \code{\link{CreateRunOptions}} for further details and examples;
+ \item the functions belonging to the \code{\link{ErrorCrit}} family require two arguments: \emph{InputsCrit} and \emph{OutputsModel}; please refer to help pages \code{\link{CreateInputsCrit}} and \code{\link{RunModel}} for further details and examples;
+ \item the functions belonging to the \code{\link{Calibration}} family require four arguments: \emph{InputsModel}, \emph{RunOptions}, \emph{InputsCrit} and \emph{CalibOptions}; please refer to help pages \code{\link{CreateInputsModel}}, \code{\link{CreateRunOptions}}, \code{\link{CreateInputsCrit}} and \code{\link{CreateCalibOptions}} for further details and examples.
+}
In order to limit the risk of mis-use and increase the flexibility of these main functions, we imposed the structure of their arguments and defined their class. Most users will not need to worry about these imposed structures since functions are provided to prepare these arguments for them: \code{\link{CreateInputsModel}}, \code{\link{CreateRunOptions}}, \code{\link{CreateInputsCrit}}, \code{\link{CreateCalibOptions}}. However, advanced users wishing to supplement the package with their own models will need to comply with these imposed structures and refer to the package source codes to get all the specification requirements. \cr\cr
-## ---- Models
+## --- Models
Seven hydrological models and one snow melt and accumulation model are implemented in airGR. The snow model can also be used alone or with the daily hydrological models, and each hydrological model can either be used alone or together with the snow model. \cr
-These models can be called within airGR using the following functions: \cr
- - \code{\link{RunModel_GR4H}}: four-parameter hourly lumped hydrological model (Mathevet, 2005) \cr
- - \code{\link{RunModel_GR5H}}: five-parameter hourly lumped hydrological model (Ficchi, 2017; Ficchi \emph{et al.}, 2019) \cr
- - \code{\link{RunModel_GR4J}}: four-parameter daily lumped hydrological model (Perrin \emph{et al.}, 2003) \cr
- - \code{\link{RunModel_GR5J}}: five-parameter daily lumped hydrological model (Le Moine, 2008) \cr
- - \code{\link{RunModel_GR6J}}: six-parameter daily lumped hydrological model (Pushpalatha \emph{et al.}, 2011) \cr
- - \code{\link{RunModel_GR2M}}: two-parameter monthly lumped hydrological model (Mouelhi, 2003; Mouelhi \emph{et al.}, 2006a) \cr
- - \code{\link{RunModel_GR1A}}: one-parameter yearly lumped hydrological model (Mouelhi, 2003; Mouelhi \emph{et al.}, 2006b) \cr
- - \code{\link{RunModel_CemaNeige}}: two-parameter degree-day snow melt and accumulation daily model (Valéry \emph{et al.}, 2014) \cr
- - \code{\link{RunModel_CemaNeigeGR4H}}: combined use of GR4H and CemaNeige \cr
- - \code{\link{RunModel_CemaNeigeGR5H}}: combined use of GR5H and CemaNeige \cr
- - \code{\link{RunModel_CemaNeigeGR4J}}: combined use of GR4J and CemaNeige \cr
- - \code{\link{RunModel_CemaNeigeGR5J}}: combined use of GR5J and CemaNeige \cr
- - \code{\link{RunModel_CemaNeigeGR6J}}: combined use of GR6J and CemaNeige \cr\cr
-
-
-## ---- How to get started
-
-To learn how to use the functions from the airGR package, it is recommended to follow the five steps described below: \cr
- 1. refer to the help for \code{\link{RunModel_GR4J}} then run the provided example to assess how to make a simulation; \cr
- 2. refer to the help for \code{\link{CreateInputsModel}} to understand how the inputs of a model are prepared/organised; \cr
- 3. refer to the help for \code{\link{CreateRunOptions}} to understand how the run options of a model are parametrised/organised; \cr
- 4. refer to the help for \code{\link{ErrorCrit_NSE}} and \code{\link{CreateInputsCrit}} to understand how the computation of an error criterion is prepared/made; \cr
- 5. refer to the help for \code{\link{Calibration_Michel}}, run the provided example and then refer to the help for \code{\link{CreateCalibOptions}} to understand how a model calibration is prepared/made. \cr
-
-For more information and to get started with the package, you can refer to the vignette (\code{vignette("airGR")}) and go on the \href{https://hydrogr.github.io/airGR/}{airGR website}. \cr\cr
-
-
-## ---- References
-
-- Ficchi, A. (2017). An adaptive hydrological model for multiple time-steps: Diagnostics and improvements based on fluxes consistency. PhD thesis, Irstea (Antony), GRNE (Paris), France.
-- Ficchi, A., C. Perrin and V. Andréassian (2019). Hydrological modelling at multiple sub-daily time steps: model improvement via flux-matching. Journal of Hydrology, 575, 1308-1327. doi: 10.1016/j.jhydrol.2019.05.084. \cr
-- Le Moine, N. (2008). Le bassin versant de surface vu par le souterrain : une voie d'amélioration des performances et du réalisme des modèles pluie-débit ?, PhD thesis (in French), UPMC - Cemagref Antony, Paris, France, 324 pp. \cr
-- Mathevet, T. (2005). Quels modèles pluie-débit globaux pour le pas de temps horaire ? Développement empirique et comparaison de modèles sur un large échantillon de bassins versants, PhD thesis (in French), ENGREF - Cemagref Antony, Paris, France, 463 pp. \cr
-- Mouelhi S. (2003). Vers une chaîne cohérente de modèles pluie-débit conceptuels globaux aux pas de temps pluriannuel, annuel, mensuel et journalier, PhD thesis (in French), ENGREF - Cemagref Antony, Paris, France, 323 pp. \cr
-- Mouelhi, S., C. Michel, C. Perrin and V. Andréassian (2006a). Stepwise development of a two-parameter monthly water balance model, Journal of Hydrology, 318(1-4), 200-214, doi: 10.1016/j.jhydrol.2005.06.014. \cr
-- Mouelhi, S., C. Michel, C. Perrin. & V. Andreassian (2006b). Linking stream flow to rainfall at the annual time step: the Manabe bucket model revisited, Journal of Hydrology, 328, 283-296, doi: 10.1016/j.jhydrol.2005.12.022. \cr
-- Perrin, C., C. Michel and V. Andréassian (2003). Improvement of a parsimonious model for streamflow simulation, Journal of Hydrology, 279(1-4), 275-289, doi: 10.1016/S0022-1694(03)00225-7. \cr
-- Pushpalatha, R., C. Perrin, N. Le Moine, T. Mathevet and V. Andréassian (2011). A downward structural sensitivity analysis of hydrological models to improve low-flow simulation, Journal of Hydrology, 411(1-2), 66-76, doi: 10.1016/j.jhydrol.2011.09.034. \cr
-- Valéry, A., V. Andréassian and C. Perrin (2014). "As simple as possible but not simpler": What is useful in a temperature-based snow-accounting routine? Part 2 - Sensitivity analysis of the Cemaneige snow accounting routine on 380 catchments, Journal of Hydrology, 517(0): 1176-1187, doi: 1176-1187, doi: 10.1016/j.jhydrol.2014.04.058. \cr
+These models can be called within airGR using the following functions:
+\itemize{
+ \item \code{\link{RunModel_GR4H}}: four-parameter hourly lumped hydrological model (Mathevet, 2005)
+ \item \code{\link{RunModel_GR5H}}: five-parameter hourly lumped hydrological model (Ficchi, 2017; Ficchi \emph{et al.}, 2019)
+ \item \code{\link{RunModel_GR4J}}: four-parameter daily lumped hydrological model (Perrin \emph{et al.}, 2003)
+ \item \code{\link{RunModel_GR5J}}: five-parameter daily lumped hydrological model (Le Moine, 2008)
+ \item \code{\link{RunModel_GR6J}}: six-parameter daily lumped hydrological model (Pushpalatha \emph{et al.}, 2011)
+ \item \code{\link{RunModel_GR2M}}: two-parameter monthly lumped hydrological model (Mouelhi, 2003; Mouelhi \emph{et al.}, 2006a)
+ \item \code{\link{RunModel_GR1A}}: one-parameter yearly lumped hydrological model (Mouelhi, 2003; Mouelhi \emph{et al.}, 2006b)
+ \item \code{\link{RunModel_CemaNeige}}: two-parameter degree-day snow melt and accumulation daily model (Valéry \emph{et al.}, 2014; Riboust \emph{et al.}, 2019)
+ \item \code{\link{RunModel_CemaNeigeGR4H}}: combined use of GR4H and CemaNeige
+ \item \code{\link{RunModel_CemaNeigeGR5H}}: combined use of GR5H and CemaNeige
+ \item \code{\link{RunModel_CemaNeigeGR4J}}: combined use of GR4J and CemaNeige
+ \item \code{\link{RunModel_CemaNeigeGR5J}}: combined use of GR5J and CemaNeige
+ \item \code{\link{RunModel_CemaNeigeGR6J}}: combined use of GR6J and CemaNeige
+}
+
+## --- How to get started
+
+To learn how to use the functions from the airGR package, it is recommended to follow the five steps described below:
+\enumerate{
+ \item refer to the help for \code{\link{RunModel_GR4J}} then run the provided example to assess how to make a simulation;
+ \item refer to the help for \code{\link{CreateInputsModel}} to understand how the inputs of a model are prepared/organised;
+ \item refer to the help for \code{\link{CreateRunOptions}} to understand how the run options of a model are parametrised/organised;
+ \item refer to the help for \code{\link{ErrorCrit_NSE}} and \code{\link{CreateInputsCrit}} to understand how the computation of an error criterion is prepared/made;
+ \item refer to the help for \code{\link{Calibration_Michel}}, run the provided example and then refer to the help for \code{\link{CreateCalibOptions}} to understand how a model calibration is prepared/made.
+}
+
+For more information and to get started with the package, you can refer to the vignette (\code{vignette("V01_get_started")}) and go on the \href{https://hydrogr.github.io/airGR/}{airGR website}. \cr\cr
+
+
+## --- References
+
+\itemize{
+\item Ficchi, A. (2017). An adaptive hydrological model for multiple time-steps: Diagnostics and improvements based on fluxes consistency. PhD thesis, UPMC - Irstea Antony, Paris, France.
+\item Ficchi, A., Perrin, C. and Andréassian, V. (2019). Hydrological modelling at multiple sub-daily time steps: model improvement via flux-matching. Journal of Hydrology, 575, 1308-1327, \doi{10.1016/j.jhydrol.2019.05.084}.
+\item Le Moine, N. (2008). Le bassin versant de surface vu par le souterrain : une voie d'amélioration des performances et du réalisme des modèles pluie-débit ?, PhD thesis (in French), UPMC - Cemagref Antony, Paris, France, 324 pp.
+\item Mathevet, T. (2005). Quels modèles pluie-débit globaux pour le pas de temps horaire ? Développement empirique et comparaison de modèles sur un large échantillon de bassins versants, PhD thesis (in French), ENGREF - Cemagref Antony, Paris, France, 463 pp.
+\item Mouelhi, S. (2003). Vers une chaîne cohérente de modèles pluie-débit conceptuels globaux aux pas de temps pluriannuel, annuel, mensuel et journalier, PhD thesis (in French), ENGREF - Cemagref Antony, Paris, France, 323 pp.
+\item Mouelhi, S., Michel, C., Perrin, C. and Andréassian, V. (2006a). Stepwise development of a two-parameter monthly water balance model. Journal of Hydrology, 318(1-4), 200-214, \doi{10.1016/j.jhydrol.2005.06.014}.
+\item Mouelhi, S., Michel, C., Perrin, C. and Andréassian, V. (2006b). Linking stream flow to rainfall at the annual time step: the Manabe bucket model revisited. Journal of Hydrology, 328, 283-296, \doi{10.1016/j.jhydrol.2005.12.022}.
+\item Perrin, C., Michel, C. and Andréassian, V. (2003). Improvement of a parsimonious model for streamflow simulation. Journal of Hydrology, 279(1-4), 275-289, \doi{10.1016/S0022-1694(03)00225-7}.
+\item Pushpalatha, R., Perrin, C., Le Moine, N., Mathevet, T. and Andréassian, V. (2011). A downward structural sensitivity analysis of hydrological models to improve low-flow simulation. Journal of Hydrology, 411(1-2), 66-76, \doi{10.1016/j.jhydrol.2011.09.034}.
+\item Riboust, P., Thirel, G., Le Moine N. and Ribstein P. (2019). Revisiting a simple degree-day model for integrating satellite data: Implementation of SWE-SCA hystereses. Journal of Hydrology and Hydromechanics, 67(1), 70–81, \doi{10.1016/j.jhydrol.2014.04.058}.
+\item Valéry, A., Andréassian, V. and Perrin, C. (2014). "As simple as possible but not simpler": What is useful in a temperature-based snow-accounting routine? Part 2 - Sensitivity analysis of the Cemaneige snow accounting routine on 380 catchments. Journal of Hydrology, 517(0), 1176-1187, \doi{10.1016/j.jhydrol.2014.04.058}.
+}
}
diff --git a/man/figures/diagramGR2M-EN.pdf b/man/figures/diagramGR2M-EN.pdf
old mode 100644
new mode 100755
index b9c3e36a3612e50109d2391b076b4b8f475212cf..3a43336941ec1cea1d752be164c6e9739dc69265
Binary files a/man/figures/diagramGR2M-EN.pdf and b/man/figures/diagramGR2M-EN.pdf differ
diff --git a/man/figures/diagramGR2M-EN.png b/man/figures/diagramGR2M-EN.png
old mode 100644
new mode 100755
index bd45291c8c6c793382b61fc481853f23878934aa..53c8756b489d6fcfb6b4e49b7638d27538a15feb
Binary files a/man/figures/diagramGR2M-EN.png and b/man/figures/diagramGR2M-EN.png differ
diff --git a/man/figures/diagramGR5H-EN.pdf b/man/figures/diagramGR5H-EN.pdf
new file mode 100755
index 0000000000000000000000000000000000000000..c6d80ec549fe619dd3a96704b25a522fe7c6885a
Binary files /dev/null and b/man/figures/diagramGR5H-EN.pdf differ
diff --git a/man/figures/diagramGR5H-EN.png b/man/figures/diagramGR5H-EN.png
new file mode 100755
index 0000000000000000000000000000000000000000..671bc0ebc1ce555a9d20bcc6fcd9936f1dc5273b
Binary files /dev/null and b/man/figures/diagramGR5H-EN.png differ
diff --git a/man/plot.OutputsModel.Rd b/man/plot.OutputsModel.Rd
index f80ec0fd60dbdb4595557addd352db50504fa918..13f864bf5ed9939d3623bd107cfd3799564ed419 100644
--- a/man/plot.OutputsModel.Rd
+++ b/man/plot.OutputsModel.Rd
@@ -76,7 +76,7 @@ Different types of independent graphs are available (depending on the model, but
\item \code{"SnowPack"}: time series of snow water equivalent (plotted only if CemaNeige is used)
\item \code{"Flows"}: time series of simulated flows (and observed flows if provided)
\item \code{"Error"}: time series of simulated flows minus observed flows (and observed flows if provided)
- \item \code{"Regime"}: interannual median monthly simulated flow (and observed flows if provided)
+ \item \code{"Regime"}: centred 30-day rolling mean applied on interannual average of daily simulated flows (and observed flows if provided)
\item \code{"CorQQ"}: correlation plot between simulated and observed flows (only if observed flows provided)
\item \code{"CumFreq"}: cumulative frequency plot for simulated flows (and observed flows if provided)
}
diff --git a/src/airGR.c b/src/airGR.c
index 639675a4d94eed29148afc175092f2c1ef95edd7..b4c256b242438470673b6a80c2f0b2ff26505b80 100644
--- a/src/airGR.c
+++ b/src/airGR.c
@@ -15,6 +15,7 @@ extern void F77_NAME(frun_gr5h)(int *, double *, double *, int *, double *, int
extern void F77_NAME(frun_gr4j)(int *, double *, double *, int *, double *, int *, double *, int *, int *, double *, double *);
extern void F77_NAME(frun_gr5j)(int *, double *, double *, int *, double *, int *, double *, int *, int *, double *, double *);
extern void F77_NAME(frun_gr6j)(int *, double *, double *, int *, double *, int *, double *, int *, int *, double *, double *);
+extern void F77_NAME(frun_pe_oudin)(int *, double *, double *, double *, double *);
static const R_FortranMethodDef FortranEntries[] = {
{"frun_cemaneige", (DL_FUNC) &F77_NAME(frun_cemaneige), 14},
@@ -25,6 +26,7 @@ static const R_FortranMethodDef FortranEntries[] = {
{"frun_gr4j", (DL_FUNC) &F77_NAME(frun_gr4j), 11},
{"frun_gr5j", (DL_FUNC) &F77_NAME(frun_gr5j), 11},
{"frun_gr6j", (DL_FUNC) &F77_NAME(frun_gr6j), 11},
+ {"frun_pe_oudin", (DL_FUNC) &F77_NAME(frun_pe_oudin), 5},
{NULL, NULL, 0}
};
diff --git a/src/frun_GR2M.f90 b/src/frun_GR2M.f90
index b56362a583264fcd387fabc137a4b9f31628b45b..b05d11397bad06fbca523078ae87eaaed13b46a8 100644
--- a/src/frun_GR2M.f90
+++ b/src/frun_GR2M.f90
@@ -11,15 +11,15 @@
! Further cleaning: G. Thirel
!------------------------------------------------------------------------------
! Creation date: 2003
-! Last modified: 25/11/2019
+! Last modified: 16/04/2020
!------------------------------------------------------------------------------
! REFERENCES
-! Mouelhi S. (2003). Vers une chaîne cohérente de modèles pluie-débit
-! conceptuels globaux aux pas de temps pluriannuel, annuel, mensuel et
+! Mouelhi S. (2003). Vers une chaîne cohérente de modèles pluie-débit
+! conceptuels globaux aux pas de temps pluriannuel, annuel, mensuel et
! journalier. PhD thesis (in French), ENGREF, Cemagref Antony, France.
!
-! Mouelhi, S., C. Michel, C. Perrin and V. Andréassian (2006). Stepwise
-! development of a two-parameter monthly water balance model. Journal of
+! Mouelhi, S., C. Michel, C. Perrin and V. Andréassian (2006). Stepwise
+! development of a two-parameter monthly water balance model. Journal of
! Hydrology, 318(1-4), 200-214. doi:10.1016/j.jhydrol.2005.06.014.
!------------------------------------------------------------------------------
! Quick description of public procedures:
@@ -31,7 +31,7 @@
SUBROUTINE frun_gr2m(LInputs,InputsPrecip,InputsPE,NParam,Param, &
NStates,StateStart,NOutputs,IndOutputs, &
Outputs,StateEnd)
-! Subroutine that initializes GR2M, get its parameters, performs the call
+! Subroutine that initializes GR2M, get its parameters, performs the call
! to the MOD_GR2M subroutine at each time step, and stores the final states
! Inputs
! LInputs ! Integer, length of input and output series
@@ -43,7 +43,7 @@
! StateStart ! Vector of real, state variables used when the model run starts (store levels [mm])
! NOutputs ! Integer, number of output series
! IndOutputs ! Vector of integer, indices of output series
-! Outputs
+! Outputs
! Outputs ! Vector of real, output series
! StateEnd ! Vector of real, state variables at the end of the model run (store levels [mm])
@@ -64,7 +64,7 @@
! out
doubleprecision, dimension(NStates), intent(out) :: StateEnd
doubleprecision, dimension(LInputs,NOutputs), intent(out) :: Outputs
-
+
!! locals
integer :: I,K
integer, parameter :: NMISC=30
@@ -145,7 +145,7 @@
!! locals
integer, parameter :: NParam=2,NMISC=30
doubleprecision :: WS,S1,S2
- doubleprecision :: P1,P2,P3,R1,R2,AE,EXCH
+ doubleprecision :: P1,P2,P3,R1,R2,AE,AEXCH,PS
doubleprecision :: expWS, TWS, Sr ! speed-up
!! dummies
@@ -157,39 +157,40 @@
! out
doubleprecision, intent(out) :: Q
doubleprecision, dimension(NMISC), intent(out) :: MISC
-
+
! Production store
- WS=P/Param(1)
+ WS=P/Param(1)
IF(WS.GT.13.) WS=13.
! speed-up
expWS = exp(2.*WS)
TWS = (expWS - 1.)/(expWS + 1.)
- S1=(St(1)+Param(1)*TWS)/(1.+St(1)/Param(1)*TWS)
- ! S1=(X(1)+Param(1)*tanHyp(WS))/(1.+X(1)/Param(1)*tanHyp(WS))
+ S1=(St(1)+Param(1)*TWS)/(1.+St(1)/Param(1)*TWS)
+ ! S1=(X(1)+Param(1)*tanHyp(WS))/(1.+X(1)/Param(1)*tanHyp(WS))
! end speed-up
- P1=P+St(1)-S1
- WS=E/Param(1)
+ P1=P+St(1)-S1
+ PS = P - P1
+ WS=E/Param(1)
IF(WS.GT.13.) WS=13.
! speed-up
expWS = exp(2.*WS)
TWS = (expWS - 1.)/(expWS + 1.)
- S2=S1*(1.-TWS)/(1.+(1.-S1/Param(1))*TWS)
- ! S2=S1*(1.-tanHyp(WS))/(1.+(1.-S1/Param(1))*tanHyp(WS))
+ S2=S1*(1.-TWS)/(1.+(1.-S1/Param(1))*TWS)
+ ! S2=S1*(1.-tanHyp(WS))/(1.+(1.-S1/Param(1))*tanHyp(WS))
! end speed-up
AE = S1 - S2
-
+
! Percolation
! speed-up
Sr = S2/Param(1)
Sr = Sr * Sr * Sr + 1.
St(1)=S2/Sr**(1./3.)
- ! X(1)=S2/(1+(S2/Param(1))**3.)**(1./3.)
+ ! X(1)=S2/(1+(S2/Param(1))**3.)**(1./3.)
! end speed-up
- P2=S2-St(1)
+ P2=S2-St(1)
P3=P1+P2
! QR calculation (routing store)
@@ -197,7 +198,7 @@
! Water exchange
R2=Param(2)*R1
- EXCH = R2 - R1
+ AEXCH = R2 - R1
! Total runoff
Q=R2*R2/(R2+60.)
@@ -211,14 +212,14 @@
MISC( 2)=P ! Precip ! [numeric] observed total precipitation [mm/month]
MISC( 3)=St(1) ! Prod ! [numeric] production store level (St(1)) [mm]
MISC( 4)=P1 ! Pn ! [numeric] net rainfall (P1) [mm/month]
- MISC( 5)=AE ! AE ! [numeric] actual evapotranspiration [mm/month]
- MISC( 6)=P2 ! Perc ! [numeric] percolation (P2) [mm/month]
- MISC( 7)=P3 ! PR ! [numeric] P3=P1+P2 [mm/month]
- MISC( 8)=St(2) ! Rout ! [numeric] routing store level (St(2)) [mm]
- MISC( 9)=EXCH ! EXCH ! [numeric] groundwater exchange (EXCH) [mm/month]
- MISC(10)=Q ! Qsim ! [numeric] simulated outflow at catchment outlet [mm/month]
+ MISC( 5)=PS ! Ps ! [numeric] part of P filling the production store [mm/month]
+ MISC( 6)=AE ! AE ! [numeric] actual evapotranspiration [mm/month]
+ MISC( 7)=P2 ! Perc ! [numeric] percolation (P2) [mm/month]
+ MISC( 8)=P3 ! PR ! [numeric] P3=P1+P2 [mm/month]
+ MISC( 9)=St(2) ! Rout ! [numeric] routing store level (St(2)) [mm]
+ MISC(10)=AEXCH ! AEXCH ! [numeric] actual groundwater exchange (AEXCH) [mm/month]
+ MISC(11)=Q ! Qsim ! [numeric] simulated outflow at catchment outlet [mm/month]
END SUBROUTINE
-
diff --git a/src/frun_GR6J.f90 b/src/frun_GR6J.f90
index 9f52bffaa7835f5edb13597fb070fb81697e1e2a..0fa325770325b1905eb8fe1017c18761b51661cd 100644
--- a/src/frun_GR6J.f90
+++ b/src/frun_GR6J.f90
@@ -296,19 +296,14 @@
IF(AR.GT.33.) AR=33.
IF(AR.LT.-33.) AR=-33.
- IF(AR.GT.7.)THEN
+ IF(AR.GT.7.) THEN
QRExp=St(3)+Param(6)/EXP(AR)
- GOTO 3
- ENDIF
-
- IF(AR.LT.-7.)THEN
+ ELSEIF(AR.LT.-7.) THEN
QRExp=Param(6)*EXP(AR)
- GOTO 3
+ ELSE
+ QRExp=Param(6)*LOG(EXP(AR)+1.)
ENDIF
- QRExp=Param(6)*LOG(EXP(AR)+1.)
- 3 CONTINUE
-
St(3)=St(3)-QRExp
! Runoff from direct branch QD
diff --git a/src/frun_PE.f90 b/src/frun_PE.f90
new file mode 100644
index 0000000000000000000000000000000000000000..be4e84a525dff970c19c1025fe01486d9b5bc298
--- /dev/null
+++ b/src/frun_PE.f90
@@ -0,0 +1,172 @@
+!------------------------------------------------------------------------------
+! Subroutines relative to the Oudin potential evapotranspiration (PE) formula
+!------------------------------------------------------------------------------
+! TITLE : airGR
+! PROJECT : airGR
+! FILE : frun_PE.f90
+!------------------------------------------------------------------------------
+! AUTHORS
+! Original code: L. Oudin
+! Cleaning and formatting for airGR: Fr. Bourgin
+! Further cleaning: O. Delaigue, G. Thirel
+!------------------------------------------------------------------------------
+! Creation date: 2004
+! Last modified: 20/10/2020
+!------------------------------------------------------------------------------
+! REFERENCES
+! Oudin, L., Hervieu, F., Michel, C., Perrin, C., Andréassian, V.,
+! Anctil, F. and Loumagne, C., 2005. Which potential evapotranspiration
+! input for a rainfall-runoff model? Part 2 - Towards a simple and
+! efficient PE model for rainfall-runoff modelling. Journal of Hydrology
+! 303(1-4), 290-306.
+!------------------------------------------------------------------------------
+! Quick description of public procedures:
+! 1. frun_pe_oudin
+! 2. PE_OUDIN
+!------------------------------------------------------------------------------
+
+
+!*******************************************************************************
+ SUBROUTINE frun_pe_oudin(LInputs,InputsLAT,InputsTemp,InputsJJ,OutputsPE)
+!*******************************************************************************
+! Subroutine that performs the call to the PE_OUDIN subroutine at each time step,
+! and stores the final values
+! Inputs
+! LInputs ! Integer, length of input and output series
+! InputsLAT ! Vector of real, input series of latitude [rad]
+! InputsTemp ! Vector of real, input series of air mean temperature [degC]
+! InputsJJ ! Vector of real, input series of Julian day [-]
+! Outputs
+! OutputsPE ! Vector of real, output series of potential evapotranspiration (PE) [mm/time step]
+
+
+
+ !DEC$ ATTRIBUTES DLLEXPORT :: frun_pe_oudin
+
+ Implicit None
+
+ !! dummies
+ ! in
+ integer, intent(in) :: LInputs
+ doubleprecision, dimension(LInputs), intent(in) :: InputsLAT
+ doubleprecision, dimension(LInputs), intent(in) :: InputsTemp
+ doubleprecision, dimension(LInputs), intent(in) :: InputsJJ
+
+ ! out
+ doubleprecision, dimension(LInputs), intent(out) :: OutputsPE
+
+ !! locals
+ integer :: k
+ doubleprecision :: FI, tt, jj, PEoud
+
+ !--------------------------------------------------------------
+ ! Time loop
+ !--------------------------------------------------------------
+ DO k = 1, LInputs
+ tt = InputsTemp(k)
+ jj = InputsJJ(k)
+ FI = InputsLAT(k)!
+ !model run on one time step
+ CALL PE_OUDIN(FI, tt, jj, PEoud)
+ !storage of outputs
+ OutputsPE(k) = PEoud
+ ENDDO
+
+ RETURN
+
+ ENDSUBROUTINE
+
+
+
+
+
+!################################################################################################################################
+
+
+
+
+!*******************************************************************************
+ SUBROUTINE PE_OUDIN(FI,DT,JD,DPE)
+!*******************************************************************************
+! Calculation of potential evapotranspiration (DPE) on a single time step
+! using air temperature and daily extra-atmospheric global radiation
+! (that depends only on Julian day)
+!
+! The PE formula is described in:
+! Oudin, L., Hervieu, F., Michel, C., Perrin, C., Andréassian, V.,
+! Anctil, F. and Loumagne, C., 2005. Which potential evapotranspiration
+! input for a rainfall-runoff model? Part 2 - Towards a simple and
+! efficient PE model for rainfall-runoff modelling. Journal of Hydrology
+! 303(1-4), 290-306.
+!
+! For the calculation of extra-atmospheric global radiation, see Appendix C of
+! the article by Morton, F.I., 1983. Operational estimates of areal
+! evapotranspiration and their significance to the science and practice
+! of hydrology. Journal of Hydrology 66 (1/4), 1-76.
+!
+!***************************************************************
+! Inputs
+! FI ! Latitude [rad]
+! DT ! Air Temperature [degC]
+! JD ! Julian day [-]
+!
+! Outputs
+! DPE ! Potential evapotranspiration [mm/time step]
+!***************************************************************
+ IMPLICIT NONE
+
+ !! dummies
+ ! in
+ doubleprecision, intent(in) :: FI, DT, JD
+ ! out
+ doubleprecision, intent(out) :: DPE
+ !! locals
+ doubleprecision :: COSFI, TETA, COSTETA, COSGZ, GZ, COSGZ2
+ doubleprecision :: SINGZ, COSOM, COSOM2, SINOM, COSPZ, OM, GE
+ doubleprecision :: ETA
+
+! Calculation of extra-atmospheric global radiation (Appendix C in Morton
+! (1983), Eq. C-6 to C-11, p.60-61)
+ COSFI=COS(FI)
+
+! TETA: Declination of the sun in radians
+ TETA=0.4093*SIN(JD/58.1-1.405)
+ COSTETA=COS(TETA)
+ COSGZ=MAX(0.001d0,COS(FI-TETA))
+
+! GZ: Noon angular zenith distance of the sun
+ GZ=ACOS(COSGZ)
+ COSGZ2=COSGZ*COSGZ
+
+ IF(COSGZ2.GE.1.) THEN
+ SINGZ=0.
+ ELSE
+ SINGZ=SQRT(1.-COSGZ2)
+ ENDIF
+
+ COSOM=1.-COSGZ/COSFI/COSTETA
+ IF(COSOM.LT.-1.) COSOM=-1.
+ IF(COSOM.GT.1.) COSOM=1.
+ COSOM2=COSOM*COSOM
+ IF(COSOM2.GE.1.) THEN
+ SINOM=0.
+ ELSE
+ SINOM=SQRT(1.-COSOM2)
+ ENDIF
+
+ OM=ACOS(COSOM)
+! PZ: Average angular zenith distance of the sun
+ COSPZ=COSGZ+COSFI*COSTETA*(SINOM/OM-1.)
+ IF(COSPZ.LT.0.001) COSPZ=0.001
+! ETA: Radius vector of the sun
+ ETA=1.+COS(JD/58.1)/30.
+! GE: extra-atmospheric global radiation
+ GE=446.*OM*COSPZ*ETA
+
+! Daily PE by Oudin et al. (2006) formula:
+ DPE=MAX(0.d0,GE*(DT+5.)/100./28.5)
+
+ RETURN
+
+ END SUBROUTINE PE_OUDIN
+!*******************************************************************************
diff --git a/tests/testthat.R b/tests/testthat.R
new file mode 100644
index 0000000000000000000000000000000000000000..34a10f5fd100848ab079fb22f70045b589bd5f11
--- /dev/null
+++ b/tests/testthat.R
@@ -0,0 +1,4 @@
+library(testthat)
+library(airGR)
+
+test_check("airGR")
diff --git a/tests/testthat/helper_regression.R b/tests/testthat/helper_regression.R
new file mode 100644
index 0000000000000000000000000000000000000000..cbcf9dbfee09f0309b429ad54636123ba988a34a
--- /dev/null
+++ b/tests/testthat/helper_regression.R
@@ -0,0 +1,81 @@
+StoreStableExampleResults <- function(
+ package = "airGR",
+ path = file.path("tests/tmp", Sys.getenv("R_VERSION"), "stable"),
+ ...) {
+ install.packages(package, repos = "http://cran.r-project.org")
+ StoreExampleResults(package = package, path = path, ...)
+}
+
+StoreDevExampleResults <- function(
+ package = "airGR",
+ path = file.path("tests/tmp", Sys.getenv("R_VERSION"), "dev"),
+ ...) {
+ StoreExampleResults(package = package, path = path, ...)
+}
+
+#' Run examples of a package and store the output variables in RDS files for further testing.
+#'
+#' @param package Name of the package from which examples are tested.
+#' @param path Path where to record the files.
+#' @param run.dontrun See \code{\link{example}}.
+#' @param run.donttest See \code{\link{example}}.
+#'
+#' @return
+#' @export
+#'
+#' @examples
+StoreExampleResults <- function(package, path, run.dontrun = FALSE, run.donttest = TRUE) {
+
+ # Install and load stable version of the package
+ library(package, character.only = TRUE)
+
+ # Get the list of documentation pages
+ rd <- unique(readRDS(system.file("help", "aliases.rds", package = package)))
+
+ dir.create(path, showWarnings = FALSE)
+
+ lapply(
+ rd,
+ StoreTopicResults,
+ package, path, run.dontrun = run.dontrun, run.donttest = run.donttest
+ )
+}
+
+StoreTopicResults <- function(topic, package, path, run.dontrun = TRUE, run.donttest = TRUE) {
+
+ cat("*******************************\n")
+ cat("*", topic, "\n")
+ cat("*******************************\n")
+
+ par(ask = FALSE) #https://stackoverflow.com/questions/34756905/how-to-turn-off-the-hit-return-to-see-next-plot-prompt-plot3d
+
+ varBefore <- c()
+ varBefore <- ls(envir = globalenv())
+
+ example(
+ topic, package = package, character.only = TRUE, echo = FALSE, ask = FALSE, local = FALSE, setRNG = TRUE,
+ run.dontrun = run.dontrun, run.donttest = run.donttest
+ )
+ dev.off()
+
+ varAfter <- ls(envir = globalenv())
+
+ varToSave <- setdiff(varAfter, varBefore)
+
+ if (length(varToSave) > 0) {
+ path <- file.path(path, topic)
+ dir.create(path, showWarnings = FALSE, recursive = TRUE)
+ lapply(varToSave, function(x) {
+ saveRDS(get(x), file = file.path(path, paste0(x, ".rds")))
+ })
+ }
+
+ rm(list = varToSave, envir = globalenv())
+
+}
+
+CompareStableDev <- function() {
+ res = testthat::test_file("tests/testthat/regression.R")
+ dRes = as.data.frame(res)
+ if(any(dRes[,"failed"]>0) | any(dRes[,"error"])) quit(status = 1)
+}
diff --git a/tests/testthat/helper_vignettes.R b/tests/testthat/helper_vignettes.R
new file mode 100644
index 0000000000000000000000000000000000000000..8dfe5e12d84bd9cf03acf5db2a37efbfbe638fc1
--- /dev/null
+++ b/tests/testthat/helper_vignettes.R
@@ -0,0 +1,95 @@
+#' Extract chunks from Rmd files (knitr::purl) and source them
+#'
+#' @param fileRmd Rmd file to
+#' @param tmpFolder Folder storing the script containing extracted chunks
+#' @param force.eval Force execution of chunks with parameter eval=FALSE
+RunRmdChunks <- function(fileRmd,
+ tmpFolder = "../tmp",
+ force.eval = TRUE) {
+ dir.create(tmpFolder, showWarnings = FALSE)
+ output <- file.path(tmpFolder,
+ gsub("\\.Rmd", "\\.R", basename(fileRmd), ignore.case = TRUE))
+ knitr::purl(fileRmd, output = output, quiet = TRUE)
+ sTxt <- readLines(output)
+ if (force.eval) {
+ sectionLines <- grep("^## ----", sTxt)
+ chunksEvalStart <- grep("^## ----.*eval=F", sTxt)
+ if (length(chunksEvalStart) > 0) {
+ if (sectionLines[length(sectionLines)] == chunksEvalStart[length(chunksEvalStart)]) {
+ lastEvalStart <- length(chunksEvalStart) - 1
+ } else {
+ lastEvalStart <- length(chunksEvalStart)
+ }
+ # Search for end lines of eval=F chunks
+ chunksEvalEnd <- sectionLines[sapply(chunksEvalStart[1:lastEvalStart], function(x) {which(sectionLines == x)}) + 1] - 1
+ if (lastEvalStart) {
+ # Add last line if last chunk is eval=FALSE
+ chunksEvalEnd <- c(chunksEvalEnd, length(sTxt))
+ }
+ chunksEvalStart <- chunksEvalStart + 1 # Chunks begin one line after the section comment
+ for (i in 1:length(chunksEvalStart)) {
+ # Remove comments on eval=F chunk lines
+ sTxt[chunksEvalStart[i]:chunksEvalEnd[i]] <- gsub(pattern = "^## ",
+ replace = "",
+ x = sTxt[chunksEvalStart[i]:chunksEvalEnd[i]])
+ }
+ }
+
+ }
+ # Remove line of code displaying data
+ removeFromGrep <- function(pattern, x) {
+ i <- grep(pattern, x)
+ if (length(i) > 0) {
+ x <- x[-i]
+ }
+ return(x)
+ }
+ sTxt <- removeFromGrep("^summary\\(.*\\)$", sTxt)
+ sTxt <- removeFromGrep("^str\\(.*\\)$", sTxt)
+ # Switch echo off for some functions
+ sTxt <- gsub("trace\\s?=\\s?[0-9]+", "trace = 0", sTxt)
+ # Add parameters to example calls
+ exLines <- grep("^example\\(.*\\)", sTxt)
+ sTxt[exLines] <- paste0(substr(sTxt[exLines], 1, nchar(sTxt[exLines]) - 1), ", echo = FALSE, verbose = FALSE, ask = FALSE)")
+ # Remove question "Hit <Return> to see next plot"
+ sTxt <- c("par(ask=F)", sTxt)
+ # Write the transformed script
+ writeLines(sTxt, output)
+ # Silently run the chunks
+ invisible(capture.output(suppressMessages(suppressWarnings(source(output))), type = "output"))
+ return(TRUE)
+}
+
+#' Extract chunks from vignette and source them
+#'
+#' @param vignette Name of the vignette
+#' @param tmpFolder Folder storing the script containing extracted chunks
+#' @param force.eval Force execution of chunks with parameter eval=FALSE
+#'
+#' @return TRUE if succeed.
+RunVignetteChunks <- function(vignette,
+ tmpFolder = "../tmp",
+ force.eval = TRUE) {
+ if(file.exists(file.path("../../vignettes/", paste0(vignette, ".Rmd")))) {
+ # testthat context in development environnement
+ RunRmdChunks(file.path("../../vignettes/", paste0(vignette, ".Rmd")), tmpFolder, force.eval)
+ } else {
+ # R CMD check context in package environnement
+ RunRmdChunks(system.file(file.path("doc/", paste0(vignette, ".Rmd")), package = "airGR"), tmpFolder, force.eval)
+ }
+ return(TRUE)
+}
+
+#' Test if conversion from Q in mm per day into Q in L/s is good in BasinObs
+#'
+#' @param BasinObs A dataframe containing columns Qmm and Qls
+#' @param BasinArea Area of the basin in km2
+#' @param tolerance See ?all.equal
+#'
+#' @return
+TestQmmQlsConversion <- function(BasinObs, BasinArea, tolerance = 1E-7) {
+ Conversion <- BasinArea * 1000^2 / 1000 * 1000 # km2 -> m2, mm -> m and m3 -> L
+ Conversion <- Conversion / 86400 # Day -> seconds
+ notNA <- which(!is.na(BasinObs$Qmm))
+ expect_equal(BasinObs$Qmm[notNA] * Conversion, BasinObs$Qls[notNA], tolerance = tolerance)
+}
\ No newline at end of file
diff --git a/tests/testthat/regression.R b/tests/testthat/regression.R
new file mode 100644
index 0000000000000000000000000000000000000000..2ccadba442cf1ab03b3834b7e28a6533e60f21b7
--- /dev/null
+++ b/tests/testthat/regression.R
@@ -0,0 +1,44 @@
+context("Compare example outputs with CRAN")
+
+CompareWithStable <- function(refVarFile, testDir, regIgnore) {
+ v <- data.frame(topic = basename(dirname(refVarFile)),
+ var = gsub("\\.rds$", "", basename(refVarFile)))
+ if (is.null(regIgnore) || all(apply(regIgnore, 1, function(x) !all(x == v)))) {
+ test_that(paste("Compare", v$topic, v$var), {
+ testVarFile <- paste0(
+ file.path(testDir, v$topic, v$var),
+ ".rds"
+ )
+ expect_true(file.exists(testVarFile))
+ if (file.exists(testVarFile)) {
+ testVar <- readRDS(testVarFile)
+ refVar <- readRDS(refVarFile)
+ expect_equivalent(testVar, refVar)
+ }
+ })
+ }
+}
+
+tmp_path <- file.path("../tmp", Sys.getenv("R_VERSION"));
+
+if (dir.exists(file.path(tmp_path, "stable")) & dir.exists(file.path(tmp_path, "dev"))) {
+ refVarFiles <- list.files(file.path(tmp_path, "stable"), recursive = TRUE, full.names = TRUE)
+ regIgnoreFile <- "../../.regressionignore"
+ if (file.exists(regIgnoreFile)) {
+ message("Using .regressionignore file. The following variables are going to be skipped:")
+ regIgnore <- read.table(file = regIgnoreFile,
+ sep = " ", header = FALSE, skip = 5,
+ col.names = c("topic", "var"),
+ stringsAsFactors = FALSE)
+ apply(regIgnore, 1, function(x) message(x[1], ": ", x[2]))
+ } else {
+ message("File ", file.path(getwd(), regIgnoreFile), " not found")
+ regIgnore <- NULL
+ }
+ lapply(X = refVarFiles, CompareWithStable, testDir = file.path(tmp_path, "dev"), regIgnore = regIgnore)
+} else {
+ stop("Regression tests compared to released version needs that you run the following instructions first:\n",
+ "Rscript tests/testthat/regression_tests.R stable\n",
+ "R CMD INSTALL .\n",
+ "Rscript tests/testthat/regression_tests.R dev")
+}
diff --git a/tests/testthat/regression_tests.R b/tests/testthat/regression_tests.R
new file mode 100644
index 0000000000000000000000000000000000000000..2b59829af88508a115abe5c20df9f0c8a7810107
--- /dev/null
+++ b/tests/testthat/regression_tests.R
@@ -0,0 +1,21 @@
+# Execute Regression test by comparing RD files stored in folders /tests/tmp/ref and /tests/tmp/test
+Args = commandArgs(trailingOnly=TRUE)
+
+source("tests/testthat/helper_regression.R")
+
+lActions = list(
+ stable = StoreStableExampleResults,
+ dev = StoreDevExampleResults,
+ compare = CompareStableDev
+)
+
+if(Args %in% names(lActions)) {
+ lActions[[Args]]()
+} else {
+ stop("This script should be run with one argument in the command line:\n",
+ "`Rscript tests/regression_tests.R [stable|dev|compare]`.\n",
+ "Available arguments are:\n",
+ "- stable: install stable version from CRAN, run and store examples\n",
+ "- dev: install dev version from current directory, run and store examples\n",
+ "- compare: stored results of both versions")
+}
diff --git a/tests/testthat/test-CreateRunOptions.R b/tests/testthat/test-CreateRunOptions.R
new file mode 100644
index 0000000000000000000000000000000000000000..91723330598bf17fe8d5dca46a00074d62d92168
--- /dev/null
+++ b/tests/testthat/test-CreateRunOptions.R
@@ -0,0 +1,31 @@
+context("CreateRunOptions")
+
+test_that("Warm start of GR4J should give same result as warmed model", {
+ data(L0123001)
+ InputsModel <- CreateInputsModel(FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR,
+ Precip = BasinObs$P, PotEvap = BasinObs$E)
+ Param <- c(X1 = 257.238, X2 = 1.012, X3 = 88.235, X4 = 2.208)
+ Ind_Run1 <- seq(which(format(BasinObs$DatesR, format = "%Y-%m-%d")=="1990-01-01"),
+ which(format(BasinObs$DatesR, format = "%Y-%m-%d")=="1990-12-31"))
+ Ind_Run2 <- seq(which(format(BasinObs$DatesR, format = "%Y-%m-%d")=="1991-01-01"),
+ which(format(BasinObs$DatesR, format = "%Y-%m-%d")=="1991-12-31"))
+ # 1990-1991
+ RunOptions <- suppressWarnings(CreateRunOptions(FUN_MOD = RunModel_GR4J,
+ InputsModel = InputsModel, IndPeriod_Run = c(Ind_Run1, Ind_Run2)))
+ OutputsModel <- RunModel_GR4J(InputsModel = InputsModel,
+ RunOptions = RunOptions, Param = Param)
+ # 1990
+ RunOptions1 <- suppressWarnings(CreateRunOptions(FUN_MOD = RunModel_GR4J,
+ InputsModel = InputsModel, IndPeriod_Run = Ind_Run1))
+ OutputsModel1 <- RunModel_GR4J(InputsModel = InputsModel,
+ RunOptions = RunOptions1, Param = Param)
+ # Warm start 1991
+ RunOptions2 <- CreateRunOptions(FUN_MOD = RunModel_GR4J,
+ InputsModel = InputsModel, IndPeriod_Run = Ind_Run2,
+ IndPeriod_WarmUp = 0L,
+ IniStates = OutputsModel1$StateEnd)
+ OutputsModel2 <- RunModel_GR4J(InputsModel = InputsModel,
+ RunOptions = RunOptions2, Param = Param)
+ # Compare 1991 Qsim from warm started and from 1990-1991
+ expect_equal(OutputsModel2$Qsim, OutputsModel$Qsim[366:730])
+})
diff --git a/tests/testthat/test-CreateiniStates.R b/tests/testthat/test-CreateiniStates.R
new file mode 100644
index 0000000000000000000000000000000000000000..58dbcf8a7ee9fd26967338907048774f82bd0ee5
--- /dev/null
+++ b/tests/testthat/test-CreateiniStates.R
@@ -0,0 +1,102 @@
+context("CreateIniStates on SD model")
+
+data(L0123001)
+
+test_that("Error: SD argument provided on non-SD 'InputsModel'", {
+ InputsModel <-
+ CreateInputsModel(
+ FUN_MOD = RunModel_GR4J,
+ DatesR = BasinObs$DatesR,
+ Precip = BasinObs$P,
+ PotEvap = BasinObs$E
+ )
+ expect_error(
+ IniStates <-
+ CreateIniStates(
+ FUN_MOD = RunModel_GR4J,
+ InputsModel = InputsModel,
+ ProdStore = 0,
+ RoutStore = 0,
+ ExpStore = NULL,
+ UH1 = c(0.52, 0.54, 0.15, rep(0, 17)),
+ UH2 = c(0.057, 0.042, 0.015, 0.005, rep(0, 36)),
+ SD = list(rep(0, 10))
+ ),
+ regexp = "'SD' argument provided and"
+ )
+})
+
+BasinAreas <- c(BasinInfo$BasinArea, BasinInfo$BasinArea)
+
+# Qupstream = sinusoid synchronised on hydrological year from 0 mm to mean value of Qobs
+Qupstream <-
+ floor((sin((
+ seq_along(BasinObs$Qmm) / 365 * 2 * 3.14
+ )) + 1) * mean(BasinObs$Qmm, na.rm = TRUE))
+
+InputsModel <- CreateInputsModel(
+ FUN_MOD = RunModel_GR4J,
+ DatesR = BasinObs$DatesR,
+ Precip = BasinObs$P,
+ PotEvap = BasinObs$E,
+ Qupstream = matrix(Qupstream, ncol = 1),
+ LengthHydro = 1000,
+ BasinAreas = BasinAreas
+)
+
+test_that("Error: Non-list 'SD' argument", {
+ expect_error(
+ IniStates <-
+ CreateIniStates(
+ FUN_MOD = RunModel_GR4J,
+ InputsModel = InputsModel,
+ ProdStore = 0,
+ RoutStore = 0,
+ ExpStore = NULL,
+ UH1 = c(0.52, 0.54, 0.15, rep(0, 17)),
+ UH2 = c(0.057, 0.042, 0.015, 0.005, rep(0, 36)),
+ SD = rep(0, 10)
+ ),
+ regexp = "'SD' argument must be a list"
+ )
+})
+
+test_that("Error: Non-numeric items in 'SD' list argument", {
+ lapply(list(list(list(rep(0, 10))), list(toto = NULL)),
+ function(x) {
+ expect_error(
+ IniStates <-
+ CreateIniStates(
+ FUN_MOD = RunModel_GR4J,
+ InputsModel = InputsModel,
+ ProdStore = 0,
+ RoutStore = 0,
+ ExpStore = NULL,
+ UH1 = c(0.52, 0.54, 0.15, rep(0, 17)),
+ UH2 = c(0.057, 0.042, 0.015, 0.005, rep(0, 36)),
+ SD = x
+ ),
+ regexp = "Each item of 'SD' list argument must be numeric"
+ )
+ })
+})
+
+test_that("Error: Number of items not equal to number of upstream connections", {
+ lapply(list(list(), list(rep(0, 10), rep(0, 10))),
+ function(x) {
+ expect_error(
+ IniStates <-
+ CreateIniStates(
+ FUN_MOD = RunModel_GR4J,
+ InputsModel = InputsModel,
+ ProdStore = 0,
+ RoutStore = 0,
+ ExpStore = NULL,
+ UH1 = c(0.52, 0.54, 0.15, rep(0, 17)),
+ UH2 = c(0.057, 0.042, 0.015, 0.005, rep(0, 36)),
+ SD = x
+ ),
+ regexp = "list argument must be the same as the number of upstream"
+ )
+ })
+})
diff --git a/tests/testthat/test-RunModel_LAG.R b/tests/testthat/test-RunModel_LAG.R
new file mode 100644
index 0000000000000000000000000000000000000000..00d0104afc576bf336f5730af9d11df00ceeff85
--- /dev/null
+++ b/tests/testthat/test-RunModel_LAG.R
@@ -0,0 +1,226 @@
+context("RunModel_Lag")
+
+data(L0123001)
+
+test_that("'BasinAreas' must have one more element than 'LengthHydro'", {
+ expect_error(
+ InputsModel <- CreateInputsModel(
+ FUN_MOD = RunModel_GR4J,
+ DatesR = BasinObs$DatesR,
+ Precip = BasinObs$P,
+ PotEvap = BasinObs$E,
+ Qupstream = matrix(BasinObs$Qmm, ncol = 1),
+ LengthHydro = 1,
+ BasinAreas = 1
+ ),
+ regexp = "'BasinAreas' must have one more element than 'LengthHydro'"
+ )
+})
+
+BasinAreas <- c(BasinInfo$BasinArea, BasinInfo$BasinArea)
+
+test_that("'Qupstream' cannot contain any NA value", {
+ expect_error(
+ InputsModel <- CreateInputsModel(
+ FUN_MOD = RunModel_GR4J,
+ DatesR = BasinObs$DatesR,
+ Precip = BasinObs$P,
+ PotEvap = BasinObs$E,
+ Qupstream = matrix(BasinObs$Qmm, ncol = 1),
+ LengthHydro = 1,
+ BasinAreas = BasinAreas
+ ),
+ regexp = "'Qupstream' cannot contain any NA value"
+ )
+})
+
+# Qupstream = sinusoid synchronised on hydrological year from 0 mm to mean value of Qobs
+Qupstream <- floor((sin((seq_along(BasinObs$Qmm)/365*2*3.14))+1) * mean(BasinObs$Qmm, na.rm = TRUE))
+
+InputsModel <- CreateInputsModel(
+ FUN_MOD = RunModel_GR4J,
+ DatesR = BasinObs$DatesR,
+ Precip = BasinObs$P,
+ PotEvap = BasinObs$E,
+ Qupstream = matrix(Qupstream, ncol = 1),
+ LengthHydro = 1000,
+ BasinAreas = BasinAreas
+)
+
+Ind_Run <- seq(which(format(BasinObs$DatesR, format = "%Y-%m-%d") == "1990-01-01"),
+ which(format(BasinObs$DatesR, format = "%Y-%m-%d") == "1999-12-31"))
+
+RunOptions <- suppressWarnings(CreateRunOptions(FUN_MOD = RunModel_GR4J,
+ InputsModel = InputsModel,
+ IndPeriod_Run = Ind_Run))
+
+test_that("InputsModel parameter should contain an OutputsModel key", {
+ expect_error(
+ RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1),
+ regexp = "'InputsModel' should contain an 'OutputsModel' key"
+ )
+})
+
+Param <- c(257.237556, 1.012237, 88.234673, 2.207958) # From vignettes/V01_get_started
+
+OutputsGR4JOnly <- RunModel_GR4J(InputsModel = InputsModel,
+ RunOptions = RunOptions,
+ Param = Param)
+
+test_that("InputsModel$OutputsModel should contain a Qsim key", {
+ InputsModel$OutputsModel <- OutputsGR4JOnly
+ InputsModel$OutputsModel$Qsim <- NULL
+ expect_error(
+ RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1),
+ regexp = "should contain a key 'Qsim'"
+ )
+})
+
+test_that("'InputsModel$OutputsModel$Qim' should have the same lenght as 'RunOptions$IndPeriod_Run'", {
+ InputsModel$OutputsModel <- OutputsGR4JOnly
+ InputsModel$OutputsModel$Qsim <- c(InputsModel$OutputsModel$Qsim, 0)
+ expect_error(
+ RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1),
+ regexp = "should have the same lenght as"
+ )
+})
+
+test_that("'InputsModel$OutputsModel$Qim' should contain no NA'", {
+ InputsModel$OutputsModel <- OutputsGR4JOnly
+ InputsModel$OutputsModel$Qsim[10L] <- NA
+ expect_error(
+ RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1),
+ regexp = "contain no NA"
+ )
+})
+
+test_that("Upstream basin with nil area should return same Qdown as GR4J alone", {
+ UpstBasinArea <- InputsModel$BasinAreas[1L]
+ InputsModel$BasinAreas[1L] <- 0
+ OutputsSD <- RunModel(InputsModel,
+ RunOptions,
+ Param = c(1, Param),
+ FUN_MOD = RunModel_GR4J)
+ expect_equal(OutputsGR4JOnly$Qsim, OutputsSD$Qsim)
+})
+
+test_that("Downstream basin with nil area and nul upstream length should return same Qdown as Qupstream alone", {
+ InputsModel$LengthHydro <- 0
+ InputsModel$BasinAreas <- c(BasinInfo$BasinArea, 0)
+ OutputsSD <- RunModel(InputsModel,
+ RunOptions,
+ Param = c(1, Param),
+ FUN_MOD = RunModel_GR4J)
+ expect_equal(OutputsSD$Qsim, Qupstream[Ind_Run])
+})
+
+ParamSD <- c(InputsModel$LengthHydro / (24 * 60 * 60), Param) # Speed corresponding to one time step delay
+
+QlsGR4Only <- OutputsGR4JOnly$Qsim * InputsModel$BasinAreas[2L] * 1e6 / 86400
+
+test_that("1 input with lag of 1 time step delay out gives an output delayed of one time step", {
+ OutputsSD <- RunModel(InputsModel, RunOptions, Param = ParamSD, FUN_MOD = RunModel_GR4J)
+ QlsSdSim <- OutputsSD$Qsim * sum(InputsModel$BasinAreas) * 1e6 / 86400
+ QlsUpstLagObs <- c(0, Qupstream[Ind_Run[1:(length(Ind_Run) - 1)]]) * InputsModel$BasinAreas[1L] * 1e6 / 86400
+ expect_equal(QlsSdSim - QlsGR4Only, QlsUpstLagObs)
+})
+
+test_that("1 input with lag of 0.5 time step delay out gives an output delayed of 0.5 time step", {
+ OutputsSD <- RunModel(InputsModel, RunOptions,
+ Param = c(InputsModel$LengthHydro / (12 * 3600), Param),
+ FUN_MOD = RunModel_GR4J)
+ QlsSdSim <- OutputsSD$Qsim * sum(InputsModel$BasinAreas) * 1e6 / 86400
+ QlsUpstLagObs <- (Qupstream[Ind_Run] + c(0, Qupstream[Ind_Run[1:(length(Ind_Run) - 1)]]))/2 * InputsModel$BasinAreas[1L] * 1e6 / 86400
+ expect_equal(QlsSdSim - QlsGR4Only, QlsUpstLagObs)
+})
+
+test_that("Params from calibration with simulated data should be similar to initial params", {
+ InputsCrit <- CreateInputsCrit(
+ FUN_CRIT = ErrorCrit_NSE,
+ InputsModel = InputsModel,
+ RunOptions = RunOptions,
+ VarObs = "Q",
+ Obs = (
+ c(0, Qupstream[Ind_Run[1:(length(Ind_Run) - 1)]]) * BasinAreas[1L] +
+ BasinObs$Qmm[Ind_Run] * BasinAreas[2L]
+ ) / sum(BasinAreas)
+ )
+ CalibOptions <- CreateCalibOptions(
+ FUN_MOD = RunModel_GR4J,
+ FUN_CALIB = Calibration_Michel,
+ IsSD = TRUE
+ )
+ OutputsCalib <- Calibration_Michel(
+ InputsModel = InputsModel,
+ RunOptions = RunOptions,
+ InputsCrit = InputsCrit,
+ CalibOptions = CalibOptions,
+ FUN_MOD = RunModel_GR4J
+ )
+ expect_equal(OutputsCalib$ParamFinalR[2:5] / ParamSD[2:5], rep(1, 4), tolerance = 1e-2)
+ expect_equal(OutputsCalib$ParamFinalR[1L], ParamSD[1L], tolerance = 2e-3)
+})
+
+test_that("1 no area input with lag of 1 time step delay out gives an output delayed of one time step converted to mm", {
+ Qm3GR4Only <- OutputsGR4JOnly$Qsim * BasinAreas[2L] * 1e3
+ # Specify that upstream flow is not related to an area
+ InputsModel$BasinAreas <- c(NA, BasinAreas[2L])
+ # Convert upstream flow to m3/day
+ InputsModel$Qupstream <- matrix(Qupstream, ncol = 1) * BasinAreas[1L] * 1e3
+
+ OutputsSD <- RunModel(InputsModel, RunOptions, Param = ParamSD, FUN_MOD = RunModel_GR4J)
+
+ expect_false(any(is.na(OutputsSD$Qsim)))
+
+ Qm3SdSim <- OutputsSD$Qsim * sum(InputsModel$BasinAreas, na.rm = TRUE) * 1e3
+ Qm3UpstLagObs <- c(0, InputsModel$Qupstream[Ind_Run[1:(length(Ind_Run) - 1)]])
+
+ expect_equal(Qm3SdSim - Qm3GR4Only, Qm3UpstLagObs)
+})
+
+# *** IniStates tests ***
+IM <- InputsModel
+IM$BasinAreas <- rep(BasinInfo$BasinArea, 3)
+IM$Qupstream <- cbind(IM$Qupstream, IM$Qupstream)
+IM$LengthHydro <- c(1000, 1500)
+
+PSDini <- ParamSD
+PSDini[1] <- PSDini[1] / 2 # 2 time step delay
+Ind_Run1 <- seq(which(format(BasinObs$DatesR, format = "%Y-%m-%d")=="1990-01-01"),
+ which(format(BasinObs$DatesR, format = "%Y-%m-%d")=="1990-12-31"))
+Ind_Run2 <- seq(which(format(BasinObs$DatesR, format = "%Y-%m-%d")=="1991-01-01"),
+ which(format(BasinObs$DatesR, format = "%Y-%m-%d")=="1991-12-31"))
+
+# 1990
+RunOptions1 <- suppressWarnings(CreateRunOptions(FUN_MOD = RunModel_GR4J,
+ InputsModel = IM, IndPeriod_Run = Ind_Run1))
+OutputsModel1 <- RunModel(InputsModel = IM,
+ RunOptions = RunOptions1, Param = PSDini, FUN_MOD = RunModel_GR4J)
+# 1990-1991
+RunOptions <- suppressWarnings(CreateRunOptions(FUN_MOD = RunModel_GR4J,
+ InputsModel = IM, IndPeriod_Run = c(Ind_Run1, Ind_Run2)))
+OutputsModel <- RunModel(InputsModel = IM,
+ RunOptions = RunOptions, Param = PSDini, FUN_MOD = RunModel_GR4J)
+
+test_that("Warm start should give same result as warmed model", {
+ # Warm start 1991
+ RunOptions2 <- CreateRunOptions(FUN_MOD = RunModel_GR4J,
+ InputsModel = IM, IndPeriod_Run = Ind_Run2,
+ IndPeriod_WarmUp = 0L,
+ IniStates = OutputsModel1$StateEnd)
+ OutputsModel2 <- RunModel(InputsModel = IM,
+ RunOptions = RunOptions2, Param = PSDini, FUN_MOD = RunModel_GR4J)
+ # Compare 1991 Qsim from warm started and from 1990-1991
+ names(OutputsModel2$Qsim) <- NULL
+ expect_equal(OutputsModel2$Qsim, OutputsModel$Qsim[366:730])
+})
+
+test_that("Error on Wrong length of iniState$SD", {
+ OutputsModel1$StateEnd$SD[[1]] <- c(1,1)
+ RunOptions2 <- CreateRunOptions(FUN_MOD = RunModel_GR4J,
+ InputsModel = IM, IndPeriod_Run = Ind_Run2,
+ IndPeriod_WarmUp = 0L,
+ IniStates = OutputsModel1$StateEnd)
+ expect_error(RunModel(InputsModel = IM, RunOptions = RunOptions2, Param = PSDini, FUN_MOD = RunModel_GR4J)
+ )
+})
diff --git a/tests/testthat/test-SeriesAggreg.R b/tests/testthat/test-SeriesAggreg.R
new file mode 100644
index 0000000000000000000000000000000000000000..c9edc42ee8d8ba01b8a4bb7f517f096dd0e5ade7
--- /dev/null
+++ b/tests/testthat/test-SeriesAggreg.R
@@ -0,0 +1,251 @@
+context("SeriesAggreg")
+
+## load catchment data
+data(L0123002)
+
+test_that("No warning with InputsModel Cemaneige'", {
+ ## preparation of the InputsModel object
+ InputsModel <- CreateInputsModel(
+ FUN_MOD = RunModel_CemaNeige,
+ DatesR = BasinObs$DatesR,
+ Precip = BasinObs$P,
+ TempMean = BasinObs$T,
+ ZInputs = BasinInfo$HypsoData[51],
+ HypsoData = BasinInfo$HypsoData,
+ NLayers = 5
+ )
+ # Expect no warning: https://stackoverflow.com/a/33638939/5300212
+ expect_warning(SeriesAggreg(InputsModel, "%m"),
+ regexp = NA)
+})
+
+test_that("Warning: deprecated 'TimeFormat' argument", {
+ InputsModel <- CreateInputsModel(
+ FUN_MOD = RunModel_GR4J,
+ DatesR = BasinObs$DatesR,
+ Precip = BasinObs$P,
+ PotEvap = BasinObs$E
+ )
+ expect_warning(SeriesAggreg(InputsModel, Format = "%Y%m", TimeFormat = "daily"),
+ regexp = "deprecated 'TimeFormat' argument")
+})
+
+test_that("Warning: deprecated 'NewTimeFormat' argument: please use 'Format' instead",
+ {
+ InputsModel <- CreateInputsModel(
+ FUN_MOD = RunModel_GR4J,
+ DatesR = BasinObs$DatesR,
+ Precip = BasinObs$P,
+ PotEvap = BasinObs$E
+ )
+ expect_warning(SeriesAggreg(InputsModel, NewTimeFormat = "monthly"),
+ regexp = "deprecated 'NewTimeFormat' argument: please use 'Format' instead")
+ })
+
+test_that("Warning: deprecated 'NewTimeFormat' argument: 'Format' argument is used instead",
+ {
+ InputsModel <- CreateInputsModel(
+ FUN_MOD = RunModel_GR4J,
+ DatesR = BasinObs$DatesR,
+ Precip = BasinObs$P,
+ PotEvap = BasinObs$E
+ )
+ expect_warning(SeriesAggreg(InputsModel, Format = "%Y%m", NewTimeFormat = "monthly"),
+ regexp = "deprecated 'NewTimeFormat' argument: 'Format' argument is used instead")
+ })
+
+test_that("Check SeriesAggreg output values on yearly aggregation", {
+ TabSeries <- data.frame(
+ DatesR = BasinObs$DatesR,
+ P = BasinObs$P,
+ E = BasinObs$E,
+ Qmm = BasinObs$Qmm
+ )
+ GoodValues <- apply(BasinObs[BasinObs$DatesR >= "1984-09-01" &
+ BasinObs$DatesR < "1985-09-01",
+ c("P", "E", "Qmm")], 2, sum)
+ TestedValues <- unlist(SeriesAggreg(TabSeries,
+ Format = "%Y",
+ YearFirstMonth = 9,
+ ConvertFun = rep("sum", 3))[1, c("P", "E", "Qmm")])
+ expect_equal(GoodValues, TestedValues)
+})
+
+test_that("Regime calculation should switch ConvertFun to 'mean' for InputsModel", {
+ InputsModel <- CreateInputsModel(
+ FUN_MOD = RunModel_GR4J,
+ DatesR = BasinObs$DatesR,
+ Precip = BasinObs$P,
+ PotEvap = BasinObs$E
+ )
+
+ expect_equal(SeriesAggreg(InputsModel, "%m")$Precip,
+ SeriesAggreg(BasinObs[, c("DatesR", "P")], "%m", ConvertFun = "mean")$P)
+})
+
+test_that("No DatesR should warning", {
+ TabSeries <- list(
+ Dates = BasinObs$DatesR,
+ P = BasinObs$P,
+ E = BasinObs$E,
+ Qmm = BasinObs$Qmm
+ )
+ expect_warning(
+ SeriesAggreg(TabSeries, "%Y%m", ConvertFun = "sum"),
+ regexp = "has been automatically chosen"
+ )
+})
+
+test_that("Check SeriesAggreg.list 'DatesR' argument", {
+ InputsModel <- CreateInputsModel(
+ FUN_MOD = RunModel_GR4J,
+ DatesR = BasinObs$DatesR,
+ Precip = BasinObs$P,
+ PotEvap = BasinObs$E
+ )
+ DatesR <- InputsModel$DatesR
+ # No InputsModel$DatesR
+ InputsModel$DatesR <- NULL
+ expect_error(SeriesAggreg(InputsModel, "%Y%m"), regexp = "'POSIXt'")
+ # Other list item chosen
+ InputsModel$SuperDates <- DatesR
+ expect_warning(SeriesAggreg(InputsModel, "%Y%m"), regexp = "SuperDates")
+ # Wrong InputsModel$DatesR
+ InputsModel$DatesR <- BasinObs$P
+ expect_error(SeriesAggreg(InputsModel, "%Y%m"), regexp = "'POSIXt'")
+
+})
+
+test_that("Check SeriesAggreg.list with embedded lists", {
+ InputsModel <-
+ CreateInputsModel(
+ FUN_MOD = RunModel_CemaNeige,
+ DatesR = BasinObs$DatesR,
+ Precip = BasinObs$P,
+ TempMean = BasinObs$T,
+ ZInputs = BasinInfo$HypsoData[51],
+ HypsoData = BasinInfo$HypsoData,
+ NLayers = 5
+ )
+ I2 <- SeriesAggreg(InputsModel, "%Y%m")
+ expect_equal(length(I2$ZLayers), 5)
+ expect_null(I2$LayerPrecip$DatesR)
+ expect_equal(length(I2$DatesR), length(I2$LayerPrecip$L1))
+})
+
+test_that("Check SeriesAggreg.outputsModel", {
+ InputsModel <-
+ CreateInputsModel(
+ FUN_MOD = RunModel_CemaNeigeGR4J,
+ DatesR = BasinObs$DatesR,
+ Precip = BasinObs$P,
+ PotEvap = BasinObs$E,
+ TempMean = BasinObs$T,
+ ZInputs = median(BasinInfo$HypsoData),
+ HypsoData = BasinInfo$HypsoData,
+ NLayers = 5
+ )
+
+ ## run period selection
+ Ind_Run <-
+ seq(which(format(BasinObs$DatesR, format = "%Y-%m-%d") == "1990-01-01"),
+ which(format(BasinObs$DatesR, format = "%Y-%m-%d") == "1999-12-31"))
+
+ ## preparation of the RunOptions object
+ suppressWarnings(
+ RunOptions <-
+ CreateRunOptions(
+ FUN_MOD = RunModel_CemaNeigeGR4J,
+ InputsModel = InputsModel,
+ IndPeriod_Run = Ind_Run
+ )
+ )
+
+ ## simulation
+ Param <- c(
+ X1 = 408.774,
+ X2 = 2.646,
+ X3 = 131.264,
+ X4 = 1.174,
+ CNX1 = 0.962,
+ CNX2 = 2.249
+ )
+ OutputsModel <- RunModel_CemaNeigeGR4J(InputsModel = InputsModel,
+ RunOptions = RunOptions,
+ Param = Param)
+
+ O2 <- SeriesAggreg(OutputsModel, "%Y%m")
+ expect_equal(length(O2$StateEnd), 3)
+ expect_equal(length(O2$DatesR),
+ length(O2$CemaNeigeLayers$Layer01$Pliq))
+})
+
+test_that("Check data.frame handling in SeriesAggreg.list", {
+ QObsUp <- imputeTS::na_interpolation(BasinObs$Qmm)
+ InputsModelDown1 <- CreateInputsModel(
+ FUN_MOD = RunModel_GR4J,
+ DatesR = BasinObs$DatesR,
+ Precip = BasinObs$P,
+ PotEvap = BasinObs$E,
+ Qupstream = matrix(QObsUp, ncol = 1),
+ # Upstream observed flow
+ LengthHydro = 100 * 1000,
+ # Distance between upstream catchment outlet and the downstream one in m
+ BasinAreas = c(180, 180) # Upstream and downstream areas in km²
+ )
+ expect_warning(SeriesAggreg(InputsModelDown1, "%Y%m"),
+ regexp = NA)
+ I2 <- SeriesAggreg(InputsModelDown1, "%Y%m")
+ expect_equal(length(I2$DatesR), nrow(I2$Qupstream))
+ InputsModelDown1$Qupstream <-
+ InputsModelDown1$Qupstream[-1, , drop = FALSE] # https://stackoverflow.com/a/7352287/5300212
+ expect_warning(SeriesAggreg(InputsModelDown1, "%Y%m"),
+ regexp = "it will be ignored in the aggregation")
+})
+
+test_that("SeriesAggreg from and to the same time step should return initial time series", {
+ InputsModel <- CreateInputsModel(
+ FUN_MOD = RunModel_GR4J,
+ DatesR = BasinObs$DatesR,
+ Precip = BasinObs$P,
+ PotEvap = BasinObs$E
+ )
+ I2 <- SeriesAggreg(InputsModel, "%Y%m")
+ expect_warning(SeriesAggreg(I2, "%Y%m"), regexp = "No time-step conversion was performed")
+ expect_equal(I2, suppressWarnings(SeriesAggreg(I2, "%Y%m")))
+})
+
+test_that("SeriesAggreg.data.frame with first column not named DatesR should work",
+ {
+ expect_warning(SeriesAggreg(
+ data.frame(BasinObs$DatesR, BasinObs$Qmm),
+ Format = "%Y%m",
+ ConvertFun = "sum"
+ ),
+ regexp = NA)
+ })
+
+test_that("SeriesAggreg should work with ConvertFun 'min', 'max' and 'median'", {
+ Qls <- BasinObs[, c("DatesR", "Qls")]
+ test_ConvertFunRegime <- function(x, ConvertFun, TimeFormat) {
+ expect_equal(nrow(SeriesAggreg(x, TimeFormat, ConvertFun = ConvertFun)),
+ length(unique(format(BasinObs$DatesR, "%Y"))))
+ }
+ lapply(c("max", "min", "median"), function(x) {test_ConvertFunRegime(Qls, x, "%Y")})
+})
+
+test_that("Error on convertFun Q without 0-100", {
+ Qls <- BasinObs[, c("DatesR", "Qls")]
+ expect_error(SeriesAggreg(Qls, "%Y", "q101"))
+ expect_error(SeriesAggreg(Qls, "%Y", "q-2"))
+ expect_error(SeriesAggreg(Qls, "%Y", "q12.5"))
+})
+
+test_that("ConvertFun q50 should be equal to median", {
+ Qls <- BasinObs[, c("DatesR", "Qls")]
+ expect_equal(SeriesAggreg(Qls, "%Y", "q50"),
+ SeriesAggreg(Qls, "%Y", "median"))
+ expect_equal(SeriesAggreg(Qls, "%Y", "q50"),
+ SeriesAggreg(Qls, "%Y", "q050"))
+})
+
diff --git a/tests/testthat/test-evap.R b/tests/testthat/test-evap.R
new file mode 100644
index 0000000000000000000000000000000000000000..aac8122d134e540315c3f4c986defad81de0d452
--- /dev/null
+++ b/tests/testthat/test-evap.R
@@ -0,0 +1,62 @@
+context("Test evaporation")
+
+comp_evap <- function(BasinObs,
+ Lat, LatUnit,
+ TimeStepIn = "daily",
+ TimeStepOut = "daily") {
+ PotEvap <- PE_Oudin(JD = as.POSIXlt(BasinObs$DatesR)$yday + 1,
+ Temp = BasinObs$T,
+ Lat = Lat, LatUnit = LatUnit,
+ TimeStepIn = TimeStepIn, TimeStepOut = TimeStepOut)
+ PotEvapFor <- PE_Oudin(JD = as.POSIXlt(BasinObs$DatesR)$yday + 1,
+ Temp = BasinObs$T,
+ Lat = Lat, LatUnit = LatUnit,
+ TimeStepIn = TimeStepIn, TimeStepOut = TimeStepOut,
+ RunFortran = TRUE)
+ all(range(PotEvap - PotEvapFor) < 0.000001)
+}
+
+test_that("PE_Oudin works", {
+ skip_on_cran()
+ rm(list = ls())
+
+ data(L0123001); BasinObs_L0123001 <- BasinObs
+ data(L0123002); BasinObs_L0123002 <- BasinObs
+
+ expect_true(comp_evap(BasinObs = BasinObs_L0123001,
+ Lat = 0.8, LatUnit = "rad",
+ TimeStepIn = "daily", TimeStepOut = "daily"))
+ expect_true(comp_evap(BasinObs = BasinObs_L0123001,
+ Lat = 0.8, LatUnit = "rad",
+ TimeStepIn = "daily", TimeStepOut = "hourly"))
+ expect_true(comp_evap(BasinObs = BasinObs_L0123002,
+ Lat = 0.9, LatUnit = "rad",
+ TimeStepIn = "daily", TimeStepOut = "daily"))
+ expect_true(comp_evap(BasinObs = BasinObs_L0123002,
+ Lat = 0.9, LatUnit = "rad",
+ TimeStepIn = "daily", TimeStepOut = "hourly"))
+
+ ## check with several catchments using different values for Lat
+
+ ## one by one
+ PotEvapFor1 <- PE_Oudin(JD = as.POSIXlt(BasinObs_L0123001$DatesR)$yday + 1,
+ Temp = BasinObs_L0123001$T,
+ Lat = 0.8, LatUnit = "rad",
+ RunFortran = TRUE)
+ PotEvapFor2 <- PE_Oudin(JD = as.POSIXlt(BasinObs_L0123002$DatesR)$yday + 1,
+ Temp = BasinObs_L0123002$T,
+ Lat = 0.9, LatUnit = "rad",
+ RunFortran = TRUE)
+
+ ## all in one
+ BasinObs_L0123001$Lat <- 0.8
+ BasinObs_L0123002$Lat <- 0.9
+ BasinObs <- rbind(BasinObs_L0123001, BasinObs_L0123002)
+ PotEvapFor <- PE_Oudin(JD = as.POSIXlt(BasinObs$DatesR)$yday + 1,
+ Temp = BasinObs$T,
+ Lat = BasinObs$Lat, LatUnit = "rad",
+ RunFortran = TRUE)
+
+ expect_equal(PotEvapFor, c(PotEvapFor1, PotEvapFor2))
+
+})
diff --git a/tests/testthat/test-vignettes.R b/tests/testthat/test-vignettes.R
new file mode 100644
index 0000000000000000000000000000000000000000..7d19c74f1ad2ecefb51218928d45128e19b733af
--- /dev/null
+++ b/tests/testthat/test-vignettes.R
@@ -0,0 +1,53 @@
+context("Test vignette chunks")
+
+test_that("V01_get_started works", {
+ skip_on_cran()
+ rm(list = ls())
+ expect_true(RunVignetteChunks("V01_get_started"))
+ TestQmmQlsConversion(BasinObs, BasinInfo$BasinArea)
+})
+
+test_that("V02.1_param_optim works", {
+ skip_on_cran()
+ rm(list = ls())
+ load(system.file("vignettesData/vignetteParamOptim.rda", package = "airGR"))
+ rda_resGLOB <- resGLOB
+ rda_resPORT <- resPORT
+ expect_true(RunVignetteChunks("V02.1_param_optim"))
+ expect_equal(summary(resGLOB), summary(rda_resGLOB), tolerance = 1E-7)
+ expect_equal(resGLOB[,-1], rda_resGLOB[,-1], tolerance = 1E-2) # High tolerance due to randomisation in optimisations
+})
+
+test_that("V02.2_param_mcmc works", {
+ skip_on_cran()
+ rm(list = ls())
+ load(system.file("vignettesData/vignetteParamMCMC.rda", package = "airGR"))
+ rda_gelRub <- gelRub
+ rda_multDRAM <- multDRAM
+ expect_true(RunVignetteChunks("V02.2_param_mcmc"))
+ expect_equal(gelRub, rda_gelRub, tolerance = 1E-7)
+ expect_equal(multDRAM, rda_multDRAM, tolerance = 1E-7)
+})
+
+test_that("V03_param_sets_GR4J works", {
+ skip_on_cran()
+ rm(list = ls())
+ expect_true(RunVignetteChunks("V03_param_sets_GR4J"))
+
+})
+
+test_that("V04_cemaneige_hysteresis works", {
+ skip_on_cran()
+ rm(list = ls())
+ load(system.file("vignettesData/vignetteCNHysteresis.rda", package = "airGR"))
+ rda_OutputsCrit_Cal <- OutputsCrit_Cal
+ rda_OutputsCrit_Cal_NoHyst <- OutputsCrit_Cal_NoHyst
+ rda_OutputsCrit_Val <- OutputsCrit_Val
+ rda_OutputsCrit_Val_NoHyst <- OutputsCrit_Val_NoHyst
+ expect_true(RunVignetteChunks("V04_cemaneige_hysteresis"))
+ TestQmmQlsConversion(BasinObs, BasinInfo$BasinArea)
+ expect_equal(OutputsCrit_Cal, rda_OutputsCrit_Cal, tolerance = 1E-7)
+ expect_equal(OutputsCrit_Cal_NoHyst, rda_OutputsCrit_Cal_NoHyst, tolerance = 1E-7)
+ expect_equal(OutputsCrit_Val, rda_OutputsCrit_Val, tolerance = 1E-7)
+ expect_equal(OutputsCrit_Val_NoHyst, rda_OutputsCrit_Val_NoHyst, tolerance = 1E-7)
+})
diff --git a/vignettes/V01_get_started.Rmd b/vignettes/V01_get_started.Rmd
index 2556debc242453c22ff418c751c26cfa5ff22302..fec3845f4c69f078dbc020e79b24d8592b460a1a 100644
--- a/vignettes/V01_get_started.Rmd
+++ b/vignettes/V01_get_started.Rmd
@@ -28,7 +28,7 @@ The models can be called within **airGR** using the following functions:
* `RunModel_GR6J()`: six-parameter daily lumped hydrological model [@pushpalatha_downward_2011]
* `RunModel_GR2M()`: two-parameter monthly lumped hydrological model [@mouelhi_vers_2003; @mouelhi_stepwise_2006]
* `RunModel_GR1A()`: one-parameter yearly lumped hydrological model [@mouelhi_vers_2003; @mouelhi_linking_2006]
- * `RunModel_CemaNeige()`: two-parameter degree-day snowmelt and accumulation model [@valery_as_2014]
+ * `RunModel_CemaNeige()`: two-parameter degree-day snowmelt and accumulation model [@valery_as_2014; @riboust_revisiting_2019]
* `RunModel_CemaNeigeGR4H()`: combined use of **GR4H** and **CemaNeige**
* `RunModel_CemaNeigeGR5H()`: combined use of **GR5H** and **CemaNeige**
* `RunModel_CemaNeigeGR4J()`: combined use of **GR4J** and **CemaNeige**
@@ -85,7 +85,7 @@ To facilitate the use of the package, there are several functions dedicated to t
To run a GR hydrological model or CemaNeige, the user has to prepare the input data with the `CreateInputsModel()` function.
As arguments, this function needs the function name corresponding to the model the user wants to run, a vector of dates, a vector of precipitation and a vector of potential evapotranspiration.
-In the example below, we already have the potential evapotranspiration. If the user does not have these data, it is possible to compute it with the [Oudin's formula](http://dx.doi.org/10.1016/j.jhydrol.2004.08.026) with the `PEdaily_Oudin()` function (this function only needs Julian days, daily average air temperature and latitude).
+In the example below, we already have the potential evapotranspiration. If the user does not have these data, it is possible to compute it with the [Oudin's formula](http://dx.doi.org/10.1016/j.jhydrol.2004.08.026) with the `PE_Oudin()` function (this function only needs Julian days, daily average air temperature and latitude).
Missing values (`NA`) of precipitation (or potential evapotranspiration) are **not allowed**.
@@ -150,6 +150,8 @@ The `CreateInputsCrit()` function allows to prepare the input in order to calcul
Missing values (`NA`) are **allowed** for observed discharge.
+It is possible to compute a composite criterion (e.g. the average between NSE computed on discharge and NSE computed on log of discharge). In this case, users have to provide lists to the following arguments (some of the are optional): `FUN_CRIT`, `Obs`, `VarObs`, `BoolCrit`, `transfo`, `Weights.`
+
```{r}
InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
RunOptions = RunOptions, VarObs = "Q", Obs = BasinObs$Qmm[Ind_Run])
diff --git a/vignettes/V02.1_param_optim.Rmd b/vignettes/V02.1_param_optim.Rmd
index f6b45bdefe3bdf8782f4e5f1433ec22f9b42d314..0063d9151e5c4c90de00a1d61aaa0374ebac4e31 100644
--- a/vignettes/V02.1_param_optim.Rmd
+++ b/vignettes/V02.1_param_optim.Rmd
@@ -13,7 +13,7 @@ vignette: >
```{r, warning=FALSE, include=FALSE, fig.keep='none', results='hide'}
library(airGR)
library(DEoptim)
-#library(hydroPSO)
+library(hydroPSO) # Needs R version >= 3.6 or latticeExtra <= 0.6-28 on R 3.5
library(Rmalschains)
# source("airGR.R")
set.seed(321)
@@ -84,7 +84,7 @@ upperGR4J <- rep(+9.99, times = 4)
We start with a local optimization strategy by using the PORT routines (using the `nlminb()` of the `stats` package) and by setting a starting point in the transformed parameter space:
```{r, warning=FALSE, results='hide', eval=FALSE}
startGR4J <- c(4.1, 3.9, -0.9, -8.7)
-optPORT <- stats::nlminb(start = startGR4J,
+optPORT <- stats::nlminb(start = startGR4J,
objective = OptimGR4J,
lower = lowerGR4J, upper = upperGR4J,
control = list(trace = 1))
@@ -97,7 +97,7 @@ For each starting point, a local optimization is performed.
```{r, warning=FALSE, results='hide', eval=FALSE}
startGR4J <- expand.grid(data.frame(CalibOptions$StartParamDistrib))
optPORT_ <- function(x) {
- opt <- stats::nlminb(start = x,
+ opt <- stats::nlminb(start = x,
objective = OptimGR4J,
lower = lowerGR4J, upper = upperGR4J,
control = list(trace = 1))
@@ -147,7 +147,7 @@ optPSO <- hydroPSO::hydroPSO(fn = OptimGR4J,
## MA-LS-Chains
```{r, warning=FALSE, results='hide', eval=FALSE}
optMALS <- Rmalschains::malschains(fn = OptimGR4J,
- lower = lowerGR4J, upper = upperGR4J,
+ lower = lowerGR4J, upper = upperGR4J,
maxEvals = 2000)
```
@@ -156,7 +156,7 @@ optMALS <- Rmalschains::malschains(fn = OptimGR4J,
As it can be seen in the table below, the four additional optimization strategies tested lead to very close optima.
```{r, warning=FALSE, echo=FALSE, eval=FALSE}
-resGLOB <- data.frame(Algo = c("airGR", "PORT", "DE", "PSO", "MA-LS"),
+resGLOB <- data.frame(Algo = c("airGR", "PORT", "DE", "PSO", "MA-LS"),
round(rbind(
OutputsCalib$ParamFinalR ,
airGR::TransfoParam_GR4J(ParamIn = optPORT$par , Direction = "TR"),
diff --git a/vignettes/V02.2_param_mcmc.Rmd b/vignettes/V02.2_param_mcmc.Rmd
index 4555cf0c7f0a0d7bc42ecbfa634d6379ce11b95f..02e9c5520c37833183840c03c4cb226d062b8888 100644
--- a/vignettes/V02.2_param_mcmc.Rmd
+++ b/vignettes/V02.2_param_mcmc.Rmd
@@ -48,8 +48,8 @@ Please note that this vignette is only for illustration purposes and does not pr
We show how to use the DRAM algorithm for SLS Bayesian inference, with the `modMCMC()` function of the [FME](https://cran.r-project.org/package=FME) package.
First, we need to define a function that returns twice the opposite of the log-likelihood for a given parameter set.
-Nota: in the `LogLikeGR4J()` function, the computation of the log-likelihood is simplified in order to ensure a good computing performance. It corresponds to a translation of the two following lines.
-```{r, echo=TRUE, eval=FALSE}
+Nota: in the `LogLikeGR4J()` function, the computation of the log-likelihood is simplified in order to ensure a good computing performance. It corresponds to a translation of the two following lines.
+```{r, echo=TRUE, eval=FALSE, purl=FALSE}
Likelihood <- sum((ObsY - ModY)^2, na.rm = TRUE)^(-sum(!is.na(ObsY)) / 2)
LogLike <- -2 * log(Likelihood)
```
@@ -68,7 +68,7 @@ LogLikeGR4J <- function(ParamOptim) {
RunOptions = RunOptions,
Param = RawParamOptim)
## Computation of the log-likelihood: N * log(SS)
- ObsY <- InputsCrit$Qobs
+ ObsY <- InputsCrit$Obs
ModY <- OutputsModel$Qsim
LogLike <- sum(!is.na(ObsY)) * log(sum((ObsY - ModY)^2, na.rm = TRUE))
}
@@ -79,7 +79,7 @@ LogLikeGR4J <- function(ParamOptim) {
## Estimation of the best-fit parameters as a starting point
We start by using the PORT optimization routine to estimate the best-fit parameters.
```{r, results='hide', eval=FALSE}
-optPORT <- stats::nlminb(start = c(4.1, 3.9, -0.9, -8.7),
+optPORT <- stats::nlminb(start = c(4.1, 3.9, -0.9, -8.7),
objective = LogLikeGR4J,
lower = rep(-9.9, times = 4), upper = rep(9.9, times = 4),
control = list(trace = 1))
diff --git a/vignettes/V04_cemaneige_hysteresis.Rmd b/vignettes/V04_cemaneige_hysteresis.Rmd
index bdc7796ea40fe1e1335b52ff14d0994090cf420e..8c87387dd98abc9e93c6676c39ddfa2f082160ea 100644
--- a/vignettes/V04_cemaneige_hysteresis.Rmd
+++ b/vignettes/V04_cemaneige_hysteresis.Rmd
@@ -204,9 +204,12 @@ We can now calibrate the model.
```{r, warning=FALSE, eval=FALSE}
## calibration
-OutputsCalib_NoHyst <- Calibration(InputsModel = InputsModel, InputsCrit = InputsCrit_Cal_NoHyst,
- RunOptions = RunOptions_Cal_NoHyst, CalibOptions = CalibOptions_NoHyst,
- FUN_MOD = RunModel_CemaNeigeGR4J, FUN_CALIB = Calibration_Michel)
+OutputsCalib_NoHyst <- Calibration(InputsModel = InputsModel,
+ InputsCrit = InputsCrit_Cal_NoHyst,
+ RunOptions = RunOptions_Cal_NoHyst,
+ CalibOptions = CalibOptions_NoHyst,
+ FUN_MOD = RunModel_CemaNeigeGR4J,
+ FUN_CALIB = Calibration_Michel)
```
And run it over the calibration and validation periods.
diff --git a/vignettes/V05_sd_model.Rmd b/vignettes/V05_sd_model.Rmd
new file mode 100644
index 0000000000000000000000000000000000000000..5e814abc10a965416d4aef1a78e95bb6631893b1
--- /dev/null
+++ b/vignettes/V05_sd_model.Rmd
@@ -0,0 +1,213 @@
+---
+title: "Simulating a reservoir with semi-distributed GR4J model"
+author: "David Dorchies"
+bibliography: V00_airgr_ref.bib
+output: rmarkdown::html_vignette
+vignette: >
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteIndexEntry{Simulating a reservoir with semi-distributed GR4J model}
+ %\VignetteEncoding{UTF-8}
+---
+
+```{r, include=FALSE, fig.keep='none', results='hide'}
+library(airGR)
+options(digits = 3)
+library(imputeTS)
+```
+
+# Introduction
+
+## Scope
+
+The **airGR** package implements semi-distributed model capabilities using a lag model between subcatchments. It allows to chain together several lumped models as well as integrating anthropogenic influence such as reservoirs or withdrawals.
+
+`RunModel_Lag` documentation gives an example of simulating the influence of a reservoir in a lumped model. Try `example(RunModel_Lag)` to get it.
+
+In this vignette, we show how to calibrate 2 sub-catchments in series with a semi-distributed model consisting of 2 GR4J models. For doing this we compare two strategies for calibrating the downstream subcatchment:
+
+- using upstream observed flows
+- using upstream simulated flows
+
+We finally compare these calibrations with a theoretical set of parameters.
+
+## Model description
+
+
+```{r, warning=FALSE, include=FALSE}
+library(airGR)
+options(digits = 3)
+```
+
+We use an example data set from the package that unfortunately contains data for only one catchment.
+
+```{r, warning=FALSE}
+## loading catchment data
+data(L0123001)
+```
+
+Let's imagine that this catchment of 360 km² is divided into 2 subcatchments:
+
+- An upstream subcatchment of 180 km²
+- 100 km downstream another subcatchment of 180 km²
+
+We consider that meteorological data are homogeneous on the whole catchment, so we use the same pluviometry `BasinObs$P` and the same evapotranspiration `BasinObs$E` for the 2 subcatchments.
+
+For the observed flow at the downstream outlet, we generate it with the assumption that the upstream flow arrives at downstream with a constant delay of 2 days.
+
+```{r}
+QObsDown <- (BasinObs$Qmm + c(0, 0, BasinObs$Qmm[1:(length(BasinObs$Qmm)-2)])) / 2
+summary(cbind(QObsUp = BasinObs$Qmm, QObsDown))
+```
+
+# Calibration of the upstream subcatchment
+
+The operations are exactly the same as the ones for a GR4J lumped model. So we do exactly the same operations as in the [Get Started](V01_get_started.html) vignette.
+
+```{r}
+InputsModelUp <- CreateInputsModel(FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR,
+ Precip = BasinObs$P, PotEvap = BasinObs$E)
+Ind_Run <- seq(which(format(BasinObs$DatesR, format = "%Y-%m-%d") == "1990-01-01"),
+ which(format(BasinObs$DatesR, format = "%Y-%m-%d") == "1999-12-31"))
+RunOptionsUp <- CreateRunOptions(FUN_MOD = RunModel_GR4J,
+ InputsModel = InputsModelUp, IndPeriod_Run = Ind_Run,
+ IniStates = NULL, IniResLevels = NULL, IndPeriod_WarmUp = NULL)
+InputsCritUp <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModelUp,
+ RunOptions = RunOptionsUp, VarObs = "Q", Obs = BasinObs$Qmm[Ind_Run])
+CalibOptionsUp <- CreateCalibOptions(FUN_MOD = RunModel_GR4J, FUN_CALIB = Calibration_Michel)
+OutputsCalibUp <- Calibration_Michel(InputsModel = InputsModelUp, RunOptions = RunOptionsUp,
+ InputsCrit = InputsCritUp, CalibOptions = CalibOptionsUp,
+ FUN_MOD = RunModel_GR4J)
+```
+
+And see the result of the simulation:
+
+```{r}
+OutputsModelUp <- RunModel_GR4J(InputsModel = InputsModelUp, RunOptions = RunOptionsUp,
+ Param = OutputsCalibUp$ParamFinalR)
+```
+
+
+# Calibration of the downstream subcatchment with upstream flow observations
+
+Observed flow data contain `NA` values and a complete time series is mandatory for running the Lag model. We propose to complete the observed upstream flow with linear interpolation:
+
+```{r}
+QObsUp <- imputeTS::na_interpolation(BasinObs$Qmm)
+```
+
+we need to create the `InputsModel` object completed with upstream information:
+
+```{r}
+InputsModelDown1 <- CreateInputsModel(
+ FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR,
+ Precip = BasinObs$P, PotEvap = BasinObs$E,
+ Qupstream = matrix(QObsUp, ncol = 1), # Upstream observed flow
+ LengthHydro = 100 * 1000, # Distance between upstream catchment outlet and the downstream one in m
+ BasinAreas = c(180, 180) # Upstream and downstream areas in km²
+)
+```
+
+And then calibrate the combination of Lag model for upstream flow transfer and GR4J model for the runoff of the downstream subcatchment:
+
+```{r}
+RunOptionsDown <- CreateRunOptions(FUN_MOD = RunModel_GR4J,
+ InputsModel = InputsModelDown1, IndPeriod_Run = Ind_Run,
+ IniStates = NULL, IniResLevels = NULL, IndPeriod_WarmUp = NULL)
+InputsCritDown <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModelDown1,
+ RunOptions = RunOptionsDown, VarObs = "Q", Obs = QObsDown[Ind_Run])
+CalibOptionsDown <- CreateCalibOptions(FUN_MOD = RunModel_GR4J,
+ FUN_CALIB = Calibration_Michel,
+ IsSD = TRUE) # Don't forget to specify that it's an SD model here
+OutputsCalibDown1 <- Calibration_Michel(InputsModel = InputsModelDown1, RunOptions = RunOptionsDown,
+ InputsCrit = InputsCritDown, CalibOptions = CalibOptionsDown,
+ FUN_MOD = RunModel_GR4J)
+```
+
+To run the complete model, we should substitute the observed upstream flow by the simulated one:
+
+```{r}
+InputsModelDown2 <- InputsModelDown1
+InputsModelDown2$Qupstream[Ind_Run] <- OutputsModelUp$Qsim
+```
+
+`RunModel` is run in order to automatically combine GR4J and Lag models.
+
+```{r}
+OutputsModelDown1 <- RunModel(InputsModel = InputsModelDown2,
+ RunOptions = RunOptionsDown,
+ Param = OutputsCalibDown1$ParamFinalR,
+ FUN_MOD = RunModel_GR4J)
+```
+
+Performance of the model validation is then:
+
+```{r}
+CritDown1 <- ErrorCrit_NSE(InputsCritDown, OutputsModelDown1)
+```
+
+
+# Calibration of the downstream subcatchment with upstream simulated flow
+
+We calibrate the model with the `InputsModel` object previously created for substituting the observed upstream flow with the simulated one:
+
+```{r}
+OutputsCalibDown2 <- Calibration_Michel(InputsModel = InputsModelDown2, RunOptions = RunOptionsDown,
+ InputsCrit = InputsCritDown, CalibOptions = CalibOptionsDown,
+ FUN_MOD = RunModel_GR4J)
+ParamDown2 <- OutputsCalibDown2$ParamFinalR
+```
+
+
+# Discussion
+
+## Identification of Lag parameter
+
+The theoretical LAG parameter should be equal to:
+
+```{r}
+Lag <- InputsModelDown1$LengthHydro / (2 * 86400)
+paste(format(Lag), "m/s")
+```
+
+Both calibrations overestimate this parameter:
+
+```{r}
+mLag <- matrix(c(Lag, OutputsCalibDown1$ParamFinalR[1], OutputsCalibDown2$ParamFinalR[1]), ncol = 1)
+rownames(mLag) = c("theoretical", "calibrated with observed upstream flow",
+ "calibrated with simulated upstream flow")
+colnames(mLag) = c("Lag parameter")
+knitr::kable(mLag)
+```
+
+## Value of the performance criteria with theoretical calibration
+
+Theoretically, the parameters of the downstream GR4J model should be the same as the upstream one and we know the lag time. So this set of parameter should give a better performance criteria:
+
+```{r}
+ParamDownTheo <- c(Lag, OutputsCalibUp$ParamFinalR)
+OutputsModelDownTheo <- RunModel(InputsModel = InputsModelDown2,
+ RunOptions = RunOptionsDown,
+ Param = ParamDownTheo,
+ FUN_MOD = RunModel_GR4J)
+CritDownTheo <- ErrorCrit_NSE(InputsCritDown, OutputsModelDownTheo)
+```
+
+
+
+## Parameters and performance of each subcatchment for all calibrations
+
+```{r}
+comp <- matrix(c(0, OutputsCalibUp$ParamFinalR, rep(OutputsCalibDown1$ParamFinalR, 2),
+ OutputsCalibDown2$ParamFinalR, ParamDownTheo), ncol = 5, byrow = TRUE)
+comp <- cbind(comp, c(OutputsCalibUp$CritFinal, OutputsCalibDown1$CritFinal,
+ CritDown1$CritValue, OutputsCalibDown2$CritFinal, CritDownTheo$CritValue))
+colnames(comp) <- c("Lag", paste0("x", 1:4), "NSE")
+rownames(comp) <- c("Calibration of the upstream subcatchment",
+ "Calibration 1 with observed upstream flow",
+ "Validation 1 with simulated upstream flow",
+ "Calibration 2 with simulated upstream flow",
+ "Validation theoretical set of parameters")
+knitr::kable(comp)
+```
+
+Even if calibration with observed upstream flows gives an improved performance criteria, in validation using simulated upstream flows the result is quite similar as the performance obtained with the calibration with upstream simulated flows. The theoretical set of parameters give also an equivalent performance but still underperforming the calibration 2 one.