Commit 728d6643 authored by Delaigue Olivier's avatar Delaigue Olivier
Browse files

v1.3.1.0 NEW: RunModel_CemaNeige can run on hourly time step

Showing with 24 additions and 16 deletions
+24 -16
Package: airGR Package: airGR
Type: Package Type: Package
Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling
Version: 1.3.0.19 Version: 1.3.1.0
Date: 2019-05-21 Date: 2019-05-21
Authors@R: c( Authors@R: c(
person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")), person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")),
......
...@@ -14,7 +14,7 @@ output: ...@@ -14,7 +14,7 @@ output:
### 1.3.0.19 Release Notes (2019-05-21) ### 1.3.1.0 Release Notes (2019-05-21)
#### New features #### New features
......
...@@ -3,7 +3,7 @@ RunModel_CemaNeige <- function(InputsModel, RunOptions, Param) { ...@@ -3,7 +3,7 @@ RunModel_CemaNeige <- function(InputsModel, RunOptions, Param) {
## Initialization of variables ## Initialization of variables
IsHyst <- inherits(RunOptions, "hysteresis") IsHyst <- inherits(RunOptions, "hysteresis")
NParam <- ifelse(test = IsHyst, yes = 4L, no = 2L) NParamCN <- ifelse(test = IsHyst, yes = 4L, no = 2L)
NStates <- 4L NStates <- 4L
FortranOutputsCemaNeige <- .FortranOutputs(GR = NULL, isCN = TRUE)$CN FortranOutputsCemaNeige <- .FortranOutputs(GR = NULL, isCN = TRUE)$CN
...@@ -12,8 +12,8 @@ RunModel_CemaNeige <- function(InputsModel, RunOptions, Param) { ...@@ -12,8 +12,8 @@ RunModel_CemaNeige <- function(InputsModel, RunOptions, Param) {
if (!inherits(InputsModel, "InputsModel")) { if (!inherits(InputsModel, "InputsModel")) {
stop("'InputsModel' must be of class 'InputsModel'") stop("'InputsModel' must be of class 'InputsModel'")
} }
if (!inherits(InputsModel, "daily")) { if (!inherits(InputsModel, "daily") & !inherits(InputsModel, "hourly")) {
stop("'InputsModel' must be of class 'daily'") stop("'InputsModel' must be of class 'daily' or 'hourly'")
} }
if (!inherits(InputsModel, "CemaNeige")) { if (!inherits(InputsModel, "CemaNeige")) {
stop("'InputsModel' must be of class 'CemaNeige'") stop("'InputsModel' must be of class 'CemaNeige'")
...@@ -27,10 +27,18 @@ RunModel_CemaNeige <- function(InputsModel, RunOptions, Param) { ...@@ -27,10 +27,18 @@ RunModel_CemaNeige <- function(InputsModel, RunOptions, Param) {
if (!is.vector(Param) | !is.numeric(Param)) { if (!is.vector(Param) | !is.numeric(Param)) {
stop("'Param' must be a numeric vector") stop("'Param' must be a numeric vector")
} }
if (sum(!is.na(Param)) != NParam) { if (sum(!is.na(Param)) != NParamCN) {
stop(sprintf("'Param' must be a vector of length %i and contain no NA", NParam)) stop(sprintf("'Param' must be a vector of length %i and contain no NA", NParamCN))
} }
if (inherits(InputsModel, "daily")) {
time_step <- "daily"
time_mult <- 1
}
if (inherits(InputsModel, "hourly")) {
time_step <- "hourly"
time_mult <- 24
}
## Input_data_preparation ## Input_data_preparation
if (identical(RunOptions$IndPeriod_WarmUp, 0)) { if (identical(RunOptions$IndPeriod_WarmUp, 0)) {
RunOptions$IndPeriod_WarmUp <- NULL RunOptions$IndPeriod_WarmUp <- NULL
...@@ -67,20 +75,20 @@ RunModel_CemaNeige <- function(InputsModel, RunOptions, Param) { ...@@ -67,20 +75,20 @@ RunModel_CemaNeige <- function(InputsModel, RunOptions, Param) {
for (iLayer in 1:NLayers) { for (iLayer in 1:NLayers) {
if (!IsHyst) { if (!IsHyst) {
StateStartCemaNeige <- RunOptions$IniStates[(7 + 20 + 40) + c(iLayer, iLayer+NLayers)] StateStartCemaNeige <- RunOptions$IniStates[(7 + 20*time_mult + 40*time_mult) + c(iLayer, iLayer+NLayers)]
} else { } else {
StateStartCemaNeige <- RunOptions$IniStates[(7 + 20 + 40) + c(iLayer, iLayer+NLayers, iLayer+2*NLayers, iLayer+3*NLayers)] StateStartCemaNeige <- RunOptions$IniStates[(7 + 20*time_mult + 40*time_mult) + c(iLayer, iLayer+NLayers, iLayer+2*NLayers, iLayer+3*NLayers)]
} }
RESULTS <- .Fortran("frun_CemaNeige", PACKAGE = "airGR", RESULTS <- .Fortran("frun_CemaNeige", PACKAGE = "airGR",
## inputs ## inputs
LInputs = as.integer(length(IndPeriod1)), ### length of input and output series LInputs = as.integer(length(IndPeriod1)), ### length of input and output series
InputsPrecip = InputsModel$LayerPrecip[[iLayer]][IndPeriod1], ### input series of total precipitation [mm/d] InputsPrecip = InputsModel$LayerPrecip[[iLayer]][IndPeriod1], ### input series of total precipitation [mm/time step]
InputsFracSolidPrecip = InputsModel$LayerFracSolidPrecip[[iLayer]][IndPeriod1], ### input series of fraction of solid precipitation [0-1] InputsFracSolidPrecip = InputsModel$LayerFracSolidPrecip[[iLayer]][IndPeriod1], ### input series of fraction of solid precipitation [0-1]
InputsTemp = InputsModel$LayerTemp[[iLayer]][IndPeriod1], ### input series of air mean temperature [degC] InputsTemp = InputsModel$LayerTemp[[iLayer]][IndPeriod1], ### input series of air mean temperature [degC]
MeanAnSolidPrecip = RunOptions$MeanAnSolidPrecip[iLayer], ### value of annual mean solid precip [mm/y] MeanAnSolidPrecip = RunOptions$MeanAnSolidPrecip[iLayer], ### value of annual mean solid precip [mm/y]
NParam = as.integer(NParam), ### number of model parameter NParam = as.integer(NParamCN), ### number of model parameters = 2 or 4
Param = as.double(ParamCemaNeige), ### parameter set Param = as.double(ParamCemaNeige), ### parameter set
NStates = as.integer(NStates), ### number of state variables used for model initialising NStates = as.integer(NStates), ### number of state variables used for model initialisation = 4
StateStart = StateStartCemaNeige, ### state variables used when the model run starts StateStart = StateStartCemaNeige, ### state variables used when the model run starts
IsHyst = as.integer(IsHyst), ### use of hysteresis IsHyst = as.integer(IsHyst), ### use of hysteresis
NOutputs = as.integer(length(IndOutputsCemaNeige)), ### number of output series NOutputs = as.integer(length(IndOutputsCemaNeige)), ### number of output series
...@@ -89,9 +97,9 @@ RunModel_CemaNeige <- function(InputsModel, RunOptions, Param) { ...@@ -89,9 +97,9 @@ RunModel_CemaNeige <- function(InputsModel, RunOptions, Param) {
Outputs = matrix(-999.999, ### output series [mm] Outputs = matrix(-999.999, ### output series [mm]
nrow = length(IndPeriod1), nrow = length(IndPeriod1),
ncol = length(IndOutputsCemaNeige)), ncol = length(IndOutputsCemaNeige)),
StateEnd = rep(-999.999, NStates) ### state variables at the end of the model run (reservoir levels [mm] and HU) StateEnd = rep(-999.999, NStates) ### state variables at the end of the model run
) )
RESULTS$Outputs[round(RESULTS$Outputs , 3) == -999.999] <- NA RESULTS$Outputs[ round(RESULTS$Outputs , 3) == -999.999] <- NA
RESULTS$StateEnd[round(RESULTS$StateEnd, 3) == -999.999] <- NA RESULTS$StateEnd[round(RESULTS$StateEnd, 3) == -999.999] <- NA
...@@ -145,7 +153,7 @@ RunModel_CemaNeige <- function(InputsModel, RunOptions, Param) { ...@@ -145,7 +153,7 @@ RunModel_CemaNeige <- function(InputsModel, RunOptions, Param) {
## End ## End
class(OutputsModel) <- c("OutputsModel", "daily", "CemaNeige") class(OutputsModel) <- c("OutputsModel", time_step, "CemaNeige")
if(IsHyst) { if(IsHyst) {
class(OutputsModel) <- c(class(OutputsModel), "hysteresis") class(OutputsModel) <- c(class(OutputsModel), "hysteresis")
} }
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment