Source

Target

Commits (1038)
Showing with 2314 additions and 2319 deletions
+2314 -2319
......@@ -2,3 +2,14 @@
^\.Rproj\.user$
^\.Rprofile$
^packrat/
^tests/tmp/
^\.gitlab-ci.yml$
^\.regressionignore$
^\.vignettechunkignore$
^\.gitlab-ci\.yml$
^\.vscode$
^Rplots\.pdf$
^ci$
^data-raw$
^revdep$
^\.devcontainer$
{
"image": "rocker/geospatial:devel",
"customizations": {
"vscode": {
"extensions": [
"eamodio.gitlens",
"REditorSupport.r"
]
}
},
// Use 'postCreateCommand' to run commands after the container is created.
"postCreateCommand": "R -q -e 'install.packages(\"languageserver\");remotes::install_deps(dep = TRUE)'",
"postStartCommand": "R -q -e 'devtools::install()'"
}
.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
# revdep
/revdep/
######################################################################################################
### 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
.Rprofile
# pkgdown site
docs/
# vscode IDE
.vscode/*
*.code-workspace
.history/
stages:
- check
- scheduled_tests
- revdepcheck
variables:
R_LIBS_USER: "$CI_PROJECT_DIR/ci/lib"
default:
tags: [docker]
cache:
key: "airGR-${R_VERSION}"
paths:
- $R_LIBS_USER
before_script:
- mkdir -p $R_LIBS_USER
- echo "R_LIBS='$R_LIBS_USER'" > .Renviron
- echo 'options(repos = c(CRAN = "https://packagemanager.posit.co/cran/__linux__/focal/latest"))' > .Rprofile
- apt-get update && apt-get install -y libstdc++6
- R -q -e 'remotes::install_deps(dependencies = TRUE)'
.R-devel:
image: rocker/geospatial:devel
variables:
R_VERSION: devel
.R-patched:
only:
refs:
- tags
- schedules
image: rocker/geospatial:latest
variables:
R_VERSION: patched
.R-oldrel:
only:
refs:
- tags
- schedules
image: rocker/geospatial:4.1
variables:
R_VERSION: oldrel
.scheduled_tests:
only:
refs:
- tags
- schedules
- master
stage: scheduled_tests
script:
- R -q -e 'devtools::install()'
- Rscript tests/scheduled_tests/scheduled.R
- Rscript tests/scheduled_tests/regression.R stable
- R CMD INSTALL .
- Rscript tests/scheduled_tests/regression.R dev
- Rscript tests/scheduled_tests/regression.R compare
.check:
stage: check
script:
- R -q -e 'tinytex::tlmgr("option repository https://ftp.tu-chemnitz.de/pub/tug/historic/systems/texlive/2021/tlnet-final")'
- tlmgr update --self && tlmgr install ec epstopdf-pkg amsmath
- R -q -e 'remotes::update_packages("rcmdcheck")'
- R -q -e 'rcmdcheck::rcmdcheck(args = c("--as-cran"), error_on = "warning")'
.test_all:
stage: check
script:
- R -q -e 'testthat::test_local()'
benchmark_devel:
extends: .R-devel
stage: check
allow_failure: true
script:
- R -q -e 'remotes::update_packages("microbenchmark", repos = "http://cran.r-project.org")'
- R -q -e 'install.packages("airGR", repos = "http://cran.r-project.org")'
- Rscript tests/scheduled_tests/benchmarkRunModel.R
- R CMD INSTALL .
- Rscript tests/scheduled_tests/benchmarkRunModel.R
artifacts:
paths:
- tests/tmp/benchmark.tsv
- tests/tmp/mean_execution_time.tsv
scheduled_tests_patched:
extends:
- .scheduled_tests
- .R-patched
scheduled_tests_devel:
extends:
- .scheduled_tests
- .R-devel
scheduled_tests_oldrel:
extends:
- .scheduled_tests
- .R-oldrel
check_patched:
extends:
- .check
- .R-patched
check_devel:
extends:
- .check
- .R-devel
test_all_patched:
extends:
- .test_all
- .R-patched
test_all_devel:
extends:
- .test_all
- .R-devel
test_all_oldrel:
extends:
- .test_all
- .R-oldrel
revdepcheck_devel:
stage: revdepcheck
only:
refs:
- tags
- schedule
- master
extends: .R-devel
script:
- R -q -e 'remotes::install_github("https://github.com/r-lib/revdepcheck")'
- R -q -e 'revdepcheck::revdep_check(timeout = as.difftime(20, units = "mins"))'
- R -q -e 'stopifnot(all("+" == sapply(revdepcheck::revdep_summary(), "[[", "status")))'
- R -q -e 'if (any(sapply(revdepcheck::revdep_summary(), function(x) {any(x$cmp$change == 1)}))) stop()'
artifacts:
when: on_failure
paths:
- revdep/README.md
- revdep/problems.md
- revdep/failures.md
- revdep/cran.md
- revdep/checks/*.log
# .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] or *<SPACE>[Variable] for every variable whatever the topic
# Example for ignoring OutputsModel variable produced by example("RunModel_GR2M"): RunModel_GR2M OutputsModel
# This file is used by the script tests/testthat/test-vignettes which test all
# chunks including those with `eval=FALSE`
# It serves to ignore chunks that should not be tested anyway
# Format: `vignette file name`[space]`id of the chunk`
V02.1_param_optim.Rmd hydroPSO1
V02.1_param_optim.Rmd hydroPSO2
V02.1_param_optim.Rmd resGLOB
Package: airGR
Type: Package
Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling
Version: 1.3.0.17
Date: 2019-05-21
Version: 1.7.6.9000
Date: 2023-10-25
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@irstea.fr"),
person("Guillaume", "Thirel", role = c("aut"), comment = c(ORCID = "0000-0002-1444-1830")),
person("Olivier", "Delaigue", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-7668-8468"), email = "airGR@inrae.fr"),
person("Guillaume", "Thirel", role = c("aut", "ths"), 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")),
person("Thibaut", "Mathevet", role = c("ctb"), comment = c(ORCID = "0000-0002-4142-4454")),
person("Safouane", "Mouelhi", role = c("ctb")),
person("Ludovic", "Oudin", role = c("ctb")),
person("Ludovic", "Oudin", role = c("ctb"), comment = c(ORCID = "0000-0002-3712-0933")),
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, hydroPSO, Rmalschains
Description: Hydrological modelling tools developed at Irstea-Antony (HYCAR Research Unit, France). The package includes several conceptual rainfall-runoff models (GR4H, 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.
Depends: R (>= 3.1.0)
Imports:
graphics,
grDevices,
stats,
utils
Suggests:
knitr, markdown, rmarkdown,
caRamel, coda, DEoptim, FME, ggmcmc, Rmalschains,
GGally, ggplot2,
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) that can be applied either on a lumped or semi-distributed way. A snow accumulation and melt model (CemaNeige) and the associated functions for the calibration and evaluation of models are also included. 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
NeedsCompilation: yes
Encoding: UTF-8
VignetteBuilder: knitr
RoxygenNote: 7.1.1
......@@ -8,7 +8,13 @@ useDynLib(airGR, .registration = TRUE)
#####################################
## S3 methods ##
#####################################
S3method("plot", "OutputsModel")
S3method('[', InputsModel)
#S3method('[', OutputsModel) ### to add in version 2.0
S3method(plot, OutputsModel)
S3method(SeriesAggreg, data.frame)
S3method(SeriesAggreg, list)
S3method(SeriesAggreg, InputsModel)
S3method(SeriesAggreg, OutputsModel)
......@@ -18,8 +24,10 @@ S3method("plot", "OutputsModel")
export(Calibration)
export(Calibration_Michel)
export(CreateCalibOptions)
export(CreateErrorCrit_GAPX)
export(CreateIniStates)
export(CreateInputsCrit)
export(CreateInputsCrit_Lavenne)
export(CreateInputsModel)
export(CreateRunOptions)
export(DataAltiExtrapolation_Valery)
......@@ -28,19 +36,24 @@ export(ErrorCrit_KGE)
export(ErrorCrit_KGE2)
export(ErrorCrit_NSE)
export(ErrorCrit_RMSE)
export(PEdaily_Oudin)
export(Imax)
export(PE_Oudin)
export(plot.OutputsModel) ### to remove from version 2.0
export(RunModel)
export(RunModel_CemaNeige)
export(RunModel_CemaNeigeGR4H)
export(RunModel_CemaNeigeGR5H)
export(RunModel_CemaNeigeGR4J)
export(RunModel_CemaNeigeGR5J)
export(RunModel_CemaNeigeGR6J)
export(RunModel_GR1A)
export(RunModel_GR2M)
export(RunModel_GR4H)
export(RunModel_GR5H)
export(RunModel_GR4J)
export(RunModel_GR5J)
export(RunModel_GR6J)
export(RunModel_Lag)
export(SeriesAggreg)
export(TransfoParam)
export(TransfoParam_CemaNeige)
......@@ -48,13 +61,13 @@ export(TransfoParam_CemaNeigeHyst)
export(TransfoParam_GR1A)
export(TransfoParam_GR2M)
export(TransfoParam_GR4H)
export(TransfoParam_GR5H)
export(TransfoParam_GR4J)
export(TransfoParam_GR5J)
export(TransfoParam_GR6J)
export(plot.OutputsModel)
exportPattern(".FortranOutputs")
exportPattern(".ErrorCrit")
export(TransfoParam_Lag)
#export(.ErrorCrit)
#export(.FeatModels)
#####################################
......
## Release History of the airGR Package
### 1.7.6 Release Notes (2023-10-25)
#### Bug fixes
- `CreateCalibOptions()` now uses parameter screening for `RunModel_Lag()` which are now expressed in the transformed space instead of the parameter space. ([#156](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/156))
- `RunModel_CemaNeige*()` now takes into account the case when `dG = 0`. ([#178](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/178))
#### Minor user-visible changes
- `Calibration_Michel()` now runs faster as the `ProposeCandidatesGrid()` was improved to create the propose candidates grid. ([#157](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/157))
- `TransfoParamGR5J()` now returns the correct error message when the number of parameters is incorrect. ([#168](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/168))
#### CRAN-compatibility updates
- `frun_*` Fortran subroutine does not use anymore the 'DLLEXPORT' command. ([#180](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/180))
- The 'Rmalschains' package is back on CRAN and it is again suggested (cf. the 'param_optim' vignette). ([#175](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/175))
- The 'hydroPSO' package is no longer suggested (but the code linked to its use and is always present in the 'param_optim' vignette). ([#182](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/182))
____________________________________________________________________________________
### 1.7.4 Release Notes (2023-04-11)
#### CRAN-compatibility updates
- The 'Rmalschains' package is no longer suggested (but the code linked to its use and is always present in the 'param_optim' vignette). ([#172](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/172))
- `.ErrorCrit()` and `.FeatModels` function are no more exported. ([#173](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/173))
____________________________________________________________________________________
### 1.7.0 Release Notes (2022-02-21)
#### New features
- Semi-distributed modelling mode can now use the regularisation calibration proposed by [Lavenne et al. (2019)](https://doi.org/10.1029/2018WR024266). Added the `CreateInputsCrit_Lavenne()` to define a composite criterion based on the formula. Added the `CreateErrorCrit_GAPX()` function to compute an error criterion based on the GAPX formula. ([#111](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/111))
- `OutputsModel`, returned by the `RunModel_*GR*()` function, gains a `RunOptions` element which is a list and contains 2 sub-elements: `WarmUpQsim` (vector series of simulated discharge on the warm-up period) and `Param` (vector of the model parameter values). ([#123](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/123))
- `plot.OutputsModel()` gains a `AxisTS` argument in order to manage x-axis representing calendar dates and times. It avoids to display ugly x-axis. ([#122](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/122))
#### Deprecated and defunct
- The deprecated `LatRad` argument has been removed from the `PEdaily_Oudin()` function. ([#81](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/81))
- The deprecated `Qobs` argument has been removed from the `CreateInputsCrit()` function. ([#81](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/81))
- The deprecated `Ind_zeroes` argument has been removed from the `CreateInputsCrit()` function. ([#81](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/81))
- The deprecated `verbose` argument has been removed from the `CreateInputsCrit()` function. ([#81](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/81))
- The deprecated `FUN_CRIT` argument has been removed from the `ErrorCrit()` function. ([#81](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/81))
#### Bug fixes
- `SeriesAggreg()` now correctly reorders regime time series when the monthly regime is computed from a time series that does not start in January. It also keeps original `data.frame` column names. ([#133](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/133))
- `DataAltiExtrapolation_Valery()` now correctly extract HypsoData values for each elevation layers. The selected indices were wrong (one less than expected) ([#144](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/144))
- `CreateIniStates()` does not return anymore an error message when `IntStore` is set and `RunModel_GR5H` is used. ([#144](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/145))
#### Major user-visible changes
- `RunModel_Lag()` now handles warm-up period simulation (set in `CreateRunOptions()`). ([#132](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/132))
#### Minor user-visible changes
- `PE_Oudin()` can use inconsistent time series. It allows to mixing time series from different stations. ([#134](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/134))
- Added the use of `.GetFeatModel()` in `CreateCalibOptions()` and `CreateIniStates()` functions in order to simplified their codes. ([#111](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/111))
- Added the `.FunTransfo` in order to manage the parameter transformations and to simplified the code of the `CreateCalibOptions()` function ([#111](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/111))
- Added the `.ArgumentsCheckGR()` function in order to check the arguments of the` RunModel_*()` functions and simplified their codes. ([#129](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/129))
- Added the `.GetOutputsModelGR()` function in order to manage the outputs of the` RunModel_*()` functions and simplified their codes. ([#129](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/129))
- The code of the `plot.OutputsModel()` function has been slightly simplified. ([#122](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/122), [#147](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/147))
#### Version control and issue tracking
- Added tests to check that the parameter sets returned by calibration algorithm do not change for any of the models. ([#120](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/120))
- Added tests to detect Decreased performance of calibration execution time. ([#136](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/136))
- Fixed the reverse package dependencies checked by the CI pipelines. ([#146](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/146))
____________________________________________________________________________________
### 1.6.12 Release Notes (2021-04-27)
#### New features
- `CreateInputsModel()` gains a `QupstrUnit` argument in order to manage the unit of the flow in the `Qupstream` argument in case of the use of a semi-distributed version of a hydrological model. ([#110](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/110))
- `RunModel_Lag()` gains a `QcontribDown` argument containing the time series of the runoff contribution of the downstream sub-basin in case of the use of a semi-distributed version of a hydrological model. ([#109](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/109))
#### Bug fixes
- Fixed bug in `RunModel`. The `RunModel_Lag()` can now be passed to the `FUN_MOD` argument. ([#108](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/108))
- Fixed bug in `RunModel_Lag()`. The function no longer returns two values for a single time step run. ([#102](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/102))
- Fixed bug in `RunModel_Lag()`. The `StateEnd` value is now correct when there are more than a single upstream basin. ([#103](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/103))
- Fixed bug in `RunModel_Lag()`. The `StateEnd` value is now correct when the upstream flow unit is mm/time step. ([#104](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/104))
- Fixed bug in `RunModel_CemaNeigeGR5H()`. The solid precipitation are now taken into account in the GR5H model. ([#105](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/105))
- Fixed bug in `RunModel_CemaNeige()` and `CreateInputsModel()`. `RunModel_CemaNeige()` now runs at the hourly time step. ([#106](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/106))
- Fixed the 'param_optim' vignette. The starting points used for the multi-start approach are now in the transformed space.([#101](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/101))
#### Major user-visible changes
- `LengthHydro` must now be set in kilometers (not anymore in meters) in the `CreateInputsModel()` function. ([#112](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/112))
- `TransfoParam_GR5H()` now use the same transformation as `TransfoParam_GR4H()` for the X1 parameter. The previous transformation set by Ficchì seems unnecessary as it provokes irrealistically high X1 values. ([#50](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/50))
#### Minor user-visible changes
- The `RunModel*()` functions now run faster. The computation times are significantly shorter for long times series with many time steps (e.g. hourly times series), due to a better management of the missing values in and out the Fortran codes. Only simulation computation times have been improved (it is largely invisible to the user for calibration computation times). ([#113](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/113))
- The external calibration algorithms used in 'param_optim' and 'param_mcmc' vignettes now run faster. The `RunModel_*()` functions used during the parameter estimation process now run faster because the outputs contain only the simulated flows (see the `Outputs_Sim` argument in the `CreateRunOptions()` help page).
- Added `.FeatModels()` and `.GetFeatModel()` functions in order to repectively store and get model features (e.g. name, number of parameters, time unit). Therefore the codes of the `CreateInputsModel()` and the `CreateRunOptions()` functions have been simplified. ([#106](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/106))
#### Version control and issue tracking
- The CI pipelines now fail when the checks return a warning message (and not just an error message). ([#86](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/86))
- The reverse dependencies packages (e.g. the 'airGRteaching' or the 'airGRdatassim') are now checked by the CI pipelines. ([#86](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/86))
____________________________________________________________________________________
### 1.6.10.4 Release Notes (2021-01-29)
#### New features
- Added a section 'param_optim' vignette to explain how to manage with multiobjective optimization using the 'caRamel' package. ([#61](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/61))
#### Major user-visible changes
- `Imax()` now returns an error message when `IndPeriod_Run` doesn't select 24 hours by day, instead of `numeric(0)`. ([#92](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/92))
#### Minor user-visible changes
- Fixed warning returned by GCC Fortran when compiling `frun_GR5H.f90`. ([#93](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/93))
#### CRAN-compatibility updates
- Coerce `character` dates into `POSIXlt` in `RunModel_GR1A()` example and in `SeriesAggreg()` tests in order to avoid bad subsetting on time series due to mixing UTC and local time (error returned on macOS flavors). ([#94](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/94))
____________________________________________________________________________________
### 1.6.9.27 Release Notes (2021-01-18)
#### 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` class object in order to extract subsets of it. ([#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
- Fixed bug in`SeriesAggreg()`. The function now runs when `TimeLag >= 3600`.
([#41](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/41))
- Fixed bug in`SeriesAggreg()`. The function 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))
- The `plot.OutputsModel()` function does not check anymore the time step by comparing the calculation of the difference of the last two time steps because it is already checked by the class of the `OutputsModel` object, which is therefore assumed to be necessarily valid. ([#56](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/56))
#### Version control and issue tracking
- Implement automatic tests in the package. ([#52](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/52))
#### CRAN-compatibility updates
- '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).
____________________________________________________________________________________
### 1.4.3.60 Release Notes (2020-01-29)
#### 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 `citation("airGR")` command.
#### Bug fixes
- Fixed bug in `Imax()`. The default value of the `TestedValues` argument was wrong due to a mistyped argument name in the `seq()` function.
____________________________________________________________________________________
### 1.4.3.52 Release Notes (2020-01-21)
#### New features
- `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 `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 `RunModel_GR4H()` function (Pn, Ps, AExch1, AExch2).
#### Minor user-visible changes
- 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
- Cleaning of the Fortran codes (comment formatting).
____________________________________________________________________________________
### 1.3.2.42 Release Notes (2019-09-20)
#### Version control and issue tracking
- 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 `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 `NA` into the `BasinObs` time series of the `L0123001` dataset.
____________________________________________________________________________________
### 1.3.2.23 Release Notes (2019-06-20)
#### New features
- `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 `PEdaily_Oudin()` function is deprecated and his use has been replaced by the use of `PE_Oudin()`.
#### Bug fixes
- Fixed bug in `plot.OutputsModel()`. The function now runs correctly when the `which` argument contains the `"CorQQ"` value without `"CumFreq"`.
#### Major user-visible changes
- `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
- `.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.
____________________________________________________________________________________
### 1.2.13.16 Release Notes (2019-04-03)
#### New features
- `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 `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
- `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
- `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.
#### CRAN-compatibility updates
- Tabulations removed, unused variables removed and variable statements fixed in Fortran files.
____________________________________________________________________________________
### 1.0.15.2 Release Notes (2018-10-10)
#### Bug fixes
- Fixed bug in `CreateRunOptions()`. The function now accounts correctly for leap years when no warm-up period is defined.
#### Minor user-visible changes
- `CreateRunOptions()` was cleaned up, with no effect on its outputs.
#### CRAN-compatibility updates
- The `vignetteParam*.rda` datasets moved to the inst directory. It contains different objects needed for 'param_optim' and 'param_mcmc' vignettes.
____________________________________________________________________________________
### 1.0.14.1 Release Notes (2018-09-28)
#### New features
- `PEdaily_Oudin()` now presents a `LatUnit` argument which allows to choose the unit of the latitude (radians and degrees).
#### Deprecated and defunct
- 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
- `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 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 `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.
____________________________________________________________________________________
### 1.0.10.11 Release Notes (2018-06-29)
#### Bug fixes
- Fixed bug in `RunModel_GR2M()`. The function now returns the total precipitation (P) instead of the net rainfall (P1).
#### Major user-visible changes
- `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.
#### Minor user-visible changes
- The documentation and help of several functions were improved.
____________________________________________________________________________________
### 1.0.9.64 Release Notes (2017-11-10)
#### New features
- 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 `RunSnowModule` argument is now deprecated in `CreateRunOptions()`.
#### Bug fixes
- 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
- `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
- `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.
#### CRAN-compatibility updates
- "airGR.c" file registers native routines.
____________________________________________________________________________________
### 1.0.5.12 Release Notes (2017-01-23)
#### New features
- `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 `DataAltiExtrapolation_Valery()`. The elevation gradients for air temperature returned by `CreateInputsModel()` are improved.
#### User-visible changes
- `DataAltiExtrapolation_Valery()` has been improved. `DataAltiExtrapolation_Valery()` now runs faster (and by consequence `CreateInputsModel()` too, when CemaNeige is used).
____________________________________________________________________________________
### 1.0.4 Release Notes (2017-01-18)
#### New features
- `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 `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
- `plot.OutputsModel()` displays air temperature time series for each layer when `CemaNeige` is used (argument `which = "Temp"` or `"all"`).
____________________________________________________________________________________
### 1.0.3 Release Notes (2016-12-09)
#### New features
- `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 `CreateCalibOptions()` when `StartParamList` or `StartParamDistrib` arguments are used.
#### User-visible changes
- `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).
____________________________________________________________________________________
### 1.0.2 Release Notes (2016-11-03)
#### New features
- `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 `vignette("airGR")` command.
#### Deprecated and defunct
- `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 `sort` for the `transfo` argument of `CreateInputsCrit()` was not taken into account. It is now fixed.
#### Major user-visible changes
- 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
- `CreateInputsModel()` and `DataAltiExtrapolation_Valery()` functions now allow both `POSIXt` formats (`POSIXct` and `POSIXlt`).
____________________________________________________________________________________
### 1.0.1 Release Notes (2016-04-21)
#### Deprecated and defunct
- 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 (`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
- 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 `citation("airGR")`.
____________________________________________________________________________________
### 0.8.1.2 Release Notes (2015-08-21)
#### Bug fixes
- 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 `IndPeriod_WarmUp = 0`.
#### CRAN-compatibility updates
- Modification of namespace file to ensure proper use under linux without compilation issues.
____________________________________________________________________________________
### 0.8.0.2 Release Notes (2015-04-15)
#### New features
- 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 `ErrorCrit_RMSE()` which led to incorrect calibration (the criterion was maximised instead of minimised).
#### Major user-visible changes
- 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 `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.
____________________________________________________________________________________
### 0.7.4 Release Notes (2014-11-01)
#### New features
- New argument in many functions (`quiet = TRUE` or `FALSE`) to choose if the warnings should be suppressed or not.
#### Deprecated and defunct
- The `CalibrationAlgo_*()` functions were renamed into `Calibration_*()`.
#### Bug fixes
- 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 `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.
#### Minor user-visible changes
- Improvements allowing the arrival of new models.
- 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.
____________________________________________________________________________________
### 0.6.2 Release Notes (2014-02-12)
#### New features
- 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) &times; NSE[Q].
#### Deprecated and defunct
- `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 `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 `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 `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.
____________________________________________________________________________________
### 0.5.2 Release Notes (2014-02-05)
#### Deprecated and defunct
- 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 `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 `OutputsAlgo()`.
#### Minor user-visible changes
- Missing values in Fortran are now -999.999 instead of -9.999.
____________________________________________________________________________________
### 0.5.1 Release Notes (2014-01-27)
#### New features
- New `EfficiencyCrit_NSE_sqrtQ()` function to compute NSE criterion on sqrt flows.
#### Bug fixes
- 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.
---
title: "Release History of the airGR Package"
output:
html_document:
toc: true
toc_float: true
depth: 3 # upto three depths of headings (specified by #, ### and ###)
number_sections: false ### if you want number sections at each table header
theme: united # many options for theme, this one is my favorite.
highlight: tango # specifies the syntax highlighting style
keep_md: true
---
### 1.3.0.17 Release Notes (2019-05-21)
#### New features
- <code>CreateInputsCrit()</code> now allows power (as numeric or character values) and the Box-Cox transformations in the <code>transfo</code> argument.
- Added <code>RunModel_CemaNeigeGR4H()</code> function ito run the hourlu model GR4H with the CemaNeige module.
- Added the <code>U2345030</code> dataset to run the examples using GR4H with CemaNeige.
#### Major user-visible changes
- <code>plot.OutputsModel()</code> can no drawn PET or error time serie if <code>which = "all"</code> or <code>"PotEvap"</code> or <code>"Error"</code>.
- <code>plot.OutputsModel()</code> now allowed new values for the which argument : <code>"all"</code> corresponds to all graphs, <code>"synth"</code> corresponds to the main graphs (by default; corresponding to <code>"all"</code> in the previous versions of the pcakage) (<code>c("Precip", "Temp", "SnowPack", "Flows", "Regime", "CumFreq", "CorQQ")</code>), "ts" corresponds to the time serie graphs (<code>c("Precip", "PotEvap", "Temp", "SnowPack", "Flows")</code>) and <code>"perf"</code> corresponds to the perfomance graphs (<code>c("Error", "Regime", "CumFreq", "CorQQ")</code>).
#### Minor user-visible changes
- <code>.ErrorCrit()</code> private function added to check inputs into <code>ErrorCrit_&#42;()</code> functions. The <code>ErrorCrit_&#42;()</code> functions were simplified accordingly.
- <code>CreateInputsCrit()</code> now returns <code>FUN_CRIT</code> as a character string.
____________________________________________________________________________________
### 1.2.13.16 Release Notes (2019-04-03)
#### 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.
#### 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).
- Added the cemaneige_hysteresis vignette to explain how to manage the use of the Linear Hysteresis with CemaNeige.
#### 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_&#42;()</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_&#42;()</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_&#42;</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>.
#### Minor user-visible changes
- <code>ErrorCrit_&#42;()</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 frun_GR2M 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&#42;()</code> functions are now checked.
- The order of authors has been updated in the DESCRIPTION and the CITATION files.
#### CRAN-compatibility updates
- Tabulations removed, unused variables removed and variable statements fixed in Fortran files.
____________________________________________________________________________________
### 1.0.15.2 Release Notes (2018-10-10)
#### Bug fixes
- Fixed bug in <code>CreateRunOptions()</code>. 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.
#### CRAN-compatibility updates
- The <code>vignetteParam&#42;.rda</code> datasets moved to the inst directory. It contains different objects needed for param_optim and param_mcmc vignettes.
____________________________________________________________________________________
### 1.0.14.1 Release Notes (2018-09-28)
#### 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.
#### 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).
#### 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_&#42;()</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>.
#### Minor user-visible changes
- Several functions of the package were cleant 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.
____________________________________________________________________________________
### 1.0.10.11 Release Notes (2018-06-29)
#### Bug fixes
- Fixed bug in <code>RunModel_GR2M()</code>. 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.
- The article reference is corrected.
#### Minor user-visible changes
- The documentation and help of several functions were improved.
____________________________________________________________________________________
### 1.0.9.64 Release Notes (2017-11-10)
#### 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.
- Three vignettes have been added. They are relative to different calibration methods (including the generalist parameters sets of the GR4J model).
#### 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.
#### Deprecated and defunct
- The <code>RunSnowModule</code> argument is now deprecated in <code>CreateRunOptions()</code>.
#### Major user-visible changes
- <code>RunModel_GR4J()</code>, <code>RunModel_GR5J()</code> and <code>RunModel_GR6J()</code> (and <code>CemaNeige_GR&#42;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.
#### 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_&#42;()</code> functions now return a warning message in this case. <code>RunModel_&#42;()</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.
- The documentation and help of several functions were improved.
#### CRAN-compatibility updates
- "airGR.c" file registers native routines.
____________________________________________________________________________________
### 1.0.5.12 Release Notes (2017-01-23)
#### 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.
#### Bug fixes
- Fixed bug in <code>DataAltiExtrapolation_Valery()</code>. The elevation gradients for air temperature returned by <code>CreateInputsModel()</code> 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).
____________________________________________________________________________________
### 1.0.4 Release Notes (2017-01-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.
#### 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>.
#### 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>).
____________________________________________________________________________________
### 1.0.3 Release Notes (2016-12-09)
#### New features
- <code>ErrorCrit_&#42;()</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).
#### Bug fixes
- Fixed bug in <code>CreateCalibOptions()</code> when <code>StartParamList</code> or <code>StartParamDistrib</code> 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).
____________________________________________________________________________________
### 1.0.2 Release Notes (2016-11-03)
#### 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.
- A tutorial is available online on the following link: from http://webgr.irstea.fr/airGR.
It can also be displayed with the <code>vignette("airGR")</code> command.
#### 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.
#### 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.
- <code>CreateCalibOptions()</code> loses the StartParam argument that was not used.
#### 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.
#### 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>).
____________________________________________________________________________________
### 1.0.1 Release Notes (2016-04-21)
#### 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>.
#### 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_&#42;()</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.
#### Minor user-visible changes
- 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>.
____________________________________________________________________________________
### 0.8.1.2 Release Notes (2015-08-21)
#### 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).
#### Minor user-visible changes
- Removal of an unnecessary warning when <code>IndPeriod_WarmUp = 0</code>.
#### CRAN-compatibility updates
- Modification of namespace file to ensure proper use under linux whithout compilation issues.
____________________________________________________________________________________
### 0.8.0.2 Release Notes (2015-04-15)
#### 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.
#### Bug fixes
- Fixed bug in <code>ErrorCrit_RMSE()</code> 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.
- 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.
- Correction of formatting issue in airGR-advanced-example regarding the "List_HypsoData.txt" file.
____________________________________________________________________________________
### 0.7.4 Release Notes (2014-11-01)
#### 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.
#### 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.
#### Deprecated and defunct
- The <code>CalibrationAlgo_&#42;()</code> functions were renamed into <code>Calibration_&#42;()</code>.
#### 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>.
- 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.
#### 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).
- Improved documentation.
____________________________________________________________________________________
### 0.6.2 Release Notes (2014-02-12)
#### 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 <code>{mco}</code> 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) &times; NSE[Q].
#### 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).
- 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.
#### Deprecated and defunct
- <code>EfficiencyCrit()</code> have been replaced by <code>ErrorCrit()</code> to avoid misunderstanding (by default, the algorithms minimise the error criterion).
#### 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>).
#### 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.
____________________________________________________________________________________
### 0.5.2 Release Notes (2014-02-05)
#### 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.
#### 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.
- Check of the model functioning time step.
- Name of the calibration criterion provided in <code>OutputsAlgo()</code>.
#### Minor user-visible changes
- Missing values in Fortran are now -999.999 instead of -9.999.
____________________________________________________________________________________
### 0.5.1 Release Notes (2014-01-27)
#### New features
- New <code>EfficiencyCrit_NSE_sqrtQ()</code> 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.
Calibration <- function(InputsModel,
RunOptions,
InputsCrit,
Calibration <- function(InputsModel,
RunOptions,
InputsCrit,
CalibOptions,
FUN_MOD,
FUN_MOD,
FUN_CRIT, # deprecated
FUN_CALIB = Calibration_Michel,
FUN_CALIB = Calibration_Michel,
FUN_TRANSFO = NULL,
verbose = TRUE) {
verbose = TRUE,
...) {
FUN_MOD <- match.fun(FUN_MOD)
if (!missing(FUN_CRIT)) {
FUN_CRIT <- match.fun(FUN_CRIT)
}
FUN_CALIB <- match.fun(FUN_CALIB)
if (!is.null(FUN_TRANSFO)) {
FUN_TRANSFO <- match.fun(FUN_TRANSFO)
}
return(FUN_CALIB(InputsModel = InputsModel, RunOptions = RunOptions, InputsCrit = InputsCrit,
CalibOptions = CalibOptions,
FUN_MOD = FUN_MOD, FUN_TRANSFO = FUN_TRANSFO,
verbose = verbose))
verbose = verbose, ...))
}
Calibration_Michel <- function(InputsModel,
RunOptions,
InputsCrit,
Calibration_Michel <- function(InputsModel,
RunOptions,
InputsCrit,
CalibOptions,
FUN_MOD,
FUN_MOD,
FUN_CRIT, # deprecated
FUN_TRANSFO = NULL,
verbose = TRUE) {
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,100 +53,16 @@ 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_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_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_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
......@@ -168,20 +91,19 @@ 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
## use unique() to avoid duplicated values when a parameter is set
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)
}
expand.grid(lapply(seq_len(ncol(DistribParam)), function(x) unique(DistribParam[, x])))
}
##Creation_of_new_candidates_______________________________________________
OptimParam <- is.na(CalibOptions$FixedParam)
if (PrefilteringType == 1) {
......@@ -190,7 +112,7 @@ Calibration_Michel <- function(InputsModel,
if (PrefilteringType == 2) {
DistribParamR <- CalibOptions$StartParamDistrib
DistribParamR[, !OptimParam] <- NA
CandidatesParamR <- ProposeCandidatesGrid(DistribParamR)$NewCandidates
CandidatesParamR <- ProposeCandidatesGrid(DistribParamR)
}
##Remplacement_of_non_optimised_values_____________________________________
CandidatesParamR <- apply(CandidatesParamR, 1, function(x) {
......@@ -202,7 +124,7 @@ Calibration_Michel <- function(InputsModel,
} else {
CandidatesParamR <- cbind(CandidatesParamR)
}
##Loop_to_test_the_various_candidates______________________________________
iNewOptim <- 0
Ncandidates <- nrow(CandidatesParamR)
......@@ -221,12 +143,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)) {
......@@ -245,8 +167,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)) {
......@@ -269,13 +191,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
......@@ -299,10 +221,10 @@ Calibration_Michel <- function(InputsModel,
PotentialCandidateT[1, I] <- NewParamOptimT[I] + Sign * Pace
##If_we_exit_the_range_of_possible_values_we_go_back_on_the_boundary
if (PotentialCandidateT[1, I] < RangesT[1, I] ) {
PotentialCandidateT[1,I] <- RangesT[1, I]
PotentialCandidateT[1, I] <- RangesT[1, I]
}
if (PotentialCandidateT[1, I] > RangesT[2, I]) {
PotentialCandidateT[1,I] <- RangesT[2,I]
PotentialCandidateT[1, I] <- RangesT[2, I]
}
##We_check_the_set_is_not_outside_the_range_of_possible_values
if (NewParamOptimT[I] == RangesT[1, I] & Sign < 0) {
......@@ -326,11 +248,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)
......@@ -342,18 +264,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")
......@@ -367,16 +289,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
......@@ -385,8 +307,8 @@ Calibration_Michel <- function(InputsModel,
}
}
NRuns <- NRuns + nrow(CandidatesParamR)
##When_a_progress_has_been_achieved_______________________________________
if (iNewOptim != 0) {
##We_store_the_optimal_set
......@@ -401,7 +323,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]
}
}
......@@ -410,8 +332,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
......@@ -435,7 +357,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) {
......@@ -447,34 +369,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))
......@@ -483,7 +405,7 @@ Calibration_Michel <- function(InputsModel,
listNameCrit <- OutputsCrit$CritCompo$MultiCritNames
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, ")")
......@@ -496,13 +418,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,
......@@ -511,8 +433,7 @@ Calibration_Michel <- function(InputsModel,
CritName = CritName, CritBestValue = CritBestValue)
class(OutputsCalib) <- c("OutputsCalib", "HBAN")
return(OutputsCalib)
}
}
......@@ -2,392 +2,253 @@ 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)) {
FUN_TRANSFO <- match.fun(FUN_TRANSFO)
}
if (!is.logical(IsHyst) | length(IsHyst) != 1L) {
stop("'IsHyst' must be a logical of length 1")
}
##check_FUN_MOD
BOOL <- FALSE
if (identical(FUN_MOD, RunModel_GR4H)) {
ObjectClass <- c(ObjectClass, "GR4H")
BOOL <- TRUE
}
if (identical(FUN_MOD, RunModel_GR4J)) {
ObjectClass <- c(ObjectClass, "GR4J")
BOOL <- TRUE
}
if (identical(FUN_MOD, RunModel_GR5J)) {
ObjectClass <- c(ObjectClass, "GR5J")
BOOL <- TRUE
}
if (identical(FUN_MOD, RunModel_GR6J)) {
ObjectClass <- c(ObjectClass, "GR6J")
BOOL <- TRUE
}
if (identical(FUN_MOD, RunModel_GR2M)) {
ObjectClass <- c(ObjectClass, "GR2M")
BOOL <- TRUE
}
if (identical(FUN_MOD, RunModel_GR1A)) {
ObjectClass <- c(ObjectClass, "GR1A")
BOOL <- TRUE
}
if (identical(FUN_MOD, RunModel_CemaNeige)) {
ObjectClass <- c(ObjectClass, "CemaNeige")
BOOL <- TRUE
}
if (identical(FUN_MOD, RunModel_CemaNeigeGR4H)) {
ObjectClass <- c(ObjectClass, "CemaNeigeGR4H")
BOOL <- TRUE
}
if (identical(FUN_MOD, RunModel_CemaNeigeGR4J)) {
ObjectClass <- c(ObjectClass, "CemaNeigeGR4J")
BOOL <- TRUE
}
if (identical(FUN_MOD, RunModel_CemaNeigeGR5J)) {
ObjectClass <- c(ObjectClass, "CemaNeigeGR5J")
BOOL <- TRUE
}
if (identical(FUN_MOD, RunModel_CemaNeigeGR6J)) {
ObjectClass <- c(ObjectClass, "CemaNeigeGR6J")
BOOL <- TRUE
}
if (IsHyst) {
ObjectClass <- c(ObjectClass, "hysteresis")
}
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
}
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
}
if (identical(FUN_MOD, RunModel_GR4J) |
identical(FUN_MOD, RunModel_CemaNeigeGR4J)) {
FUN1 <- TransfoParam_GR4J
}
if (identical(FUN_MOD, RunModel_GR5J) |
identical(FUN_MOD, RunModel_CemaNeigeGR5J)) {
FUN1 <- TransfoParam_GR5J
}
if (identical(FUN_MOD, RunModel_GR6J) |
identical(FUN_MOD, RunModel_CemaNeigeGR6J)) {
FUN1 <- TransfoParam_GR6J
}
if (identical(FUN_MOD, RunModel_GR2M)) {
FUN1 <- TransfoParam_GR2M
}
if (identical(FUN_MOD, RunModel_GR1A)) {
FUN1 <- TransfoParam_GR1A
}
if (identical(FUN_MOD, RunModel_CemaNeige)) {
if (IsHyst) {
FUN1 <- TransfoParam_CemaNeigeHyst
} else {
FUN1 <- TransfoParam_CemaNeige
}
}
if (is.null(FUN1)) {
stop("'FUN1' was not found")
return(NULL)
}
##_set_FUN2
if (IsHyst) {
FUN2 <- TransfoParam_CemaNeigeHyst
} else {
FUN2 <- TransfoParam_CemaNeige
}
##_set_FUN_TRANSFO
if (sum(ObjectClass %in% c("GR4H", "GR4J", "GR5J", "GR6J", "GR2M", "GR1A", "CemaNeige")) > 0) {
FUN_TRANSFO <- FUN1
} else {
if (IsHyst) {
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)
if (NParam <= 3) {
ParamOut[, 1:(NParam - 2)] <- FUN1(cbind(ParamIn[, 1:(NParam - 2)]), Direction)
} else {
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")
return(NULL)
}
##NParam
if ("GR4H" %in% ObjectClass) {
NParam <- 4
}
if ("GR4J" %in% ObjectClass) {
NParam <- 4
}
if ("GR5J" %in% ObjectClass) {
NParam <- 5
}
if ("GR6J" %in% ObjectClass) {
NParam <- 6
}
if ("GR2M" %in% ObjectClass) {
NParam <- 2
}
if ("GR1A" %in% ObjectClass) {
NParam <- 1
}
if ("CemaNeige" %in% ObjectClass) {
NParam <- 2
}
if ("CemaNeigeGR4H" %in% ObjectClass) {
NParam <- 6
}
if ("CemaNeigeGR4J" %in% ObjectClass) {
NParam <- 6
}
if ("CemaNeigeGR5J" %in% ObjectClass) {
NParam <- 7
}
if ("CemaNeigeGR6J" %in% ObjectClass) {
NParam <- 8
}
if (IsHyst) {
NParam <- NParam + 2
}
##check_FixedParam
if (is.null(FixedParam)) {
FixedParam <- rep(NA, NParam)
} else {
if (!is.vector(FixedParam)) {
stop("FixedParam must be a vector")
}
if (length(FixedParam) != NParam) {
stop("Incompatibility between 'FixedParam' length and 'FUN_MOD'")
}
if (all(!is.na(FixedParam))) {
stop("At least one parameter must be not set (NA)")
}
if (all(is.na(FixedParam))) {
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")
}
if (!is.numeric(SearchRanges)) {
stop("'SearchRanges' must be a matrix of numeric values")
}
if (sum(is.na(SearchRanges)) != 0) {
stop("'SearchRanges' must not include NA values")
}
if (nrow(SearchRanges) != 2) {
stop("'SearchRanges' must have 2 rows")
}
if (ncol(SearchRanges) != NParam) {
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)
}
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)
}
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,
+3.90, -0.50, +4.10, -8.70, +0.10, +4.00,
+4.50, +0.50, +5.00, -8.10, +1.10, +5.00), ncol = 6, byrow = TRUE)
}
if ("GR2M" %in% ObjectClass) {
ParamT <- matrix(c(+5.03, -7.15,
+5.22, -6.74,
+5.85, -6.37), ncol = 2, byrow = TRUE)
}
if ("GR1A" %in% ObjectClass) {
ParamT <- matrix(c(-1.69,
-0.38,
+1.39), ncol = 1, byrow = TRUE)
}
# if (inherits(FUN_MOD, "hysteresis")) {
# if ("CemaNeige" %in% ObjectClass) {
# ParamT <- matrix(c(-9.96, +6.63, -9.08, -6.99,
# -9.14, +6.90, -8.00, -3.20,
# +4.10, +7.21, -6.40, +9.99), ncol = NParam, byrow = TRUE)
# }
# if ("CemaNeigeGR4J" %in% ObjectClass) {
# ParamT <- matrix(c(+5.13, -1.60, +3.03, -9.05, -9.96, +6.63, -9.08, -6.99,
# +5.51, -0.61, +3.74, -8.51, -9.14, +6.90, -8.00, -3.20,
# +6.07, -0.02, +4.42, -8.06, +4.10, +7.21, -6.40, +9.99), ncol = NParam, byrow = TRUE)
# }
# if ("CemaNeigeGR5J" %in% ObjectClass) {
# ParamT <- matrix(c(+5.17, -1.13, +3.08, -9.37, -7.45, -9.96, +6.63, -9.08, -6.99,
# +5.55, -0.46, +3.75, -9.09, -4.69, -9.14, +6.90, -8.00, -3.20,
# +6.10, -0.11, +4.43, -8.60, -0.66, +4.10, +7.21, -6.40, +9.99), ncol = NParam, byrow = TRUE)
# }
# if ("CemaNeigeGR6J" %in% ObjectClass) {
# ParamT <- matrix(c(+3.60, -1.00, +3.30, -9.10, -0.90, +3.00, -9.96, +6.63, -9.08, -6.99,
# +3.90, -0.50, +4.10, -8.70, +0.10, +4.00, -9.14, +6.90, -8.00, -3.20,
# +4.50, +0.50, +5.00, -8.10, +1.10, +5.00, +4.10, +7.21, -6.40, +9.99), ncol = NParam, byrow = TRUE)
# }
# } else {
if ("CemaNeige" %in% ObjectClass) {
ParamT <- matrix(c(-9.96, +6.63,
-9.14, +6.90,
+4.10, +7.21), ncol = 2, byrow = TRUE)
}
if ("CemaNeigeGR4H" %in% ObjectClass) {
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 ("CemaNeigeGR4J" %in% ObjectClass) {
ParamT <- matrix(c(+5.13, -1.60, +3.03, -9.05, -9.96, +6.63,
+5.51, -0.61, +3.74, -8.51, -9.14, +6.90,
+6.07, -0.02, +4.42, -8.06, +4.10, +7.21), ncol = 6, byrow = TRUE)
}
if ("CemaNeigeGR5J" %in% ObjectClass) {
ParamT <- matrix(c(+5.17, -1.13, +3.08, -9.37, -7.45, -9.96, +6.63,
+5.55, -0.46, +3.75, -9.09, -4.69, -9.14, +6.90,
+6.10, -0.11, +4.43, -8.60, -0.66, +4.10, +7.21), ncol = 7, byrow = TRUE)
}
if ("CemaNeigeGR6J" %in% ObjectClass) {
ParamT <- matrix(c(+3.60, -1.00, +3.30, -9.10, -0.90, +3.00, -9.96, +6.63,
+3.90, -0.50, +4.10, -8.70, +0.10, +4.00, -9.14, +6.90,
+4.50, +0.50, +5.00, -8.10, +1.10, +5.00, +4.10, +7.21), ncol = 8, byrow = TRUE)
}
# }
if (IsHyst) {
ParamTHyst <- matrix(c(-7.00, -7.00,
-0.00, -0.00,
+7.00, +7.00), ncol = 2, byrow = TRUE)
ParamT <- cbind(ParamT, ParamTHyst)
}
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)) {
stop("'StartParamList' must be a matrix")
}
if (!is.numeric(StartParamList)) {
stop("'StartParamList' must be a matrix of numeric values")
}
if (sum(is.na(StartParamList)) != 0) {
stop("'StartParamList' must not include NA values")
}
if (ncol(StartParamList) != NParam) {
stop("Incompatibility between 'StartParamList' ncol and 'FUN_MOD'")
}
}
if ("HBAN" %in% ObjectClass & !is.null(StartParamDistrib)) {
if (!is.matrix(StartParamDistrib)) {
stop("'StartParamDistrib' must be a matrix")
}
if (!is.numeric(StartParamDistrib[1, ])) {
stop("'StartParamDistrib' must be a matrix of numeric values")
}
if (sum(is.na(StartParamDistrib[1, ])) != 0) {
stop("'StartParamDistrib' must not include NA values on the first line")
}
if (ncol(StartParamDistrib) != NParam) {
stop("Incompatibility between 'StartParamDistrib' ncol and 'FUN_MOD'")
}
}
##Create_CalibOptions
CalibOptions <- list(FixedParam = FixedParam, SearchRanges = SearchRanges)
if (!is.null(StartParamList)) {
CalibOptions <- c(CalibOptions, list(StartParamList = StartParamList))
}
if (!is.null(StartParamDistrib)) {
CalibOptions <- c(CalibOptions, list(StartParamDistrib = StartParamDistrib))
}
class(CalibOptions) <- c("CalibOptions", ObjectClass)
return(CalibOptions)
FUN_MOD <- match.fun(FUN_MOD)
FUN_CALIB <- match.fun(FUN_CALIB)
if (!is.null(FUN_TRANSFO)) {
FUN_TRANSFO <- match.fun(FUN_TRANSFO)
}
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
FeatFUN_MOD <- .GetFeatModel(FUN_MOD = FUN_MOD)
FeatFUN_MOD$IsHyst <- IsHyst
FeatFUN_MOD$IsSD <- IsSD
ObjectClass <- FeatFUN_MOD$Class
if (identical(FUN_MOD, RunModel_Lag) && IsSD) {
stop("RunModel_Lag should not be used with 'IsSD=TRUE'")
}
if (IsHyst) {
ObjectClass <- c(ObjectClass, "hysteresis")
}
if (IsSD) {
ObjectClass <- c(ObjectClass, "SD")
}
## check FUN_CALIB
BOOL <- FALSE
if (identical(FUN_CALIB, Calibration_Michel)) {
ObjectClass <- c(ObjectClass, "HBAN")
BOOL <- TRUE
}
if (!BOOL) {
stop("incorrect 'FUN_CALIB' for use in 'CreateCalibOptions'")
return(NULL)
}
## check FUN_TRANSFO
if (is.null(FUN_TRANSFO)) {
FUN_TRANSFO <- .FunTransfo(FeatFUN_MOD)
}
## NParam
NParam <- FeatFUN_MOD$NbParam
if (IsHyst) {
NParam <- NParam + 2
}
if (IsSD) {
NParam <- NParam + 1
}
## check FixedParam
if (is.null(FixedParam)) {
FixedParam <- rep(NA, NParam)
} else {
if (!is.vector(FixedParam)) {
stop("FixedParam must be a vector")
}
if (length(FixedParam) != NParam) {
stop("Incompatibility between 'FixedParam' length and 'FUN_MOD'")
}
if (all(!is.na(FixedParam))) {
stop("At least one parameter must be not set (NA)")
}
if (all(is.na(FixedParam))) {
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")
}
if (!is.numeric(SearchRanges)) {
stop("'SearchRanges' must be a matrix of numeric values")
}
if (sum(is.na(SearchRanges)) != 0) {
stop("'SearchRanges' must not include NA values")
}
if (nrow(SearchRanges) != 2) {
stop("'SearchRanges' must have 2 rows")
}
if (ncol(SearchRanges) != NParam) {
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" == FeatFUN_MOD$CodeMod) {
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)
}
if (("GR5H" == FeatFUN_MOD$CodeMod) & ("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)
}
if (("GR5H" == FeatFUN_MOD$CodeMod) & !("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)
}
if ("GR4J" == FeatFUN_MOD$CodeMod) {
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)
}
if ("GR5J" == FeatFUN_MOD$CodeMod) {
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" == FeatFUN_MOD$CodeMod) {
ParamT <- matrix(c(+3.60, -1.00, +3.30, -9.10, -0.90, +3.00,
+3.90, -0.50, +4.10, -8.70, +0.10, +4.00,
+4.50, +0.50, +5.00, -8.10, +1.10, +5.00), ncol = 6, byrow = TRUE)
}
if ("GR2M" == FeatFUN_MOD$CodeMod) {
ParamT <- matrix(c(+5.03, -7.15,
+5.22, -6.74,
+5.85, -6.37), ncol = 2, byrow = TRUE)
}
if ("GR1A" == FeatFUN_MOD$CodeMod) {
ParamT <- matrix(c(-1.69,
-0.38,
+1.39), ncol = 1, byrow = TRUE)
}
if ("CemaNeige" == FeatFUN_MOD$CodeMod) {
ParamT <- matrix(c(-9.96, +6.63,
-9.14, +6.90,
+4.10, +7.21), ncol = 2, byrow = TRUE)
}
if ("CemaNeigeGR4H" == FeatFUN_MOD$CodeMod) {
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" == FeatFUN_MOD$CodeMod) & ("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)
}
if (("CemaNeigeGR5H" == FeatFUN_MOD$CodeMod) & !("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)
}
if ("CemaNeigeGR4J" == FeatFUN_MOD$CodeMod) {
ParamT <- matrix(c(+5.13, -1.60, +3.03, -9.05, -9.96, +6.63,
+5.51, -0.61, +3.74, -8.51, -9.14, +6.90,
+6.07, -0.02, +4.42, -8.06, +4.10, +7.21), ncol = 6, byrow = TRUE)
}
if ("CemaNeigeGR5J" == FeatFUN_MOD$CodeMod) {
ParamT <- matrix(c(+5.17, -1.13, +3.08, -9.37, -7.45, -9.96, +6.63,
+5.55, -0.46, +3.75, -9.09, -4.69, -9.14, +6.90,
+6.10, -0.11, +4.43, -8.60, -0.66, +4.10, +7.21), ncol = 7, byrow = TRUE)
}
if ("CemaNeigeGR6J" == FeatFUN_MOD$CodeMod) {
ParamT <- matrix(c(+3.60, -1.00, +3.30, -9.10, -0.90, +3.00, -9.96, +6.63,
+3.90, -0.50, +4.10, -8.70, +0.10, +4.00, -9.14, +6.90,
+4.50, +0.50, +5.00, -8.10, +1.10, +5.00, +4.10, +7.21), ncol = 8, byrow = TRUE)
}
if (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(-8.75,
-7.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)) {
stop("'StartParamList' must be a matrix")
}
if (!is.numeric(StartParamList)) {
stop("'StartParamList' must be a matrix of numeric values")
}
if (sum(is.na(StartParamList)) != 0) {
stop("'StartParamList' must not include NA values")
}
if (ncol(StartParamList) != NParam) {
stop("Incompatibility between 'StartParamList' ncol and 'FUN_MOD'")
}
}
if ("HBAN" %in% ObjectClass & !is.null(StartParamDistrib)) {
if (!is.matrix(StartParamDistrib)) {
stop("'StartParamDistrib' must be a matrix")
}
if (!is.numeric(StartParamDistrib[1, ])) {
stop("'StartParamDistrib' must be a matrix of numeric values")
}
if (sum(is.na(StartParamDistrib[1, ])) != 0) {
stop("'StartParamDistrib' must not include NA values on the first line")
}
if (ncol(StartParamDistrib) != NParam) {
stop("Incompatibility between 'StartParamDistrib' ncol and 'FUN_MOD'")
}
}
##Create_CalibOptions
CalibOptions <- list(FixedParam = FixedParam, SearchRanges = SearchRanges, FUN_TRANSFO = FUN_TRANSFO)
if (!is.null(StartParamList)) {
CalibOptions <- c(CalibOptions, list(StartParamList = StartParamList))
}
if (!is.null(StartParamDistrib)) {
CalibOptions <- c(CalibOptions, list(StartParamDistrib = StartParamDistrib))
}
class(CalibOptions) <- c("CalibOptions", ObjectClass)
return(CalibOptions)
}
CreateErrorCrit_GAPX <- function(FUN_TRANSFO) {
FUN_CRIT <- function(InputsCrit, OutputsModel, warnings = TRUE, verbose = TRUE) {
## Arguments check
if (!inherits(OutputsModel, "OutputsModel")) {
stop("'OutputsModel' must be of class 'OutputsModel'")
}
OutputsModel$RunOptions$ParamT <- FUN_TRANSFO(OutputsModel$RunOptions$Param, "RT")
EC <- .ErrorCrit(InputsCrit = InputsCrit, Crit = "GAPX", OutputsModel = OutputsModel, warnings = warnings)
CritValue <- NA
if (EC$CritCompute) {
ParamApr <- EC$VarObs[!EC$TS_ignore]
ParamOpt <- EC$VarSim[!EC$TS_ignore]
## ErrorCrit
Crit <- 1 - sum(((ParamApr - ParamOpt) / 20)^2)^0.5
if (is.numeric(Crit) & is.finite(Crit)) {
CritValue <- Crit
}
## Verbose
if (verbose) {
message(sprintf("Crit. %s = %.4f", EC$CritName, CritValue))
}
}
## Output
OutputsCrit <- list(CritValue = CritValue,
CritName = EC$CritName,
CritBestValue = EC$CritBestValue,
Multiplier = EC$Multiplier,
Ind_notcomputed = EC$Ind_TS_ignore)
class(OutputsCrit) <- c("GAPX", "ErrorCrit")
return(OutputsCrit)
}
class(FUN_CRIT) <- c("FUN_CRIT", class(FUN_CRIT))
return(FUN_CRIT)
}
CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE,
ProdStore = 350, RoutStore = 90, ExpStore = NULL,
CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = FALSE,
ProdStore = 350, RoutStore = 90, ExpStore = NULL, IntStore = NULL,
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)) {
ObjectClass <- c(ObjectClass, "GR", "hourly")
BOOL <- TRUE
}
if (identical(FUN_MOD, RunModel_GR4J) |
identical(FUN_MOD, RunModel_GR5J) |
identical(FUN_MOD, RunModel_GR6J)) {
ObjectClass <- c(ObjectClass, "GR", "daily")
BOOL <- TRUE
}
if (identical(FUN_MOD, RunModel_GR2M)) {
ObjectClass <- c(ObjectClass, "GR", "monthly")
BOOL <- TRUE
}
if (identical(FUN_MOD, RunModel_GR1A)) {
stop("'RunModel_GR1A' does not require 'IniStates' object")
}
if (identical(FUN_MOD, RunModel_CemaNeige)) {
ObjectClass <- c(ObjectClass, "CemaNeige", "daily")
BOOL <- TRUE
}
if (identical(FUN_MOD, RunModel_CemaNeigeGR4H)) {
ObjectClass <- c(ObjectClass, "GR", "CemaNeige", "hourly")
BOOL <- TRUE
}
if (identical(FUN_MOD, RunModel_CemaNeigeGR4J) |
identical(FUN_MOD, RunModel_CemaNeigeGR5J) |
identical(FUN_MOD, RunModel_CemaNeigeGR6J)) {
ObjectClass <- c(ObjectClass, "GR", "CemaNeige", "daily")
BOOL <- TRUE
}
if (!BOOL) {
stop("incorrect 'FUN_MOD' for use in 'CreateIniStates'")
}
FeatFUN_MOD <- .GetFeatModel(FUN_MOD = FUN_MOD, DatesR = InputsModel$DatesR)
ObjectClass <- FeatFUN_MOD$Class
if (!"CemaNeige" %in% ObjectClass & IsHyst) {
stop("'IsHyst' cannot be TRUE if CemaNeige is not used in 'FUN_MOD'")
}
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'")
......@@ -65,118 +35,136 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE,
!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")
}
} else if (!is.null(ExpStore)) {
if (verbose) {
warning(sprintf("'%s' does not require 'ExpStore'. Value set to NA", nameFUN_MOD))
warning(sprintf("'%s' does not require 'ExpStore'. Value set to NA", FeatFUN_MOD$NameFunMod))
}
ExpStore <- Inf
}
if (identical(FUN_MOD, RunModel_GR2M)) {
if (!is.null(UH1)) {
if (verbose) {
warning(sprintf("'%s' does not require 'UH1'. Values set to NA", nameFUN_MOD))
warning(sprintf("'%s' does not require 'UH1'. Values set to NA", FeatFUN_MOD$NameFunMod))
}
UH1 <- rep(Inf, UH1n)
}
if (!is.null(UH2)) {
if (verbose) {
warning(sprintf("'%s' does not require 'UH2'. Values set to NA", nameFUN_MOD))
warning(sprintf("'%s' does not require 'UH2'. Values set to NA", FeatFUN_MOD$NameFunMod))
}
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))
warning(sprintf("'%s' does not require 'UH1'. Values set to NA", FeatFUN_MOD$NameFunMod))
}
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", FeatFUN_MOD$NameFunMod))
}
IntStore <- Inf
}
if ("CemaNeige" %in% ObjectClass & ! "GR" %in% ObjectClass) {
if (!is.null(ProdStore)) {
if (verbose) {
warning(sprintf("'%s' does not require 'ProdStore'. Values set to NA", nameFUN_MOD))
warning(sprintf("'%s' does not require 'ProdStore'. Values set to NA", FeatFUN_MOD$NameFunMod))
}
}
ProdStore <- Inf
if (!is.null(RoutStore)) {
if (verbose) {
warning(sprintf("'%s' does not require 'RoutStore'. Values set to NA", nameFUN_MOD))
warning(sprintf("'%s' does not require 'RoutStore'. Values set to NA", FeatFUN_MOD$NameFunMod))
}
}
RoutStore <- Inf
if (!is.null(ExpStore)) {
if (verbose) {
warning(sprintf("'%s' does not require 'ExpStore'. Values set to NA", nameFUN_MOD))
warning(sprintf("'%s' does not require 'ExpStore'. Values set to NA", FeatFUN_MOD$NameFunMod))
}
}
ExpStore <- Inf
if (!is.null(IntStore)) {
if (verbose) {
warning(sprintf("'%s' does not require 'IntStore'. Values set to NA", FeatFUN_MOD$NameFunMod))
}
}
IntStore <- Inf
if (!is.null(UH1)) {
if (verbose) {
warning(sprintf("'%s' does not require 'UH1'. Values set to NA", nameFUN_MOD))
warning(sprintf("'%s' does not require 'UH1'. Values set to NA", FeatFUN_MOD$NameFunMod))
}
}
UH1 <- rep(Inf, UH1n)
if (!is.null(UH2)) {
if (verbose) {
warning(sprintf("'%s' does not require 'UH2'. Values set to NA", nameFUN_MOD))
warning(sprintf("'%s' does not require 'UH2'. Values set to NA", FeatFUN_MOD$NameFunMod))
}
}
UH2 <- rep(Inf, UH2n)
}
if("CemaNeige" %in% ObjectClass & !IsHyst &
if (IsIntStore & is.null(IntStore)) {
stop(sprintf("'%s' need values for 'IntStore'", FeatFUN_MOD$NameFunMod))
}
if ("CemaNeige" %in% ObjectClass & !IsHyst &
(is.null(GCemaNeigeLayers) | is.null(eTGCemaNeigeLayers))) {
stop(sprintf("'%s' need values for 'GCemaNeigeLayers' and 'GCemaNeigeLayers'", nameFUN_MOD))
stop(sprintf("'%s' need values for 'GCemaNeigeLayers' and 'GCemaNeigeLayers'", FeatFUN_MOD$NameFunMod))
}
if("CemaNeige" %in% ObjectClass & IsHyst &
if ("CemaNeige" %in% ObjectClass & IsHyst &
(is.null(GCemaNeigeLayers) | is.null(eTGCemaNeigeLayers) |
is.null(GthrCemaNeigeLayers) | is.null(GlocmaxCemaNeigeLayers))) {
stop(sprintf("'%s' need values for 'GCemaNeigeLayers', 'GCemaNeigeLayers', 'GthrCemaNeigeLayers' and 'GlocmaxCemaNeigeLayers'", nameFUN_MOD))
stop(sprintf("'%s' need values for 'GCemaNeigeLayers', 'GCemaNeigeLayers', 'GthrCemaNeigeLayers' and 'GlocmaxCemaNeigeLayers'", FeatFUN_MOD$NameFunMod))
}
if("CemaNeige" %in% ObjectClass & !IsHyst &
if ("CemaNeige" %in% ObjectClass & !IsHyst &
(!is.null(GthrCemaNeigeLayers) | !is.null(GlocmaxCemaNeigeLayers))) {
if (verbose) {
warning(sprintf("'%s' does not require 'GthrCemaNeigeLayers' and 'GlocmaxCemaNeigeLayers'. Values set to NA", nameFUN_MOD))
warning(sprintf("'%s' does not require 'GthrCemaNeigeLayers' and 'GlocmaxCemaNeigeLayers'. Values set to NA", FeatFUN_MOD$NameFunMod))
}
GthrCemaNeigeLayers <- Inf
GlocmaxCemaNeigeLayers <- Inf
GlocmaxCemaNeigeLayers <- Inf
}
if(!"CemaNeige" %in% ObjectClass &
if (!"CemaNeige" %in% ObjectClass &
(!is.null(GCemaNeigeLayers) | !is.null(eTGCemaNeigeLayers) | !is.null(GthrCemaNeigeLayers) | !is.null(GlocmaxCemaNeigeLayers))) {
if (verbose) {
warning(sprintf("'%s' does not require 'GCemaNeigeLayers' 'GCemaNeigeLayers', 'GthrCemaNeigeLayers' and 'GlocmaxCemaNeigeLayers'. Values set to NA", nameFUN_MOD))
warning(sprintf("'%s' does not require 'GCemaNeigeLayers' 'GCemaNeigeLayers', 'GthrCemaNeigeLayers' and 'GlocmaxCemaNeigeLayers'. Values set to NA", FeatFUN_MOD$NameFunMod))
}
GCemaNeigeLayers <- Inf
eTGCemaNeigeLayers <- Inf
GthrCemaNeigeLayers <- Inf
GlocmaxCemaNeigeLayers <- Inf
GlocmaxCemaNeigeLayers <- Inf
}
## set states
if("CemaNeige" %in% ObjectClass) {
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
}
if (is.null(UH1)) {
if ("hourly" %in% ObjectClass) {
......@@ -203,19 +191,24 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE,
if (is.null(GthrCemaNeigeLayers)) {
GthrCemaNeigeLayers <- rep(Inf, NLayers)
}
if (any(is.infinite(GthrCemaNeigeLayers))) {
GthrCemaNeigeLayers <- rep(Inf, NLayers)
}
if (is.null(GlocmaxCemaNeigeLayers)) {
GlocmaxCemaNeigeLayers <- rep(Inf, NLayers)
}
if (any(is.infinite(GlocmaxCemaNeigeLayers))) {
GlocmaxCemaNeigeLayers <- rep(Inf, NLayers)
}
# check negative values
if (any(ProdStore < 0) | any(RoutStore < 0) |
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', 'UH1', 'UH2', 'GCemaNeigeLayers'")
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")
......@@ -226,6 +219,9 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE,
if (!is.numeric(ExpStore) || length(ExpStore) != 1L) {
stop("'ExpStore' must be numeric of length one")
}
if (!is.numeric(IntStore) || length(IntStore) != 1L) {
stop("'IntStore' must be numeric of length one")
}
if ( "hourly" %in% ObjectClass & (!is.numeric(UH1) || length(UH1) != UH1n * 24)) {
stop(sprintf("'UH1' must be numeric of length 480 (%i * 24)", UH1n))
}
......@@ -252,23 +248,46 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE,
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),
IniStates <- list(Store = list(Prod = ProdStore, Rout = RoutStore, Exp = ExpStore, Int = IntStore),
UH = list(UH1 = UH1, UH2 = UH2),
CemaNeigeLayers = list(G = GCemaNeigeLayers, eTG = eTGCemaNeigeLayers,
Gthr = GthrCemaNeigeLayers, Glocmax = GlocmaxCemaNeigeLayers))
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) {
if (IsHyst) {
class(IniStatesNA) <- c(class(IniStatesNA), "hysteresis")
}
if (IsIntStore) {
class(IniStatesNA) <- c(class(IniStatesNA), "interception")
}
return(IniStatesNA)
}
CreateInputsCrit <- function(FUN_CRIT,
InputsModel,
RunOptions,
Qobs, # deprecated
Obs,
VarObs = "Q",
BoolCrit = NULL,
transfo = "",
Weights = NULL,
Ind_zeroes = NULL, # deprecated
epsilon = NULL,
warnings = TRUE,
verbose = TRUE) {
warnings = TRUE) {
ObjectClass <- NULL
## ---------- check arguments
if (!missing(Qobs)) {
if (missing(Obs)) {
if (warnings) {
warning("argument 'Qobs' is deprecated. Please use 'Obs' and 'VarObs' instead")
}
Obs <- Qobs
# VarObs <- "Qobs"
} else {
warning("argument 'Qobs' is deprecated. The values set in 'Obs' will be used instead")
}
}
if (!missing(Ind_zeroes) & warnings) {
warning("deprecated 'Ind_zeroes' argument")
}
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)) {
stop(sprintf("'Obs' must be a (list of) vector(s) of numeric values of length %i", LLL), call. = FALSE)
if (!is.numeric(unlist(Obs))) {
stop("'Obs' must be a (list of) vector(s) of numeric values")
}
Obs2 <- Obs
if ("ParamT" %in% VarObs) {
if (is.list(Obs2)) {
Obs2[[which(VarObs == "ParamT")]] <- NULL
} else {
Obs2 <- NULL
}
}
if (!is.null(Obs2)) {
vecObs <- unlist(Obs2)
if (length(vecObs) %% LLL != 0) {
stop(sprintf("'Obs' must be a (list of) vector(s) of numeric values of length %i", LLL), call. = FALSE)
}
}
if (!is.list(Obs)) {
idLayer <- list(1L)
......@@ -65,8 +56,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 +67,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 +83,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 +95,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,67 +110,76 @@ 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")
inVarObs <- c("Q", "SCA", "SWE", "ParamT")
msgVarObs <- "'VarObs' must be a (list of) character vector(s) and one of %s"
msgVarObs <- sprintf(msgVarObs, paste(sapply(inVarObs, shQuote), collapse = ", "))
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) {
## define FUN_CRIT as a character string
iListArgs2$FUN_CRIT <- match.fun(iListArgs2$FUN_CRIT)
## 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))) {
if (!all(class(iListArgs2$FUN_CRIT) == c("FUN_CRIT", "function"))) {
stop("incorrect 'FUN_CRIT' for use in 'CreateInputsCrit'", call. = FALSE)
}
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)
if (iListArgs2$VarObs == "ParamT") {
# Parameter for regularisation
L2 <- RunOptions$FeatFUN_MOD$NbParam
} else {
# Observation time series
L2 <- LLL
}
if (!is.vector(iListArgs2$Obs) | length(iListArgs2$Obs) != L2 | !is.numeric(iListArgs2$Obs)) {
stop(sprintf("'Obs' must be a (list of) vector(s) of numeric values of length %i", L2), call. = FALSE)
}
## check 'BoolCrit'
if (is.null(iListArgs2$BoolCrit)) {
iListArgs2$BoolCrit <- rep(TRUE, length(iListArgs2$Obs))
......@@ -187,15 +187,15 @@ CreateInputsCrit <- function(FUN_CRIT,
if (!is.logical(iListArgs2$BoolCrit)) {
stop("'BoolCrit' must be a (list of) vector(s) of boolean", call. = FALSE)
}
if (length(iListArgs2$BoolCrit) != LLL) {
stop("'BoolCrit' and 'InputsModel' series must have the same length", call. = FALSE)
if (length(iListArgs2$BoolCrit) != L2) {
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,21 +279,14 @@ 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)) {
if(any(listVarObs %in% inCnVarObs)) {
if (any(listVarObs %in% inCnVarObs)) {
stop(sprintf("'VarObs' can not be equal to %i if CemaNeige is not used",
paste(sapply(inCnVarObs, shQuote), collapse = " or ")))
}
......@@ -311,10 +304,10 @@ CreateInputsCrit <- function(FUN_CRIT,
}
}
}
## define idLayer as an index of the layer to use
for (iInCnVarObs in unique(listVarObs)) {
if (iInCnVarObs == "Q") {
if (!iInCnVarObs %in% inCnVarObs) {
for (i in which(listVarObs == iInCnVarObs)) {
InputsCrit[[i]]$idLayer <- NA
}
......@@ -330,8 +323,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]]
......@@ -348,12 +341,12 @@ CreateInputsCrit <- function(FUN_CRIT,
combInputsCrit <- combn(x = length(InputsCrit), m = 2)
apply(combInputsCrit, MARGIN = 2, function(i) {
equalInputsCrit <- identical(InputsCrit[[i[1]]], InputsCrit[[i[2]]])
if(equalInputsCrit) {
if (equalInputsCrit) {
warning(sprintf("elements %i and %i of the criteria list are identical. This might not be necessary", i[1], i[2]), call. = FALSE)
}
})
}
return(InputsCrit)
}
CreateInputsCrit_Lavenne <- function(FUN_CRIT = ErrorCrit_KGE,
InputsModel,
RunOptions,
Obs,
VarObs = "Q",
AprParamR,
AprCrit = 1,
k = 0.15,
BoolCrit = NULL,
transfo = "sqrt",
epsilon = NULL) {
# Check parameters
if (!is.numeric(AprCrit) || length(AprCrit) != 1 || AprCrit > 1) {
stop("'AprCrit' must be a numeric of length 1 with a maximum value of 1")
}
if (!is.numeric(k) || length(k) != 1 || k < 0 || k > 1) {
stop("'k' must be a numeric of length 1 with a value between 0 and 1")
}
if (!is.null(BoolCrit) && !is.logical(BoolCrit)) {
stop("'BoolCrit must be logical")
}
if (!is.character(transfo)) {
stop("'transfo' must be character")
}
if (!is.null(epsilon) && !is.numeric(epsilon)) {
stop("'epsilon' must be numeric")
}
if (!is.numeric(AprParamR) || length(AprParamR) != RunOptions$FeatFUN_MOD$NbParam) {
stop("'AprParamR' must be a numeric vector of length ",
RunOptions$FeatFUN_MOD$NbParam)
}
FUN_TRANSFO <- .FunTransfo(RunOptions$FeatFUN_MOD)
AprParamT <- FUN_TRANSFO(AprParamR, "RT")
ErrorCrit_GAPX <- CreateErrorCrit_GAPX(FUN_TRANSFO)
CreateInputsCrit(FUN_CRIT = list(FUN_CRIT, ErrorCrit_GAPX),
InputsModel = InputsModel,
RunOptions = RunOptions,
Obs = list(Obs, AprParamT),
VarObs = c("Q", "ParamT"),
Weights = c(1 - k, k * max(0, AprCrit)),
BoolCrit = list(BoolCrit, NULL),
transfo = list(transfo, ""),
epsilon = list(epsilon, NULL))
}
......@@ -4,303 +4,296 @@ CreateInputsModel <- function(FUN_MOD,
PotEvap = NULL,
TempMean = NULL, TempMin = NULL, TempMax = NULL,
ZInputs = NULL, HypsoData = NULL, NLayers = 5,
Qupstream = NULL, LengthHydro = NULL, BasinAreas = NULL,
QupstrUnit = "mm",
verbose = TRUE) {
ObjectClass <- NULL
FUN_MOD <- match.fun(FUN_MOD)
##check_FUN_MOD
BOOL <- FALSE
if (identical(FUN_MOD, RunModel_GR4H)) {
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)) {
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)) {
stop("'DatesR' is missing")
}
if (!"POSIXlt" %in% class(DatesR) & !"POSIXct" %in% class(DatesR)) {
stop("'DatesR' must be defined as 'POSIXlt' or 'POSIXct'")
}
if (!"POSIXlt" %in% class(DatesR)) {
DatesR <- as.POSIXlt(DatesR)
}
if (!difftime(tail(DatesR, 1), tail(DatesR, 2), units = "secs")[[1]] %in% TimeStep) {
TimeStepName <- grep("hourly|daily|monthly|yearly", ObjectClass, value = TRUE)
stop(paste0("the time step of the model inputs must be ", TimeStepName, "\n"))
}
if (any(duplicated(DatesR))) {
stop("'DatesR' must not include duplicated values")
}
LLL <- length(DatesR)
ObjectClass <- NULL
## check DatesR
if (is.null(DatesR)) {
stop("'DatesR' is missing")
}
if (!"POSIXlt" %in% class(DatesR) & !"POSIXct" %in% class(DatesR)) {
stop("'DatesR' must be defined as 'POSIXlt' or 'POSIXct'")
}
if (!"POSIXlt" %in% class(DatesR)) {
DatesR <- as.POSIXlt(DatesR)
}
if (any(duplicated(DatesR))) {
stop("'DatesR' must not include duplicated values")
}
LLL <- length(DatesR)
## check FUN_MOD
FUN_MOD <- match.fun(FUN_MOD)
FeatFUN_MOD <- .GetFeatModel(FUN_MOD = FUN_MOD, DatesR = DatesR)
ObjectClass <- FeatFUN_MOD$Class
TimeStep <- FeatFUN_MOD$TimeStep
##check_arguments
if ("GR" %in% ObjectClass) {
if (is.null(Precip)) {
stop("Precip is missing")
}
if ("GR" %in% ObjectClass) {
if (is.null(Precip)) {
stop("Precip is missing")
}
if (is.null(PotEvap)) {
stop("'PotEvap' is missing")
}
if (!is.vector(Precip) | !is.vector(PotEvap)) {
stop("'Precip' and 'PotEvap' must be vectors of numeric values")
}
if (!is.numeric(Precip) | !is.numeric(PotEvap)) {
stop("'Precip' and 'PotEvap' must be vectors of numeric values")
}
if (length(Precip) != LLL | length(PotEvap) != LLL) {
stop("'Precip', 'PotEvap' and 'DatesR' must have the same length")
}
if (is.null(PotEvap)) {
stop("'PotEvap' is missing")
}
if ("CemaNeige" %in% ObjectClass) {
if (is.null(Precip)) {
stop("'Precip' is missing")
if (!is.vector(Precip) | !is.vector(PotEvap)) {
stop("'Precip' and 'PotEvap' must be vectors of numeric values")
}
if (!is.numeric(Precip) | !is.numeric(PotEvap)) {
stop("'Precip' and 'PotEvap' must be vectors of numeric values")
}
if (length(Precip) != LLL | length(PotEvap) != LLL) {
stop("'Precip', 'PotEvap' and 'DatesR' must have the same length")
}
}
if ("CemaNeige" %in% ObjectClass) {
if (is.null(Precip)) {
stop("'Precip' is missing")
}
if (is.null(TempMean)) {
stop("'TempMean' is missing")
}
if (!is.vector(Precip) | !is.vector(TempMean)) {
stop("'Precip' and 'TempMean' must be vectors of numeric values")
}
if (!is.numeric(Precip) | !is.numeric(TempMean)) {
stop("'Precip' and 'TempMean' must be vectors of numeric values")
}
if (length(Precip) != LLL | length(TempMean) != LLL) {
stop("'Precip', 'TempMean' and 'DatesR' must have the same length")
}
if (is.null(TempMin) != is.null(TempMax)) {
stop("'TempMin' and 'TempMax' must be both defined if not null")
}
if (!is.null(TempMin) & !is.null(TempMax)) {
if (!is.vector(TempMin) | !is.vector(TempMax)) {
stop("'TempMin' and 'TempMax' must be vectors of numeric values")
}
if (is.null(TempMean)) {
stop("'TempMean' is missing")
if (!is.numeric(TempMin) | !is.numeric(TempMax)) {
stop("'TempMin' and 'TempMax' must be vectors of numeric values")
}
if (!is.vector(Precip) | !is.vector(TempMean)) {
stop("'Precip' and 'TempMean' must be vectors of numeric values")
if (length(TempMin) != LLL | length(TempMax) != LLL) {
stop("'TempMin', 'TempMax' and 'DatesR' must have the same length")
}
if (!is.numeric(Precip) | !is.numeric(TempMean)) {
stop("'Precip' and 'TempMean' must be vectors of numeric values")
}
if (!is.null(HypsoData)) {
if (!is.vector(HypsoData)) {
stop("'HypsoData' must be a vector of numeric values if not null")
}
if (length(Precip) != LLL | length(TempMean) != LLL) {
stop("'Precip', 'TempMean' and 'DatesR' must have the same length")
if (!is.numeric(HypsoData)) {
stop("'HypsoData' must be a vector of numeric values if not null")
}
if (is.null(TempMin) != is.null(TempMax)) {
stop("'TempMin' and 'TempMax' must be both defined if not null")
if (length(HypsoData) != 101) {
stop("'HypsoData' must be of length 101 if not null")
}
if (!is.null(TempMin) & !is.null(TempMax)) {
if (!is.vector(TempMin) | !is.vector(TempMax)) {
stop("'TempMin' and 'TempMax' must be vectors of numeric values")
}
if (!is.numeric(TempMin) | !is.numeric(TempMax)) {
stop("'TempMin' and 'TempMax' must be vectors of numeric values")
}
if (length(TempMin) != LLL | length(TempMax) != LLL) {
stop("'TempMin', 'TempMax' and 'DatesR' must have the same length")
}
if (sum(is.na(HypsoData)) != 0 & sum(is.na(HypsoData)) != 101) {
stop("'HypsoData' must not contain any NA if not null")
}
if (!is.null(HypsoData)) {
if (!is.vector(HypsoData)) {
stop("'HypsoData' must be a vector of numeric values if not null")
}
if (!is.numeric(HypsoData)) {
stop("'HypsoData' must be a vector of numeric values if not null")
}
if (length(HypsoData) != 101) {
stop("'HypsoData' must be of length 101 if not null")
}
if (sum(is.na(HypsoData)) != 0 & sum(is.na(HypsoData)) != 101) {
stop("'HypsoData' must not contain any NA if not null")
}
}
if (!is.null(ZInputs)) {
if (length(ZInputs) != 1) {
stop("'ZInputs' must be a single numeric value if not null")
}
if (!is.null(ZInputs)) {
if (length(ZInputs) != 1) {
stop("'ZInputs' must be a single numeric value if not null")
}
if (is.na(ZInputs) | !is.numeric(ZInputs)) {
stop("'ZInputs' must be a single numeric value if not null")
}
if (is.na(ZInputs) | !is.numeric(ZInputs)) {
stop("'ZInputs' must be a single numeric value if not null")
}
if (is.null(HypsoData)) {
if (verbose) {
warning("'HypsoData' is missing: a single layer is used and no extrapolation is made")
}
HypsoData <- as.numeric(rep(NA, 101))
ZInputs <- as.numeric(NA)
NLayers <- as.integer(1)
}
if (is.null(HypsoData)) {
if (verbose) {
warning("'HypsoData' is missing: a single layer is used and no extrapolation is made", call. = FALSE)
}
if (is.null(ZInputs)) {
if (verbose & !identical(HypsoData, as.numeric(rep(NA, 101)))) {
warning("'ZInputs' is missing: HypsoData[51] is used")
}
ZInputs <- HypsoData[51L]
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)))) {
warning("'ZInputs' is missing: HypsoData[51] is used")
}
if (NLayers <= 0) {
stop("'NLayers' must be a positive integer value")
ZInputs <- HypsoData[51L]
}
if (NLayers <= 0) {
stop("'NLayers' must be a positive integer value")
}
if (NLayers != as.integer(NLayers)) {
warning("Coerce 'NLayers' to be of integer type (", NLayers, ": ", as.integer(NLayers), ")")
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))) {
warning("'Qupstream' contains NA values: model outputs will contain NAs")
}
if (any(LengthHydro > 1000)) {
warning("The unit of 'LengthHydro' has changed from m to km in airGR >= 1.6.12: values superior to 1000 km seem unrealistic")
}
QupstrUnit <- tolower(QupstrUnit)
QupstrUnit <- match.arg(arg = QupstrUnit, choices = c("mm", "m3", "m3/s", "l/s"))
}
##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) {
BOOL_NA <- BOOL_NA | BOOL_NA_TMP
if (verbose) {
warning("Values < 0 or NA values detected in 'Precip' series")
}
if (NLayers != as.integer(NLayers)) {
warning("Coerce 'NLayers' to be of integer type (", NLayers, ": ", as.integer(NLayers), ")")
NLayers <- as.integer(NLayers)
}
BOOL_NA_TMP <- (PotEvap < 0) | is.na(PotEvap)
if (sum(BOOL_NA_TMP) != 0) {
BOOL_NA <- BOOL_NA | BOOL_NA_TMP
if (verbose) {
warning("Values < 0 or NA values detected in 'PotEvap' series")
}
}
##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) {
BOOL_NA <- BOOL_NA | BOOL_NA_TMP
if (verbose) {
warning("Values < 0 or NA values detected in 'Precip' series")
}
}
if ("CemaNeige" %in% ObjectClass) {
BOOL_NA_TMP <- (Precip < 0) | is.na(Precip)
if (sum(BOOL_NA_TMP) != 0) {
BOOL_NA <- BOOL_NA | BOOL_NA_TMP
if (verbose) {
warning("Values < 0 or NA values detected in 'Precip' series")
}
BOOL_NA_TMP <- (PotEvap < 0) | is.na(PotEvap)
if (sum(BOOL_NA_TMP) != 0) {
BOOL_NA <- BOOL_NA | BOOL_NA_TMP
if (verbose) {
warning("Values < 0 or NA values detected in 'PotEvap' series")
}
}
BOOL_NA_TMP <- (TempMean < (-150)) | is.na(TempMean)
if (sum(BOOL_NA_TMP) != 0) {
BOOL_NA <- BOOL_NA | BOOL_NA_TMP
if (verbose) {
warning("Values < -150 or NA values detected in 'TempMean' series")
}
}
if ("CemaNeige" %in% ObjectClass) {
BOOL_NA_TMP <- (Precip < 0) | is.na(Precip)
if (!is.null(TempMin) & !is.null(TempMax)) {
BOOL_NA_TMP <- (TempMin < (-150)) | is.na(TempMin)
if (sum(BOOL_NA_TMP) != 0) {
BOOL_NA <- BOOL_NA | BOOL_NA_TMP
if (verbose) {
warning("Values < 0 or NA values detected in 'Precip' series")
warning("Values < -150 or NA values detected in 'TempMin' series")
}
}
BOOL_NA_TMP <- (TempMean < (-150)) | is.na(TempMean)
BOOL_NA_TMP <- (TempMax < (-150)) | is.na(TempMax)
if (sum(BOOL_NA_TMP) != 0) {
BOOL_NA <- BOOL_NA | BOOL_NA_TMP
if (verbose) {
warning("Values < -150 or NA values detected in 'TempMean' series")
warning("Values < -150 or NA values detected in 'TempMax' series")
}
}
}
}
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")
}
if ("GR" %in% ObjectClass) {
Precip <- Precip[Select]
PotEvap <- PotEvap[Select]
}
if ("CemaNeige" %in% ObjectClass) {
Precip <- Precip[Select]
TempMean <- TempMean[Select]
if (!is.null(TempMin) & !is.null(TempMax)) {
BOOL_NA_TMP <- (TempMin < (-150)) | is.na(TempMin)
if (sum(BOOL_NA_TMP) != 0) {
BOOL_NA <- BOOL_NA | BOOL_NA_TMP
if (verbose) {
warning("Values < -150 or NA values detected in 'TempMin' series")
}
}
BOOL_NA_TMP <- (TempMax < (-150)) | is.na(TempMax)
if (sum(BOOL_NA_TMP) != 0) {
BOOL_NA <- BOOL_NA | BOOL_NA_TMP
if (verbose) {
warning("Values < -150 or NA values detected in 'TempMax' series")
}
}
TempMin <- TempMin[Select]
TempMax <- TempMax[Select]
}
}
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 list time-step")
}
if ("GR" %in% ObjectClass) {
Precip <- Precip[Select]
PotEvap <- PotEvap[Select]
}
if ("CemaNeige" %in% ObjectClass) {
Precip <- Precip[Select]
TempMean <- TempMean[Select]
if (!is.null(TempMin) & !is.null(TempMax)) {
TempMin <- TempMin[Select]
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)
}
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,
Precip = Precip, PrecipScale = PrecipScale,
TempMean = TempMean, TempMin = TempMin, TempMax = TempMax,
ZInputs = ZInputs, HypsoData = HypsoData, NLayers = NLayers,
verbose = verbose)
if (verbose) {
if (NLayers == 1) {
message("input series were successfully created on 1 elevation layer for use by CemaNeige")
} else {
message( "input series were successfully created on ", NLayers, " elevation layers for use by CemaNeige")
}
}
##DataAltiExtrapolation_Valery
if ("CemaNeige" %in% ObjectClass) {
RESULT <- DataAltiExtrapolation_Valery(DatesR = DatesR,
Precip = Precip, PrecipScale = PrecipScale,
TempMean = TempMean, TempMin = TempMin, TempMax = TempMax,
ZInputs = ZInputs, HypsoData = HypsoData, NLayers = NLayers,
verbose = verbose)
if (verbose) {
if (NLayers == 1) {
message("input series were successfully created on 1 elevation layer for use by CemaNeige")
} else {
message( "input series were successfully created on ", NLayers, " elevation layers for use by CemaNeige")
}
}
##Create_InputsModel
InputsModel <- list(DatesR = DatesR)
if ("GR" %in% ObjectClass) {
InputsModel <- c(InputsModel, list(Precip = as.double(Precip), PotEvap = as.double(PotEvap)))
}
##Create_InputsModel
InputsModel <- list(DatesR = DatesR)
if ("GR" %in% ObjectClass) {
InputsModel <- c(InputsModel, list(Precip = as.double(Precip), PotEvap = as.double(PotEvap)))
}
if ("CemaNeige" %in% ObjectClass) {
InputsModel <- c(InputsModel, list(LayerPrecip = RESULT$LayerPrecip,
LayerTempMean = RESULT$LayerTempMean,
LayerFracSolidPrecip = RESULT$LayerFracSolidPrecip,
ZLayers = RESULT$ZLayers))
}
if ("SD" %in% ObjectClass) {
# Qupstream is internally stored in m3/time step
if (QupstrUnit == "mm") {
iConvBasins <- which(!is.na(BasinAreas[seq.int(length(LengthHydro))]))
Qupstream[, iConvBasins] <- Qupstream[, iConvBasins] * rep(BasinAreas[iConvBasins], each = LLL) * 1e3
} else if (QupstrUnit == "m3/s") {
Qupstream <- Qupstream * TimeStep
} else if (QupstrUnit == "l/s") {
Qupstream <- Qupstream * TimeStep / 1e3
}
if ("CemaNeige" %in% ObjectClass) {
InputsModel <- c(InputsModel, list(LayerPrecip = RESULT$LayerPrecip,
LayerTempMean = RESULT$LayerTempMean,
LayerFracSolidPrecip = RESULT$LayerFracSolidPrecip,
ZLayers = RESULT$ZLayers))
}
class(InputsModel) <- c("InputsModel", ObjectClass)
return(InputsModel)
InputsModel <- c(InputsModel, list(Qupstream = Qupstream,
LengthHydro = LengthHydro,
BasinAreas = BasinAreas))
}
class(InputsModel) <- c("InputsModel", ObjectClass)
return(InputsModel)
}
CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndPeriod_Run,
IniStates = NULL, IniResLevels = NULL,
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.logical(IsHyst) | length(IsHyst) != 1L) {
stop("'IsHyst' must be a 'logical' of length 1")
if (!is.null(Imax)) {
if (!is.numeric(Imax) | length(Imax) != 1L) {
stop("'Imax' must be a non negative 'numeric' value of length 1")
} else {
if (Imax < 0) {
stop("'Imax' must be a non negative 'numeric' value of length 1")
}
}
IsIntStore <- TRUE
} else {
IsIntStore <- FALSE
}
ObjectClass <- NULL
## check FUN_MOD
FUN_MOD <- match.fun(FUN_MOD)
##check_FUN_MOD
BOOL <- FALSE
if (identical(FUN_MOD, RunModel_GR4H)) {
ObjectClass <- c(ObjectClass, "GR", "hourly")
BOOL <- TRUE
}
if (identical(FUN_MOD, RunModel_GR4J) | identical(FUN_MOD, RunModel_GR5J) | identical(FUN_MOD, RunModel_GR6J)) {
ObjectClass <- c(ObjectClass, "GR", "daily")
BOOL <- TRUE
}
if (identical(FUN_MOD, RunModel_GR2M)) {
ObjectClass <- c(ObjectClass, "GR", "monthly")
BOOL <- TRUE
}
if (identical(FUN_MOD, RunModel_GR1A)) {
ObjectClass <- c(ObjectClass, "GR", "yearly")
BOOL <- TRUE
}
if (identical(FUN_MOD, RunModel_CemaNeige)) {
ObjectClass <- c(ObjectClass, "CemaNeige", "daily")
BOOL <- TRUE
FeatFUN_MOD <- .GetFeatModel(FUN_MOD = FUN_MOD, DatesR = InputsModel$DatesR)
ObjectClass <- FeatFUN_MOD$Class
TimeStepMean <- FeatFUN_MOD$TimeStepMean
## Model output variable list
FortranOutputs <- .FortranOutputs(GR = FeatFUN_MOD$CodeModHydro,
isCN = "CemaNeige" %in% FeatFUN_MOD$Class)
## manage class
if (IsIntStore) {
ObjectClass <- c(ObjectClass, "interception")
}
if (identical(FUN_MOD, RunModel_CemaNeigeGR4J) | identical(FUN_MOD, RunModel_CemaNeigeGR5J) | identical(FUN_MOD, RunModel_CemaNeigeGR6J)) {
ObjectClass <- c(ObjectClass, "GR", "CemaNeige", "daily")
BOOL <- TRUE
if ("CemaNeige" %in% FeatFUN_MOD$Class) {
FeatFUN_MOD$IsHyst <- IsHyst
if (IsHyst) {
ObjectClass <- c(ObjectClass, "hysteresis")
FeatFUN_MOD$NbParam <- FeatFUN_MOD$NbParam + 2
}
}
if (identical(FUN_MOD, RunModel_CemaNeigeGR4H)) {
ObjectClass <- c(ObjectClass, "GR", "CemaNeige", "hourly")
BOOL <- TRUE
## SD model
FeatFUN_MOD$IsSD <- inherits(InputsModel, "SD")
if (FeatFUN_MOD$IsSD) {
FeatFUN_MOD$NbParam <- FeatFUN_MOD$NbParam + 1
}
if (IsHyst) {
ObjectClass <- c(ObjectClass, "hysteresis")
if (!"CemaNeige" %in% ObjectClass & "hysteresis" %in% ObjectClass) {
stop("'IsHyst' cannot be TRUE for the chosen 'FUN_MOD'")
}
if (!BOOL) {
stop("incorrect 'FUN_MOD' for use in 'CreateRunOptions'")
if (!(identical(FUN_MOD, RunModel_GR5H) | identical(FUN_MOD, RunModel_CemaNeigeGR5H)) & "interception" %in% ObjectClass) {
stop("'IMax' cannot be set for the chosen 'FUN_MOD'")
}
##check_InputsModel
if (!inherits(InputsModel, "InputsModel")) {
stop("'InputsModel' must be of class 'InputsModel'")
......@@ -77,8 +79,8 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
!inherits(InputsModel, "yearly")) {
stop("'InputsModel' must be of class 'yearly'")
}
##check_IndPeriod_Run
if (!is.vector(IndPeriod_Run)) {
stop("'IndPeriod_Run' must be a vector of numeric values")
......@@ -92,15 +94,15 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
if (storage.mode(IndPeriod_Run) != "integer") {
stop("'IndPeriod_Run' should be of type integer")
}
##check_IndPeriod_WarmUp
WTxt <- NULL
if (is.null(IndPeriod_WarmUp)) {
WTxt <- paste(WTxt, "model warm up period not defined: default configuration used", sep = "")
##If_the_run_period_starts_at_the_very_beginning_of_the_time_series
if (IndPeriod_Run[1L] == 1L) {
IndPeriod_WarmUp <- as.integer(0)
IndPeriod_WarmUp <- 0L
WTxt <- paste0(WTxt,"\n no data were found for model warm up!")
##We_look_for_the_longest_period_preceeding_the_run_period_with_a_maximum_of_one_year
} else {
......@@ -112,19 +114,7 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
TmpDateR <- TmpDateR - 1 * 24 * 60 * 60
}
IndPeriod_WarmUp <- which(InputsModel$DatesR == max(InputsModel$DatesR[1], TmpDateR)):(IndPeriod_Run[1] - 1)
if ("hourly" %in% ObjectClass) {
TimeStep <- as.integer(60 * 60)
}
if ("daily" %in% ObjectClass) {
TimeStep <- as.integer(24 * 60 * 60)
}
if ("monthly" %in% ObjectClass) {
TimeStep <- as.integer(30.44 * 24 * 60 * 60)
}
if ("yearly" %in% ObjectClass) {
TimeStep <- as.integer(365.25 * 24 * 60 * 60)
}
if (length(IndPeriod_WarmUp) * TimeStep / (365 * 24 * 60 * 60) >= 1) {
if (length(IndPeriod_WarmUp) * TimeStepMean / (365 * 24 * 60 * 60) >= 1) {
WTxt <- paste0(WTxt, "\n the year preceding the run period is used \n")
} else {
WTxt <- paste0(WTxt, "\n less than a year (without missing values) was found for model warm up:")
......@@ -142,41 +132,79 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
if (storage.mode(IndPeriod_WarmUp) != "integer") {
stop("'IndPeriod_WarmUp' should be of type integer")
}
if (identical(IndPeriod_WarmUp, as.integer(0)) & verbose) {
if (identical(IndPeriod_WarmUp, 0L) & verbose) {
message(paste0(WTxt, " No warm up period is used"))
}
if ((IndPeriod_Run[1] - 1) != tail(IndPeriod_WarmUp, 1) & !identical(IndPeriod_WarmUp, as.integer(0))) {
if ((IndPeriod_Run[1] - 1) != tail(IndPeriod_WarmUp, 1) & !identical(IndPeriod_WarmUp, 0L)) {
WTxt <- paste0(WTxt, " Model warm up period is not directly before the model run period")
}
}
if (!is.null(WTxt) & warnings) {
warning(WTxt)
}
## check IniResLevels
## check IniResLevels
if ("GR" %in% ObjectClass & ("monthly" %in% ObjectClass | "daily" %in% ObjectClass | "hourly" %in% ObjectClass)) {
if (!is.null(IniResLevels)) {
if (!is.vector(IniResLevels) | !is.numeric(IniResLevels) | any(is.na(IniResLevels))) {
stop("'IniResLevels' must be a vector of numeric values")
# if (!is.vector(IniResLevels) | !is.numeric(IniResLevels) | any(is.na(IniResLevels))) {
if (!is.vector(IniResLevels) | is.character(IniResLevels) | is.factor(IniResLevels) | length(IniResLevels) != 4) {
stop("'IniResLevels' must be a vector of 4 numeric values")
}
if ((identical(FUN_MOD, RunModel_GR4H) | identical(FUN_MOD, RunModel_CemaNeigeGR4H) |
identical(FUN_MOD, RunModel_GR4J) | identical(FUN_MOD, RunModel_CemaNeigeGR4J) |
identical(FUN_MOD, RunModel_GR5J) | identical(FUN_MOD, RunModel_CemaNeigeGR5J) |
identical(FUN_MOD, RunModel_GR2M)) &
length(IniResLevels) != 2) {
stop("the length of 'IniResLevels' must be 2 for the chosen 'FUN_MOD'")
# if ((identical(FUN_MOD, RunModel_GR4H) | identical(FUN_MOD, RunModel_CemaNeigeGR4H) |
# # (identical(FUN_MOD, RunModel_GR5H) & !IsIntStore) |
# identical(FUN_MOD, RunModel_GR5H) |
# identical(FUN_MOD, RunModel_GR4J) | identical(FUN_MOD, RunModel_CemaNeigeGR4J) |
# identical(FUN_MOD, RunModel_GR5J) | identical(FUN_MOD, RunModel_CemaNeigeGR5J) |
# identical(FUN_MOD, RunModel_GR2M)) &
# length(IniResLevels) != 2) {
# stop("the length of 'IniResLevels' must be 2 for the chosen 'FUN_MOD'")
# }
if (any(is.na(IniResLevels[1:2]))) {
stop("the first 2 values of 'IniResLevels' cannot be missing values for the chosen 'FUN_MOD'")
}
# if ((identical(FUN_MOD, RunModel_GR6J) | identical(FUN_MOD, RunModel_CemaNeigeGR6J) |
# (identical(FUN_MOD, RunModel_GR5H) & IsIntStore)) &
# length(IniResLevels) != 3) {
# stop("the length of 'IniResLevels' must be 3 for the chosen 'FUN_MOD'")
# }
if ((identical(FUN_MOD, RunModel_GR6J) | identical(FUN_MOD, RunModel_CemaNeigeGR6J))) {
if (is.na(IniResLevels[3L])) {
stop("the third value of 'IniResLevels' cannot be a missing value for the chosen 'FUN_MOD'")
}
} else {
if (!is.na(IniResLevels[3L])) {
warning("the third value of 'IniResLevels' is set to NA value for the chosen 'FUN_MOD'. Only GR6J presents an exponential store")
IniResLevels[3L] <- NA
}
}
if ((identical(FUN_MOD,RunModel_GR6J) | identical(FUN_MOD,RunModel_CemaNeigeGR6J)) &
length(IniResLevels) != 3) {
stop("the length of 'IniResLevels' must be 3 for the chosen 'FUN_MOD'")
if (identical(FUN_MOD, RunModel_GR5H) | identical(FUN_MOD, RunModel_CemaNeigeGR5H)) {
if (IsIntStore & is.na(IniResLevels[4L])) {
stop("the fourth value of 'IniResLevels' cannot be a missing value for the chosen 'FUN_MOD' (GR5H with an interception store)")
}
if (!IsIntStore & !is.na(IniResLevels[4L])) {
warning("the fourth value of 'IniResLevels' is set to NA value for the chosen 'FUN_MOD'. Only GR5H used with an 'Imax' value presents an interception store")
IniResLevels[4L] <- NA
}
} else {
if (!is.na(IniResLevels[4L])) {
warning("the fourth value of 'IniResLevels' is set to NA value for the chosen 'FUN_MOD'. Only GR5H used with an 'Imax' value presents an interception store")
IniResLevels[4L] <- NA
}
}
} else if (is.null(IniStates)) {
IniResLevels <- as.double(c(0.3, 0.5, NA, NA))
if (identical(FUN_MOD, RunModel_GR6J) | identical(FUN_MOD, RunModel_CemaNeigeGR6J)) {
IniResLevels <- as.double(c(0.3, 0.5, 0))
} else {
IniResLevels <- as.double(c(0.3, 0.5, NA))
IniResLevels <- as.double(c(0.3, 0.5, 0, NA))
}
if ((identical(FUN_MOD, RunModel_GR5H) | identical(FUN_MOD, RunModel_CemaNeigeGR5H)) & IsIntStore) {
IniResLevels <- as.double(c(0.3, 0.5, NA, 0))
}
# if (!identical(FUN_MOD, RunModel_GR6J) & !identical(FUN_MOD, RunModel_CemaNeigeGR6J) &
# !identical(FUN_MOD, RunModel_GR5H) & !identical(FUN_MOD, RunModel_CemaNeigeGR5H)) {
# if (is.null(IniStates)) {
# IniResLevels <- as.double(c(0.3, 0.5, NA, NA))
# }
}
} else {
if (!is.null(IniResLevels)) {
......@@ -198,7 +226,7 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
NState <- NULL
if ("GR" %in% ObjectClass | "CemaNeige" %in% ObjectClass) {
if ("hourly" %in% ObjectClass) {
NState <- 7 + 3 * 24 * 20+ 4 * NLayers
NState <- 7 + 3 * 24 * 20 + 4 * NLayers
}
if ("daily" %in% ObjectClass) {
NState <- 7 + 3 * 20 + 4 * NLayers
......@@ -211,7 +239,7 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
}
}
if (!is.null(IniStates)) {
if (!inherits(IniStates, "IniStates")) {
stop("'IniStates' must be an object of class 'IniStates'")
}
......@@ -221,25 +249,31 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
if (identical(FUN_MOD, RunModel_GR1A) & !is.null(IniStates)) { ## GR1A
stop(paste0("'IniStates' is not available for the chosen 'FUN_MOD'"))
}
if ((identical(FUN_MOD, RunModel_GR5J) | identical(FUN_MOD, RunModel_CemaNeigeGR5J)) & !all(is.na(IniStates$UH$UH1))) { ## GR5J
if ((identical(FUN_MOD, RunModel_GR5J) | identical(FUN_MOD, RunModel_CemaNeigeGR5J) |
identical(FUN_MOD, RunModel_GR5H) | identical(FUN_MOD, RunModel_CemaNeigeGR5H)) &
!all(is.na(IniStates$UH$UH1))) { ## GR5J or GR5H
stop(paste0("non convenient 'IniStates' for the chosen 'FUN_MOD'.' In 'IniStates', 'UH1' has to be a vector of NA for GR5J"))
}
if ((identical(FUN_MOD, RunModel_GR6J) | identical(FUN_MOD, RunModel_CemaNeigeGR6J)) & is.na(IniStates$Store$Exp)) { ## GR6J
stop(paste0("non convenient 'IniStates' for the chosen 'FUN_MOD'.' GR6J needs an exponential store value in 'IniStates'"))
}
if ((identical(FUN_MOD, RunModel_GR5H) | identical(FUN_MOD, RunModel_CemaNeigeGR5H)) & is.na(IniStates$Store$Int)) { ## GR5H interception
stop(paste0("non convenient 'IniStates' for the chosen 'FUN_MOD'.' GR5H (with interception store) needs an interception store value in 'IniStates'"))
}
if (!(identical(FUN_MOD, RunModel_GR6J) | identical(FUN_MOD, RunModel_CemaNeigeGR6J)) & !is.na(IniStates$Store$Exp)) { ## except GR6J
stop(paste0("non convenient 'IniStates' for the chosen 'FUN_MOD'.' No exponential store value needed in 'IniStates'"))
}
if (!(identical(FUN_MOD, RunModel_GR5H) | identical(FUN_MOD, RunModel_CemaNeigeGR5H)) & !is.na(IniStates$Store$Int)) { ## except GR5H interception
stop(paste0("non convenient 'IniStates' for the chosen 'FUN_MOD'.' No interception store value needed in 'IniStates'"))
}
# if (length(na.omit(unlist(IniStates))) != NState) {
# stop(paste0("the length of IniStates must be ", NState, " for the chosen FUN_MOD"))
# }
if ((!"CemaNeige" %in% ObjectClass & inherits(IniStates, "CemaNeige")) |
if ((!"CemaNeige" %in% ObjectClass & inherits(IniStates, "CemaNeige")) |
( "CemaNeige" %in% ObjectClass & !inherits(IniStates, "CemaNeige"))) {
stop("'FUN_MOD' and 'IniStates' must be both of class 'CemaNeige'")
}
if (!"CemaNeige" %in% ObjectClass & "hysteresis" %in% ObjectClass) {
stop("'IsHyst' cannot be TRUE for the chosen 'FUN_MOD'")
}
if (( "hysteresis" %in% ObjectClass & !inherits(IniStates, "hysteresis")) |
(!"hysteresis" %in% ObjectClass & inherits(IniStates, "hysteresis"))) {
stop("'IsHyst' and 'IniStates' are not consistent on the use of the hysteresis")
......@@ -256,7 +290,7 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
if (!"CemaNeige" %in% ObjectClass & any(is.na(IniStates$CemaNeigeLayers$Glocmax))) {
IniStates$CemaNeigeLayers$Glocmax <- NULL
}
IniStates$Store$Rest <- rep(NA, 4)
IniStates$Store$Rest <- rep(NA, 3)
IniStates <- unlist(IniStates)
IniStates[is.na(IniStates)] <- 0
if ("monthly" %in% ObjectClass) {
......@@ -265,34 +299,16 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
} else {
IniStates <- as.double(rep(0.0, NState))
}
##check_Outputs_Cal_and_Sim
##Outputs_all
Outputs_all <- NULL
if (identical(FUN_MOD,RunModel_GR4H) | identical(FUN_MOD,RunModel_CemaNeigeGR4H)) {
Outputs_all <- c(Outputs_all, .FortranOutputs(GR = "GR4H")$GR)
}
if (identical(FUN_MOD,RunModel_GR4J) | identical(FUN_MOD,RunModel_CemaNeigeGR4J)) {
Outputs_all <- c(Outputs_all, .FortranOutputs(GR = "GR4J")$GR)
Outputs_all <- c("DatesR", unlist(FortranOutputs), "WarmUpQsim", "StateEnd", "Param")
if (FeatFUN_MOD$IsSD) {
Outputs_all <- c(Outputs_all, "QsimDown", "Qsim_m3")
}
if (identical(FUN_MOD,RunModel_GR5J) | identical(FUN_MOD,RunModel_CemaNeigeGR5J)) {
Outputs_all <- c(Outputs_all, .FortranOutputs(GR = "GR5J")$GR)
}
if (identical(FUN_MOD,RunModel_GR6J) | identical(FUN_MOD,RunModel_CemaNeigeGR6J)) {
Outputs_all <- c(Outputs_all, .FortranOutputs(GR = "GR6J")$GR)
}
if (identical(FUN_MOD,RunModel_GR2M)) {
Outputs_all <- c(Outputs_all, .FortranOutputs(GR = "GR2M")$GR)
}
if (identical(FUN_MOD,RunModel_GR1A)) {
Outputs_all <- c(Outputs_all, .FortranOutputs(GR = "GR1A")$GR)
}
if ("CemaNeige" %in% ObjectClass) {
Outputs_all <- c(Outputs_all, .FortranOutputs(GR = NULL, isCN = TRUE)$CN)
}
##check_Outputs_Sim
if (!is.vector(Outputs_Sim)) {
stop("'Outputs_Sim' must be a vector of characters")
......@@ -304,28 +320,26 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
stop("'Outputs_Sim' must not contain NA")
}
if ("all" %in% Outputs_Sim) {
Outputs_Sim <- c("DatesR", Outputs_all, "StateEnd")
Outputs_Sim <- Outputs_all
}
Test <- which(!Outputs_Sim %in% c("DatesR", Outputs_all, "StateEnd"))
Test <- which(!Outputs_Sim %in% Outputs_all)
if (length(Test) != 0) {
stop(paste0( "'Outputs_Sim' is incorrectly defined: ",
paste(Outputs_Sim[Test], collapse = ", "), " not found"))
}
Outputs_Sim <- Outputs_Sim[!duplicated(Outputs_Sim)]
##check_Outputs_Cal
if (is.null(Outputs_Cal)) {
if ("GR" %in% ObjectClass) {
Outputs_Cal <- c("Qsim")
}
if ("CemaNeige" %in% ObjectClass) {
Outputs_Cal <- c("Qsim", "Param")
if ("CemaNeige" %in% ObjectClass) {
Outputs_Cal <- c("PliqAndMelt", Outputs_Cal)
}
} else if ("CemaNeige" %in% ObjectClass) {
Outputs_Cal <- c("all")
}
if ("GR" %in% ObjectClass &
"CemaNeige" %in% ObjectClass) {
Outputs_Cal <- c("PliqAndMelt", "Qsim")
}
} else {
if (!is.vector(Outputs_Cal)) {
stop("'Outputs_Cal' must be a vector of characters")
......@@ -338,17 +352,16 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
}
}
if ("all" %in% Outputs_Cal) {
Outputs_Cal <- c("DatesR", Outputs_all, "StateEnd")
Outputs_Cal <- Outputs_all
}
Test <- which(!Outputs_Cal %in% c("DatesR", Outputs_all, "StateEnd"))
Test <- which(!Outputs_Cal %in% Outputs_all)
if (length(Test) != 0) {
stop(paste0("'Outputs_Cal' is incorrectly defined: ",
paste(Outputs_Cal[Test], collapse = ", "), " not found"))
}
Outputs_Cal <- unique(Outputs_Cal)
##check_MeanAnSolidPrecip
if ("CemaNeige" %in% ObjectClass & is.null(MeanAnSolidPrecip)) {
NLayers <- length(InputsModel$LayerPrecip)
......@@ -397,8 +410,8 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
stop(paste0("'MeanAnSolidPrecip' must be a numeric vector of length ", NLayers, ""))
}
}
##check_PliqAndMelt
if ("GR" %in% ObjectClass & "CemaNeige" %in% ObjectClass) {
if (!"PliqAndMelt" %in% Outputs_Cal & !"all" %in% Outputs_Cal) {
......@@ -420,8 +433,8 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
Outputs_Sim <- c(Outputs_Sim, "PliqAndMelt")
}
}
##check_Qsim
if ("GR" %in% ObjectClass) {
if (!"Qsim" %in% Outputs_Cal & !"all" %in% Outputs_Cal) {
......@@ -443,22 +456,27 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
Outputs_Sim <- c(Outputs_Sim, "Qsim")
}
}
##Create_RunOptions
RunOptions <- list(IndPeriod_WarmUp = IndPeriod_WarmUp,
IndPeriod_Run = IndPeriod_Run,
IniStates = IniStates,
IniResLevels = IniResLevels,
Outputs_Cal = Outputs_Cal,
Outputs_Sim = Outputs_Sim)
Outputs_Sim = Outputs_Sim,
FortranOutputs = FortranOutputs,
FeatFUN_MOD = FeatFUN_MOD)
if ("CemaNeige" %in% ObjectClass) {
RunOptions <- c(RunOptions, list(MeanAnSolidPrecip = MeanAnSolidPrecip))
}
if ("interception" %in% ObjectClass) {
RunOptions <- c(RunOptions, list(Imax = Imax))
}
class(RunOptions) <- c("RunOptions", ObjectClass)
return(RunOptions)
}
......@@ -3,549 +3,171 @@ DataAltiExtrapolation_Valery <- function(DatesR,
TempMean, TempMin = NULL, TempMax = NULL,
ZInputs, HypsoData, NLayers,
verbose = TRUE) {
##Altitudinal_gradient_functions_______________________________________________________________
##unique_gradient_for_precipitation
GradP_Valery2010 <- function() {
return(0.00041) ### value from Valery PhD thesis page 126
}
##daily_gradients_for_mean_min_and_max_air_temperature
GradT_Valery2010 <- function() {
RESULT <- matrix(c(
01, 01, 0.434, 0.366, 0.498,
02, 01, 0.434, 0.366, 0.500,
03, 01, 0.435, 0.367, 0.501,
04, 01, 0.436, 0.367, 0.503,
05, 01, 0.437, 0.367, 0.504,
06, 01, 0.439, 0.367, 0.506,
07, 01, 0.440, 0.367, 0.508,
08, 01, 0.441, 0.368, 0.510,
09, 01, 0.442, 0.368, 0.512,
10, 01, 0.444, 0.368, 0.514,
11, 01, 0.445, 0.368, 0.517,
12, 01, 0.446, 0.368, 0.519,
13, 01, 0.448, 0.369, 0.522,
14, 01, 0.450, 0.369, 0.525,
15, 01, 0.451, 0.369, 0.527,
16, 01, 0.453, 0.370, 0.530,
17, 01, 0.455, 0.370, 0.533,
18, 01, 0.456, 0.370, 0.537,
19, 01, 0.458, 0.371, 0.540,
20, 01, 0.460, 0.371, 0.543,
21, 01, 0.462, 0.371, 0.547,
22, 01, 0.464, 0.372, 0.550,
23, 01, 0.466, 0.372, 0.554,
24, 01, 0.468, 0.373, 0.558,
25, 01, 0.470, 0.373, 0.561,
26, 01, 0.472, 0.374, 0.565,
27, 01, 0.474, 0.374, 0.569,
28, 01, 0.476, 0.375, 0.573,
29, 01, 0.478, 0.375, 0.577,
30, 01, 0.480, 0.376, 0.582,
31, 01, 0.483, 0.376, 0.586,
01, 02, 0.485, 0.377, 0.590,
02, 02, 0.487, 0.377, 0.594,
03, 02, 0.489, 0.378, 0.599,
04, 02, 0.492, 0.379, 0.603,
05, 02, 0.494, 0.379, 0.607,
06, 02, 0.496, 0.380, 0.612,
07, 02, 0.498, 0.381, 0.616,
08, 02, 0.501, 0.381, 0.621,
09, 02, 0.503, 0.382, 0.625,
10, 02, 0.505, 0.383, 0.630,
11, 02, 0.508, 0.384, 0.634,
12, 02, 0.510, 0.384, 0.639,
13, 02, 0.512, 0.385, 0.643,
14, 02, 0.515, 0.386, 0.648,
15, 02, 0.517, 0.387, 0.652,
16, 02, 0.519, 0.387, 0.657,
17, 02, 0.522, 0.388, 0.661,
18, 02, 0.524, 0.389, 0.666,
19, 02, 0.526, 0.390, 0.670,
20, 02, 0.528, 0.391, 0.674,
21, 02, 0.530, 0.392, 0.679,
22, 02, 0.533, 0.393, 0.683,
23, 02, 0.535, 0.393, 0.687,
24, 02, 0.537, 0.394, 0.691,
25, 02, 0.539, 0.395, 0.695,
26, 02, 0.541, 0.396, 0.699,
27, 02, 0.543, 0.397, 0.703,
28, 02, 0.545, 0.398, 0.707,
29, 02, 0.546, 0.399, 0.709,
01, 03, 0.547, 0.399, 0.711,
02, 03, 0.549, 0.400, 0.715,
03, 03, 0.551, 0.401, 0.718,
04, 03, 0.553, 0.402, 0.722,
05, 03, 0.555, 0.403, 0.726,
06, 03, 0.557, 0.404, 0.729,
07, 03, 0.559, 0.405, 0.732,
08, 03, 0.560, 0.406, 0.736,
09, 03, 0.562, 0.406, 0.739,
10, 03, 0.564, 0.407, 0.742,
11, 03, 0.566, 0.408, 0.745,
12, 03, 0.567, 0.409, 0.748,
13, 03, 0.569, 0.410, 0.750,
14, 03, 0.570, 0.411, 0.753,
15, 03, 0.572, 0.412, 0.756,
16, 03, 0.573, 0.413, 0.758,
17, 03, 0.575, 0.414, 0.761,
18, 03, 0.576, 0.415, 0.763,
19, 03, 0.577, 0.416, 0.765,
20, 03, 0.579, 0.417, 0.767,
21, 03, 0.580, 0.417, 0.769,
22, 03, 0.581, 0.418, 0.771,
23, 03, 0.582, 0.419, 0.773,
24, 03, 0.583, 0.420, 0.774,
25, 03, 0.584, 0.421, 0.776,
26, 03, 0.585, 0.422, 0.777,
27, 03, 0.586, 0.422, 0.779,
28, 03, 0.587, 0.423, 0.780,
29, 03, 0.588, 0.424, 0.781,
30, 03, 0.589, 0.425, 0.782,
31, 03, 0.590, 0.425, 0.783,
01, 04, 0.591, 0.426, 0.784,
02, 04, 0.591, 0.427, 0.785,
03, 04, 0.592, 0.427, 0.785,
04, 04, 0.593, 0.428, 0.786,
05, 04, 0.593, 0.429, 0.787,
06, 04, 0.594, 0.429, 0.787,
07, 04, 0.595, 0.430, 0.787,
08, 04, 0.595, 0.431, 0.788,
09, 04, 0.596, 0.431, 0.788,
10, 04, 0.596, 0.432, 0.788,
11, 04, 0.597, 0.432, 0.788,
12, 04, 0.597, 0.433, 0.788,
13, 04, 0.597, 0.433, 0.788,
14, 04, 0.598, 0.434, 0.788,
15, 04, 0.598, 0.434, 0.788,
16, 04, 0.598, 0.435, 0.787,
17, 04, 0.599, 0.435, 0.787,
18, 04, 0.599, 0.436, 0.787,
19, 04, 0.599, 0.436, 0.786,
20, 04, 0.599, 0.436, 0.786,
21, 04, 0.600, 0.437, 0.785,
22, 04, 0.600, 0.437, 0.785,
23, 04, 0.600, 0.437, 0.784,
24, 04, 0.600, 0.438, 0.784,
25, 04, 0.600, 0.438, 0.783,
26, 04, 0.601, 0.438, 0.783,
27, 04, 0.601, 0.438, 0.782,
28, 04, 0.601, 0.439, 0.781,
29, 04, 0.601, 0.439, 0.781,
30, 04, 0.601, 0.439, 0.780,
01, 05, 0.601, 0.439, 0.779,
02, 05, 0.601, 0.439, 0.778,
03, 05, 0.601, 0.439, 0.778,
04, 05, 0.601, 0.440, 0.777,
05, 05, 0.601, 0.440, 0.776,
06, 05, 0.601, 0.440, 0.775,
07, 05, 0.601, 0.440, 0.775,
08, 05, 0.601, 0.440, 0.774,
09, 05, 0.601, 0.440, 0.773,
10, 05, 0.602, 0.440, 0.772,
11, 05, 0.602, 0.440, 0.772,
12, 05, 0.602, 0.440, 0.771,
13, 05, 0.602, 0.440, 0.770,
14, 05, 0.602, 0.440, 0.770,
15, 05, 0.602, 0.440, 0.769,
16, 05, 0.602, 0.440, 0.768,
17, 05, 0.602, 0.440, 0.768,
18, 05, 0.602, 0.440, 0.767,
19, 05, 0.602, 0.440, 0.767,
20, 05, 0.602, 0.440, 0.766,
21, 05, 0.602, 0.440, 0.766,
22, 05, 0.602, 0.440, 0.765,
23, 05, 0.602, 0.440, 0.765,
24, 05, 0.602, 0.440, 0.764,
25, 05, 0.602, 0.440, 0.764,
26, 05, 0.602, 0.440, 0.764,
27, 05, 0.602, 0.439, 0.763,
28, 05, 0.602, 0.439, 0.763,
29, 05, 0.602, 0.439, 0.763,
30, 05, 0.602, 0.439, 0.762,
31, 05, 0.602, 0.439, 0.762,
01, 06, 0.602, 0.439, 0.762,
02, 06, 0.602, 0.439, 0.762,
03, 06, 0.602, 0.439, 0.762,
04, 06, 0.602, 0.439, 0.762,
05, 06, 0.602, 0.439, 0.762,
06, 06, 0.602, 0.438, 0.761,
07, 06, 0.602, 0.438, 0.761,
08, 06, 0.602, 0.438, 0.761,
09, 06, 0.602, 0.438, 0.761,
10, 06, 0.602, 0.438, 0.761,
11, 06, 0.602, 0.438, 0.762,
12, 06, 0.602, 0.438, 0.762,
13, 06, 0.602, 0.438, 0.762,
14, 06, 0.602, 0.438, 0.762,
15, 06, 0.602, 0.437, 0.762,
16, 06, 0.602, 0.437, 0.762,
17, 06, 0.602, 0.437, 0.762,
18, 06, 0.602, 0.437, 0.762,
19, 06, 0.602, 0.437, 0.763,
20, 06, 0.602, 0.437, 0.763,
21, 06, 0.602, 0.437, 0.763,
22, 06, 0.602, 0.436, 0.763,
23, 06, 0.602, 0.436, 0.763,
24, 06, 0.602, 0.436, 0.764,
25, 06, 0.602, 0.436, 0.764,
26, 06, 0.601, 0.436, 0.764,
27, 06, 0.601, 0.436, 0.764,
28, 06, 0.601, 0.436, 0.764,
29, 06, 0.601, 0.435, 0.765,
30, 06, 0.601, 0.435, 0.765,
01, 07, 0.601, 0.435, 0.765,
02, 07, 0.600, 0.435, 0.765,
03, 07, 0.600, 0.435, 0.765,
04, 07, 0.600, 0.434, 0.766,
05, 07, 0.600, 0.434, 0.766,
06, 07, 0.599, 0.434, 0.766,
07, 07, 0.599, 0.434, 0.766,
08, 07, 0.599, 0.434, 0.766,
09, 07, 0.598, 0.433, 0.766,
10, 07, 0.598, 0.433, 0.766,
11, 07, 0.598, 0.433, 0.766,
12, 07, 0.597, 0.433, 0.766,
13, 07, 0.597, 0.432, 0.767,
14, 07, 0.597, 0.432, 0.767,
15, 07, 0.596, 0.432, 0.767,
16, 07, 0.596, 0.432, 0.766,
17, 07, 0.595, 0.431, 0.766,
18, 07, 0.595, 0.431, 0.766,
19, 07, 0.594, 0.431, 0.766,
20, 07, 0.594, 0.430, 0.766,
21, 07, 0.593, 0.430, 0.766,
22, 07, 0.593, 0.430, 0.766,
23, 07, 0.592, 0.429, 0.765,
24, 07, 0.592, 0.429, 0.765,
25, 07, 0.591, 0.428, 0.765,
26, 07, 0.590, 0.428, 0.765,
27, 07, 0.590, 0.428, 0.764,
28, 07, 0.589, 0.427, 0.764,
29, 07, 0.588, 0.427, 0.764,
30, 07, 0.588, 0.426, 0.763,
31, 07, 0.587, 0.426, 0.763,
01, 08, 0.586, 0.425, 0.762,
02, 08, 0.586, 0.425, 0.762,
03, 08, 0.585, 0.424, 0.761,
04, 08, 0.584, 0.424, 0.761,
05, 08, 0.583, 0.423, 0.760,
06, 08, 0.583, 0.423, 0.760,
07, 08, 0.582, 0.422, 0.759,
08, 08, 0.581, 0.421, 0.758,
09, 08, 0.580, 0.421, 0.758,
10, 08, 0.579, 0.420, 0.757,
11, 08, 0.578, 0.420, 0.756,
12, 08, 0.578, 0.419, 0.755,
13, 08, 0.577, 0.418, 0.754,
14, 08, 0.576, 0.418, 0.754,
15, 08, 0.575, 0.417, 0.753,
16, 08, 0.574, 0.416, 0.752,
17, 08, 0.573, 0.415, 0.751,
18, 08, 0.572, 0.415, 0.750,
19, 08, 0.571, 0.414, 0.749,
20, 08, 0.570, 0.413, 0.748,
21, 08, 0.569, 0.413, 0.747,
22, 08, 0.569, 0.412, 0.746,
23, 08, 0.568, 0.411, 0.745,
24, 08, 0.567, 0.410, 0.744,
25, 08, 0.566, 0.409, 0.743,
26, 08, 0.565, 0.409, 0.742,
27, 08, 0.564, 0.408, 0.741,
28, 08, 0.563, 0.407, 0.740,
29, 08, 0.562, 0.406, 0.738,
30, 08, 0.561, 0.405, 0.737,
31, 08, 0.560, 0.405, 0.736,
01, 09, 0.558, 0.404, 0.735,
02, 09, 0.557, 0.403, 0.734,
03, 09, 0.556, 0.402, 0.732,
04, 09, 0.555, 0.401, 0.731,
05, 09, 0.554, 0.401, 0.730,
06, 09, 0.553, 0.400, 0.728,
07, 09, 0.552, 0.399, 0.727,
08, 09, 0.551, 0.398, 0.725,
09, 09, 0.550, 0.397, 0.724,
10, 09, 0.549, 0.396, 0.723,
11, 09, 0.548, 0.396, 0.721,
12, 09, 0.546, 0.395, 0.720,
13, 09, 0.545, 0.394, 0.718,
14, 09, 0.544, 0.393, 0.717,
15, 09, 0.543, 0.392, 0.715,
16, 09, 0.542, 0.391, 0.713,
17, 09, 0.541, 0.391, 0.712,
18, 09, 0.540, 0.390, 0.710,
19, 09, 0.538, 0.389, 0.709,
20, 09, 0.537, 0.388, 0.707,
21, 09, 0.536, 0.388, 0.705,
22, 09, 0.535, 0.387, 0.703,
23, 09, 0.533, 0.386, 0.702,
24, 09, 0.532, 0.385, 0.700,
25, 09, 0.531, 0.385, 0.698,
26, 09, 0.530, 0.384, 0.696,
27, 09, 0.528, 0.383, 0.694,
28, 09, 0.527, 0.383, 0.692,
29, 09, 0.526, 0.382, 0.690,
30, 09, 0.525, 0.381, 0.688,
01, 10, 0.523, 0.381, 0.686,
02, 10, 0.522, 0.380, 0.684,
03, 10, 0.521, 0.379, 0.682,
04, 10, 0.519, 0.379, 0.680,
05, 10, 0.518, 0.378, 0.678,
06, 10, 0.517, 0.377, 0.676,
07, 10, 0.515, 0.377, 0.674,
08, 10, 0.514, 0.376, 0.671,
09, 10, 0.512, 0.376, 0.669,
10, 10, 0.511, 0.375, 0.667,
11, 10, 0.510, 0.375, 0.664,
12, 10, 0.508, 0.374, 0.662,
13, 10, 0.507, 0.374, 0.659,
14, 10, 0.505, 0.373, 0.657,
15, 10, 0.504, 0.373, 0.654,
16, 10, 0.502, 0.372, 0.652,
17, 10, 0.501, 0.372, 0.649,
18, 10, 0.499, 0.372, 0.647,
19, 10, 0.498, 0.371, 0.644,
20, 10, 0.496, 0.371, 0.641,
21, 10, 0.495, 0.371, 0.639,
22, 10, 0.493, 0.370, 0.636,
23, 10, 0.492, 0.370, 0.633,
24, 10, 0.490, 0.370, 0.630,
25, 10, 0.489, 0.369, 0.628,
26, 10, 0.487, 0.369, 0.625,
27, 10, 0.485, 0.369, 0.622,
28, 10, 0.484, 0.368, 0.619,
29, 10, 0.482, 0.368, 0.616,
30, 10, 0.481, 0.368, 0.613,
31, 10, 0.479, 0.368, 0.610,
01, 11, 0.478, 0.368, 0.607,
02, 11, 0.476, 0.367, 0.604,
03, 11, 0.475, 0.367, 0.601,
04, 11, 0.473, 0.367, 0.598,
05, 11, 0.471, 0.367, 0.595,
06, 11, 0.470, 0.367, 0.592,
07, 11, 0.468, 0.367, 0.589,
08, 11, 0.467, 0.366, 0.586,
09, 11, 0.465, 0.366, 0.583,
10, 11, 0.464, 0.366, 0.580,
11, 11, 0.462, 0.366, 0.577,
12, 11, 0.461, 0.366, 0.574,
13, 11, 0.459, 0.366, 0.571,
14, 11, 0.458, 0.366, 0.568,
15, 11, 0.456, 0.366, 0.565,
16, 11, 0.455, 0.366, 0.562,
17, 11, 0.454, 0.366, 0.559,
18, 11, 0.452, 0.365, 0.556,
19, 11, 0.451, 0.365, 0.553,
20, 11, 0.450, 0.365, 0.550,
21, 11, 0.448, 0.365, 0.547,
22, 11, 0.447, 0.365, 0.544,
23, 11, 0.446, 0.365, 0.542,
24, 11, 0.445, 0.365, 0.539,
25, 11, 0.443, 0.365, 0.536,
26, 11, 0.442, 0.365, 0.533,
27, 11, 0.441, 0.365, 0.531,
28, 11, 0.440, 0.365, 0.528,
29, 11, 0.439, 0.365, 0.526,
30, 11, 0.438, 0.365, 0.523,
01, 12, 0.437, 0.365, 0.521,
02, 12, 0.436, 0.365, 0.519,
03, 12, 0.435, 0.365, 0.517,
04, 12, 0.434, 0.365, 0.515,
05, 12, 0.434, 0.365, 0.513,
06, 12, 0.433, 0.365, 0.511,
07, 12, 0.432, 0.365, 0.509,
08, 12, 0.431, 0.365, 0.507,
09, 12, 0.431, 0.365, 0.505,
10, 12, 0.430, 0.365, 0.504,
11, 12, 0.430, 0.365, 0.502,
12, 12, 0.429, 0.365, 0.501,
13, 12, 0.429, 0.365, 0.500,
14, 12, 0.429, 0.365, 0.498,
15, 12, 0.428, 0.365, 0.497,
16, 12, 0.428, 0.365, 0.496,
17, 12, 0.428, 0.365, 0.496,
18, 12, 0.428, 0.365, 0.495,
19, 12, 0.428, 0.365, 0.494,
20, 12, 0.428, 0.365, 0.494,
21, 12, 0.428, 0.365, 0.494,
22, 12, 0.428, 0.365, 0.493,
23, 12, 0.429, 0.365, 0.493,
24, 12, 0.429, 0.366, 0.493,
25, 12, 0.429, 0.366, 0.493,
26, 12, 0.430, 0.366, 0.494,
27, 12, 0.430, 0.366, 0.494,
28, 12, 0.431, 0.366, 0.495,
29, 12, 0.431, 0.366, 0.495,
30, 12, 0.432, 0.366, 0.496,
31, 12, 0.433, 0.366, 0.497), ncol = 5, byrow = TRUE)
dimnames(RESULT) <- list(1:366, c("day", "month", "grad_Tmean", "grad_Tmin", "grad_Tmax"))
return(RESULT)
}
##Altitudinal_gradient_functions_______________________________________________________________
##unique_gradient_for_precipitation
GradP_Valery2010 <- 0.00041 ### value from Valery PhD thesis page 126
##Format_______________________________________________________________________________________
HypsoData <- as.double(HypsoData)
ZInputs <- as.double(ZInputs)
HypsoData <- as.double(HypsoData)
ZInputs <- as.double(ZInputs)
##ElevationLayers_Creation_____________________________________________________________________
ZLayers <- as.double(rep(NA, NLayers))
if (!identical(HypsoData, as.double(rep(NA, 101)))) {
nmoy <- 100 %/% NLayers
nreste <- 100 %% NLayers
ncont <- 0
for (iLayer in 1:NLayers) {
if (nreste > 0) {
nn <- nmoy + 1
nreste <- nreste - 1
} else {
nn <- nmoy
}
if (nn == 1) {
ZLayers[iLayer] <- HypsoData[ncont + 1]
}
if (nn == 2) {
ZLayers[iLayer] <- 0.5 * (HypsoData[ncont + 1] + HypsoData[ncont + 2])
}
if (nn > 2) {
ZLayers[iLayer] <- HypsoData[ncont + nn / 2]
}
ncont <- ncont + nn
ZLayers <- as.double(rep(NA, NLayers))
if (!identical(HypsoData, as.double(rep(NA, 101)))) {
nmoy <- 100 %/% NLayers
nreste <- 100 %% NLayers
ncont <- 0
for (iLayer in 1:NLayers) {
if (nreste > 0) {
nn <- nmoy + 1
nreste <- nreste - 1
} else {
nn <- nmoy
}
if (nn == 1) {
ZLayers[iLayer] <- HypsoData[ncont + 1]
}
if (nn == 2) {
ZLayers[iLayer] <- 0.5 * (HypsoData[ncont + 1] + HypsoData[ncont + 2])
}
if (nn > 2) {
ZLayers[iLayer] <- HypsoData[ncont + nn / 2 + 1]
}
ncont <- ncont + nn
}
}
##Precipitation_extrapolation__________________________________________________________________
##Initialisation
if (identical(ZInputs, HypsoData[51]) & NLayers == 1) {
LayerPrecip <- list(as.double(Precip))
} else {
##Elevation_gradients_for_daily_mean_precipitation
GradP <- GradP_Valery2010() ### single value
TabGradP <- rep(GradP, length(Precip))
##Extrapolation
##Thresold_of_inputs_median_elevation
Zthreshold <- 4000
LayerPrecip_mat <- sapply(1:NLayers, function(iLayer) {
##If_layer_elevation_smaller_than_Zthreshold
if (ZLayers[iLayer] <= Zthreshold) {
prcp <- as.double(Precip * exp(TabGradP * (ZLayers[iLayer] - ZInputs)))
##If_layer_elevation_greater_than_Zthreshold
if (identical(ZInputs, HypsoData[51]) & NLayers == 1) {
LayerPrecip <- list(as.double(Precip))
} else {
##Elevation_gradients_for_daily_mean_precipitation
GradP <- GradP_Valery2010 ### single value
TabGradP <- rep(GradP, length(Precip))
##Extrapolation
##Thresold_of_inputs_median_elevation
Zthreshold <- 4000
LayerPrecip_mat <- sapply(1:NLayers, function(iLayer) {
##If_layer_elevation_smaller_than_Zthreshold
if (ZLayers[iLayer] <= Zthreshold) {
prcp <- as.double(Precip * exp(TabGradP * (ZLayers[iLayer] - ZInputs)))
##If_layer_elevation_greater_than_Zthreshold
} else {
##If_inputs_median_elevation_smaller_than_Zthreshold
if (ZInputs <= Zthreshold) {
prcp <- as.double(Precip * exp(TabGradP * (Zthreshold - ZInputs)))
##If_inputs_median_elevation_greater_then_Zthreshold
} else {
##If_inputs_median_elevation_smaller_than_Zthreshold
if (ZInputs <= Zthreshold) {
prcp <- as.double(Precip * exp(TabGradP * (Zthreshold - ZInputs)))
##If_inputs_median_elevation_greater_then_Zthreshold
} else {
prcp <- as.double(Precip)
}
prcp <- as.double(Precip)
}
return(prcp)
})
if (PrecipScale) {
LayerPrecip_mat <- LayerPrecip_mat / rowMeans(LayerPrecip_mat) * Precip
LayerPrecip_mat[is.nan(LayerPrecip_mat)] <- 0
}
LayerPrecip <- as.list(as.data.frame(LayerPrecip_mat))
return(prcp)
})
if (PrecipScale) {
LayerPrecip_mat <- LayerPrecip_mat / rowMeans(LayerPrecip_mat) * Precip
LayerPrecip_mat[is.nan(LayerPrecip_mat)] <- 0
}
LayerPrecip <- as.list(as.data.frame(LayerPrecip_mat))
}
##Temperature_extrapolation____________________________________________________________________
##Initialisation
LayerTempMean <- list()
LayerTempMin <- list()
LayerTempMax <- list()
if (identical(ZInputs, HypsoData[51]) & NLayers == 1) {
LayerTempMean[[1]] <- as.double(TempMean)
LayerTempMean <- list()
LayerTempMin <- list()
LayerTempMax <- list()
if (identical(ZInputs, HypsoData[51]) & NLayers == 1) {
LayerTempMean[[1]] <- as.double(TempMean)
if (!is.null(TempMin) & !is.null(TempMax)) {
LayerTempMin[[1]] <- as.double(TempMin)
LayerTempMax[[1]] <- as.double(TempMax)
}
} else {
##Elevation_gradients_for_daily_mean_min_and_max_temperature
GradT <- .GradT_Valery2010
iday <- match(format(DatesR, format = "%d%m"),
sprintf("%02i%02i", GradT[, "day"], GradT[, "month"]))
TabGradT <- GradT[iday, c("grad_Tmean", "grad_Tmin", "grad_Tmax")]
##Extrapolation
##On_each_elevation_layer...
for (iLayer in 1:NLayers) {
LayerTempMean[[iLayer]] <- as.double(TempMean + (ZInputs - ZLayers[iLayer]) * abs(TabGradT[, "grad_Tmean"]) / 100)
if (!is.null(TempMin) & !is.null(TempMax)) {
LayerTempMin[[1]] <- as.double(TempMin)
LayerTempMax[[1]] <- as.double(TempMax)
}
} else {
##Elevation_gradients_for_daily_mean_min_and_max_temperature
GradT <- as.data.frame(GradT_Valery2010())
iday <- match(format(DatesR, format = "%d%m"),
sprintf("%02i%02i", GradT[, "day"], GradT[, "month"]))
TabGradT <-
GradT[iday, c("grad_Tmean", "grad_Tmin", "grad_Tmax")]
##Extrapolation
##On_each_elevation_layer...
for (iLayer in 1:NLayers) {
LayerTempMean[[iLayer]] <- as.double(TempMean + (ZInputs - ZLayers[iLayer]) * abs(TabGradT[, "grad_Tmean"]) / 100)
if (!is.null(TempMin) & !is.null(TempMax)) {
LayerTempMin[[iLayer]] <- as.double(TempMin + (ZInputs - ZLayers[iLayer]) * abs(TabGradT[, "grad_Tmin"]) / 100)
LayerTempMax[[iLayer]] <- as.double(TempMax + (ZInputs - ZLayers[iLayer]) * abs(TabGradT[, "grad_Tmax"]) / 100)
}
LayerTempMin[[iLayer]] <- as.double(TempMin + (ZInputs - ZLayers[iLayer]) * abs(TabGradT[, "grad_Tmin"]) / 100)
LayerTempMax[[iLayer]] <- as.double(TempMax + (ZInputs - ZLayers[iLayer]) * abs(TabGradT[, "grad_Tmax"]) / 100)
}
}
}
##Solid_Fraction_for_each_elevation_layer______________________________________________________
LayerFracSolidPrecip <- list()
##Thresold_of_inputs_median_elevation
Zthreshold <- 1500
##Option
Option <- "USACE"
if (!is.na(ZInputs)) {
if (ZInputs < Zthreshold & !is.null(TempMin) & !is.null(TempMax)) {
Option <- "Hydrotel"
}
LayerFracSolidPrecip <- list()
##Thresold_of_inputs_median_elevation
Zthreshold <- 1500
##Option
Option <- "USACE"
if (!is.na(ZInputs)) {
if (ZInputs < Zthreshold & !is.null(TempMin) & !is.null(TempMax)) {
Option <- "Hydrotel"
}
##On_each_elevation_layer...
for (iLayer in 1:NLayers) {
}
##Turcotte_formula_from_Hydrotel
if (Option == "Hydrotel") {
TempMin <- LayerTempMin[[iLayer]]
TempMax <- LayerTempMax[[iLayer]]
SolidFraction <- 1 - TempMax / (TempMax - TempMin)
SolidFraction[TempMin >= 0] <- 0
SolidFraction[TempMax <= 0] <- 1
}
##USACE_formula
if (Option == "USACE") {
USACE_Tmin <- -1.0
USACE_Tmax <- 3.0
TempMean <- LayerTempMean[[iLayer]]
SolidFraction <- 1 - (TempMean - USACE_Tmin) / (USACE_Tmax - USACE_Tmin)
SolidFraction[TempMean > USACE_Tmax] <- 0
SolidFraction[TempMean < USACE_Tmin] <- 1
}
LayerFracSolidPrecip[[iLayer]] <- as.double(SolidFraction)
##On_each_elevation_layer...
for (iLayer in 1:NLayers) {
##Turcotte_formula_from_Hydrotel
if (Option == "Hydrotel") {
TempMin <- LayerTempMin[[iLayer]]
TempMax <- LayerTempMax[[iLayer]]
SolidFraction <- 1 - TempMax / (TempMax - TempMin)
SolidFraction[TempMin >= 0] <- 0
SolidFraction[TempMax <= 0] <- 1
}
namesLayer <- sprintf("L%i", seq_along(LayerPrecip))
names(LayerPrecip) <- namesLayer
names(LayerTempMean) <- namesLayer
if (!is.null(TempMin) & !is.null(TempMax)) {
names(LayerTempMin) <- namesLayer
names(LayerTempMax) <- namesLayer
}
names(LayerFracSolidPrecip) <- namesLayer
##USACE_formula
if (Option == "USACE") {
USACE_Tmin <- -1.0
USACE_Tmax <- 3.0
TempMean <- LayerTempMean[[iLayer]]
SolidFraction <- 1 - (TempMean - USACE_Tmin) / (USACE_Tmax - USACE_Tmin)
SolidFraction[TempMean > USACE_Tmax] <- 0
SolidFraction[TempMean < USACE_Tmin] <- 1
}
LayerFracSolidPrecip[[iLayer]] <- as.double(SolidFraction)
}
namesLayer <- sprintf("L%i", seq_along(LayerPrecip))
names(LayerPrecip) <- namesLayer
names(LayerTempMean) <- namesLayer
if (!is.null(TempMin) & !is.null(TempMax)) {
names(LayerTempMin) <- namesLayer
names(LayerTempMax) <- namesLayer
}
names(LayerFracSolidPrecip) <- namesLayer
##END__________________________________________________________________________________________
return(list(LayerPrecip = LayerPrecip,
LayerTempMean = LayerTempMean,
LayerTempMin = LayerTempMin,
LayerTempMax = LayerTempMax,
LayerFracSolidPrecip = LayerFracSolidPrecip,
ZLayers = ZLayers))
return(list(LayerPrecip = LayerPrecip,
LayerTempMean = LayerTempMean,
LayerTempMin = LayerTempMin,
LayerTempMax = LayerTempMax,
LayerFracSolidPrecip = LayerFracSolidPrecip,
ZLayers = ZLayers))
}