Commit b1db2ae8 authored by Delaigue Olivier's avatar Delaigue Olivier
Browse files

v1.6.3.56 style: add line breaks for blocks of codes between braces in RunModel_GR* functions

Refs #14
parent 82796c60
Pipeline #17583 passed with stages
in 11 minutes and 22 seconds
Package: airGR
Type: Package
Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling
Version: 1.6.3.55
Date: 2020-11-12
Version: 1.6.3.56
Date: 2020-11-16
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"),
......
......@@ -4,7 +4,7 @@
### 1.6.3.55 Release Notes (2020-11-12)
### 1.6.3.56 Release Notes (2020-11-16)
#### New features
......
......@@ -7,13 +7,27 @@ 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 (!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 (inherits(InputsModel, "InputsModel") == FALSE) {
stop("'InputsModel' must be of class 'InputsModel'")
}
if (inherits(InputsModel, "monthly" ) == FALSE) {
stop("'InputsModel' must be of class 'monthly' ")
}
if (inherits(InputsModel, "GR" ) == FALSE) {
stop("'InputsModel' must be of class 'GR' ")
}
if (inherits(RunOptions, "RunOptions" ) == FALSE) {
stop("'RunOptions' must be of class 'RunOptions' ")
}
if (inherits(RunOptions, "GR" ) == FALSE) {
stop("'RunOptions' must be of class 'GR' ")
}
if (!is.vector(Param) | !is.numeric(Param)) {
stop("'Param' must be a numeric vector")
}
if (sum(!is.na(Param)) != NParam) {
stop(paste("'Param' must be a vector of length ", NParam, " and contain no NA", sep = ""))
}
Param <- as.double(Param)
Param_X1X2_threshold <- 1e-2
......@@ -27,11 +41,16 @@ RunModel_GR2M <- function(InputsModel, RunOptions, Param) {
}
## Input_data_preparation
if (identical(RunOptions$IndPeriod_WarmUp, as.integer(0))) { RunOptions$IndPeriod_WarmUp <- NULL }
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) }
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
......@@ -75,23 +94,27 @@ RunModel_GR2M <- function(InputsModel, RunOptions, Param) {
## OutputsModel_only
if (ExportDatesR == FALSE & ExportStateEnd == FALSE) {
OutputsModel <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i])
names(OutputsModel) <- FortranOutputs[IndOutputs] }
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]) }
names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs])
}
## OutputsModel_and_SateEnd_only
if (ExportDatesR == FALSE & ExportStateEnd == TRUE) {
OutputsModel <- c( lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
list(RESULTS$StateEnd) )
names(OutputsModel) <- c(FortranOutputs[IndOutputs], "StateEnd") }
names(OutputsModel) <- c(FortranOutputs[IndOutputs], "StateEnd")
}
## DatesR_and_OutputsModel_and_SateEnd
if ((ExportDatesR==TRUE & ExportStateEnd==TRUE) | "all" %in% RunOptions$Outputs_Sim) {
OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
list(RESULTS$StateEnd) )
names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs], "StateEnd") }
names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs], "StateEnd")
}
## End
rm(RESULTS)
......
......@@ -7,13 +7,27 @@ 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 (!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 (inherits(InputsModel, "InputsModel") == FALSE) {
stop("'InputsModel' must be of class 'InputsModel'")
}
if (inherits(InputsModel, "hourly" ) == FALSE) {
stop("'InputsModel' must be of class 'hourly' ")
}
if (inherits(InputsModel, "GR" ) == FALSE) {
stop("'InputsModel' must be of class 'GR' ")
}
if (inherits(RunOptions, "RunOptions" ) == FALSE) {
stop("'RunOptions' must be of class 'RunOptions' ")
}
if (inherits(RunOptions, "GR" ) == FALSE) {
stop("'RunOptions' must be of class 'GR' ")
}
if (!is.vector(Param) | !is.numeric(Param)) {
stop("'Param' must be a numeric vector")
}
if (sum(!is.na(Param)) != NParam) {
stop(paste("'Param' must be a vector of length ", NParam, " and contain no NA", sep = ""))
}
Param <- as.double(Param)
Param_X1X3_threshold <- 1e-2
......@@ -32,11 +46,16 @@ RunModel_GR4H <- function(InputsModel, RunOptions, Param) {
}
## Input_data_preparation
if (identical(RunOptions$IndPeriod_WarmUp, as.integer(0))) { RunOptions$IndPeriod_WarmUp <- NULL }
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) }
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
......@@ -80,23 +99,27 @@ RunModel_GR4H <- function(InputsModel, RunOptions, Param) {
## OutputsModel_only
if (ExportDatesR == FALSE & ExportStateEnd == FALSE) {
OutputsModel <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i])
names(OutputsModel) <- FortranOutputs[IndOutputs] }
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]) }
names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs])
}
## OutputsModel_and_SateEnd_only
if (ExportDatesR == FALSE & ExportStateEnd == TRUE) {
OutputsModel <- c( lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
list(RESULTS$StateEnd) )
names(OutputsModel) <- c(FortranOutputs[IndOutputs], "StateEnd") }
names(OutputsModel) <- c(FortranOutputs[IndOutputs], "StateEnd")
}
## DatesR_and_OutputsModel_and_SateEnd
if ((ExportDatesR == TRUE & ExportStateEnd == TRUE) | "all" %in% RunOptions$Outputs_Sim) {
OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
list(RESULTS$StateEnd) )
names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs], "StateEnd") }
names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs], "StateEnd")
}
## End
rm(RESULTS)
......
......@@ -7,13 +7,27 @@ 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 (!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 (inherits(InputsModel, "InputsModel") == FALSE) {
stop("'InputsModel' must be of class 'InputsModel'")
}
if (inherits(InputsModel, "daily" ) == FALSE) {
stop("'InputsModel' must be of class 'daily' ")
}
if (inherits(InputsModel, "GR" ) == FALSE) {
stop("'InputsModel' must be of class 'GR' ")
}
if (inherits(RunOptions, "RunOptions" ) == FALSE) {
stop("'RunOptions' must be of class 'RunOptions' ")
}
if (inherits(RunOptions, "GR" ) == FALSE) {
stop("'RunOptions' must be of class 'GR' ")
}
if (!is.vector(Param) | !is.numeric(Param)) {
stop("'Param' must be a numeric vector")
}
if (sum(!is.na(Param)) != NParam) {
stop(paste("'Param' must be a vector of length ", NParam, " and contain no NA", sep = ""))
}
Param <- as.double(Param)
Param_X1X3_threshold <- 1e-2
......@@ -32,11 +46,16 @@ RunModel_GR4J <- function(InputsModel, RunOptions, Param) {
}
## Input_data_preparation
if (identical(RunOptions$IndPeriod_WarmUp, as.integer(0))) { RunOptions$IndPeriod_WarmUp <- NULL }
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) }
if ("all" %in% RunOptions$Outputs_Sim) {
IndOutputs <- as.integer(1:length(FortranOutputs))
} else {
IndOutputs <- which(FortranOutputs %in% RunOptions$Outputs_Sim)
}
## Input_data_preparation
IndPeriod2 <- (length(RunOptions$IndPeriod_WarmUp)+1):LInputSeries
ExportDatesR <- "DatesR" %in% RunOptions$Outputs_Sim
......@@ -79,23 +98,27 @@ RunModel_GR4J <- function(InputsModel, RunOptions, Param) {
## OutputsModel_only
if (ExportDatesR == FALSE & ExportStateEnd == FALSE) {
OutputsModel <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i])
names(OutputsModel) <- FortranOutputs[IndOutputs] }
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]) }
names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs])
}
## OutputsModel_and_StateEnd_only
if (ExportDatesR == FALSE & ExportStateEnd == TRUE) {
OutputsModel <- c( lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
list(RESULTS$StateEnd) )
names(OutputsModel) <- c(FortranOutputs[IndOutputs], "StateEnd") }
names(OutputsModel) <- c(FortranOutputs[IndOutputs], "StateEnd")
}
## DatesR_and_OutputsModel_and_StateEnd
if ((ExportDatesR == TRUE & ExportStateEnd == TRUE) | "all" %in% RunOptions$Outputs_Sim) {
OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
list(RESULTS$StateEnd) )
names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs], "StateEnd") }
names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs], "StateEnd")
}
## End
rm(RESULTS)
......
......@@ -13,13 +13,27 @@ 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 (!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 (inherits(InputsModel, "InputsModel") == FALSE) {
stop("'InputsModel' must be of class 'InputsModel'")
}
if (inherits(InputsModel, "hourly" ) == FALSE) {
stop("'InputsModel' must be of class 'hourly' ")
}
if (inherits(InputsModel, "GR" ) == FALSE) {
stop("'InputsModel' must be of class 'GR' ")
}
if (inherits(RunOptions, "RunOptions" ) == FALSE) {
stop("'RunOptions' must be of class 'RunOptions' ")
}
if (inherits(RunOptions, "GR" ) == FALSE) {
stop("'RunOptions' must be of class 'GR' ")
}
if (!is.vector(Param) | !is.numeric(Param)) {
stop("'Param' must be a numeric vector")
}
if (sum(!is.na(Param)) != NParam) {
stop(paste("'Param' must be a vector of length ", NParam, " and contain no NA", sep = ""))
}
Param <- as.double(Param)
Param_X1X3_threshold <- 1e-2
......@@ -38,11 +52,15 @@ RunModel_GR5H <- function(InputsModel, RunOptions, Param) {
}
## Input_data_preparation
if (identical(RunOptions$IndPeriod_WarmUp, as.integer(0))) { RunOptions$IndPeriod_WarmUp <- NULL }
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) }
} else {
IndOutputs <- which(FortranOutputs %in% RunOptions$Outputs_Sim)
}
## Output_data_preparation
IndPeriod2 <- (length(RunOptions$IndPeriod_WarmUp)+1):LInputSeries
......@@ -91,23 +109,27 @@ RunModel_GR5H <- function(InputsModel, RunOptions, Param) {
## OutputsModel_only
if (ExportDatesR == FALSE & ExportStateEnd == FALSE) {
OutputsModel <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i])
names(OutputsModel) <- FortranOutputs[IndOutputs] }
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]) }
names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs])
}
## OutputsModel_and_StateEnd_only
if (ExportDatesR == FALSE & ExportStateEnd == TRUE) {
OutputsModel <- c( lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
list(RESULTS$StateEnd) )
names(OutputsModel) <- c(FortranOutputs[IndOutputs], "StateEnd") }
names(OutputsModel) <- c(FortranOutputs[IndOutputs], "StateEnd")
}
## DatesR_and_OutputsModel_and_StateEnd
if ((ExportDatesR == TRUE & ExportStateEnd == TRUE) | "all" %in% RunOptions$Outputs_Sim) {
OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
list(RESULTS$StateEnd) )
names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs], "StateEnd") }
names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs], "StateEnd")
}
## End
rm(RESULTS)
......
......@@ -7,13 +7,27 @@ 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 (!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 (inherits(InputsModel, "InputsModel") == FALSE) {
stop("'InputsModel' must be of class 'InputsModel'")
}
if (inherits(InputsModel, "daily" ) == FALSE) {
stop("'InputsModel' must be of class 'daily' ")
}
if (inherits(InputsModel, "GR" ) == FALSE) {
stop("'InputsModel' must be of class 'GR' ")
}
if (inherits(RunOptions, "RunOptions" ) == FALSE) {
stop("'RunOptions' must be of class 'RunOptions' ")
}
if (inherits(RunOptions, "GR" ) == FALSE) {
stop("'RunOptions' must be of class 'GR' ")
}
if (!is.vector(Param) | !is.numeric(Param)) {
stop("'Param' must be a numeric vector")
}
if (sum(!is.na(Param)) != NParam) {
stop(paste("'Param' must be a vector of length ", NParam, " and contain no NA", sep = ""))
}
Param <- as.double(Param)
Param_X1X3_threshold <- 1e-2
......@@ -32,11 +46,16 @@ RunModel_GR5J <- function(InputsModel, RunOptions, Param) {
}
## Input_data_preparation
if (identical(RunOptions$IndPeriod_WarmUp, as.integer(0))) { RunOptions$IndPeriod_WarmUp <- NULL }
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) }
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
......@@ -80,23 +99,27 @@ RunModel_GR5J <- function(InputsModel, RunOptions, Param) {
## OutputsModel_only
if (ExportDatesR == FALSE & ExportStateEnd == FALSE) {
OutputsModel <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i])
names(OutputsModel) <- FortranOutputs[IndOutputs] }
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]) }
names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs])
}
## OutputsModel_and_SateEnd_only
if (ExportDatesR == FALSE & ExportStateEnd == TRUE) {
OutputsModel <- c( lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
list(RESULTS$StateEnd) )
names(OutputsModel) <- c(FortranOutputs[IndOutputs], "StateEnd") }
names(OutputsModel) <- c(FortranOutputs[IndOutputs], "StateEnd")
}
## DatesR_and_OutputsModel_and_SateEnd
if ((ExportDatesR == TRUE & ExportStateEnd == TRUE) | "all" %in% RunOptions$Outputs_Sim) {
OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
list(RESULTS$StateEnd) )
names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs], "StateEnd") }
names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs], "StateEnd")
}
## End
rm(RESULTS)
......
......@@ -7,13 +7,27 @@ 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 (!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 (inherits(InputsModel, "InputsModel") == FALSE) {
stop("'InputsModel' must be of class 'InputsModel'")
}
if (inherits(InputsModel, "daily" ) == FALSE) {
stop("'InputsModel' must be of class 'daily' ")
}
if (inherits(InputsModel, "GR" ) == FALSE) {
stop("'InputsModel' must be of class 'GR' ")
}
if (inherits(RunOptions, "RunOptions" ) == FALSE) {
stop("'RunOptions' must be of class 'RunOptions' ")
}
if (inherits(RunOptions, "GR" ) == FALSE) {
stop("'RunOptions' must be of class 'GR' ")
}
if (!is.vector(Param) | !is.numeric(Param)) {
stop("'Param' must be a numeric vector")
}
if (sum(!is.na(Param)) != NParam) {
stop(paste("'Param' must be a vector of length ", NParam, " and contain no NA", sep = ""))
}
Param <- as.double(Param)
Param_X1X3X6_threshold <- 1e-2
......@@ -36,11 +50,16 @@ RunModel_GR6J <- function(InputsModel, RunOptions, Param) {
}
## Input_data_preparation
if (identical(RunOptions$IndPeriod_WarmUp, as.integer(0))) { RunOptions$IndPeriod_WarmUp <- NULL }
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) }
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
......@@ -85,23 +104,27 @@ RunModel_GR6J <- function(InputsModel, RunOptions, Param) {
## OutputsModel_only
if (ExportDatesR == FALSE & ExportStateEnd == FALSE) {
OutputsModel <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i])
names(OutputsModel) <- FortranOutputs[IndOutputs] }
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]) }
names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs])
}
## OutputsModel_and_SateEnd_only
if (ExportDatesR == FALSE & ExportStateEnd == TRUE) {
OutputsModel <- c( lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
list(RESULTS$StateEnd) )
names(OutputsModel) <- c(FortranOutputs[IndOutputs], "StateEnd") }
names(OutputsModel) <- c(FortranOutputs[IndOutputs], "StateEnd")
}
## DatesR_and_OutputsModel_and_SateEnd
if ((ExportDatesR == TRUE & ExportStateEnd == TRUE) | "all" %in% RunOptions$Outputs_Sim) {
OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
list(RESULTS$StateEnd) )
names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs], "StateEnd") }
names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs], "StateEnd")
}
## End
rm(RESULTS)
......
Markdown is supported
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