diff --git a/DESCRIPTION b/DESCRIPTION index de8de46d95f4bdabec98a1f591d6fd7bfdf49df7..37c96600a7a0cc47e96e3f1fbb7cb4b108537e5f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Package: airGR Type: Package Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling -Version: 1.6.3.53 -Date: 2020-11-11 +Version: 1.6.3.54 +Date: 2020-11-12 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"), diff --git a/NEWS.md b/NEWS.md index 18b21a79694189c1e0c27ea559e42d9f01ff4196..64c53d10a858ec6e7b145c061ccd29670eab0ce7 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,7 +4,7 @@ -### 1.6.3.53 Release Notes (2020-11-11) +### 1.6.3.54 Release Notes (2020-11-12) #### New features diff --git a/R/RunModel_GR1A.R b/R/RunModel_GR1A.R index f502410d9a55cab38c1e5682d3163e0b30661955..8e973fcc59309636f2025dd59c932dc288c45c62 100644 --- a/R/RunModel_GR1A.R +++ b/R/RunModel_GR1A.R @@ -51,7 +51,7 @@ RunModel_GR1A <- function(InputsModel, RunOptions, Param) { ## Call_fortan - RESULTS <- .Fortran("frun_gr1a", PACKAGE = "airGR", + RESULTS <- .Fortran("frun_gr1a", PACKAGE = "airGR", ## inputs LInputs = LInputSeries, ### length of input and output series InputsPrecip = InputsModel$Precip[IndPeriod1], ### input series of total precipitation [mm/y] @@ -63,7 +63,7 @@ RunModel_GR1A <- function(InputsModel, RunOptions, Param) { NOutputs = as.integer(length(IndOutputs)), ### number of output series IndOutputs = IndOutputs, ### indices of output series ## outputs - Outputs = matrix(as.double(-999.999), nrow = LInputSeries,ncol=length(IndOutputs)), ### output series [mm] + Outputs = matrix(as.double(-999.999), nrow = LInputSeries, ncol=length(IndOutputs)), ### output series [mm] StateEnd = rep(as.double(-999.999), length(RunOptions$IniStates)) ### state variables at the end of the model run ) RESULTS$Outputs[ round(RESULTS$Outputs , 3) == (-999.999)] <- NA @@ -78,20 +78,20 @@ RunModel_GR1A <- 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 SateEnd only if (!ExportDatesR & ExportStateEnd) { - OutputsModel <- c(lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]), + OutputsModel <- c(lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]), list(RESULTS$StateEnd)) names(OutputsModel) <- c(FortranOutputs[IndOutputs], "StateEnd") } ## DatesR and OutputsModel and SateEnd if ((ExportDatesR & ExportStateEnd) | "all" %in% RunOptions$Outputs_Sim) { - OutputsModel <- c(list(InputsModel$DatesR[RunOptions$IndPeriod_Run]), - lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]), + OutputsModel <- c(list(InputsModel$DatesR[RunOptions$IndPeriod_Run]), + lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]), list(RESULTS$StateEnd)) names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs], "StateEnd") } diff --git a/R/RunModel_GR2M.R b/R/RunModel_GR2M.R index c0955435c1145889c442c09e3a5894234c8b8110..cc889d1882e3b06dd28aeb5a5acb5a6b313a93b1 100644 --- a/R/RunModel_GR2M.R +++ b/R/RunModel_GR2M.R @@ -1,4 +1,4 @@ -RunModel_GR2M <- function(InputsModel,RunOptions,Param) { +RunModel_GR2M <- function(InputsModel, RunOptions, Param) { ## Initialization of variables @@ -7,13 +7,13 @@ RunModel_GR2M <- function(InputsModel,RunOptions,Param) { ## Arguments_check - if (inherits(InputsModel,"InputsModel") == FALSE) { stop("'InputsModel' must be of class 'InputsModel'") } - if (inherits(InputsModel,"monthly" ) == FALSE) { stop("'InputsModel' must be of class 'monthly' ") } - if (inherits(InputsModel,"GR" ) == FALSE) { stop("'InputsModel' must be of class 'GR' ") } - if (inherits(RunOptions,"RunOptions" ) == FALSE) { stop("'RunOptions' must be of class 'RunOptions' ") } - if (inherits(RunOptions,"GR" ) == FALSE) { stop("'RunOptions' must be of class 'GR' ") } + if (inherits(InputsModel, "InputsModel") == FALSE) { stop("'InputsModel' must be of class 'InputsModel'") } + if (inherits(InputsModel, "monthly" ) == FALSE) { stop("'InputsModel' must be of class 'monthly' ") } + if (inherits(InputsModel, "GR" ) == FALSE) { stop("'InputsModel' must be of class 'GR' ") } + if (inherits(RunOptions, "RunOptions" ) == FALSE) { stop("'RunOptions' must be of class 'RunOptions' ") } + if (inherits(RunOptions, "GR" ) == FALSE) { stop("'RunOptions' must be of class 'GR' ") } if (!is.vector(Param) | !is.numeric(Param)) { stop("'Param' must be a numeric vector") } - if (sum(!is.na(Param)) != NParam) { stop(paste("'Param' must be a vector of length ",NParam," and contain no NA",sep = "")) } + if (sum(!is.na(Param)) != NParam) { stop(paste("'Param' must be a vector of length ", NParam, " and contain no NA", sep = "")) } Param <- as.double(Param); Param_X1X2_threshold <- 1e-2 @@ -27,8 +27,8 @@ RunModel_GR2M <- function(InputsModel,RunOptions,Param) { } ## Input_data_preparation - if (identical(RunOptions$IndPeriod_WarmUp,as.integer(0))) { RunOptions$IndPeriod_WarmUp <- NULL; } - IndPeriod1 <- c(RunOptions$IndPeriod_WarmUp,RunOptions$IndPeriod_Run); + if (identical(RunOptions$IndPeriod_WarmUp, as.integer(0))) { RunOptions$IndPeriod_WarmUp <- NULL; } + IndPeriod1 <- c(RunOptions$IndPeriod_WarmUp, RunOptions$IndPeriod_Run); LInputSeries <- as.integer(length(IndPeriod1)) if ("all" %in% RunOptions$Outputs_Sim) { IndOutputs <- as.integer(1:length(FortranOutputs)); } else { IndOutputs <- which(FortranOutputs %in% RunOptions$Outputs_Sim); } @@ -45,7 +45,7 @@ RunModel_GR2M <- function(InputsModel,RunOptions,Param) { } ## Call_fortan - RESULTS <- .Fortran("frun_gr2M",PACKAGE = "airGR", + RESULTS <- .Fortran("frun_gr2M", PACKAGE = "airGR", ## inputs LInputs = LInputSeries, ### length of input and output series InputsPrecip = InputsModel$Precip[IndPeriod1], ### input series of total precipitation [mm/month] @@ -57,16 +57,16 @@ RunModel_GR2M <- function(InputsModel,RunOptions,Param) { NOutputs = as.integer(length(IndOutputs)), ### number of output series IndOutputs = IndOutputs, ### indices of output series ## outputs - Outputs = matrix(as.double(-999.999),nrow = LInputSeries,ncol = length(IndOutputs)), ### output series [mm] - StateEnd = rep(as.double(-999.999),length(RunOptions$IniStates)) ### state variables at the end of the model run + Outputs = matrix(as.double(-999.999), nrow = LInputSeries, ncol = length(IndOutputs)), ### output series [mm] + StateEnd = rep(as.double(-999.999), length(RunOptions$IniStates)) ### state variables at the end of the model run ) - RESULTS$Outputs [round(RESULTS$Outputs ,3) == (-999.999)] <- NA; - RESULTS$StateEnd[round(RESULTS$StateEnd,3) == (-999.999)] <- NA; + RESULTS$Outputs [round(RESULTS$Outputs , 3) == (-999.999)] <- NA; + RESULTS$StateEnd[round(RESULTS$StateEnd, 3) == (-999.999)] <- NA; if (ExportStateEnd) { - RESULTS$StateEnd <- CreateIniStates(FUN_MOD = RunModel_GR2M, InputsModel = InputsModel, - ProdStore = RESULTS$StateEnd[1L], RoutStore = RESULTS$StateEnd[2L], ExpStore = NULL, - UH1 = NULL, UH2 = NULL, - GCemaNeigeLayers = NULL, eTGCemaNeigeLayers = NULL, + RESULTS$StateEnd <- CreateIniStates(FUN_MOD = RunModel_GR2M, InputsModel = InputsModel, + ProdStore = RESULTS$StateEnd[1L], RoutStore = RESULTS$StateEnd[2L], ExpStore = NULL, + UH1 = NULL, UH2 = NULL, + GCemaNeigeLayers = NULL, eTGCemaNeigeLayers = NULL, verbose = FALSE) } @@ -74,28 +74,28 @@ RunModel_GR2M <- function(InputsModel,RunOptions,Param) { ## Output_data_preparation ## OutputsModel_only if (ExportDatesR == FALSE & ExportStateEnd == FALSE) { - OutputsModel <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]); + OutputsModel <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]); names(OutputsModel) <- FortranOutputs[IndOutputs]; } ## DatesR_and_OutputsModel_only if (ExportDatesR == TRUE & ExportStateEnd == FALSE) { - OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]), - lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]) ); - names(OutputsModel) <- c("DatesR",FortranOutputs[IndOutputs]); } + OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]), + lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]) ); + names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs]); } ## OutputsModel_and_SateEnd_only if (ExportDatesR == FALSE & ExportStateEnd == TRUE) { - OutputsModel <- c( lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]), + OutputsModel <- c( lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]), list(RESULTS$StateEnd) ); - names(OutputsModel) <- c(FortranOutputs[IndOutputs],"StateEnd"); } + names(OutputsModel) <- c(FortranOutputs[IndOutputs], "StateEnd"); } ## DatesR_and_OutputsModel_and_SateEnd if ((ExportDatesR==TRUE & ExportStateEnd==TRUE) | "all" %in% RunOptions$Outputs_Sim) { - OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]), - lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]), + OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]), + lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]), list(RESULTS$StateEnd) ); - names(OutputsModel) <- c("DatesR",FortranOutputs[IndOutputs],"StateEnd"); } + names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs], "StateEnd"); } ## End rm(RESULTS); - class(OutputsModel) <- c("OutputsModel","monthly","GR"); + class(OutputsModel) <- c("OutputsModel", "monthly", "GR"); return(OutputsModel); } diff --git a/R/RunModel_GR4H.R b/R/RunModel_GR4H.R index 3f11612a2e5f5bd594c670306f7b0af1c86ae84b..7f2f8c078146b1463b439847e56035a3f5efffd3 100644 --- a/R/RunModel_GR4H.R +++ b/R/RunModel_GR4H.R @@ -1,4 +1,4 @@ -RunModel_GR4H <- function(InputsModel,RunOptions,Param) { +RunModel_GR4H <- function(InputsModel, RunOptions, Param) { ## Initialization of variables @@ -7,13 +7,13 @@ RunModel_GR4H <- function(InputsModel,RunOptions,Param) { ## Arguments_check - if (inherits(InputsModel,"InputsModel") == FALSE) { stop("'InputsModel' must be of class 'InputsModel'") } - if (inherits(InputsModel,"hourly" ) == FALSE) { stop("'InputsModel' must be of class 'hourly' ") } - if (inherits(InputsModel,"GR" ) == FALSE) { stop("'InputsModel' must be of class 'GR' ") } - if (inherits(RunOptions,"RunOptions" ) == FALSE) { stop("'RunOptions' must be of class 'RunOptions' ") } - if (inherits(RunOptions,"GR" ) == FALSE) { stop("'RunOptions' must be of class 'GR' ") } + if (inherits(InputsModel, "InputsModel") == FALSE) { stop("'InputsModel' must be of class 'InputsModel'") } + if (inherits(InputsModel, "hourly" ) == FALSE) { stop("'InputsModel' must be of class 'hourly' ") } + if (inherits(InputsModel, "GR" ) == FALSE) { stop("'InputsModel' must be of class 'GR' ") } + if (inherits(RunOptions, "RunOptions" ) == FALSE) { stop("'RunOptions' must be of class 'RunOptions' ") } + if (inherits(RunOptions, "GR" ) == FALSE) { stop("'RunOptions' must be of class 'GR' ") } if (!is.vector(Param) | !is.numeric(Param)) { stop("'Param' must be a numeric vector") } - if (sum(!is.na(Param)) != NParam) { stop(paste("'Param' must be a vector of length ",NParam," and contain no NA",sep = "")) } + if (sum(!is.na(Param)) != NParam) { stop(paste("'Param' must be a vector of length ", NParam, " and contain no NA", sep = "")) } Param <- as.double(Param); Param_X1X3_threshold <- 1e-2 @@ -32,8 +32,8 @@ RunModel_GR4H <- function(InputsModel,RunOptions,Param) { } ## Input_data_preparation - if (identical(RunOptions$IndPeriod_WarmUp,as.integer(0))) { RunOptions$IndPeriod_WarmUp <- NULL; } - IndPeriod1 <- c(RunOptions$IndPeriod_WarmUp,RunOptions$IndPeriod_Run); + if (identical(RunOptions$IndPeriod_WarmUp, as.integer(0))) { RunOptions$IndPeriod_WarmUp <- NULL; } + IndPeriod1 <- c(RunOptions$IndPeriod_WarmUp, RunOptions$IndPeriod_Run); LInputSeries <- as.integer(length(IndPeriod1)) if ("all" %in% RunOptions$Outputs_Sim) { IndOutputs <- as.integer(1:length(FortranOutputs)); } else { IndOutputs <- which(FortranOutputs %in% RunOptions$Outputs_Sim); } @@ -50,7 +50,7 @@ RunModel_GR4H <- function(InputsModel,RunOptions,Param) { } ## Call_fortan - RESULTS <- .Fortran("frun_gr4h",PACKAGE = "airGR", + RESULTS <- .Fortran("frun_gr4h", PACKAGE = "airGR", ## inputs LInputs = LInputSeries, ### length of input and output series InputsPrecip = InputsModel$Precip[IndPeriod1], ### input series of total precipitation [mm/h] @@ -62,45 +62,45 @@ RunModel_GR4H <- function(InputsModel,RunOptions,Param) { NOutputs = as.integer(length(IndOutputs)), ### number of output series IndOutputs = IndOutputs, ### indices of output series ## outputs - Outputs = matrix(as.double(-999.999),nrow = LInputSeries,ncol = length(IndOutputs)), ### output series [mm] - StateEnd = rep(as.double(-999.999),length(RunOptions$IniStates)) ### state variables at the end of the model run + Outputs = matrix(as.double(-999.999), nrow = LInputSeries, ncol = length(IndOutputs)), ### output series [mm] + StateEnd = rep(as.double(-999.999), length(RunOptions$IniStates)) ### state variables at the end of the model run ) - RESULTS$Outputs[ round(RESULTS$Outputs ,3) == (-999.999)] <- NA; - RESULTS$StateEnd[round(RESULTS$StateEnd,3) == (-999.999)] <- NA; + RESULTS$Outputs[ round(RESULTS$Outputs , 3) == (-999.999)] <- NA; + RESULTS$StateEnd[round(RESULTS$StateEnd, 3) == (-999.999)] <- NA; if (ExportStateEnd) { RESULTS$StateEnd[-3L] <- ifelse(RESULTS$StateEnd[-3L] < 0, 0, RESULTS$StateEnd[-3L]) ### remove negative values except for the ExpStore location - RESULTS$StateEnd <- CreateIniStates(FUN_MOD = RunModel_GR4H, InputsModel = InputsModel, - ProdStore = RESULTS$StateEnd[1L], RoutStore = RESULTS$StateEnd[2L], ExpStore = NULL, - UH1 = RESULTS$StateEnd[(1:(20*24))+7], UH2 = RESULTS$StateEnd[(1:(40*24))+(7+20*24)], - GCemaNeigeLayers = NULL, eTGCemaNeigeLayers = NULL, + RESULTS$StateEnd <- CreateIniStates(FUN_MOD = RunModel_GR4H, InputsModel = InputsModel, + ProdStore = RESULTS$StateEnd[1L], RoutStore = RESULTS$StateEnd[2L], ExpStore = NULL, + UH1 = RESULTS$StateEnd[(1:(20*24))+7], UH2 = RESULTS$StateEnd[(1:(40*24))+(7+20*24)], + GCemaNeigeLayers = NULL, eTGCemaNeigeLayers = NULL, verbose = FALSE) } ## Output_data_preparation ## OutputsModel_only if (ExportDatesR == FALSE & ExportStateEnd == FALSE) { - OutputsModel <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]); + OutputsModel <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]); names(OutputsModel) <- FortranOutputs[IndOutputs]; } ## DatesR_and_OutputsModel_only if (ExportDatesR == TRUE & ExportStateEnd == FALSE) { - OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]), - lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]) ); - names(OutputsModel) <- c("DatesR",FortranOutputs[IndOutputs]); } + OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]), + lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]) ); + names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs]); } ## OutputsModel_and_SateEnd_only if (ExportDatesR == FALSE & ExportStateEnd == TRUE) { - OutputsModel <- c( lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]), + OutputsModel <- c( lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]), list(RESULTS$StateEnd) ); - names(OutputsModel) <- c(FortranOutputs[IndOutputs],"StateEnd"); } + names(OutputsModel) <- c(FortranOutputs[IndOutputs], "StateEnd"); } ## DatesR_and_OutputsModel_and_SateEnd if ((ExportDatesR == TRUE & ExportStateEnd == TRUE) | "all" %in% RunOptions$Outputs_Sim) { - OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]), - lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]), + OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]), + lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]), list(RESULTS$StateEnd) ); - names(OutputsModel) <- c("DatesR",FortranOutputs[IndOutputs],"StateEnd"); } + names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs], "StateEnd"); } ## End rm(RESULTS); - class(OutputsModel) <- c("OutputsModel","hourly","GR"); + class(OutputsModel) <- c("OutputsModel", "hourly", "GR"); return(OutputsModel); } diff --git a/R/RunModel_GR4J.R b/R/RunModel_GR4J.R index ce7fc48900ecec9e5d465a5493562398754539c2..8d8c5da6f7cd209ff0693d855f7eafe8c50f857f 100644 --- a/R/RunModel_GR4J.R +++ b/R/RunModel_GR4J.R @@ -1,4 +1,4 @@ -RunModel_GR4J <- function(InputsModel,RunOptions,Param) { +RunModel_GR4J <- function(InputsModel, RunOptions, Param) { ## Initialization of variables @@ -7,13 +7,13 @@ RunModel_GR4J <- function(InputsModel,RunOptions,Param) { ## Arguments_check - if (inherits(InputsModel,"InputsModel") == FALSE) { stop("'InputsModel' must be of class 'InputsModel'") } - if (inherits(InputsModel,"daily" ) == FALSE) { stop("'InputsModel' must be of class 'daily' ") } - if (inherits(InputsModel,"GR" ) == FALSE) { stop("'InputsModel' must be of class 'GR' ") } - if (inherits(RunOptions,"RunOptions" ) == FALSE) { stop("'RunOptions' must be of class 'RunOptions' ") } - if (inherits(RunOptions,"GR" ) == FALSE) { stop("'RunOptions' must be of class 'GR' ") } + if (inherits(InputsModel, "InputsModel") == FALSE) { stop("'InputsModel' must be of class 'InputsModel'") } + if (inherits(InputsModel, "daily" ) == FALSE) { stop("'InputsModel' must be of class 'daily' ") } + if (inherits(InputsModel, "GR" ) == FALSE) { stop("'InputsModel' must be of class 'GR' ") } + if (inherits(RunOptions, "RunOptions" ) == FALSE) { stop("'RunOptions' must be of class 'RunOptions' ") } + if (inherits(RunOptions, "GR" ) == FALSE) { stop("'RunOptions' must be of class 'GR' ") } if (!is.vector(Param) | !is.numeric(Param)) { stop("'Param' must be a numeric vector") } - if (sum(!is.na(Param)) != NParam) { stop(paste("'Param' must be a vector of length ",NParam," and contain no NA",sep = "")) } + if (sum(!is.na(Param)) != NParam) { stop(paste("'Param' must be a vector of length ", NParam, " and contain no NA", sep = "")) } Param <- as.double(Param); Param_X1X3_threshold <- 1e-2 @@ -32,8 +32,8 @@ RunModel_GR4J <- function(InputsModel,RunOptions,Param) { } ## Input_data_preparation - if (identical(RunOptions$IndPeriod_WarmUp,as.integer(0))) { RunOptions$IndPeriod_WarmUp <- NULL; } - IndPeriod1 <- c(RunOptions$IndPeriod_WarmUp,RunOptions$IndPeriod_Run); + if (identical(RunOptions$IndPeriod_WarmUp, as.integer(0))) { RunOptions$IndPeriod_WarmUp <- NULL; } + IndPeriod1 <- c(RunOptions$IndPeriod_WarmUp, RunOptions$IndPeriod_Run); LInputSeries <- as.integer(length(IndPeriod1)) if ("all" %in% RunOptions$Outputs_Sim) { IndOutputs <- as.integer(1:length(FortranOutputs)); } else { IndOutputs <- which(FortranOutputs %in% RunOptions$Outputs_Sim); } @@ -49,7 +49,7 @@ RunModel_GR4J <- function(InputsModel,RunOptions,Param) { } ## Call_fortan - RESULTS <- .Fortran("frun_gr4j",PACKAGE = "airGR", + RESULTS <- .Fortran("frun_gr4j", PACKAGE = "airGR", ## inputs LInputs = LInputSeries, ### length of input and output series InputsPrecip = InputsModel$Precip[IndPeriod1], ### input series of total precipitation [mm/d] @@ -61,45 +61,45 @@ RunModel_GR4J <- function(InputsModel,RunOptions,Param) { NOutputs = as.integer(length(IndOutputs)), ### number of output series IndOutputs = IndOutputs, ### indices of output series ## outputs - Outputs = matrix(as.double(-999.999),nrow = LInputSeries,ncol = length(IndOutputs)), ### output series [mm] - StateEnd = rep(as.double(-999.999),length(RunOptions$IniStates)) ### state variables at the end of the model run + Outputs = matrix(as.double(-999.999), nrow = LInputSeries, ncol = length(IndOutputs)), ### output series [mm] + StateEnd = rep(as.double(-999.999), length(RunOptions$IniStates)) ### state variables at the end of the model run ) - RESULTS$Outputs[ round(RESULTS$Outputs ,3) == (-999.999)] <- NA; - RESULTS$StateEnd[round(RESULTS$StateEnd,3) == (-999.999)] <- NA; + RESULTS$Outputs[ round(RESULTS$Outputs , 3) == (-999.999)] <- NA; + RESULTS$StateEnd[round(RESULTS$StateEnd, 3) == (-999.999)] <- NA; if (ExportStateEnd) { RESULTS$StateEnd[-3L] <- ifelse(RESULTS$StateEnd[-3L] < 0, 0, RESULTS$StateEnd[-3L]) ### remove negative values except for the ExpStore location - RESULTS$StateEnd <- CreateIniStates(FUN_MOD = RunModel_GR4J, InputsModel = InputsModel, - ProdStore = RESULTS$StateEnd[1L], RoutStore = RESULTS$StateEnd[2L], ExpStore = NULL, - UH1 = RESULTS$StateEnd[(1:20)+7], UH2 = RESULTS$StateEnd[(1:40)+(7+20)], - GCemaNeigeLayers = NULL, eTGCemaNeigeLayers = NULL, + RESULTS$StateEnd <- CreateIniStates(FUN_MOD = RunModel_GR4J, InputsModel = InputsModel, + ProdStore = RESULTS$StateEnd[1L], RoutStore = RESULTS$StateEnd[2L], ExpStore = NULL, + UH1 = RESULTS$StateEnd[(1:20)+7], UH2 = RESULTS$StateEnd[(1:40)+(7+20)], + GCemaNeigeLayers = NULL, eTGCemaNeigeLayers = NULL, verbose = FALSE) } ## Output_data_preparation ## OutputsModel_only if (ExportDatesR == FALSE & ExportStateEnd == FALSE) { - OutputsModel <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]); + OutputsModel <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]); names(OutputsModel) <- FortranOutputs[IndOutputs]; } ## DatesR_and_OutputsModel_only if (ExportDatesR == TRUE & ExportStateEnd == FALSE) { - OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]), - lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]) ); - names(OutputsModel) <- c("DatesR",FortranOutputs[IndOutputs]); } + OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]), + lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]) ); + names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs]); } ## OutputsModel_and_StateEnd_only if (ExportDatesR == FALSE & ExportStateEnd == TRUE) { - OutputsModel <- c( lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]), + OutputsModel <- c( lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]), list(RESULTS$StateEnd) ); - names(OutputsModel) <- c(FortranOutputs[IndOutputs],"StateEnd"); } + names(OutputsModel) <- c(FortranOutputs[IndOutputs], "StateEnd"); } ## DatesR_and_OutputsModel_and_StateEnd if ((ExportDatesR == TRUE & ExportStateEnd == TRUE) | "all" %in% RunOptions$Outputs_Sim) { - OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]), - lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]), + OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]), + lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]), list(RESULTS$StateEnd) ); - names(OutputsModel) <- c("DatesR",FortranOutputs[IndOutputs],"StateEnd"); } + names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs], "StateEnd"); } ## End rm(RESULTS); - class(OutputsModel) <- c("OutputsModel","daily","GR"); + class(OutputsModel) <- c("OutputsModel", "daily", "GR"); return(OutputsModel); } diff --git a/R/RunModel_GR5H.R b/R/RunModel_GR5H.R index 6d548944ea803bf70911f0379fd44c21b1209c8d..e8295302ee4cbeef0ef2e3588b7410918b07eeec 100644 --- a/R/RunModel_GR5H.R +++ b/R/RunModel_GR5H.R @@ -1,4 +1,4 @@ -RunModel_GR5H <- function(InputsModel,RunOptions,Param) { +RunModel_GR5H <- function(InputsModel, RunOptions, Param) { ## Initialization of variables @@ -13,13 +13,13 @@ RunModel_GR5H <- function(InputsModel,RunOptions,Param) { ## Arguments_check - if (inherits(InputsModel,"InputsModel") == FALSE) { stop("'InputsModel' must be of class 'InputsModel'") } - if (inherits(InputsModel,"hourly" ) == FALSE) { stop("'InputsModel' must be of class 'hourly' ") } - if (inherits(InputsModel,"GR" ) == FALSE) { stop("'InputsModel' must be of class 'GR' ") } - if (inherits(RunOptions,"RunOptions" ) == FALSE) { stop("'RunOptions' must be of class 'RunOptions' ") } - if (inherits(RunOptions,"GR" ) == FALSE) { stop("'RunOptions' must be of class 'GR' ") } + if (inherits(InputsModel, "InputsModel") == FALSE) { stop("'InputsModel' must be of class 'InputsModel'") } + if (inherits(InputsModel, "hourly" ) == FALSE) { stop("'InputsModel' must be of class 'hourly' ") } + if (inherits(InputsModel, "GR" ) == FALSE) { stop("'InputsModel' must be of class 'GR' ") } + if (inherits(RunOptions, "RunOptions" ) == FALSE) { stop("'RunOptions' must be of class 'RunOptions' ") } + if (inherits(RunOptions, "GR" ) == FALSE) { stop("'RunOptions' must be of class 'GR' ") } if (!is.vector(Param) | !is.numeric(Param)) { stop("'Param' must be a numeric vector") } - if (sum(!is.na(Param)) != NParam) { stop(paste("'Param' must be a vector of length ",NParam," and contain no NA",sep = "")) } + if (sum(!is.na(Param)) != NParam) { stop(paste("'Param' must be a vector of length ", NParam, " and contain no NA", sep = "")) } Param <- as.double(Param); Param_X1X3_threshold <- 1e-2 @@ -38,8 +38,8 @@ RunModel_GR5H <- function(InputsModel,RunOptions,Param) { } ## Input_data_preparation - if (identical(RunOptions$IndPeriod_WarmUp,as.integer(0))) { RunOptions$IndPeriod_WarmUp <- NULL; } - IndPeriod1 <- c(RunOptions$IndPeriod_WarmUp,RunOptions$IndPeriod_Run); + if (identical(RunOptions$IndPeriod_WarmUp, as.integer(0))) { RunOptions$IndPeriod_WarmUp <- NULL; } + IndPeriod1 <- c(RunOptions$IndPeriod_WarmUp, RunOptions$IndPeriod_Run); LInputSeries <- as.integer(length(IndPeriod1)) if ("all" %in% RunOptions$Outputs_Sim) { IndOutputs <- as.integer(1:length(FortranOutputs)); } else { IndOutputs <- which(FortranOutputs %in% RunOptions$Outputs_Sim); } @@ -59,7 +59,7 @@ RunModel_GR5H <- function(InputsModel,RunOptions,Param) { } ## Call_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] @@ -72,46 +72,46 @@ RunModel_GR5H <- function(InputsModel,RunOptions,Param) { NOutputs = as.integer(length(IndOutputs)), ### number of output series IndOutputs = IndOutputs, ### indices of output series ## outputs - Outputs = matrix(as.double(-999.999),nrow = LInputSeries,ncol = length(IndOutputs)), ### output series [mm or mm/h] - StateEnd = rep(as.double(-999.999),length(RunOptions$IniStates)) ### state variables at the end of the model run + Outputs = matrix(as.double(-999.999), nrow = LInputSeries, ncol = length(IndOutputs)), ### output series [mm or mm/h] + StateEnd = rep(as.double(-999.999), length(RunOptions$IniStates)) ### state variables at the end of the model run ) - RESULTS$Outputs[ round(RESULTS$Outputs ,3) == (-999.999)] <- NA; - RESULTS$StateEnd[round(RESULTS$StateEnd,3) == (-999.999)] <- NA; + RESULTS$Outputs[ round(RESULTS$Outputs , 3) == (-999.999)] <- NA; + RESULTS$StateEnd[round(RESULTS$StateEnd, 3) == (-999.999)] <- NA; if (ExportStateEnd) { RESULTS$StateEnd[-3L] <- ifelse(RESULTS$StateEnd[-3L] < 0, 0, RESULTS$StateEnd[-3L]) ### remove negative values except for the ExpStore location - RESULTS$StateEnd <- CreateIniStates(FUN_MOD = RunModel_GR5H, InputsModel = InputsModel, - ProdStore = RESULTS$StateEnd[1L], RoutStore = RESULTS$StateEnd[2L], ExpStore = NULL, - IntStore = RESULTS$StateEnd[4L], - UH1 = NULL, UH2 = RESULTS$StateEnd[(1:(40*24))+(7+20*24)], - GCemaNeigeLayers = NULL, eTGCemaNeigeLayers = NULL, + RESULTS$StateEnd <- CreateIniStates(FUN_MOD = RunModel_GR5H, InputsModel = InputsModel, + ProdStore = RESULTS$StateEnd[1L], RoutStore = RESULTS$StateEnd[2L], ExpStore = NULL, + IntStore = RESULTS$StateEnd[4L], + UH1 = NULL, UH2 = RESULTS$StateEnd[(1:(40*24))+(7+20*24)], + GCemaNeigeLayers = NULL, eTGCemaNeigeLayers = NULL, verbose = FALSE) } ## Output_data_preparation ## OutputsModel_only if (ExportDatesR == FALSE & ExportStateEnd == FALSE) { - OutputsModel <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]); + OutputsModel <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]); names(OutputsModel) <- FortranOutputs[IndOutputs]; } ## DatesR_and_OutputsModel_only if (ExportDatesR == TRUE & ExportStateEnd == FALSE) { - OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]), - lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]) ); - names(OutputsModel) <- c("DatesR",FortranOutputs[IndOutputs]); } + OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]), + lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]) ); + names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs]); } ## OutputsModel_and_StateEnd_only if (ExportDatesR == FALSE & ExportStateEnd == TRUE) { - OutputsModel <- c( lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]), + OutputsModel <- c( lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]), list(RESULTS$StateEnd) ); - names(OutputsModel) <- c(FortranOutputs[IndOutputs],"StateEnd"); } + names(OutputsModel) <- c(FortranOutputs[IndOutputs], "StateEnd"); } ## DatesR_and_OutputsModel_and_StateEnd if ((ExportDatesR == TRUE & ExportStateEnd == TRUE) | "all" %in% RunOptions$Outputs_Sim) { - OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]), - lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]), + OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]), + lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]), list(RESULTS$StateEnd) ); - names(OutputsModel) <- c("DatesR",FortranOutputs[IndOutputs],"StateEnd"); } + names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs], "StateEnd"); } ## End rm(RESULTS); - class(OutputsModel) <- c("OutputsModel","hourly","GR"); + class(OutputsModel) <- c("OutputsModel", "hourly", "GR"); if (IsIntStore) { class(OutputsModel) <- c(class(OutputsModel), "interception") } diff --git a/R/RunModel_GR5J.R b/R/RunModel_GR5J.R index a67b07d77f648d28f7d69c26e3e38a1efd88fac6..ba94d13fb090f258f917d1b5fa87ee18e7c15cd4 100644 --- a/R/RunModel_GR5J.R +++ b/R/RunModel_GR5J.R @@ -1,4 +1,4 @@ -RunModel_GR5J <- function(InputsModel,RunOptions,Param) { +RunModel_GR5J <- function(InputsModel, RunOptions, Param) { ## Initialization of variables @@ -7,13 +7,13 @@ RunModel_GR5J <- function(InputsModel,RunOptions,Param) { ## Arguments_check - if (inherits(InputsModel,"InputsModel") == FALSE) { stop("'InputsModel' must be of class 'InputsModel'") } - if (inherits(InputsModel,"daily" ) == FALSE) { stop("'InputsModel' must be of class 'daily' ") } - if (inherits(InputsModel,"GR" ) == FALSE) { stop("'InputsModel' must be of class 'GR' ") } - if (inherits(RunOptions,"RunOptions" ) == FALSE) { stop("'RunOptions' must be of class 'RunOptions' ") } - if (inherits(RunOptions,"GR" ) == FALSE) { stop("'RunOptions' must be of class 'GR' ") } + if (inherits(InputsModel, "InputsModel") == FALSE) { stop("'InputsModel' must be of class 'InputsModel'") } + if (inherits(InputsModel, "daily" ) == FALSE) { stop("'InputsModel' must be of class 'daily' ") } + if (inherits(InputsModel, "GR" ) == FALSE) { stop("'InputsModel' must be of class 'GR' ") } + if (inherits(RunOptions, "RunOptions" ) == FALSE) { stop("'RunOptions' must be of class 'RunOptions' ") } + if (inherits(RunOptions, "GR" ) == FALSE) { stop("'RunOptions' must be of class 'GR' ") } if (!is.vector(Param) | !is.numeric(Param)) { stop("'Param' must be a numeric vector") } - if (sum(!is.na(Param)) != NParam) { stop(paste("'Param' must be a vector of length ",NParam," and contain no NA",sep = "")) } + if (sum(!is.na(Param)) != NParam) { stop(paste("'Param' must be a vector of length ", NParam, " and contain no NA", sep = "")) } Param <- as.double(Param); Param_X1X3_threshold <- 1e-2 @@ -32,8 +32,8 @@ RunModel_GR5J <- function(InputsModel,RunOptions,Param) { } ## Input_data_preparation - if (identical(RunOptions$IndPeriod_WarmUp,as.integer(0))) { RunOptions$IndPeriod_WarmUp <- NULL; } - IndPeriod1 <- c(RunOptions$IndPeriod_WarmUp,RunOptions$IndPeriod_Run); + if (identical(RunOptions$IndPeriod_WarmUp, as.integer(0))) { RunOptions$IndPeriod_WarmUp <- NULL; } + IndPeriod1 <- c(RunOptions$IndPeriod_WarmUp, RunOptions$IndPeriod_Run); LInputSeries <- as.integer(length(IndPeriod1)) if ("all" %in% RunOptions$Outputs_Sim) { IndOutputs <- as.integer(1:length(FortranOutputs)); } else { IndOutputs <- which(FortranOutputs %in% RunOptions$Outputs_Sim); } @@ -50,7 +50,7 @@ RunModel_GR5J <- function(InputsModel,RunOptions,Param) { } ## Call_fortan - RESULTS <- .Fortran("frun_gr5j",PACKAGE = "airGR", + RESULTS <- .Fortran("frun_gr5j", PACKAGE = "airGR", ## inputs LInputs = LInputSeries, ### length of input and output series InputsPrecip = InputsModel$Precip[IndPeriod1], ### input series of total precipitation [mm/d] @@ -62,45 +62,45 @@ RunModel_GR5J <- function(InputsModel,RunOptions,Param) { NOutputs = as.integer(length(IndOutputs)), ### number of output series IndOutputs = IndOutputs, ### indices of output series ## outputs - Outputs = matrix(as.double(-999.999),nrow = LInputSeries,ncol = length(IndOutputs)), ### output series [mm] - StateEnd = rep(as.double(-999.999),length(RunOptions$IniStates)) ### state variables at the end of the model run + Outputs = matrix(as.double(-999.999), nrow = LInputSeries, ncol = length(IndOutputs)), ### output series [mm] + StateEnd = rep(as.double(-999.999), length(RunOptions$IniStates)) ### state variables at the end of the model run ) - RESULTS$Outputs[ round(RESULTS$Outputs ,3) == (-999.999)] <- NA; - RESULTS$StateEnd[round(RESULTS$StateEnd,3) == (-999.999)] <- NA; + RESULTS$Outputs[ round(RESULTS$Outputs , 3) == (-999.999)] <- NA; + RESULTS$StateEnd[round(RESULTS$StateEnd, 3) == (-999.999)] <- NA; if (ExportStateEnd) { RESULTS$StateEnd[-3L] <- ifelse(RESULTS$StateEnd[-3L] < 0, 0, RESULTS$StateEnd[-3L]) ### remove negative values except for the ExpStore location - RESULTS$StateEnd <- CreateIniStates(FUN_MOD = RunModel_GR5J, InputsModel = InputsModel, - ProdStore = RESULTS$StateEnd[1L], RoutStore = RESULTS$StateEnd[2L], ExpStore = NULL, - UH1 = NULL, UH2 = RESULTS$StateEnd[(1:40)+(7+20)], - GCemaNeigeLayers = NULL, eTGCemaNeigeLayers = NULL, + RESULTS$StateEnd <- CreateIniStates(FUN_MOD = RunModel_GR5J, InputsModel = InputsModel, + ProdStore = RESULTS$StateEnd[1L], RoutStore = RESULTS$StateEnd[2L], ExpStore = NULL, + UH1 = NULL, UH2 = RESULTS$StateEnd[(1:40)+(7+20)], + GCemaNeigeLayers = NULL, eTGCemaNeigeLayers = NULL, verbose = FALSE) } ## Output_data_preparation ## OutputsModel_only if (ExportDatesR == FALSE & ExportStateEnd == FALSE) { - OutputsModel <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]); + OutputsModel <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]); names(OutputsModel) <- FortranOutputs[IndOutputs]; } ## DatesR_and_OutputsModel_only if (ExportDatesR == TRUE & ExportStateEnd == FALSE) { - OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]), - lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]) ); - names(OutputsModel) <- c("DatesR",FortranOutputs[IndOutputs]); } + OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]), + lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]) ); + names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs]); } ## OutputsModel_and_SateEnd_only if (ExportDatesR == FALSE & ExportStateEnd == TRUE) { - OutputsModel <- c( lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]), + OutputsModel <- c( lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]), list(RESULTS$StateEnd) ); - names(OutputsModel) <- c(FortranOutputs[IndOutputs],"StateEnd"); } + names(OutputsModel) <- c(FortranOutputs[IndOutputs], "StateEnd"); } ## DatesR_and_OutputsModel_and_SateEnd if ((ExportDatesR == TRUE & ExportStateEnd == TRUE) | "all" %in% RunOptions$Outputs_Sim) { - OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]), - lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]), + OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]), + lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]), list(RESULTS$StateEnd) ); - names(OutputsModel) <- c("DatesR",FortranOutputs[IndOutputs],"StateEnd"); } + names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs], "StateEnd"); } ## End rm(RESULTS); - class(OutputsModel) <- c("OutputsModel","daily","GR"); + class(OutputsModel) <- c("OutputsModel", "daily", "GR"); return(OutputsModel); } diff --git a/R/RunModel_GR6J.R b/R/RunModel_GR6J.R index b69f5c2cf14e5c61551bca992aded29b60d8d443..2a43efc17e18d7c49738fce41a17c42090b0ae68 100644 --- a/R/RunModel_GR6J.R +++ b/R/RunModel_GR6J.R @@ -1,4 +1,4 @@ -RunModel_GR6J <- function(InputsModel,RunOptions,Param) { +RunModel_GR6J <- function(InputsModel, RunOptions, Param) { ## Initialization of variables @@ -7,13 +7,13 @@ RunModel_GR6J <- function(InputsModel,RunOptions,Param) { ## Arguments_check - if (inherits(InputsModel,"InputsModel") == FALSE) { stop("'InputsModel' must be of class 'InputsModel'") } - if (inherits(InputsModel,"daily" ) == FALSE) { stop("'InputsModel' must be of class 'daily' ") } - if (inherits(InputsModel,"GR" ) == FALSE) { stop("'InputsModel' must be of class 'GR' ") } - if (inherits(RunOptions,"RunOptions" ) == FALSE) { stop("'RunOptions' must be of class 'RunOptions' ") } - if (inherits(RunOptions,"GR" ) == FALSE) { stop("'RunOptions' must be of class 'GR' ") } + if (inherits(InputsModel, "InputsModel") == FALSE) { stop("'InputsModel' must be of class 'InputsModel'") } + if (inherits(InputsModel, "daily" ) == FALSE) { stop("'InputsModel' must be of class 'daily' ") } + if (inherits(InputsModel, "GR" ) == FALSE) { stop("'InputsModel' must be of class 'GR' ") } + if (inherits(RunOptions, "RunOptions" ) == FALSE) { stop("'RunOptions' must be of class 'RunOptions' ") } + if (inherits(RunOptions, "GR" ) == FALSE) { stop("'RunOptions' must be of class 'GR' ") } if (!is.vector(Param) | !is.numeric(Param)) { stop("'Param' must be a numeric vector") } - if (sum(!is.na(Param)) != NParam) { stop(paste("'Param' must be a vector of length ",NParam," and contain no NA",sep = "")) } + if (sum(!is.na(Param)) != NParam) { stop(paste("'Param' must be a vector of length ", NParam, " and contain no NA", sep = "")) } Param <- as.double(Param); Param_X1X3X6_threshold <- 1e-2 @@ -36,8 +36,8 @@ RunModel_GR6J <- function(InputsModel,RunOptions,Param) { } ## Input_data_preparation - if (identical(RunOptions$IndPeriod_WarmUp,as.integer(0))) { RunOptions$IndPeriod_WarmUp <- NULL; } - IndPeriod1 <- c(RunOptions$IndPeriod_WarmUp,RunOptions$IndPeriod_Run); + if (identical(RunOptions$IndPeriod_WarmUp, as.integer(0))) { RunOptions$IndPeriod_WarmUp <- NULL; } + IndPeriod1 <- c(RunOptions$IndPeriod_WarmUp, RunOptions$IndPeriod_Run); LInputSeries <- as.integer(length(IndPeriod1)) if ("all" %in% RunOptions$Outputs_Sim) { IndOutputs <- as.integer(1:length(FortranOutputs)); } else { IndOutputs <- which(FortranOutputs %in% RunOptions$Outputs_Sim); } @@ -55,7 +55,7 @@ RunModel_GR6J <- function(InputsModel,RunOptions,Param) { } ## Call_fortan - RESULTS <- .Fortran("frun_gr6j",PACKAGE = "airGR", + RESULTS <- .Fortran("frun_gr6j", PACKAGE = "airGR", ## inputs LInputs = LInputSeries, ### length of input and output series InputsPrecip = InputsModel$Precip[IndPeriod1], ### input series of total precipitation [mm/d] @@ -67,45 +67,45 @@ RunModel_GR6J <- function(InputsModel,RunOptions,Param) { NOutputs = as.integer(length(IndOutputs)), ### number of output series IndOutputs = IndOutputs, ### indices of output series ## outputs - Outputs = matrix(as.double(-999.999),nrow = LInputSeries,ncol = length(IndOutputs)), ### output series [mm] - StateEnd = rep(as.double(-999.999),length(RunOptions$IniStates)) ### state variables at the end of the model run + Outputs = matrix(as.double(-999.999), nrow = LInputSeries, ncol = length(IndOutputs)), ### output series [mm] + StateEnd = rep(as.double(-999.999), length(RunOptions$IniStates)) ### state variables at the end of the model run ) - RESULTS$Outputs[ round(RESULTS$Outputs ,3) == (-999.999)] <- NA; - RESULTS$StateEnd[round(RESULTS$StateEnd,3) == (-999.999)] <- NA; + RESULTS$Outputs[ round(RESULTS$Outputs , 3) == (-999.999)] <- NA; + RESULTS$StateEnd[round(RESULTS$StateEnd, 3) == (-999.999)] <- NA; if (ExportStateEnd) { RESULTS$StateEnd[-3L] <- ifelse(RESULTS$StateEnd[-3L] < 0, 0, RESULTS$StateEnd[-3L]) ### remove negative values except for the ExpStore location - RESULTS$StateEnd <- CreateIniStates(FUN_MOD = RunModel_GR6J, InputsModel = InputsModel, - ProdStore = RESULTS$StateEnd[1L], RoutStore = RESULTS$StateEnd[2L], ExpStore = RESULTS$StateEnd[3L], - UH1 = RESULTS$StateEnd[(1:20)+7], UH2 = RESULTS$StateEnd[(1:40)+(7+20)], - GCemaNeigeLayers = NULL, eTGCemaNeigeLayers = NULL, + RESULTS$StateEnd <- CreateIniStates(FUN_MOD = RunModel_GR6J, InputsModel = InputsModel, + ProdStore = RESULTS$StateEnd[1L], RoutStore = RESULTS$StateEnd[2L], ExpStore = RESULTS$StateEnd[3L], + UH1 = RESULTS$StateEnd[(1:20)+7], UH2 = RESULTS$StateEnd[(1:40)+(7+20)], + GCemaNeigeLayers = NULL, eTGCemaNeigeLayers = NULL, verbose = FALSE) } ## Output_data_preparation ## OutputsModel_only if (ExportDatesR == FALSE & ExportStateEnd == FALSE) { - OutputsModel <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]); + OutputsModel <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]); names(OutputsModel) <- FortranOutputs[IndOutputs]; } ## DatesR_and_OutputsModel_only if (ExportDatesR == TRUE & ExportStateEnd == FALSE) { - OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]), - lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]) ); - names(OutputsModel) <- c("DatesR",FortranOutputs[IndOutputs]); } + OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]), + lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]) ); + names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs]); } ## OutputsModel_and_SateEnd_only if (ExportDatesR == FALSE & ExportStateEnd == TRUE) { - OutputsModel <- c( lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]), + OutputsModel <- c( lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]), list(RESULTS$StateEnd) ); - names(OutputsModel) <- c(FortranOutputs[IndOutputs],"StateEnd"); } + names(OutputsModel) <- c(FortranOutputs[IndOutputs], "StateEnd"); } ## DatesR_and_OutputsModel_and_SateEnd if ((ExportDatesR == TRUE & ExportStateEnd == TRUE) | "all" %in% RunOptions$Outputs_Sim) { - OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]), - lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]), + OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]), + lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]), list(RESULTS$StateEnd) ); - names(OutputsModel) <- c("DatesR",FortranOutputs[IndOutputs],"StateEnd"); } + names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs], "StateEnd"); } ## End rm(RESULTS); - class(OutputsModel) <- c("OutputsModel","daily","GR"); + class(OutputsModel) <- c("OutputsModel", "daily", "GR"); return(OutputsModel); }