Commit 55c5df86 authored by Delaigue Olivier's avatar Delaigue Olivier
Browse files

Merge branch 'dev' into 'master'

CRAN v1.6.10.4

See merge request !29
parents e01ed232 083e9fdf
Pipeline #19783 passed with stages
in 15 minutes and 32 seconds
......@@ -9,6 +9,7 @@ default:
- echo "setwd(\"$(pwd)\")" > .Rprofile
- PATH=~/R/sources/R-${R_VERSION}/bin:$PATH
- rename "s/${R_VERSION}.airGR/airGR/" *.tar.gz
- R -e 'chooseCRANmirror(graphics = FALSE, ind = 1); pkg <- "caRamel"; pkgInst <- installed.packages()[, "Package"]; pkgMiss <- setdiff(pkg, pkgInst); if (length(pkgMiss) > 0) install.packages(pkgMiss)'
.update_packages:
stage: update_packages
......
......@@ -3,28 +3,6 @@
# The format of this file is: 5 lines of comments followed by one line by
# ignored variable : [Topic]<SPACE>[Variable].
# Example for ignoring OutputsModel variable produced by example("RunModel_GR2M"): RunModel_GR2M OutputsModel
RunModel_GR1A BasinObs
RunModel_GR1A ConvertFun
RunModel_GR1A NewTabSeries
RunModel_GR1A NewTimeFormat
RunModel_GR1A OutputsModel
RunModel_GR1A TabSeries
RunModel_GR1A TimeFormat
RunModel_GR1A YearFirstMonth
RunModel_GR2M BasinObs
RunModel_GR2M ConvertFun
RunModel_GR2M NewTabSeries
RunModel_GR2M NewTimeFormat
RunModel_GR2M OutputsModel
RunModel_GR2M RunOptions
RunModel_GR1A OutputsModel
Calibration_Michel CalibOptions
Calibration CalibOptions
CreateCalibOptions CalibOptions
# New version of the SeriesAggreg function
RunModel_GR2M TabSeries
RunModel_GR2M TimeFormat
SeriesAggreg BasinInfo
SeriesAggreg BasinObs
SeriesAggreg NewTabSeries
Package: airGR
Type: Package
Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling
Version: 1.6.9.27
Date: 2021-01-18
Version: 1.6.10.4
Date: 2021-01-29
Authors@R: c(
person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")),
person("Olivier", "Delaigue", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-7668-8468"), email = "airGR@inrae.fr"),
......@@ -28,7 +28,8 @@ Imports:
utils
Suggests:
knitr, rmarkdown,
coda, DEoptim, dplyr, FME, ggmcmc, hydroPSO, imputeTS, Rmalschains,
caRamel, coda, DEoptim, dplyr, FME, ggmcmc, hydroPSO, imputeTS, 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), a snow accumulation and melt model (CemaNeige) and the associated functions for their calibration and evaluation. Use help(airGR) for package description and references.
License: GPL-2
......
......@@ -2,6 +2,30 @@
### 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 `POSIXlt` dates into character in `RunModel_GR1A()` example and in `SeriesAggreg()` tests in order to avoid bad subsetting on time series due to mixing UTC and local time on macOS flavors. ([#94](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/94))
____________________________________________________________________________________
### 1.6.9.27 Release Notes (2021-01-18)
#### New features
......
......@@ -219,10 +219,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) {
......
......@@ -21,7 +21,7 @@ CreateCalibOptions <- function(FUN_MOD,
if (!is.logical(IsSD) | length(IsSD) != 1L) {
stop("'IsSD' must be a logical of length 1")
}
##check_FUN_MOD
## check FUN_MOD
BOOL <- FALSE
if (identical(FUN_MOD, RunModel_GR4H)) {
......@@ -87,7 +87,7 @@ CreateCalibOptions <- function(FUN_MOD,
return(NULL)
}
##check_FUN_CALIB
## check FUN_CALIB
BOOL <- FALSE
if (identical(FUN_CALIB, Calibration_Michel)) {
......@@ -100,9 +100,9 @@ CreateCalibOptions <- function(FUN_MOD,
}
##check_FUN_TRANSFO
## check FUN_TRANSFO
if (is.null(FUN_TRANSFO)) {
##_set_FUN1
## set FUN1
if (identical(FUN_MOD, RunModel_GR4H) |
identical(FUN_MOD, RunModel_CemaNeigeGR4H)) {
FUN_GR <- TransfoParam_GR4H
......@@ -140,17 +140,17 @@ CreateCalibOptions <- function(FUN_MOD,
stop("'FUN_GR' was not found")
return(NULL)
}
##_set_FUN2
## set FUN2
if (IsHyst) {
FUN_SNOW <- TransfoParam_CemaNeigeHyst
} else {
FUN_SNOW <- TransfoParam_CemaNeige
}
##_set_FUN_LAG
## set FUN_LAG
if (IsSD) {
FUN_LAG <- TransfoParam_Lag
}
##_set_FUN_TRANSFO
## set FUN_TRANSFO
if (sum(ObjectClass %in% c("GR4H", "GR5H", "GR4J", "GR5J", "GR6J", "GR2M", "GR1A", "CemaNeige")) > 0) {
if (!IsSD) {
FUN_TRANSFO <- FUN_GR
......@@ -179,7 +179,7 @@ CreateCalibOptions <- function(FUN_MOD,
}
ParamOut <- NA * ParamIn
NParam <- ncol(ParamIn)
ParamOut[, 1:(NParam - 4) ] <- FUN_GR(ParamIn[, 1:(NParam - 4) ], Direction)
ParamOut[, 1:(NParam - 4) ] <- FUN_GR(ParamIn[, 1:(NParam - 4)], Direction)
ParamOut[, (NParam - 3):NParam] <- FUN_SNOW(ParamIn[, (NParam - 3):NParam], Direction)
if (!Bool) {
ParamOut <- ParamOut[1, ]
......@@ -198,7 +198,7 @@ CreateCalibOptions <- function(FUN_MOD,
if (NParam <= 3) {
ParamOut[, 1:(NParam - 2)] <- FUN_GR(cbind(ParamIn[, 1:(NParam - 2)]), Direction)
} else {
ParamOut[, 1:(NParam - 2)] <- FUN_GR( ParamIn[, 1:(NParam - 2)], Direction)
ParamOut[, 1:(NParam - 2)] <- FUN_GR(ParamIn[, 1:(NParam - 2)], Direction)
}
ParamOut[, (NParam - 1):NParam] <- FUN_SNOW(ParamIn[, (NParam - 1):NParam], Direction)
if (!Bool) {
......@@ -215,9 +215,9 @@ CreateCalibOptions <- function(FUN_MOD,
}
ParamOut <- NA * ParamIn
NParam <- ncol(ParamIn)
ParamOut[, 2:(NParam - 4) ] <- FUN_GR( ParamIn[, 2:(NParam - 4) ], Direction)
ParamOut[, (NParam - 3):NParam] <- FUN_SNOW( ParamIn[, (NParam - 3):NParam], Direction)
ParamOut[, 1 ] <- FUN_LAG(as.matrix(ParamIn[, 1 ]), Direction)
ParamOut[, 2:(NParam - 4) ] <- FUN_GR(ParamIn[, 2:(NParam - 4)], Direction)
ParamOut[, (NParam - 3):NParam] <- FUN_SNOW(ParamIn[, (NParam - 3):NParam], Direction)
ParamOut[, 1 ] <- FUN_LAG(as.matrix(ParamIn[, 1]), Direction)
if (!Bool) {
ParamOut <- ParamOut[1, ]
}
......@@ -235,9 +235,9 @@ CreateCalibOptions <- function(FUN_MOD,
if (NParam <= 3) {
ParamOut[, 2:(NParam - 2)] <- FUN_GR(cbind(ParamIn[, 2:(NParam - 2)]), Direction)
} else {
ParamOut[, 2:(NParam - 2)] <- FUN_GR( ParamIn[, 2:(NParam - 2)], Direction)
ParamOut[, 2:(NParam - 2)] <- FUN_GR(ParamIn[, 2:(NParam - 2)], Direction)
}
ParamOut[, (NParam - 1):NParam] <- FUN_SNOW( ParamIn[, (NParam - 1):NParam], Direction)
ParamOut[, (NParam - 1):NParam] <- FUN_SNOW(ParamIn[, (NParam - 1):NParam], Direction)
ParamOut[, 1 ] <- FUN_LAG(as.matrix(ParamIn[, 1]), Direction)
if (!Bool) {
ParamOut <- ParamOut[1, ]
......@@ -252,7 +252,7 @@ CreateCalibOptions <- function(FUN_MOD,
return(NULL)
}
##NParam
## NParam
if ("GR4H" %in% ObjectClass) {
NParam <- 4
}
......@@ -299,7 +299,7 @@ CreateCalibOptions <- function(FUN_MOD,
NParam <- NParam + 1
}
##check_FixedParam
## check FixedParam
if (is.null(FixedParam)) {
FixedParam <- rep(NA, NParam)
} else {
......@@ -317,10 +317,10 @@ CreateCalibOptions <- function(FUN_MOD,
}
}
##check_SearchRanges
## check SearchRanges
if (is.null(SearchRanges)) {
ParamT <- matrix(c(rep(-9.99, NParam), rep(+9.99, NParam)),
ncol = NParam, byrow = TRUE)
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 {
......@@ -341,7 +341,7 @@ CreateCalibOptions <- function(FUN_MOD,
}
}
##check_StartParamList_and_StartParamDistrib__default_values
## 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,
......@@ -351,12 +351,12 @@ CreateCalibOptions <- function(FUN_MOD,
if (("GR5H" %in% ObjectClass) & ("interception" %in% ObjectClass)) {
ParamT <- matrix(c(+3.46, -1.25, +4.04, -9.53, -9.34,
+3.74, -0.41, +4.78, -8.94, -3.33,
+4.29, +0.16, +5.39, -7.39, +3.33), ncol=5, byrow = TRUE);
+4.29, +0.16, +5.39, -7.39, +3.33), ncol = 5, byrow = TRUE)
}
if (("GR5H" %in% ObjectClass) & !("interception" %in% ObjectClass)) {
ParamT <- matrix(c(+3.28, -0.39, +4.14, -9.54, -7.49,
+3.62, -0.19, +4.80, -9.00, -6.31,
+4.01, -0.04, +5.43, -7.53, -5.33), ncol=5, byrow = TRUE);
+4.01, -0.04, +5.43, -7.53, -5.33), ncol = 5, byrow = TRUE)
}
if ("GR4J" %in% ObjectClass) {
ParamT <- matrix(c(+5.13, -1.60, +3.03, -9.05,
......@@ -399,12 +399,12 @@ CreateCalibOptions <- function(FUN_MOD,
if (("CemaNeigeGR5H" %in% ObjectClass) & ("interception" %in% ObjectClass)) {
ParamT <- matrix(c(+3.46, -1.25, +4.04, -9.53, -9.34, -9.96, +6.63,
+3.74, -0.41, +4.78, -8.94, -3.33, -9.14, +6.90,
+4.29, +0.16, +5.39, -7.39, +3.33, +4.10, +7.21), ncol = 7, byrow = TRUE);
+4.29, +0.16, +5.39, -7.39, +3.33, +4.10, +7.21), ncol = 7, byrow = TRUE)
}
if (("CemaNeigeGR5H" %in% ObjectClass) & !("interception" %in% ObjectClass)) {
ParamT <- matrix(c(+3.28, -0.39, +4.14, -9.54, -7.49, -9.96, +6.63,
+3.62, -0.19, +4.80, -9.00, -6.31, -9.14, +6.90,
+4.01, -0.04, +5.43, -7.53, -5.33, +4.10, +7.21), ncol = 7, byrow = TRUE);
+4.01, -0.04, +5.43, -7.53, -5.33, +4.10, +7.21), ncol = 7, byrow = TRUE)
}
if ("CemaNeigeGR4J" %in% ObjectClass) {
ParamT <- matrix(c(+5.13, -1.60, +3.03, -9.05, -9.96, +6.63,
......@@ -440,7 +440,7 @@ CreateCalibOptions <- function(FUN_MOD,
}
##check_StartParamList_and_StartParamDistrib__format
## check StartParamList and StartParamDistrib format
if ("HBAN" %in% ObjectClass & !is.null(StartParamList)) {
if (!is.matrix(StartParamList)) {
stop("'StartParamList' must be a matrix")
......
This diff is collapsed.
This diff is collapsed.
Imax <- function(InputsModel,
IndPeriod_Run,
Imax <- function(InputsModel,
IndPeriod_Run,
TestedValues = seq(from = 0.1, to = 3, by = 0.1)) {
##_____Arguments_check_____________________________________________________________________
## ---------- check arguments
## InputsModel
if (!inherits(InputsModel, "InputsModel")) {
stop("'InputsModel' must be of class 'InputsModel'")
}
}
if (!inherits(InputsModel, "hourly")) {
stop("'InputsModel' must be of class 'hourly'")
}
##check_IndPeriod_Run
}
## IndPeriod_Run
if (!is.vector(IndPeriod_Run)) {
stop("'IndPeriod_Run' must be a vector of numeric values")
}
......@@ -21,24 +24,28 @@ Imax <- function(InputsModel,
if (!identical(as.integer(IndPeriod_Run), IndPeriod_Run[1]:IndPeriod_Run[length(IndPeriod_Run)])) {
stop("'IndPeriod_Run' must be a continuous sequence of integers")
}
##TestedValues
## TestedValues
if (!(is.numeric(TestedValues))) {
stop("'TestedValues' must be 'numeric'")
}
##aggregate data at the daily time step
TabSeries <- data.frame(DatesR = InputsModel$DatesR[IndPeriod_Run],
Precip = InputsModel$Precip[IndPeriod_Run],
PotEvap = InputsModel$PotEvap[IndPeriod_Run])
daily_data <- SeriesAggreg(TabSeries, Format = "%Y%m%d",
ConvertFun = c("sum", "sum"))
##calculate total interception of daily GR models on the period
## ---------- hourly inputs aggregation
## aggregate data at the daily time step
daily_data <- SeriesAggreg(InputsModel[IndPeriod_Run], Format = "%Y%m%d")
## ---------- calculate interception
## calculate total interception of daily GR models on the period
cum_daily <- sum(pmin(daily_data$Precip, daily_data$PotEvap))
##calculate total interception of the GR5H interception store on the period
if (anyNA(cum_daily)) {
stop("'IndPeriod_Run' must be set to select 24 hours by day")
}
## calculate total interception of the GR5H interception store on the period
## and compute difference with daily values
differences <- array(NA, c(length(TestedValues)))
for (Imax in TestedValues) {
......@@ -52,8 +59,8 @@ Imax <- function(InputsModel,
}
differences[which(Imax == TestedValues)] <- abs(cum_hourly - cum_daily)
}
##return the Imax value that minimises the difference
## return the Imax value that minimises the difference
return(TestedValues[which.min(differences)])
}
......@@ -65,7 +65,7 @@ PE_Oudin <- function(JD, Temp,
LInputs = as.integer(length(Temp))
if (length(FI) == 1) {
FI <- rep(FI, LInputs)
FI <- rep(FI, LInputs)
}
RESULTS <- .Fortran("frun_pe_oudin", PACKAGE = "airGR",
......@@ -96,7 +96,7 @@ PE_Oudin <- function(JD, Temp,
COSOM <- -1
}
if (COSOM > 1) {
COSOM <- 1
COSOM <- 1
}
COSOM2 <- COSOM * COSOM
......
......@@ -70,7 +70,7 @@ PEdaily_Oudin <- function(JD,
COSOM <- -1
}
if (COSOM > 1) {
COSOM <- 1
COSOM <- 1
}
COSOM2 <- COSOM * COSOM
......@@ -94,11 +94,11 @@ PEdaily_Oudin <- function(JD,
if (is.na(Temp[k])) {
PE_Oudin_D[k] <- NA
} else {
if (Temp[k] >= -5.0) {
PE_Oudin_D[k] <- GE * (Temp[k] + 5) / 100 / 28.5
} else {
PE_Oudin_D[k] <- 0
}
if (Temp[k] >= -5.0) {
PE_Oudin_D[k] <- GE * (Temp[k] + 5) / 100 / 28.5
} else {
PE_Oudin_D[k] <- 0
}
}
}
......
......@@ -3,7 +3,7 @@ RunModel <- function(InputsModel, RunOptions, Param, FUN_MOD) {
FUN_MOD <- match.fun(FUN_MOD)
if (inherits(InputsModel, "SD")) {
# LAG Model take one parameter at the beginning of the vector
# Lag model take one parameter at the beginning of the vector
iFirstParamRunOffModel <- 2
} else {
# All parameters
......
......@@ -59,8 +59,8 @@ RunModel_GR2M <- function(InputsModel, RunOptions, Param) {
## Use of IniResLevels
if (!is.null(RunOptions$IniResLevels)) {
RunOptions$IniStates[1] <- RunOptions$IniResLevels[1]*Param[1] ### production store level (mm)
RunOptions$IniStates[2] <- RunOptions$IniResLevels[2]*Param[2] ### routing store level (mm)
RunOptions$IniStates[1] <- RunOptions$IniResLevels[1] * Param[1] ### production store level (mm)
RunOptions$IniStates[2] <- RunOptions$IniResLevels[2] * Param[2] ### routing store level (mm)
}
## Call GR model Fortan
......
......@@ -64,8 +64,8 @@ RunModel_GR4H <- function(InputsModel, RunOptions, Param) {
## Use of IniResLevels
if (!is.null(RunOptions$IniResLevels)) {
RunOptions$IniStates[1] <- RunOptions$IniResLevels[1]*Param[1] ### production store level (mm)
RunOptions$IniStates[2] <- RunOptions$IniResLevels[2]*Param[3] ### routing store level (mm)
RunOptions$IniStates[1] <- RunOptions$IniResLevels[1] * Param[1] ### production store level (mm)
RunOptions$IniStates[2] <- RunOptions$IniResLevels[2] * Param[3] ### routing store level (mm)
}
## Call GR model Fortan
......
......@@ -63,8 +63,8 @@ RunModel_GR4J <- function(InputsModel, RunOptions, Param) {
## Use of IniResLevels
if (!is.null(RunOptions$IniResLevels)) {
RunOptions$IniStates[1] <- RunOptions$IniResLevels[1]*Param[1] ### production store level (mm)
RunOptions$IniStates[2] <- RunOptions$IniResLevels[2]*Param[3] ### routing store level (mm)
RunOptions$IniStates[1] <- RunOptions$IniResLevels[1] * Param[1] ### production store level (mm)
RunOptions$IniStates[2] <- RunOptions$IniResLevels[2] * Param[3] ### routing store level (mm)
}
## Call GR model Fortan
......
RunModel_GR5H <- function(InputsModel, RunOptions, Param) {
## Initialization of variables
NParam <- 5
FortranOutputs <- .FortranOutputs(GR = "GR5H")$GR
......@@ -10,24 +10,24 @@ RunModel_GR5H <- function(InputsModel, RunOptions, Param) {
} else {
Imax <- -99
}
## Arguments check
if (!inherits(InputsModel, "InputsModel")) {
stop("'InputsModel' must be of class 'InputsModel'")
}
}
if (!inherits(InputsModel, "hourly" )) {
stop("'InputsModel' must be of class 'hourly' ")
}
}
if (!inherits(InputsModel, "GR" )) {
stop("'InputsModel' must be of class 'GR' ")
}
}
if (!inherits(RunOptions, "RunOptions" )) {
stop("'RunOptions' must be of class 'RunOptions' ")
}
}
if (!inherits(RunOptions, "GR" )) {
stop("'RunOptions' must be of class 'GR' ")
}
}
if (!is.vector(Param) | !is.numeric(Param)) {
stop("'Param' must be a numeric vector")
}
......@@ -35,7 +35,7 @@ RunModel_GR5H <- function(InputsModel, RunOptions, Param) {
stop(paste("'Param' must be a vector of length ", NParam, " and contain no NA", sep = ""))
}
Param <- as.double(Param)
Param_X1X3_threshold <- 1e-2
Param_X4_threshold <- 0.5
if (Param[1L] < Param_X1X3_threshold) {
......@@ -49,35 +49,36 @@ RunModel_GR5H <- function(InputsModel, RunOptions, Param) {
if (Param[4L] < Param_X4_threshold) {
warning(sprintf("Param[4] (X4: unit hydrograph time constant [h]) < %.2f\n X4 set to %.2f", Param_X4_threshold, Param_X4_threshold))
Param[4L] <- Param_X4_threshold
}
}
## Input data preparation
if (identical(RunOptions$IndPeriod_WarmUp, 0L)) {
RunOptions$IndPeriod_WarmUp <- NULL
}
IndPeriod1 <- c(RunOptions$IndPeriod_WarmUp, RunOptions$IndPeriod_Run)
LInputSeries <- as.integer(length(IndPeriod1))
if ("all" %in% RunOptions$Outputs_Sim) { IndOutputs <- as.integer(1:length(FortranOutputs))
if ("all" %in% RunOptions$Outputs_Sim) {
IndOutputs <- as.integer(1:length(FortranOutputs))
} else {
IndOutputs <- which(FortranOutputs %in% RunOptions$Outputs_Sim)
}
## Output data preparation
IndPeriod2 <- (length(RunOptions$IndPeriod_WarmUp)+1):LInputSeries
ExportDatesR <- "DatesR" %in% RunOptions$Outputs_Sim
ExportStateEnd <- "StateEnd" %in% RunOptions$Outputs_Sim
## Use of IniResLevels
if (!is.null(RunOptions$IniResLevels)) {
RunOptions$IniStates[1] <- RunOptions$IniResLevels[1]*Param[1] ### production store level (mm)
RunOptions$IniStates[2] <- RunOptions$IniResLevels[2]*Param[3] ### routing store level (mm)
RunOptions$IniStates[1] <- RunOptions$IniResLevels[1] * Param[1] ### production store level (mm)
RunOptions$IniStates[2] <- RunOptions$IniResLevels[2] * Param[3] ### routing store level (mm)
if (IsIntStore) {
RunOptions$IniStates[4] <- RunOptions$IniResLevels[4] * Imax ### interception store level (mm)
}
}
## Call GR model Fortan
RESULTS <- .Fortran("frun_gr5h", PACKAGE = "airGR",
RESULTS <- .Fortran("frun_gr5h", PACKAGE = "airGR",
## inputs
LInputs = LInputSeries, ### length of input and output series
InputsPrecip = InputsModel$Precip[IndPeriod1], ### input series of total precipitation [mm/h]
......@@ -97,14 +98,14 @@ RunModel_GR5H <- function(InputsModel, RunOptions, Param) {
RESULTS$StateEnd[round(RESULTS$StateEnd, 3) == -999.999] <- NA
if (ExportStateEnd) {
RESULTS$StateEnd[-3L] <- ifelse(RESULTS$StateEnd[-3L] < 0, 0, RESULTS$StateEnd[-3L]) ### remove negative values except for the ExpStore location
RESULTS$StateEnd <- CreateIniStates(FUN_MOD = RunModel_GR5H, InputsModel = InputsModel,
ProdStore = RESULTS$StateEnd[1L], RoutStore = RESULTS$StateEnd[2L], ExpStore = NULL,
IntStore = RESULTS$StateEnd[4L],
UH1 = NULL, UH2 = RESULTS$StateEnd[(1:(40*24))+(7+20*24)],
GCemaNeigeLayers = NULL, eTGCemaNeigeLayers = NULL,
RESULTS$StateEnd <- CreateIniStates(FUN_MOD = RunModel_GR5H, InputsModel = InputsModel,
ProdStore = RESULTS$StateEnd[1L], RoutStore = RESULTS$StateEnd[2L], ExpStore = NULL,
IntStore = RESULTS$StateEnd[4L],
UH1 = NULL, UH2 = RESULTS$StateEnd[(1:(40*24))+(7+20*24)],
GCemaNeigeLayers = NULL, eTGCemaNeigeLayers = NULL,
verbose = FALSE)
}
## Output data preparation
## OutputsModel only
if (!ExportDatesR & !ExportStateEnd) {
......@@ -113,30 +114,30 @@ RunModel_GR5H <- function(InputsModel, RunOptions, Param) {
}
## DatesR and OutputsModel only
if (ExportDatesR & !ExportStateEnd) {
OutputsModel <- c(list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
OutputsModel <- c(list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]))
names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs])
}
## OutputsModel and StateEnd only
if (!