From be73406efc4dc618aa3e7481f98d490331ca13e1 Mon Sep 17 00:00:00 2001 From: Delaigue Olivier <olivier.delaigue@irstea.fr> Date: Fri, 6 Nov 2020 11:49:35 +0100 Subject: [PATCH] v1.6.3.27 style: clean GR1A R code add spaces manage indentation remove semicolons Refs #65 --- DESCRIPTION | 2 +- NEWS.md | 2 +- R/RunModel_GR1A.R | 176 ++++++++++++++++++++++++++-------------------- 3 files changed, 102 insertions(+), 78 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 3e643917..4f61d773 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: airGR Type: Package Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling -Version: 1.6.3.26 +Version: 1.6.3.27 Date: 2020-11-06 Authors@R: c( person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")), diff --git a/NEWS.md b/NEWS.md index 3030333b..e88e01ca 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,7 +4,7 @@ -### 1.6.3.26 Release Notes (2020-11-06) +### 1.6.3.27 Release Notes (2020-11-06) #### New features diff --git a/R/RunModel_GR1A.R b/R/RunModel_GR1A.R index aa81ee64..8972e003 100644 --- a/R/RunModel_GR1A.R +++ b/R/RunModel_GR1A.R @@ -1,78 +1,102 @@ -RunModel_GR1A <- function(InputsModel,RunOptions,Param){ - - NParam <- 1; - FortranOutputs <- .FortranOutputs(GR = "GR1A")$GR - - ##Arguments_check - if(inherits(InputsModel,"InputsModel")==FALSE){ stop("'InputsModel' must be of class 'InputsModel'") } - if(inherits(InputsModel,"yearly" )==FALSE){ stop("'InputsModel' must be of class 'yearly' ") } - 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); - - ##Input_data_preparation - 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); } - - ##Output_data_preparation - IndPeriod2 <- (length(RunOptions$IndPeriod_WarmUp)+1):LInputSeries; - ExportDatesR <- "DatesR" %in% RunOptions$Outputs_Sim; - ExportStateEnd <- "StateEnd" %in% RunOptions$Outputs_Sim; - - ##Call_fortan - 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] - InputsPE=InputsModel$PotEvap[IndPeriod1], ### input series potential evapotranspiration [mm/y] - NParam=as.integer(length(Param)), ### number of model parameter - Param=Param, ### parameter set - NStates=as.integer(length(RunOptions$IniStates)), ### number of state variables used for model initialising - StateStart=RunOptions$IniStates, ### state variables used when the model run starts - 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 - ) - RESULTS$Outputs[ round(RESULTS$Outputs ,3)==(-999.999)] <- NA; - RESULTS$StateEnd[round(RESULTS$StateEnd,3)==(-999.999)] <- NA; - - - - ##Output_data_preparation - ##OutputsModel_only - if(ExportDatesR==FALSE & ExportStateEnd==FALSE){ - 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_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"); } - ##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"); } - - - ##End - rm(RESULTS); - class(OutputsModel) <- c("OutputsModel","yearly","GR"); - return(OutputsModel); - +RunModel_GR1A <- function(InputsModel, RunOptions, Param) { + + NParam <- 1 + + FortranOutputs <- .FortranOutputs(GR = "GR1A")$GR + + ## Arguments_check + if (inherits(InputsModel, "InputsModel") == FALSE) { + stop("'InputsModel' must be of class 'InputsModel'") + } + if (inherits(InputsModel, "yearly") == FALSE) { + stop("'InputsModel' must be of class 'yearly'") + } + 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")) + } + Param <- as.double(Param) + + + ## Input data preparation + 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) + } + + ## Output data preparation + IndPeriod2 <- (length(RunOptions$IndPeriod_WarmUp) + 1):LInputSeries + ExportDatesR <- "DatesR" %in% RunOptions$Outputs_Sim + ExportStateEnd <- "StateEnd" %in% RunOptions$Outputs_Sim + + ## Call_fortan + 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] + InputsPE = InputsModel$PotEvap[IndPeriod1], ### input series potential evapotranspiration [mm/y] + NParam = as.integer(length(Param)), ### number of model parameter + Param = Param, ### parameter set + NStates = as.integer(length(RunOptions$IniStates)), ### number of state variables used for model initialising + StateStart = RunOptions$IniStates, ### state variables used when the model run starts + 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 + ) + RESULTS$Outputs[ round(RESULTS$Outputs , 3) == (-999.999)] <- NA + RESULTS$StateEnd[round(RESULTS$StateEnd, 3) == (-999.999)] <- NA + + + ## Output data preparation + ## OutputsModel only + if (ExportDatesR == FALSE & ExportStateEnd == FALSE) { + 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 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") + } + ## 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") + } + + + ## End + rm(RESULTS) + class(OutputsModel) <- c("OutputsModel", "yearly", "GR") + return(OutputsModel) + } -- GitLab