diff --git a/DESCRIPTION b/DESCRIPTION index e0819b428ccf6ad164406c2b66af70970a4fbfff..fafb3d221658e619501bb3c8ad1e350f8eeeabef 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -13,5 +13,4 @@ Description: This package brings into R the hydrological modelling tools used at for their calibration and evaluation (GR4H, GR4J, GR5J, GR6J, GR2M, GR1A and CemaNeige). Use help(airGR) for package description. License: GPL-2 -Built: R 3.0.2; x86_64-w64-mingw32; 2015-10-27 18:41:54 UTC; windows -Archs: i386, x64 +Packaged: 2015-10-27 18:41:47 UTC; H61970 diff --git a/INDEX b/INDEX deleted file mode 100644 index 188e0fbdfdc6ceda1d083233176f539cf1c55a0d..0000000000000000000000000000000000000000 --- a/INDEX +++ /dev/null @@ -1,67 +0,0 @@ -BasinInfo Data sample: characteristics of a fictional - catchment (L0123001, L0123002 or L0123003) -BasinObs Data sample: time series of observations of a - fictional catchment (L0123001, L0123002 or - L0123003) -Calibration Calibration algorithm which minimises an error - criterion on the model outputs using the - provided functions -Calibration_HBAN Calibration algorithm which minimises the error - criterion using the Irstea-HBAN procedure -Calibration_optim Calibration algorithm which minimises the error - criterion using the stats::optim function -CreateCalibOptions Creation of the CalibOptions object required to - the Calibration functions -CreateInputsCrit Creation of the InputsCrit object required to - the ErrorCrit functions -CreateInputsModel Creation of the InputsModel object required to - the RunModel functions -CreateRunOptions Creation of the RunOptions object required to - the RunModel functions -DataAltiExtrapolation_HBAN - Altitudinal extrapolation of precipitation and - temperature series -ErrorCrit Error criterion using the provided function -ErrorCrit_KGE Error criterion based on the KGE formula -ErrorCrit_KGE2 Error criterion based on the KGE' formula -ErrorCrit_NSE Error criterion based on the NSE formula -ErrorCrit_RMSE Error criterion based on the RMSE -PEdaily_Oudin Computation of daily series of potential - evapotranspiration with Oudin's formula -RunModel Run with the provided hydrological model - function -RunModel_CemaNeige Run with the CemaNeige snow module -RunModel_CemaNeigeGR4J - Run with the CemaNeigeGR4J hydrological model -RunModel_CemaNeigeGR5J - Run with the CemaNeigeGR5J hydrological model -RunModel_CemaNeigeGR6J - Run with the CemaNeigeGR6J hydrological model -RunModel_GR1A Run with the GR1A hydrological model -RunModel_GR2M Run with the GR2M hydrological model -RunModel_GR4H Run with the GR4H hydrological model -RunModel_GR4J Run with the GR4J hydrological model -RunModel_GR5J Run with the GR5J hydrological model -RunModel_GR6J Run with the GR6J hydrological model -SeriesAggreg Conversion of time series to another time-step - (aggregation only) -TransfoParam Transformation of the parameters using the - provided function -TransfoParam_CemaNeige - Transformation of the parameters from the - CemaNeige module -TransfoParam_GR1A Transformation of the parameters from the GR1A - model -TransfoParam_GR2M Transformation of the parameters from the GR2M - model -TransfoParam_GR4H Transformation of the parameters from the GR4H - model -TransfoParam_GR4J Transformation of the parameters from the GR4J - model -TransfoParam_GR5J Transformation of the parameters from the GR5J - model -TransfoParam_GR6J Transformation of the parameters from the GR6J - model -airGR Modelling tools used at Irstea-HBAN (France), - including GR4J and CemaNeige -plot_OutputsModel Default preview of model outputs diff --git a/MD5 b/MD5 deleted file mode 100644 index d21ce05625d22a7d009180e5d8de91269708a1b1..0000000000000000000000000000000000000000 --- a/MD5 +++ /dev/null @@ -1,24 +0,0 @@ -745f1ff9a1a987be74e26d327e1001f3 *DESCRIPTION -8cfd5d38abb52c25f9de6da3b5a49dbd *INDEX -4ef88d7fe2a815ae9d537a6a0ce475e2 *Meta/Rd.rds -32a1c5de93e3b6254dbd86b07ba073ba *Meta/data.rds -85e37b304c759576eef3e1715799d846 *Meta/hsearch.rds -13463ac75ee802be8ab7942c547edf89 *Meta/links.rds -db1f9a1a649ce0c9ed5f0bf1321337a4 *Meta/nsInfo.rds -886528f90ab482d4b30d2586da61f7e7 *Meta/package.rds -ef20fcb07a98bb3a13d1dfbce9b66ab0 *NAMESPACE -ebf0fc819595d631b8bf280c4b049940 *R/airGR -44c5327b5161fa3578c84656f9e872c6 *R/airGR.rdb -af79b71953440b5fb2bb5968d1c7c4a5 *R/airGR.rdx -9a4212f4316f102accff6f1b737b591f *data/L0123001.rda -1940776e833cda1019508134b87c65f0 *data/L0123002.rda -517b0e945c588adcb1846db0b138cd10 *data/L0123003.rda -98c6e43c002546b43228d42f834515f2 *help/AnIndex -7d2aecc63e95084cf48a00bb02d63f5c *help/airGR.rdb -42aefbf56becfa3987a4b3e94f8c032d *help/airGR.rdx -ddae52805808b1d0202eea1457a18f12 *help/aliases.rds -06e18f0d21774860b6fe45293af4f4fb *help/paths.rds -e5b5791fbc25b39ec22b8509c01f4d69 *html/00Index.html -444535b9cb76ddff1bab1e1865a3fb14 *html/R.css -c27696c4a2f0ae0ccc8b7cd8ad62b66e *libs/i386/airGR.dll -991f7b24c923dfc3bd5b7420ae1a6cc7 *libs/x64/airGR.dll diff --git a/Meta/Rd.rds b/Meta/Rd.rds deleted file mode 100644 index 054d837052dfef37a15a13d83d69177f8f561af1..0000000000000000000000000000000000000000 Binary files a/Meta/Rd.rds and /dev/null differ diff --git a/Meta/data.rds b/Meta/data.rds deleted file mode 100644 index 216de635f65820f8e7827f455b266dfe5a43f744..0000000000000000000000000000000000000000 Binary files a/Meta/data.rds and /dev/null differ diff --git a/Meta/hsearch.rds b/Meta/hsearch.rds deleted file mode 100644 index bc9992aa96926fa112a772dcdd25b255b0a311e3..0000000000000000000000000000000000000000 Binary files a/Meta/hsearch.rds and /dev/null differ diff --git a/Meta/links.rds b/Meta/links.rds deleted file mode 100644 index 8dcea7746eec82dfbde09be2b7e639ec79d0c4fa..0000000000000000000000000000000000000000 Binary files a/Meta/links.rds and /dev/null differ diff --git a/Meta/nsInfo.rds b/Meta/nsInfo.rds deleted file mode 100644 index ded75a3aa73e2d5a3afe43b76b32aee8385b6fea..0000000000000000000000000000000000000000 Binary files a/Meta/nsInfo.rds and /dev/null differ diff --git a/Meta/package.rds b/Meta/package.rds deleted file mode 100644 index e7051aaf8526643f0f65b70c0d9ea1aae359984c..0000000000000000000000000000000000000000 Binary files a/Meta/package.rds and /dev/null differ diff --git a/R/BasinData.R b/R/BasinData.R new file mode 100644 index 0000000000000000000000000000000000000000..b1e6d222b6fa9446a9b6f8f6e23225cc5ba8ece6 --- /dev/null +++ b/R/BasinData.R @@ -0,0 +1,42 @@ +#' @name BasinInfo +#' @docType data +#' @title Data sample: characteristics of a fictional catchment (L0123001, L0123002 or L0123003) +#' @description +#' R-object containing the code, station's name, area and hypsometric curve of the catchment. +#' @encoding UTF-8 +#' @format +#' List named 'BasinInfo' containing +#' \itemize{ +#' \item two strings: catchment's code and station's name +#' \item one float: catchment's area in km2 +#' \item one numeric vector: catchment's hypsometric curve (min, quantiles 01 to 99 and max) in metres +#' } +#' @examples +#' require(airGR) +#' data(L0123001) +#' str(BasinInfo) + +NULL + + +#' @name BasinObs +#' @docType data +#' @title Data sample: time series of observations of a fictional catchment (L0123001, L0123002 or L0123003) +#' @description +#' R-object containing the times series of precipitation, temperature, potential evapotranspiration and discharges. \cr +#' Times series for L0123001 or L0123002 are at the daily time-step for use with daily models such as GR4J, GR5J, GR6J, CemaNeigeGR4J, CemaNeigeGR5J and CemaNeigeGR6J. +#' Times series for L0123003 are at the hourly time-step for use with hourly models such as GR4H. +#' @encoding UTF-8 +#' @format +#' Data frame named 'BasinObs' containing +#' \itemize{ +#' \item one POSIXlt vector: time series dates in the POSIXlt format +#' \item five numeric vectors: time series of catchment average precipitation [mm], catchment average air temperature [degC], catchment average potential evapotranspiration [mm], outlet discharge [l/s], outlet discharge [mm] +#' } +#' @examples +#' require(airGR) +#' data(L0123001) +#' str(BasinObs) + +NULL + diff --git a/R/Calibration.R b/R/Calibration.R new file mode 100644 index 0000000000000000000000000000000000000000..874740b53c95b48dd2dee4c936ef8ffaee3aa460 --- /dev/null +++ b/R/Calibration.R @@ -0,0 +1,29 @@ +#************************************************************************************************* +#' Calibration algorithm which minimises the error criterion using the provided functions. \cr +#************************************************************************************************* +#' @title Calibration algorithm which minimises an error criterion on the model outputs using the provided functions +#' @author Laurent Coron (June 2014) +#' @seealso \code{\link{Calibration_HBAN}}, \code{\link{Calibration_optim}}, +#' \code{\link{RunModel}}, \code{\link{ErrorCrit}}, \code{\link{TransfoParam}}, +#' \code{\link{CreateInputsModel}}, \code{\link{CreateRunOptions}}, +#' \code{\link{CreateInputsCrit}}, \code{\link{CreateCalibOptions}}. +#' @example tests/example_Calibration.R +#' @export +#' @encoding UTF-8 +#_FunctionInputs__________________________________________________________________________________ +#' @param InputsModel [object of class \emph{InputsModel}] see \code{\link{CreateInputsModel}} for details +#' @param RunOptions [object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details +#' @param InputsCrit [object of class \emph{InputsCrit}] see \code{\link{CreateInputsCrit}} for details +#' @param CalibOptions [object of class \emph{CalibOptions}] see \code{\link{CreateCalibOptions}} for details +#' @param FUN_MOD [function] hydrological model function (e.g. RunModel_GR4J, RunModel_CemaNeigeGR4J) +#' @param FUN_CRIT [function] error criterion function (e.g. ErrorCrit_RMSE, ErrorCrit_NSE) +#' @param FUN_CALIB (optional) [function] calibration algorithm function (e.g. Calibration_HBAN, Calibration_optim), default=Calibration_HBAN +#' @param FUN_TRANSFO (optional) [function] model parameters transformation function, if the FUN_MOD used is native in the package FUN_TRANSFO is automatically defined +#' @param quiet (optional) [boolean] boolean indicating if the function is run in quiet mode or not, default=FALSE +#_FunctionOutputs_________________________________________________________________________________ +#' @return [list] see \code{\link{Calibration_HBAN}} or \code{\link{Calibration_optim}} +#************************************************************************************************** +Calibration <- function(InputsModel,RunOptions,InputsCrit,CalibOptions,FUN_MOD,FUN_CRIT,FUN_CALIB=Calibration_HBAN,FUN_TRANSFO=NULL,quiet=FALSE){ + return( FUN_CALIB(InputsModel,RunOptions,InputsCrit,CalibOptions,FUN_MOD,FUN_CRIT,FUN_TRANSFO,quiet=quiet) ) +} + diff --git a/R/Calibration_HBAN.R b/R/Calibration_HBAN.R new file mode 100644 index 0000000000000000000000000000000000000000..152ac7a50fe822a8b7c365e87a1b65b5bf901328 --- /dev/null +++ b/R/Calibration_HBAN.R @@ -0,0 +1,404 @@ +#************************************************************************************************* +#' Calibration algorithm which minimises the error criterion. \cr +#' \cr +#' The algorithm is based on a local search procedure. +#' First, a screening is performed using either a rough predefined grid or a list of parameter sets +#' and then a simple steepest descent local search algorithm is performed. +#' +#' A screening is first performed either from a rough predefined grid (considering various initial +#' values for each paramete) or from a list of initial parameter sets. \cr +#' The best set identified in this screening is then used as a starting point for the steepest +#' descent local search algorithm. \cr +#' For this search, the parameters are used in a transformed version, to obtain uniform +#' variation ranges (and thus a similar pace), while the true ranges might be quite different. \cr +#' At each iteration, we start from a parameter set of NParam values (NParam being the number of +#' free parameters of the chosen hydrological model) and we determine the 2*NParam-1 new candidates +#' by changing one by one the different parameters (+/- pace). \cr +#' All these candidates are tested and the best one kept to be the starting point for the next +#' iteration. At the end of each iteration, the pace is either increased or decreased to adapt +#' the progression speed. A diagonal progress can occasionally be done. \cr +#' The calibration algorithm stops when the pace becomes too small. \cr +#' +#' To optimise the exploration of the parameter space, transformation functions are used to convert +#' the model parameters. This is done using the TransfoParam functions. +#************************************************************************************************* +#' @title Calibration algorithm which minimises the error criterion using the Irstea-HBAN procedure +#' @author Laurent Coron (August 2013) +#' @references +#' Michel, C. (1991), +#' Hydrologie appliquée aux petits bassins ruraux, Hydrology handout (in French), Cemagref, Antony, France. +#' @example tests/example_Calibration_HBAN.R +#' @seealso \code{\link{Calibration}}, \code{\link{Calibration_optim}}, +#' \code{\link{RunModel_GR4J}}, \code{\link{TransfoParam_GR4J}}, \code{\link{ErrorCrit_RMSE}}, +#' \code{\link{CreateInputsModel}}, \code{\link{CreateRunOptions}}, +#' \code{\link{CreateInputsCrit}}, \code{\link{CreateCalibOptions}}. +#' @encoding UTF-8 +#' @export +#_FunctionInputs__________________________________________________________________________________ +#' @param InputsModel [object of class \emph{InputsModel}] see \code{\link{CreateInputsModel}} for details +#' @param RunOptions [object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details +#' @param InputsCrit [object of class \emph{InputsCrit}] see \code{\link{CreateInputsCrit}} for details +#' @param CalibOptions [object of class \emph{CalibOptions}] see \code{\link{CreateCalibOptions}} for details +#' @param FUN_MOD [function] hydrological model function (e.g. RunModel_GR4J, RunModel_CemaNeigeGR4J) +#' @param FUN_CRIT [function] error criterion function (e.g. ErrorCrit_RMSE, ErrorCrit_NSE) +#' @param FUN_TRANSFO (optional) [function] model parameters transformation function, if the FUN_MOD used is native in the package FUN_TRANSFO is automatically defined +#' @param quiet (optional) [boolean] boolean indicating if the function is run in quiet mode or not, default=FALSE +#_FunctionOutputs_________________________________________________________________________________ +#' @return [list] list containing the function outputs organised as follows: +#' \tabular{ll}{ +#' \emph{$ParamFinalR } \tab [numeric] parameter set obtained at the end of the calibration \cr +#' \emph{$CritFinal } \tab [numeric] error criterion obtained at the end of the calibration \cr +#' \emph{$NIter } \tab [numeric] number of iterations during the calibration \cr +#' \emph{$NRuns } \tab [numeric] number of model runs done during the calibration \cr +#' \emph{$HistParamR } \tab [numeric] table showing the progression steps in the search for optimal set: parameter values \cr +#' \emph{$HistCrit } \tab [numeric] table showing the progression steps in the search for optimal set: criterion values \cr +#' \emph{$MatBoolCrit } \tab [boolean] table giving the requested and actual time steps when the model is calibrated \cr +#' \emph{$CritName } \tab [character] name of the calibration criterion \cr +#' \emph{$CritBestValue} \tab [numeric] theoretical best criterion value \cr +#' } +#************************************************************************************************** +Calibration_HBAN <- function(InputsModel,RunOptions,InputsCrit,CalibOptions,FUN_MOD,FUN_CRIT,FUN_TRANSFO=NULL,quiet=FALSE){ + + +##_____Arguments_check_____________________________________________________________________ + if(inherits(InputsModel,"InputsModel")==FALSE){ stop("InputsModel must be of class 'InputsModel' \n"); return(NULL); } + if(inherits(RunOptions,"RunOptions")==FALSE){ stop("RunOptions must be of class 'RunOptions' \n"); return(NULL); } + if(inherits(InputsCrit,"InputsCrit")==FALSE){ stop("InputsCrit must be of class 'InputsCrit' \n"); return(NULL); } + if(inherits(CalibOptions,"CalibOptions")==FALSE){ stop("CalibOptions must be of class 'CalibOptions' \n"); return(NULL); } + if(inherits(CalibOptions,"HBAN")==FALSE){ stop("CalibOptions must be of class 'HBAN' if Calibration_HBAN is used \n"); return(NULL); } + + + ##_check_FUN_TRANSFO + if(is.null(FUN_TRANSFO)){ + if(identical(FUN_MOD,RunModel_GR4H )){ FUN_TRANSFO <- TransfoParam_GR4H ; } + if(identical(FUN_MOD,RunModel_GR4J )){ FUN_TRANSFO <- TransfoParam_GR4J ; } + if(identical(FUN_MOD,RunModel_GR5J )){ FUN_TRANSFO <- TransfoParam_GR5J ; } + if(identical(FUN_MOD,RunModel_GR6J )){ FUN_TRANSFO <- TransfoParam_GR6J ; } + if(identical(FUN_MOD,RunModel_GR2M )){ FUN_TRANSFO <- TransfoParam_GR2M ; } + if(identical(FUN_MOD,RunModel_GR1A )){ FUN_TRANSFO <- TransfoParam_GR1A ; } + if(identical(FUN_MOD,RunModel_CemaNeige )){ FUN_TRANSFO <- TransfoParam_CemaNeige; } + if(identical(FUN_MOD,RunModel_CemaNeigeGR4J) | identical(FUN_MOD,RunModel_CemaNeigeGR5J) | identical(FUN_MOD,RunModel_CemaNeigeGR6J)){ + if(identical(FUN_MOD,RunModel_CemaNeigeGR4J)){ FUN1 <- TransfoParam_GR4J; FUN2 <- TransfoParam_CemaNeige; } + if(identical(FUN_MOD,RunModel_CemaNeigeGR5J)){ FUN1 <- TransfoParam_GR5J; FUN2 <- TransfoParam_CemaNeige; } + if(identical(FUN_MOD,RunModel_CemaNeigeGR6J)){ FUN1 <- TransfoParam_GR6J; FUN2 <- TransfoParam_CemaNeige; } + FUN_TRANSFO <- function(ParamIn,Direction){ + Bool <- is.matrix(ParamIn); + if(Bool==FALSE){ ParamIn <- rbind(ParamIn); } + ParamOut <- NA*ParamIn; + NParam <- ncol(ParamIn); + ParamOut[, 1:(NParam-2)] <- FUN1(ParamIn[, 1:(NParam-2)],Direction); + ParamOut[,(NParam-1):NParam ] <- FUN2(ParamIn[,(NParam-1):NParam ],Direction); + if(Bool==FALSE){ ParamOut <- ParamOut[1,]; } + return(ParamOut); + } + } + if(is.null(FUN_TRANSFO)){ stop("FUN_TRANSFO was not found (in Calibration function) \n"); return(NULL); } + } + + ##_variables_initialisation + ParamFinalR <- NULL; ParamFinalT <- NULL; CritFinal <- NULL; + NRuns <- 0; NIter <- 0; + if("StartParamDistrib" %in% names(CalibOptions)){ PrefilteringType <- 2; } else { PrefilteringType <- 1; } + if(PrefilteringType==1){ NParam <- ncol(CalibOptions$StartParamList); } + if(PrefilteringType==2){ NParam <- ncol(CalibOptions$StartParamDistrib); } + if(NParam>20){ stop("Calibration_HBAN can handle a maximum of 20 parameters \n"); return(NULL); } + HistParamR <- matrix(NA,nrow=500*NParam,ncol=NParam); + HistParamT <- matrix(NA,nrow=500*NParam,ncol=NParam); + HistCrit <- matrix(NA,nrow=500*NParam,ncol=1); + CritName <- NULL; + CritBestValue <- NULL; + Multiplier <- NULL; + CritOptim <- +1E100; + ##_temporary_change_of_Outputs_Sim + RunOptions$Outputs_Sim <- RunOptions$Outputs_Cal; ### this reduces the size of the matrix exchange with fortran and therefore speeds the calibration + + + +##_____Parameter_Grid_Screening____________________________________________________________ + + + ##Definition_of_the_function_creating_all_possible_parameter_sets_from_different_values_for_each_parameter + ProposeCandidatesGrid <- function(DistribParam){ + ##Managing_matrix_sizes + Nvalmax <- nrow(DistribParam); + NParam <- ncol(DistribParam); + ##we_add_columns_to_MatDistrib_until_it_has_20_columns + DistribParam2 <- matrix(NA,nrow=Nvalmax,ncol=20); + DistribParam2[1:Nvalmax,1:NParam] <- DistribParam; + ##we_check_the_number_of_values_to_test_for_each_param + NbDistrib <- rep(1,20); + for(iC in 1:20){ NbDistrib[iC] <- max( 1 , Nvalmax-sum(is.na(DistribParam2[,iC])) ); } + ##Loop_on_the_various_values_to_test ###(if 4 param and 3 values for each => 3^4 sets) + ##NB_we_always_do_20_loops ###which_is_here_the_max_number_of_param_that_can_be_optimised + VECT <- NULL; + for(iL01 in 1:NbDistrib[01]){ for(iL02 in 1:NbDistrib[02]){ for(iL03 in 1:NbDistrib[03]){ for(iL04 in 1:NbDistrib[04]){ for(iL05 in 1:NbDistrib[05]){ + for(iL06 in 1:NbDistrib[06]){ for(iL07 in 1:NbDistrib[07]){ for(iL08 in 1:NbDistrib[08]){ for(iL09 in 1:NbDistrib[09]){ for(iL10 in 1:NbDistrib[10]){ + for(iL11 in 1:NbDistrib[11]){ for(iL12 in 1:NbDistrib[12]){ for(iL13 in 1:NbDistrib[13]){ for(iL14 in 1:NbDistrib[14]){ for(iL15 in 1:NbDistrib[15]){ + for(iL16 in 1:NbDistrib[16]){ for(iL17 in 1:NbDistrib[17]){ for(iL18 in 1:NbDistrib[18]){ for(iL19 in 1:NbDistrib[19]){ for(iL20 in 1:NbDistrib[20]){ + VECT <- c(VECT, + DistribParam2[iL01,01],DistribParam2[iL02,02],DistribParam2[iL03,03],DistribParam2[iL04,04],DistribParam2[iL05,05], + DistribParam2[iL06,06],DistribParam2[iL07,07],DistribParam2[iL08,08],DistribParam2[iL09,09],DistribParam2[iL10,10], + DistribParam2[iL11,11],DistribParam2[iL12,12],DistribParam2[iL13,13],DistribParam2[iL14,14],DistribParam2[iL15,15], + DistribParam2[iL16,16],DistribParam2[iL17,17],DistribParam2[iL18,18],DistribParam2[iL19,19],DistribParam2[iL20,20]); + } } } } } + } } } } } + } } } } } + } } } } } + MAT <- matrix(VECT,ncol=20,byrow=TRUE)[,1:NParam]; + if(is.matrix(MAT)==FALSE){ MAT <- cbind(MAT); } + Output <- NULL; + Output$NewCandidates <- MAT; + return(Output); + } + + + ##Creation_of_new_candidates_______________________________________________ + if(PrefilteringType==1){ CandidatesParamR <- CalibOptions$StartParamList; } + if(PrefilteringType==2){ DistribParamR <- CalibOptions$StartParamDistrib; DistribParamR[,!CalibOptions$OptimParam] <- NA; CandidatesParamR <- ProposeCandidatesGrid(DistribParamR)$NewCandidates; } + ##Remplacement_of_non_optimised_values_____________________________________ + CandidatesParamR <- apply(CandidatesParamR,1,function(x){ x[!CalibOptions$OptimParam] <- CalibOptions$FixedParam[!CalibOptions$OptimParam]; return(x); }); + if(NParam>1){ CandidatesParamR <- t(CandidatesParamR); } else { CandidatesParamR <- cbind(CandidatesParamR); } + + ##Loop_to_test_the_various_candidates______________________________________ + iNewOptim <- 0; + Ncandidates <- nrow(CandidatesParamR); + if(!quiet & Ncandidates>1){ + if(PrefilteringType==1){ cat(paste("\t List-Screening in progress (",sep="")); } + if(PrefilteringType==2){ cat(paste("\t Grid-Screening in progress (",sep="")); } + cat("0%"); + } + for(iNew in 1:nrow(CandidatesParamR)){ + if(!quiet & Ncandidates>1){ + for(k in c(2,4,6,8)){ if(iNew==round(k/10*Ncandidates)){ cat(paste(" ",10*k,"%",sep="")); } } + } + ##Model_run + Param <- CandidatesParamR[iNew,]; + OutputsModel <- FUN_MOD(InputsModel,RunOptions,Param); + ##Calibration_criterion_computation + OutputsCrit <- FUN_CRIT(InputsCrit,OutputsModel); + if(!is.na(OutputsCrit$CritValue)){ if(OutputsCrit$CritValue*OutputsCrit$Multiplier < CritOptim){ + CritOptim <- OutputsCrit$CritValue*OutputsCrit$Multiplier; + iNewOptim <- iNew; + } } + ##Storage_of_crit_info + if(is.null(CritName) | is.null(CritBestValue) | is.null(Multiplier)){ + CritName <- OutputsCrit$CritName; + CritBestValue <- OutputsCrit$CritBestValue; + Multiplier <- OutputsCrit$Multiplier; + } + } + if(!quiet & Ncandidates>1){ cat(" 100%) \n"); } + + + ##End_of_first_step_Parameter_Screening____________________________________ + ParamStartR <- CandidatesParamR[iNewOptim,]; if(!is.matrix(ParamStartR)){ ParamStartR <- matrix(ParamStartR,nrow=1); } + ParamStartT <- FUN_TRANSFO(ParamStartR,"RT"); + CritStart <- CritOptim; + NRuns <- NRuns+nrow(CandidatesParamR); + if(!quiet){ + if(Ncandidates> 1){ cat(paste("\t Screening completed (",NRuns," runs): \n",sep="")); } + if(Ncandidates==1){ cat(paste("\t Starting point for steepest-descent local search: \n",sep="")); } + cat(paste("\t Param = ",paste(formatC(ParamStartR,format="f",width=8,digits=3),collapse=" , "),"\n",sep="")); + cat(paste("\t Crit ",format(CritName,width=12,justify="left")," = ",formatC(CritStart*Multiplier,format="f",digits=4),"\n",sep="")); + } + ##Results_archiving________________________________________________________ + HistParamR[1,] <- ParamStartR; + HistParamT[1,] <- ParamStartT; + HistCrit[1,] <- CritStart; + + + + +##_____Steepest_Descent_Local_Search_______________________________________________________ + + + ##Definition_of_the_function_creating_new_parameter_sets_through_a_step_by_step_progression_procedure + ProposeCandidatesLoc <- function(NewParamOptimT,OldParamOptimT,RangesT,OptimParam,Pace){ + ##Format_checking + if(nrow(NewParamOptimT)!=1 | nrow(OldParamOptimT)!=1){ stop("each input set must be a matrix of one single line \n"); return(NULL); } + if(ncol(NewParamOptimT)!=ncol(OldParamOptimT) | ncol(NewParamOptimT)!=length(OptimParam)){ stop("each input set must have the same number of values \n"); return(NULL); } + ##Proposal_of_new_parameter_sets ###(local search providing 2*NParam-1 new sets) + NParam <- ncol(NewParamOptimT); + VECT <- NULL; + for(I in 1:NParam){ + ##We_check_that_the_current_parameter_should_indeed_be_optimised + if(OptimParam[I]==TRUE){ + for(J in 1:2){ + Sign <- 2*J-3; #Sign can be equal to -1 or +1 + ##We_define_the_new_potential_candidate + Add <- TRUE; + PotentialCandidateT <- NewParamOptimT; + 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]; } + if(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 ){ Add <- FALSE; } + if( NewParamOptimT[I]==RangesT[2,I] & Sign>0 ){ Add <- FALSE; } + ##We_check_that_this_set_has_not_been_tested_during_the_last_iteration + if(identical(PotentialCandidateT,OldParamOptimT)){ Add <- FALSE; } + ##We_add_the_candidate_to_our_list + if(Add==TRUE){ VECT <- c(VECT,PotentialCandidateT); } + } + } + } + Output <- NULL; + Output$NewCandidatesT <- matrix(VECT,ncol=NParam,byrow=TRUE); + return(Output); + } + + + ##Initialisation_of_variables + if(!quiet){ + cat("\t Steepest-descent local search in progress \n"); + } + Pace <- 0.64; + PaceDiag <- rep(0,NParam); + CLG <- 0.7^(1/NParam); + Compt <- 0; + CritOptim <- CritStart; + ##Conversion_of_real_parameter_values + RangesR <- CalibOptions$SearchRanges; + RangesT <- FUN_TRANSFO(RangesR,"RT"); + NewParamOptimT <- ParamStartT; + OldParamOptimT <- ParamStartT; + + + ##START_LOOP_ITER_________________________________________________________ + for(ITER in 1:(100*NParam)){ + + + ##Exit_loop_when_Pace_becomes_too_small___________________________________ + if(Pace<0.01){ break; } + + + ##Creation_of_new_candidates______________________________________________ + CandidatesParamT <- ProposeCandidatesLoc(NewParamOptimT,OldParamOptimT,RangesT,CalibOptions$OptimParam,Pace)$NewCandidatesT; + CandidatesParamR <- FUN_TRANSFO(CandidatesParamT,"TR"); + ##Remplacement_of_non_optimised_values_____________________________________ + CandidatesParamR <- apply(CandidatesParamR,1,function(x){ x[!CalibOptions$OptimParam] <- CalibOptions$FixedParam[!CalibOptions$OptimParam]; return(x); }); + if(NParam>1){ CandidatesParamR <- t(CandidatesParamR); } else { CandidatesParamR <- cbind(CandidatesParamR); } + + + ##Loop_to_test_the_various_candidates_____________________________________ + iNewOptim <- 0; + for(iNew in 1:nrow(CandidatesParamR)){ + ##Model_run + Param <- CandidatesParamR[iNew,]; + OutputsModel <- FUN_MOD(InputsModel,RunOptions,Param); + ##Calibration_criterion_computation + OutputsCrit <- FUN_CRIT(InputsCrit,OutputsModel); + if(!is.na(OutputsCrit$CritValue)){ if(OutputsCrit$CritValue*OutputsCrit$Multiplier < CritOptim){ + CritOptim <- OutputsCrit$CritValue*OutputsCrit$Multiplier; + iNewOptim <- iNew; + } } + } + NRuns <- NRuns+nrow(CandidatesParamR); + + + ##When_a_progress_has_been_achieved_______________________________________ + if(iNewOptim!=0){ + ##We_store_the_optimal_set + OldParamOptimT <- NewParamOptimT; + NewParamOptimT <- matrix(CandidatesParamT[iNewOptim,1:NParam],nrow=1); + Compt <- Compt+1; + ##When_necessary_we_increase_the_pace ### if_successive_progress_occur_in_a_row + if(Compt>2*NParam){ + Pace <- Pace*2; + Compt <- 0; + } + ##We_update_PaceDiag + VectPace <- NewParamOptimT-OldParamOptimT; + for(iC in 1:NParam){ if(CalibOptions$OptimParam[iC]==TRUE){ + if(VectPace[iC]!=0){ PaceDiag[iC] <- CLG*PaceDiag[iC]+(1-CLG)*VectPace[iC]; } + if(VectPace[iC]==0){ PaceDiag[iC] <- CLG*PaceDiag[iC]; } + } } + } else { + ##When_no_progress_has_been_achieved_we_decrease_the_pace_________________ + Pace <- Pace/2; + Compt <- 0; + } + + + ##Test_of_an_additional_candidate_using_diagonal_progress_________________ + if(ITER>4*NParam){ + + NRuns <- NRuns+1; + iNewOptim <- 0; iNew <- 1; + CandidatesParamT <- NewParamOptimT+PaceDiag; if(!is.matrix(CandidatesParamT)){ CandidatesParamT <- matrix(CandidatesParamT,nrow=1); } + ##If_we_exit_the_range_of_possible_values_we_go_back_on_the_boundary + for(iC in 1:NParam){ if(CalibOptions$OptimParam[iC]==TRUE){ + if(CandidatesParamT[iNew,iC]<RangesT[1,iC]){ CandidatesParamT[iNew,iC] <- RangesT[1,iC]; } + if(CandidatesParamT[iNew,iC]>RangesT[2,iC]){ CandidatesParamT[iNew,iC] <- RangesT[2,iC]; } + } } + CandidatesParamR <- FUN_TRANSFO(CandidatesParamT,"TR"); + ##Model_run + Param <- CandidatesParamR[iNew,]; + OutputsModel <- FUN_MOD(InputsModel,RunOptions,Param); + ##Calibration_criterion_computation + OutputsCrit <- FUN_CRIT(InputsCrit,OutputsModel); + if(OutputsCrit$CritValue*OutputsCrit$Multiplier < CritOptim){ + CritOptim <- OutputsCrit$CritValue*OutputsCrit$Multiplier; + iNewOptim <- iNew; + } + ##When_a_progress_has_been_achieved + if(iNewOptim!=0){ + OldParamOptimT <- NewParamOptimT; + NewParamOptimT <- matrix(CandidatesParamT[iNewOptim,1:NParam],nrow=1); + } + + } + + + ##Results_archiving_______________________________________________________ + NewParamOptimR <- FUN_TRANSFO(NewParamOptimT,"TR"); + HistParamR[ITER+1,] <- NewParamOptimR; + HistParamT[ITER+1,] <- NewParamOptimT; + HistCrit[ITER+1,] <- CritOptim; + ### if(!quiet){ cat(paste("\t Iter ",formatC(ITER,format="d",width=3)," Crit ",formatC(CritOptim,format="f",digits=4)," Pace ",formatC(Pace,format="f",digits=4),"\n",sep="")); } + + + + } ##END_LOOP_ITER_________________________________________________________ + ITER <- ITER-1; + + + ##Case_when_the_starting_parameter_set_remains_the_best_solution__________ + if(CritOptim==CritStart & !quiet){ + cat("\t No progress achieved \n"); + } + + ##End_of_Steepest_Descent_Local_Search____________________________________ + ParamFinalR <- NewParamOptimR; + ParamFinalT <- NewParamOptimT; + CritFinal <- CritOptim; + NIter <- 1+ITER; + if(!quiet){ + cat(paste("\t Calibration completed (",NIter," iterations, ",NRuns," runs): \n",sep="")); + cat(paste("\t Param = ",paste(formatC(ParamFinalR,format="f",width=8,digits=3),collapse=" , "),"\n",sep="")); + cat(paste("\t Crit ",format(CritName,width=12,justify="left")," = ",formatC(CritFinal*Multiplier,format="f",digits=4),"\n",sep="")); + } + ##Results_archiving_______________________________________________________ + HistParamR <- cbind(HistParamR[1:NIter,]); colnames(HistParamR) <- paste("Param",1:NParam,sep=""); + HistParamT <- cbind(HistParamT[1:NIter,]); colnames(HistParamT) <- paste("Param",1:NParam,sep=""); + HistCrit <- cbind(HistCrit[1:NIter,]); ###colnames(HistCrit) <- paste("HistCrit"); + + BoolCrit_Actual <- InputsCrit$BoolCrit; BoolCrit_Actual[OutputsCrit$Ind_notcomputed] <- FALSE; + MatBoolCrit <- cbind( InputsCrit$BoolCrit , BoolCrit_Actual ); + colnames(MatBoolCrit) <- c("BoolCrit_Requested","BoolCrit_Actual"); + + +##_____Output______________________________________________________________________________ + OutputsCalib <- list(as.double(ParamFinalR),CritFinal*Multiplier,NIter,NRuns,HistParamR,HistCrit*Multiplier,MatBoolCrit,CritName,CritBestValue); + names(OutputsCalib) <- c("ParamFinalR","CritFinal","NIter","NRuns","HistParamR","HistCrit","MatBoolCrit","CritName","CritBestValue"); + class(OutputsCalib) <- c("OutputsCalib","HBAN"); + return(OutputsCalib); + + + +} + + + + + diff --git a/R/Calibration_optim.R b/R/Calibration_optim.R new file mode 100644 index 0000000000000000000000000000000000000000..154d6b5dba6c326c483d2eaab7032d9b7886638c --- /dev/null +++ b/R/Calibration_optim.R @@ -0,0 +1,152 @@ +#************************************************************************************************* +#' Calibration algorithm which minimises the error criterion. \cr +#' \cr +#' The algorithm is based on the "optim" function from the "stats" R-package +#' (using method="L-BFGS-B", i.e. a local optimization quasi-Newton method). +#' +#' To optimise the exploration of the parameter space, transformation functions are used to convert +#' the model parameters. This is done using the TransfoParam functions. +#************************************************************************************************* +#' @title Calibration algorithm which minimises the error criterion using the stats::optim function +#' @author Laurent Coron (August 2013) +#' @example tests/example_Calibration_optim.R +#' @seealso \code{\link{Calibration}}, \code{\link{Calibration_HBAN}}, +#' \code{\link{RunModel_GR4J}}, \code{\link{TransfoParam_GR4J}}, \code{\link{ErrorCrit_RMSE}}, +#' \code{\link{CreateInputsModel}}, \code{\link{CreateRunOptions}}, +#' \code{\link{CreateInputsCrit}}, \code{\link{CreateCalibOptions}}. +#' @encoding UTF-8 +#' @export +#_FunctionInputs__________________________________________________________________________________ +#' @param InputsModel [object of class \emph{InputsModel}] see \code{\link{CreateInputsModel}} for details +#' @param RunOptions [object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details +#' @param InputsCrit [object of class \emph{InputsCrit}] see \code{\link{CreateInputsCrit}} for details +#' @param CalibOptions [object of class \emph{CalibOptions}] see \code{\link{CreateCalibOptions}} for details +#' @param FUN_MOD [function] hydrological model function (e.g. RunModel_GR4J, RunModel_CemaNeigeGR4J) +#' @param FUN_CRIT [function] error criterion function (e.g. ErrorCrit_RMSE, ErrorCrit_NSE) +#' @param FUN_TRANSFO (optional) [function] model parameters transformation function, if the FUN_MOD used is native in the package FUN_TRANSFO is automatically defined +#' @param quiet (optional) [boolean] boolean indicating if the function is run in quiet mode or not, default=FALSE +#_FunctionOutputs_________________________________________________________________________________ +#' @return [list] list containing the function outputs organised as follows: +#' \tabular{ll}{ +#' \emph{$ParamFinalR } \tab [numeric] parameter set obtained at the end of the calibration \cr +#' \emph{$CritFinal } \tab [numeric] error criterion obtained at the end of the calibration \cr +#' \emph{$Nruns } \tab [numeric] number of model runs done during the calibration \cr +#' \emph{$CritName } \tab [character] name of the calibration criterion \cr +#' \emph{$CritBestValue} \tab [numeric] theoretical best criterion value \cr +#' } +#************************************************************************************************** +Calibration_optim <- function(InputsModel,RunOptions,InputsCrit,CalibOptions,FUN_MOD,FUN_CRIT,FUN_TRANSFO=NULL,quiet=FALSE){ + + + ##_check_class + if(inherits(InputsModel,"InputsModel")==FALSE){ stop("InputsModel must be of class 'InputsModel' \n"); return(NULL); } + if(inherits(RunOptions,"RunOptions")==FALSE){ stop("RunOptions must be of class 'RunOptions' \n"); return(NULL); } + if(inherits(InputsCrit,"InputsCrit")==FALSE){ stop("InputsCrit must be of class 'InputsCrit' \n"); return(NULL); } + if(inherits(CalibOptions,"CalibOptions")==FALSE){ stop("CalibOptions must be of class 'CalibOptions' \n"); return(NULL); } + if(inherits(CalibOptions,"optim")==FALSE){ stop("CalibOptions must be of class 'optim' if Calibration_optim is used \n"); return(NULL); } + + + ##_check_FUN_TRANSFO + if(is.null(FUN_TRANSFO)){ + if(identical(FUN_MOD,RunModel_GR4H )){ FUN_TRANSFO <- TransfoParam_GR4H ; } + if(identical(FUN_MOD,RunModel_GR4J )){ FUN_TRANSFO <- TransfoParam_GR4J ; } + if(identical(FUN_MOD,RunModel_GR5J )){ FUN_TRANSFO <- TransfoParam_GR5J ; } + if(identical(FUN_MOD,RunModel_GR6J )){ FUN_TRANSFO <- TransfoParam_GR6J ; } + if(identical(FUN_MOD,RunModel_GR2M )){ FUN_TRANSFO <- TransfoParam_GR2M ; } + if(identical(FUN_MOD,RunModel_GR1A )){ FUN_TRANSFO <- TransfoParam_GR1A ; } + if(identical(FUN_MOD,RunModel_CemaNeige )){ FUN_TRANSFO <- TransfoParam_CemaNeige; } + if(identical(FUN_MOD,RunModel_CemaNeigeGR4J) | identical(FUN_MOD,RunModel_CemaNeigeGR5J) | identical(FUN_MOD,RunModel_CemaNeigeGR6J)){ + if(identical(FUN_MOD,RunModel_CemaNeigeGR4J)){ FUN1 <- TransfoParam_GR4J; FUN2 <- TransfoParam_CemaNeige; } + if(identical(FUN_MOD,RunModel_CemaNeigeGR5J)){ FUN1 <- TransfoParam_GR5J; FUN2 <- TransfoParam_CemaNeige; } + if(identical(FUN_MOD,RunModel_CemaNeigeGR6J)){ FUN1 <- TransfoParam_GR6J; FUN2 <- TransfoParam_CemaNeige; } + FUN_TRANSFO <- function(ParamIn,Direction){ + Bool <- is.matrix(ParamIn); + if(Bool==FALSE){ ParamIn <- rbind(ParamIn); } + ParamOut <- NA*ParamIn; + NParam <- ncol(ParamIn); + ParamOut[, 1:(NParam-2)] <- FUN1(ParamIn[, 1:(NParam-2)],Direction); + ParamOut[,(NParam-1):NParam ] <- FUN2(ParamIn[,(NParam-1):NParam ],Direction); + if(Bool==FALSE){ ParamOut <- ParamOut[1,]; } + return(ParamOut); + } + } + if(is.null(FUN_TRANSFO)){ stop("FUN_TRANSFO was not found (in Calibration function) \n"); return(NULL); } + } + + + ##_RunModelAndCrit + RunModelAndCrit <- function(par,InputsModel,RunOptions,InputsCrit,CalibOptions,FUN_MOD,FUN_CRIT,FUN_TRANSFO){ + ParamT <- NA*CalibOptions$FixedParam; + ParamT[CalibOptions$OptimParam] <- par; + Param <- FUN_TRANSFO(ParamIn=ParamT,Direction="TR"); + Param[!CalibOptions$OptimParam] <- CalibOptions$FixedParam[!CalibOptions$OptimParam]; + OutputsModel <- FUN_MOD(InputsModel=InputsModel,RunOptions=RunOptions,Param=Param); + OutputsCrit <- FUN_CRIT(InputsCrit=InputsCrit,OutputsModel=OutputsModel); + return(OutputsCrit$CritValue*OutputsCrit$Multiplier); + } + + + ##_temporary_change_of_Outputs_Sim + RunOptions$Outputs_Sim <- RunOptions$Outputs_Cal; ### this reduces the size of the matrix exchange with fortran and therefore speeds the calibration + ##_screenPrint + if(!quiet){ + cat(paste("\t Calibration in progress (function optim from the stats package) \n",sep="")); + } + + + ##_lower_and_upper_limit_values (transformed) + RangesR <- CalibOptions$SearchRanges; + RangesT <- FUN_TRANSFO(RangesR,"RT"); + lower <- RangesT[1,CalibOptions$OptimParam]; + upper <- RangesT[2,CalibOptions$OptimParam]; + + ##_starting_values (transformed) + ParamStartT <- FUN_TRANSFO(CalibOptions$StartParam,"RT"); + par_start <- ParamStartT[CalibOptions$OptimParam]; + + + ##_calibration + RESULT <- optim(par=par_start,fn=RunModelAndCrit,gr=NULL, + InputsModel,RunOptions,InputsCrit,CalibOptions,FUN_MOD,FUN_CRIT,FUN_TRANSFO, ## arguments for the RunModelAndCrit function (other than par) + method="L-BFGS-B",lower=lower,upper=upper,control=list(),hessian=FALSE) + + + ##_outputs_preparation + ParamFinalT <- NA*ParamStartT; + ParamFinalT[CalibOptions$OptimParam] <- RESULT$par; + ParamFinalR <- FUN_TRANSFO(ParamFinalT,"TR"); + ParamFinalR[!CalibOptions$OptimParam] <- CalibOptions$FixedParam[!CalibOptions$OptimParam]; + CritFinal <- RESULT$value; + + ##_storage_of_crit_info + OutputsModel <- FUN_MOD(InputsModel=InputsModel,RunOptions=RunOptions,Param=ParamFinalR); + OutputsCrit <- FUN_CRIT(InputsCrit=InputsCrit,OutputsModel=OutputsModel); + CritName <- OutputsCrit$CritName; + CritBestValue <- OutputsCrit$CritBestValue; + Multiplier <- OutputsCrit$Multiplier; + + ##_screenPrint + if(!quiet){ + if(RESULT$convergence==0){ + cat(paste("\t Calibration completed: \n",sep="")); + cat(paste("\t Param = ",paste(formatC(ParamFinalR,format="f",width=8,digits=3),collapse=" , "),"\n",sep="")); + cat(paste("\t Crit ",format(CritName,width=12,justify="left")," = ",formatC(CritFinal*Multiplier,format="f",digits=4),"\n",sep="")); + } else { + cat(paste("\t Calibration failed: \n",sep="")); + cat(paste("\t ",RESULT$message,sep="")); + } + } + + + ##_function_output + OutputsCalib <- list(as.double(ParamFinalR),CritFinal*Multiplier,as.integer(RESULT$counts[1]),CritName,CritBestValue); + names(OutputsCalib) <- c("ParamFinalR","CritFinal","NRuns","CritName","CritBestValue"); + class(OutputsCalib) <- c("OutputsCalib","optim"); + return(OutputsCalib); + + +} + + + + diff --git a/R/CreateCalibOptions.R b/R/CreateCalibOptions.R new file mode 100644 index 0000000000000000000000000000000000000000..72fec803fb71aca0f7ed4d2a2e65759f37a8a85e --- /dev/null +++ b/R/CreateCalibOptions.R @@ -0,0 +1,242 @@ +#************************************************************************************************* +#' Creation of the CalibOptions object required to the Calibration functions. +#' +#' Users wanting to use FUN_MOD, FUN_CALIB or FUN_TRANSFO functions that are not included in +#' the package must create their own CalibOptions object accordingly. +#************************************************************************************************* +#' @title Creation of the CalibOptions object required to the Calibration functions +#' @author Laurent Coron (June 2014) +#' @seealso \code{\link{Calibration}}, \code{\link{RunModel}} +#' @example tests/example_Calibration.R +#' @encoding UTF-8 +#' @export +#_FunctionInputs__________________________________________________________________________________ +#' @param FUN_MOD [function] hydrological model function (e.g. RunModel_GR4J, RunModel_CemaNeigeGR4J) +#' @param FUN_CALIB (optional) [function] calibration algorithm function (e.g. Calibration_HBAN, Calibration_optim), default=Calibration_HBAN +#' @param FUN_TRANSFO (optional) [function] model parameters transformation function, if the FUN_MOD used is native in the package FUN_TRANSFO is automatically defined +#' @param OptimParam (optional) [boolean] vector of booleans indicating which parameters must be optimised (NParam columns, 1 line) +#' @param FixedParam (optional) [numeric] vector giving the values to allocate to non-optimised parameter values (NParam columns, 1 line) +#' @param SearchRanges (optional) [numeric] matrix giving the ranges of real parameters (NParam columns, 2 lines) +#' \tabular{llllll}{ +#' \tab [X1] \tab [X2] \tab [X3] \tab [...] \tab [Xi] \cr +#' [1,] \tab 0 \tab -1 \tab 0 \tab ... \tab 0.0 \cr +#' [2,] \tab 3000 \tab +1 \tab 100 \tab ... \tab 3.0 \cr +#' } +#' @param StartParam (optional) [numeric] vector of parameter values used to start global search calibration procedure (e.g. Calibration_optim) +#' \tabular{llllll}{ +#' \tab [X1] \tab [X2] \tab [X3] \tab [...] \tab [Xi] \cr +#' \tab 1000 \tab -0.5 \tab 22 \tab ... \tab 1.1 \cr +#' } +#' @param StartParamList (optional) [numeric] matrix of parameter sets used for grid-screening calibration procedure (values in columns, sets in line) +#' \tabular{llllll}{ +#' \tab [X1] \tab [X2] \tab [X3] \tab [...] \tab [Xi] \cr +#' [set1] \tab 800 \tab -0.7 \tab 25 \tab ... \tab 1.0 \cr +#' [set2] \tab 1000 \tab -0.5 \tab 22 \tab ... \tab 1.1 \cr +#' [...] \tab ... \tab ... \tab ... \tab ... \tab ... \cr +#' [set n] \tab 200 \tab -0.3 \tab 17 \tab ... \tab 1.0 \cr +#' } +#' @param StartParamDistrib (optional) [numeric] matrix of parameter values used for grid-screening calibration procedure (values in columns, percentiles in line) \cr +#' \tabular{llllll}{ +#' \tab [X1] \tab [X2] \tab [X3] \tab [...] \tab [Xi] \cr +#' [value1] \tab 800 \tab -0.7 \tab 25 \tab ... \tab 1.0 \cr +#' [value2] \tab 1000 \tab NA \tab 50 \tab ... \tab 1.2 \cr +#' [value3] \tab 1200 \tab NA \tab NA \tab ... \tab 1.6 \cr +#' } +#_FunctionOutputs_________________________________________________________________________________ +#' @return [list] object of class \emph{CalibOptions} containing the data required to evaluate the model outputs; it can include the following: +#' \tabular{ll}{ +#' \emph{$OptimParam } \tab [boolean] vector of booleans indicating which parameters must be optimised \cr +#' \emph{$FixedParam } \tab [numeric] vector giving the values to allocate to non-optimised parameter values \cr +#' \emph{$SearchRanges } \tab [numeric] matrix giving the ranges of real parameters \cr +#' \emph{$StartParam } \tab [numeric] vector of parameter values used to start global search calibration procedure \cr +#' \emph{$StartParamList } \tab [numeric] matrix of parameter sets used for grid-screening calibration procedure \cr +#' \emph{$StartParamDistrib} \tab [numeric] matrix of parameter values used for grid-screening calibration procedure \cr +#' } +#************************************************************************************************** +CreateCalibOptions <- function(FUN_MOD,FUN_CALIB=Calibration_HBAN,FUN_TRANSFO=NULL,OptimParam=NULL,FixedParam=NULL,SearchRanges=NULL, + StartParam=NULL,StartParamList=NULL,StartParamDistrib=NULL){ + + + ObjectClass <- NULL; + + ##check_FUN_MOD + BOOL <- FALSE; + if(identical(FUN_MOD,RunModel_GR4H )){ ObjectClass <- c(ObjectClass,"GR4H" ); BOOL <- TRUE; } + if(identical(FUN_MOD,RunModel_GR4J )){ ObjectClass <- c(ObjectClass,"GR4J" ); BOOL <- TRUE; } + if(identical(FUN_MOD,RunModel_GR5J )){ ObjectClass <- c(ObjectClass,"GR5J" ); BOOL <- TRUE; } + if(identical(FUN_MOD,RunModel_GR6J )){ ObjectClass <- c(ObjectClass,"GR6J" ); BOOL <- TRUE; } + if(identical(FUN_MOD,RunModel_GR2M )){ ObjectClass <- c(ObjectClass,"GR2M" ); BOOL <- TRUE; } + if(identical(FUN_MOD,RunModel_GR1A )){ ObjectClass <- c(ObjectClass,"GR1A" ); BOOL <- TRUE; } + if(identical(FUN_MOD,RunModel_CemaNeige )){ ObjectClass <- c(ObjectClass,"CemaNeige" ); BOOL <- TRUE; } + if(identical(FUN_MOD,RunModel_CemaNeigeGR4J)){ ObjectClass <- c(ObjectClass,"CemaNeigeGR4J"); BOOL <- TRUE; } + if(identical(FUN_MOD,RunModel_CemaNeigeGR5J)){ ObjectClass <- c(ObjectClass,"CemaNeigeGR5J"); BOOL <- TRUE; } + if(identical(FUN_MOD,RunModel_CemaNeigeGR6J)){ ObjectClass <- c(ObjectClass,"CemaNeigeGR6J"); BOOL <- TRUE; } + if(!BOOL){ stop("incorrect FUN_MOD for use in CreateCalibOptions \n"); return(NULL); } + + ##check_FUN_CALIB + BOOL <- FALSE; + if(identical(FUN_CALIB,Calibration_HBAN )){ ObjectClass <- c(ObjectClass,"HBAN" ); BOOL <- TRUE; } + if(identical(FUN_CALIB,Calibration_optim )){ ObjectClass <- c(ObjectClass,"optim" ); BOOL <- TRUE; } + if(!BOOL){ stop("incorrect FUN_CALIB for use in CreateCalibOptions \n"); return(NULL); } + + ##check_FUN_TRANSFO + if(is.null(FUN_TRANSFO)){ + ##_set_FUN1 + if(identical(FUN_MOD,RunModel_GR4H ) ){ FUN1 <- TransfoParam_GR4H ; } + if(identical(FUN_MOD,RunModel_GR4J ) | identical(FUN_MOD,RunModel_CemaNeigeGR4J) ){ FUN1 <- TransfoParam_GR4J ; } + if(identical(FUN_MOD,RunModel_GR5J ) | identical(FUN_MOD,RunModel_CemaNeigeGR5J) ){ FUN1 <- TransfoParam_GR5J ; } + if(identical(FUN_MOD,RunModel_GR6J ) | identical(FUN_MOD,RunModel_CemaNeigeGR6J) ){ FUN1 <- TransfoParam_GR6J ; } + if(identical(FUN_MOD,RunModel_GR2M ) ){ FUN1 <- TransfoParam_GR2M ; } + if(identical(FUN_MOD,RunModel_GR1A ) ){ FUN1 <- TransfoParam_GR1A ; } + if(identical(FUN_MOD,RunModel_CemaNeige) ){ FUN1 <- TransfoParam_CemaNeige; } + if(is.null(FUN1)){ stop("FUN1 was not found \n"); return(NULL); } + ##_set_FUN2 + FUN2 <- TransfoParam_CemaNeige; + ##_set_FUN_TRANSFO + if(sum(ObjectClass %in% c("GR4H","GR4J","GR5J","GR6J","GR2M","GR1A","CemaNeige"))>0){ + FUN_TRANSFO <- FUN1; + } else { + FUN_TRANSFO <- function(ParamIn,Direction){ + Bool <- is.matrix(ParamIn); + if(Bool==FALSE){ ParamIn <- rbind(ParamIn); } + ParamOut <- NA*ParamIn; + NParam <- ncol(ParamIn); + if(NParam <= 3){ + ParamOut[, 1:(NParam-2)] <- FUN1(cbind(ParamIn[,1:(NParam-2)]),Direction); + } else { + ParamOut[, 1:(NParam-2)] <- FUN1(ParamIn[,1:(NParam-2) ],Direction); } + ParamOut[,(NParam-1):NParam ] <- FUN2(ParamIn[,(NParam-1):NParam],Direction); + if(Bool==FALSE){ ParamOut <- ParamOut[1,]; } + return(ParamOut); + } + } + } + if(is.null(FUN_TRANSFO)){ stop("FUN_TRANSFO was not found \n"); return(NULL); } + + ##NParam + if("GR4H" %in% ObjectClass){ NParam <- 4; } + if("GR4J" %in% ObjectClass){ NParam <- 4; } + if("GR5J" %in% ObjectClass){ NParam <- 5; } + if("GR6J" %in% ObjectClass){ NParam <- 6; } + if("GR2M" %in% ObjectClass){ NParam <- 2; } + if("GR1A" %in% ObjectClass){ NParam <- 1; } + if("CemaNeige" %in% ObjectClass){ NParam <- 2; } + if("CemaNeigeGR4J" %in% ObjectClass){ NParam <- 6; } + if("CemaNeigeGR5J" %in% ObjectClass){ NParam <- 7; } + if("CemaNeigeGR6J" %in% ObjectClass){ NParam <- 8; } + + ##check_OptimParam + if(is.null(OptimParam)){ + OptimParam <- rep(TRUE,NParam); + } else { + if(!is.vector(OptimParam) ){ stop("OptimParam must be a vector of booleans \n"); return(NULL); } + if(length(OptimParam)!=NParam){ stop("Incompatibility between OptimParam length and FUN_MOD \n"); return(NULL); } + if(!is.logical(OptimParam) ){ stop("OptimParam must be a vector of booleans \n"); return(NULL); } + } + + ##check_FixedParam + if(is.null(FixedParam)){ + FixedParam <- rep(NA,NParam); + } else { + if(!is.vector(FixedParam) ){ stop("FixedParam must be a vector \n"); return(NULL); } + if(length(FixedParam)!=NParam ){ stop("Incompatibility between OptimParam length and FUN_MOD \n"); return(NULL); } + if(sum(!OptimParam)>0){ + if(!is.numeric(FixedParam[!OptimParam])){ stop("if OptimParam[i]==FALSE, FixedParam[i] must be a numeric value \n"); return(NULL); } } + } + + ##check_SearchRanges + if(is.null(SearchRanges)){ + 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 { + if(!is.matrix( SearchRanges) ){ stop("SearchRanges must be a matrix \n"); return(NULL); } + if(!is.numeric(SearchRanges) ){ stop("SearchRanges must be a matrix of numeric values \n"); return(NULL); } + if(sum(is.na(SearchRanges))!=0){ stop("SearchRanges must not include NA values \n"); return(NULL); } + if(nrow(SearchRanges)!=2 ){ stop("SearchRanges must have 2 rows \n"); return(NULL); } + if(ncol(SearchRanges)!=NParam ){ stop("Incompatibility between SearchRanges ncol and FUN_MOD \n"); return(NULL); } + } + + ##check_StartParamList_and_StartParamDistrib__default_values + if( ("HBAN" %in% ObjectClass & is.null(StartParamList) & is.null(StartParamDistrib)) | + ("optim" %in% ObjectClass & is.null(StartParam)) ){ + + if("GR4H"%in% ObjectClass){ + ParamT <- matrix( c( +3.60, -2.00, +3.40, -9.10, + +3.90, -0.90, +4.10, -8.70, + +4.50, -0.10, +5.00, -8.10),ncol=NParam,byrow=TRUE); } + if("GR4J"%in% ObjectClass){ + ParamT <- matrix( c( +3.60, -2.00, +3.40, -9.10, + +3.90, -0.90, +4.10, -8.70, + +4.50, -0.10, +5.00, -8.10),ncol=NParam,byrow=TRUE); } + if("GR5J"%in% ObjectClass){ + ParamT <- matrix( c( +3.60, -1.70, +3.30, -9.10, -0.70, + +3.90, -0.60, +4.10, -8.70, +0.30, + +4.50, -0.10, +5.00, -8.10, +0.50),ncol=NParam,byrow=TRUE); } + if("GR6J"%in% ObjectClass){ + ParamT <- matrix( c( +3.60, -1.00, +3.30, -9.10, -0.90, +3.00, + +3.90, -0.50, +4.10, -8.70, +0.10, +4.00, + +4.50, +0.50, +5.00, -8.10, +1.10, +5.00),ncol=NParam,byrow=TRUE); } + if("GR2M"%in% ObjectClass){ + ParamT <- matrix( c( +3.60, -5.00, + +3.90, +0.00, + +4.50, +5.00),ncol=NParam,byrow=TRUE); } + if("GR1A"%in% ObjectClass){ + ParamT <- matrix( c( -5.00, + +0.00, + +5.00),ncol=NParam,byrow=TRUE); } + if("CemaNeige"%in% ObjectClass){ + ParamT <- matrix( c( -6.26, +0.55, + -2.13, +0.92, + +4.86, +1.40),ncol=NParam,byrow=TRUE); } + if("CemaNeigeGR4J"%in% ObjectClass){ + ParamT <- matrix( c( +3.60, -2.00, +3.40, -9.10, -6.26, +0.55, + +3.90, -0.90, +4.10, -8.70, -2.13, +0.92, + +4.50, -0.10, +5.00, -8.10, +4.86, +1.40),ncol=NParam,byrow=TRUE); } + if("CemaNeigeGR5J"%in% ObjectClass){ + ParamT <- matrix( c( +3.60, -1.70, +3.30, -9.10, -0.70, -6.26, +0.55, + +3.90, -0.60, +4.10, -8.70, +0.30, -2.13, +0.92, + +4.50, -0.10, +5.00, -8.10, +0.50, +4.86, +1.40),ncol=NParam,byrow=TRUE); } + if("CemaNeigeGR6J"%in% ObjectClass){ + ParamT <- matrix( c( +3.60, -1.00, +3.30, -9.10, -0.90, +3.00, -6.26, +0.55, + +3.90, -0.50, +4.10, -8.70, +0.10, +4.00, -2.13, +0.92, + +4.50, +0.50, +5.00, -8.10, +1.10, +5.00, +4.86, +1.40),ncol=NParam,byrow=TRUE); } + + StartParamList <- NULL; + StartParamDistrib <- TransfoParam(ParamIn=ParamT,Direction="TR",FUN_TRANSFO=FUN_TRANSFO); + StartParam <- StartParamDistrib[2,]; + } + + ##check_StartParamList_and_StartParamDistrib__format + if("HBAN" %in% ObjectClass & !is.null(StartParamList)){ + if(!is.matrix( StartParamList) ){ stop("StartParamList must be a matrix \n"); return(NULL); } + if(!is.numeric(StartParamList) ){ stop("StartParamList must be a matrix of numeric values \n"); return(NULL); } + if(sum(is.na(StartParamList))!=0){ stop("StartParamList must not include NA values \n"); return(NULL); } + if(ncol(StartParamList)!=NParam ){ stop("Incompatibility between StartParamList ncol and FUN_MOD \n"); return(NULL); } + } + if("HBAN" %in% ObjectClass & !is.null(StartParamDistrib)){ + if(!is.matrix( StartParamDistrib) ){ stop("StartParamDistrib must be a matrix \n"); return(NULL); } + if(!is.numeric(StartParamDistrib[1,]) ){ stop("StartParamDistrib must be a matrix of numeric values \n"); return(NULL); } + if(sum(is.na(StartParamDistrib[1,]))!=0){ stop("StartParamDistrib must not include NA values on the first line \n"); return(NULL); } + if(ncol(StartParamDistrib)!=NParam ){ stop("Incompatibility between StartParamDistrib ncol and FUN_MOD \n"); return(NULL); } + } + if("optim" %in% ObjectClass & !is.null(StartParam)){ + if(!is.vector( StartParam) ){ stop("StartParam must be a vector \n"); return(NULL); } + if(!is.numeric(StartParam) ){ stop("StartParam must be a vector of numeric values \n"); return(NULL); } + if(sum(is.na(StartParam))!=0 ){ stop("StartParam must not include NA values \n"); return(NULL); } + if(length(StartParam)!=NParam ){ stop("Incompatibility between StartParam length and FUN_MOD \n"); return(NULL); } + } + + + ##Create_CalibOptions + CalibOptions <- list(OptimParam=OptimParam,FixedParam=FixedParam,SearchRanges=SearchRanges); + if(!is.null(StartParam )){ CalibOptions <- c(CalibOptions,list(StartParam=StartParam)); } + if(!is.null(StartParamList )){ CalibOptions <- c(CalibOptions,list(StartParamList=StartParamList)); } + if(!is.null(StartParamDistrib)){ CalibOptions <- c(CalibOptions,list(StartParamDistrib=StartParamDistrib)); } + class(CalibOptions) <- c("CalibOptions",ObjectClass); + return(CalibOptions); + + +} + + + diff --git a/R/CreateInputsCrit.R b/R/CreateInputsCrit.R new file mode 100644 index 0000000000000000000000000000000000000000..09bc06d10c54cadc3aaf47dfc4fff11278793294 --- /dev/null +++ b/R/CreateInputsCrit.R @@ -0,0 +1,81 @@ +#************************************************************************************************* +#' Creation of the InputsCrit object required to the ErrorCrit functions. +#' +#' Users wanting to use FUN_CRIT functions that are not included in +#' the package must create their own InputsCrit object accordingly. +#************************************************************************************************* +#' @title Creation of the InputsCrit object required to the ErrorCrit functions +#' @author Laurent Coron (June 2014) +#' @seealso \code{\link{RunModel}}, \code{\link{CreateInputsModel}}, \code{\link{CreateRunOptions}}, \code{\link{CreateCalibOptions}} +#' @example tests/example_ErrorCrit.R +#' @encoding UTF-8 +#' @export +#_FunctionInputs__________________________________________________________________________________ +#' @param FUN_CRIT [function] error criterion function (e.g. ErrorCrit_RMSE, ErrorCrit_NSE) +#' @param InputsModel [object of class \emph{InputsModel}] see \code{\link{CreateInputsModel}} for details +#' @param RunOptions [object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details +#' @param Qobs [numeric] series of observed discharges [mm] +#' @param BoolCrit (optional) [boolean] boolean giving the time steps to consider in the computation (all time steps are consider by default) +#' @param transfo (optional) [character] name of the transformation (e.g. "", "sqrt", "log", "inv", "sort") +#' @param Ind_zeroes (optional) [numeric] indices of the time-steps where zeroes are observed +#' @param epsilon (optional) [numeric] epsilon to add to all Qobs and Qsim if \emph{$Ind_zeroes} is not empty +#_FunctionOutputs_________________________________________________________________________________ +#' @return [list] object of class \emph{InputsCrit} containing the data required to evaluate the model outputs; it can include the following: +#' \tabular{ll}{ +#' \emph{$BoolCrit } \tab [boolean] boolean giving the time steps to consider in the computation \cr +#' \emph{$Qobs } \tab [numeric] series of observed discharges [mm] \cr +#' \emph{$transfo } \tab [character] name of the transformation (e.g. "", "sqrt", "log", "inv", "sort") \cr +#' \emph{$Ind_zeroes} \tab [numeric] indices of the time-steps where zeroes are observed \cr +#' \emph{$epsilon } \tab [numeric] epsilon to add to all Qobs and Qsim if \emph{$Ind_zeroes} is not empty \cr +#' } +#************************************************************************************************** +CreateInputsCrit <- function(FUN_CRIT,InputsModel,RunOptions,Qobs,BoolCrit=NULL,transfo="",Ind_zeroes=NULL,epsilon=NULL){ + + ObjectClass <- NULL; + + ##check_FUN_CRIT + BOOL <- FALSE; + if(identical(FUN_CRIT,ErrorCrit_NSE) | identical(FUN_CRIT,ErrorCrit_KGE) | identical(FUN_CRIT,ErrorCrit_KGE2) | + identical(FUN_CRIT,ErrorCrit_RMSE)){ + BOOL <- TRUE; } + if(!BOOL){ stop("incorrect FUN_CRIT for use in CreateInputsCrit \n"); return(NULL); } + + ##check_arguments + if(inherits(InputsModel,"InputsModel")==FALSE){ stop("InputsModel must be of class 'InputsModel' \n" ); return(NULL); } + if(inherits(RunOptions ,"RunOptions" )==FALSE){ stop("RunOptions must be of class 'RunOptions' \n" ); return(NULL); } + LLL <- length(InputsModel$DatesR[RunOptions$IndPeriod_Run]) + + if(is.null(Qobs) ){ stop("Qobs is missing \n"); return(NULL); } + if(!is.vector( Qobs)){ stop(paste("Qobs must be a vector of numeric values \n",sep="")); return(NULL); } + if(!is.numeric(Qobs)){ stop(paste("Qobs must be a vector of numeric values \n",sep="")); return(NULL); } + if(length(Qobs)!=LLL){ stop("Qobs and InputsModel series must have the same length \n"); return(NULL); } + + if(is.null(BoolCrit)){ BoolCrit <- rep(TRUE,length(Qobs)); } + if(!is.logical(BoolCrit)){ stop("BoolCrit must be a vector of boolean \n" ); return(NULL); } + if(length(BoolCrit)!=LLL){ stop("BoolCrit and InputsModel series must have the same length \n"); return(NULL); } + + if(is.null(transfo) ){ stop("transfo must be a chosen among the following: '', 'sqrt', 'log' or 'inv' \n"); return(NULL); } + if(!is.vector(transfo )){ stop("transfo must be a chosen among the following: '', 'sqrt', 'log' or 'inv' \n"); return(NULL); } + if(length(transfo)!=1 ){ stop("transfo must be a chosen among the following: '', 'sqrt', 'log' or 'inv' \n"); return(NULL); } + if(!is.character(transfo)){ stop("transfo must be a chosen among the following: '', 'sqrt', 'log' or 'inv' \n"); return(NULL); } + if(transfo %in% c("","sqrt","log","inv") == FALSE){ + stop("transfo must be a chosen among the following: '', 'sqrt', 'log' or 'inv' \n"); return(NULL); } + + if(!is.null(Ind_zeroes)){ + if(!is.vector( Ind_zeroes)){ stop("Ind_zeroes must be a vector of integers \n" ); return(NULL); } + if(!is.integer(Ind_zeroes)){ stop("Ind_zeroes must be a vector of integers \n" ); return(NULL); } + } + if(!is.null(epsilon)){ + if(!is.vector( epsilon) | length(epsilon)!=1 | !is.numeric(epsilon)){ + stop("epsilon must be single numeric value \n" ); return(NULL); } + epsilon=as.double(epsilon); + } + + ##Create_InputsCrit + InputsCrit <- list(BoolCrit=BoolCrit,Qobs=Qobs,transfo=transfo,Ind_zeroes=Ind_zeroes,epsilon=epsilon); + class(InputsCrit) <- c("InputsCrit",ObjectClass); + return(InputsCrit); + + +} + diff --git a/R/CreateInputsModel.R b/R/CreateInputsModel.R new file mode 100644 index 0000000000000000000000000000000000000000..8dcacd06a31de7bd21ab384bfb24bc0def9e4c3d --- /dev/null +++ b/R/CreateInputsModel.R @@ -0,0 +1,171 @@ +#************************************************************************************************* +#' Creation of the InputsModel object required to the RunModel functions. +#' +#' Users wanting to use FUN_MOD functions that are not included in +#' the package must create their own InputsModel object accordingly. +#************************************************************************************************* +#' @title Creation of the InputsModel object required to the RunModel functions +#' @author Laurent Coron (June 2014) +#' @seealso \code{\link{RunModel}}, \code{\link{CreateRunOptions}}, \code{\link{CreateInputsCrit}}, \code{\link{CreateCalibOptions}}, \code{\link{DataAltiExtrapolation_HBAN}} +#' @example tests/example_RunModel.R +#' @encoding UTF-8 +#' @export +#_FunctionInputs__________________________________________________________________________________ +#' @param FUN_MOD [function] hydrological model function (e.g. RunModel_GR4J, RunModel_CemaNeigeGR4J) +#' @param DatesR [POSIXlt] vector of dates required to create the GR model and CemaNeige module inputs +#' @param Precip [numeric] time series of total precipitation (catchment average) [mm], required to create the GR model and CemaNeige module inputs +#' @param PotEvap [numeric] time series of potential evapotranspiration (catchment average) [mm], required to create the GR model inputs +#' @param TempMean (optional) [numeric] time series of mean air temperature [degC], required to create the CemaNeige module inputs +#' @param TempMin (optional) [numeric] time series of min air temperature [degC], possibly used to create the CemaNeige module inputs +#' @param TempMax (optional) [numeric] time series of max air temperature [degC], possibly used to create the CemaNeige module inputs +#' @param ZInputs (optional) [numeric] real giving the mean elevation of the Precip and Temp series (before extrapolation) [m] +#' @param HypsoData (optional) [numeric] vector of 101 reals: min, q01 to q99 and max of catchment elevation distribution [m], required to create the GR model inputs, if not defined a single elevation is used for CemaNeige +#' @param NLayers (optional) [numeric] integer giving the number of elevation layers requested [-], required to create the GR model inputs, default=5 +#' @param quiet (optional) [boolean] boolean indicating if the function is run in quiet mode or not, default=FALSE +#_FunctionOutputs_________________________________________________________________________________ +#' @return [list] object of class \emph{InputsModel} containing the data required to evaluate the model outputs; it can include the following: +#' \tabular{ll}{ +#' \emph{$DatesR } \tab [POSIXlt] vector of dates \cr +#' \emph{$Precip } \tab [numeric] time series of total precipitation (catchment average) [mm] \cr +#' \emph{$PotEvap } \tab [numeric] time series of potential evapotranspiration (catchment average) [mm], \cr\tab defined if FUN_MOD includes GR4H, GR4J, GR5J, GR6J, GR2M or GR1A \cr \cr +#' \emph{$LayerPrecip } \tab [list] list of time series of precipitation (layer average) [mm], \cr\tab defined if FUN_MOD includes CemaNeige \cr \cr +#' \emph{$LayerTempMean } \tab [list] list of time series of mean air temperature (layer average) [degC], \cr\tab defined if FUN_MOD includes CemaNeige \cr \cr +#' \emph{$LayerFracSolidPrecip} \tab [list] list of time series of solid precip. fract. (layer average) [-], \cr\tab defined if FUN_MOD includes CemaNeige \cr \cr +#' } +#************************************************************************************************** +CreateInputsModel <- function(FUN_MOD,DatesR,Precip,PotEvap=NULL,TempMean=NULL,TempMin=NULL,TempMax=NULL,ZInputs=NULL,HypsoData=NULL,NLayers=5,quiet=FALSE){ + + ObjectClass <- NULL; + + ##check_FUN_MOD + BOOL <- FALSE; + if(identical(FUN_MOD,RunModel_GR4H)){ + ObjectClass <- c(ObjectClass,"hourly","GR"); + TimeStep <- as.integer(60*60); + BOOL <- TRUE; + } + if(identical(FUN_MOD,RunModel_GR4J) | identical(FUN_MOD,RunModel_GR5J) | identical(FUN_MOD,RunModel_GR6J)){ + ObjectClass <- c(ObjectClass,"daily","GR"); + TimeStep <- as.integer(24*60*60); + BOOL <- TRUE; + } + if(identical(FUN_MOD,RunModel_GR2M)){ + ObjectClass <- c(ObjectClass,"GR","monthly"); + TimeStep <- as.integer(c(28,29,30,31)*24*60*60); + BOOL <- TRUE; + } + if(identical(FUN_MOD,RunModel_GR1A)){ + ObjectClass <- c(ObjectClass,"GR","yearly"); + TimeStep <- as.integer(c(365,366)*24*60*60); + BOOL <- TRUE; + } + if(identical(FUN_MOD,RunModel_CemaNeige)){ + ObjectClass <- c(ObjectClass,"daily","CemaNeige"); + TimeStep <- as.integer(24*60*60); + BOOL <- TRUE; + } + if(identical(FUN_MOD,RunModel_CemaNeigeGR4J) | identical(FUN_MOD,RunModel_CemaNeigeGR5J) | identical(FUN_MOD,RunModel_CemaNeigeGR6J)){ + ObjectClass <- c(ObjectClass,"daily","GR","CemaNeige"); + TimeStep <- as.integer(24*60*60); + BOOL <- TRUE; + } + if(!BOOL){ stop("incorrect FUN_MOD for use in CreateInputsModel \n"); return(NULL); } + + ##check_arguments + if("GR" %in% ObjectClass | "CemaNeige" %in% ObjectClass){ + if(is.null(DatesR)){ stop("DatesR is missing \n"); return(NULL); } + if("POSIXlt" %in% class(DatesR) == FALSE & "POSIXct" %in% class(DatesR) == FALSE){ stop("DatesR must be defined as POSIXlt or POSIXct \n"); return(NULL); } + if("POSIXlt" %in% class(DatesR) == FALSE){ DatesR <- as.POSIXlt(DatesR); } + if(difftime(tail(DatesR,1),tail(DatesR,2),units="secs")[[1]] %in% TimeStep==FALSE){ stop(paste("the time step of the model inputs must be ",TimeStep," seconds \n",sep="")); return(NULL); } + LLL <- length(DatesR); + } + if("GR" %in% ObjectClass){ + if(is.null(Precip )){ stop("Precip is missing \n" ); return(NULL); } + if(is.null(PotEvap )){ stop("PotEvap is missing \n" ); return(NULL); } + if(!is.vector( Precip) | !is.vector( PotEvap)){ stop("Precip and PotEvap must be vectors of numeric values \n"); return(NULL); } + if(!is.numeric(Precip) | !is.numeric(PotEvap)){ stop("Precip and PotEvap must be vectors of numeric values \n"); return(NULL); } + if(length(Precip)!=LLL | length(PotEvap)!=LLL){ stop("Precip, PotEvap and DatesR must have the same length \n"); return(NULL); } + } + if("CemaNeige" %in% ObjectClass){ + if(is.null(Precip )){ stop("Precip is missing \n" ); return(NULL); } + if(is.null(TempMean)){ stop("TempMean is missing \n"); return(NULL); } + if(!is.vector( Precip) | !is.vector( TempMean)){ stop("Precip and TempMean must be vectors of numeric values \n"); return(NULL); } + if(!is.numeric(Precip) | !is.numeric(TempMean)){ stop("Precip and TempMean must be vectors of numeric values \n"); return(NULL); } + if(length(Precip)!=LLL | length(TempMean)!=LLL){ stop("Precip, TempMean and DatesR must have the same length \n"); return(NULL); } + if(is.null(TempMin)!=is.null(TempMax)){ stop("TempMin and TempMax must be both defined if not null \n"); return(NULL); } + if(!is.null(TempMin) & !is.null(TempMax)){ + if(!is.vector( TempMin) | !is.vector( TempMax)){ stop("TempMin and TempMax must be vectors of numeric values \n"); return(NULL); } + if(!is.numeric(TempMin) | !is.numeric(TempMax)){ stop("TempMin and TempMax must be vectors of numeric values \n"); return(NULL); } + if(length(TempMin)!=LLL | length(TempMax)!=LLL){ stop("TempMin, TempMax and DatesR must have the same length \n"); return(NULL); } + } + if(!is.null(HypsoData)){ + if(!is.vector( HypsoData)){ stop("HypsoData must be a vector of numeric values if not null \n"); return(NULL); } + if(!is.numeric(HypsoData)){ stop("HypsoData must be a vector of numeric values if not null \n"); return(NULL); } + if(length(HypsoData)!=101){ stop("HypsoData must be of length 101 if not null \n"); return(NULL); } + if(sum(is.na(HypsoData))!=0 & sum(is.na(HypsoData))!=101){ stop("HypsoData must not contain any NA if not null \n"); return(NULL); } + } + if(!is.null(ZInputs)){ + if(length(ZInputs)!=1 ){ stop("\t ZInputs must be a single numeric value if not null \n"); return(NULL); } + if(is.na(ZInputs) | !is.numeric(ZInputs)){ stop("\t ZInputs must be a single numeric value if not null \n"); return(NULL); } + } + if(is.null(HypsoData)){ + if(!quiet){ warning("\t HypsoData is missing => a single layer is used and no extrapolation is made \n"); } + HypsoData <- as.numeric(rep(NA,101)); ZInputs <- as.numeric(NA); NLayers <- as.integer(1); + } + if(is.null(ZInputs)){ + if(!quiet & !identical(HypsoData,as.numeric(rep(NA,101)))){ warning("\t ZInputs is missing => HypsoData[51] is used \n"); } + ZInputs <- HypsoData[51]; + } + } + + + ##check_NA_values + BOOL_NA <- rep(FALSE,length(DatesR)); + if("GR" %in% ObjectClass){ + BOOL_NA_TMP <- (Precip < 0) | is.na(Precip ); if(sum(BOOL_NA_TMP)!=0){ BOOL_NA <- BOOL_NA | BOOL_NA_TMP; if(!quiet){ warning("\t Values < 0 or NA values detected in Precip series \n"); } } + BOOL_NA_TMP <- (PotEvap < 0) | is.na(PotEvap); if(sum(BOOL_NA_TMP)!=0){ BOOL_NA <- BOOL_NA | BOOL_NA_TMP; if(!quiet){ warning("\t Values < 0 or NA values detected in PotEvap series \n"); } } + } + if("CemaNeige" %in% ObjectClass){ + BOOL_NA_TMP <- (Precip < 0 ) | is.na(Precip ); if(sum(BOOL_NA_TMP)!=0){ BOOL_NA <- BOOL_NA | BOOL_NA_TMP; if(!quiet){ warning("\t Values < 0 or NA values detected in Precip series \n"); } } + BOOL_NA_TMP <- (TempMean<(-150)) | is.na(TempMean); if(sum(BOOL_NA_TMP)!=0){ BOOL_NA <- BOOL_NA | BOOL_NA_TMP; if(!quiet){ warning("\t Values < -150) or NA values detected in TempMean series \n"); } } + if(!is.null(TempMin) & !is.null(TempMax)){ + BOOL_NA_TMP <- (TempMin<(-150)) | is.na(TempMin); if(sum(BOOL_NA_TMP)!=0){ BOOL_NA <- BOOL_NA | BOOL_NA_TMP; if(!quiet){ warning("\t Values < -150) or NA values detected in TempMin series \n"); } } + BOOL_NA_TMP <- (TempMax<(-150)) | is.na(TempMax); if(sum(BOOL_NA_TMP)!=0){ BOOL_NA <- BOOL_NA | BOOL_NA_TMP; if(!quiet){ warning("\t Values < -150) or NA values detected in TempMax series \n"); } } } + } + if(sum(BOOL_NA)!=0){ + WTxt <- NULL; + WTxt <- paste(WTxt,"\t Missing values are not allowed in InputsModel \n",sep=""); + Select <- (max(which(BOOL_NA))+1):length(BOOL_NA); + if(Select[1]>Select[2]){ stop(paste("time series could not be trunced since missing values were detected at the list time-step \n",sep="")); return(NULL); } + if("GR" %in% ObjectClass){ + Precip <- Precip[Select]; PotEvap <- PotEvap[Select]; } + if("CemaNeige" %in% ObjectClass){ + Precip <- Precip[Select]; TempMean <- TempMean[Select]; if(!is.null(TempMin) & !is.null(TempMax)){ TempMin <- TempMin[Select]; TempMax <- TempMax[Select]; } } + WTxt <- paste(WTxt,"\t -> data were trunced to keep the most recent available time-steps \n",sep=""); + WTxt <- paste(WTxt,"\t -> ",length(Select)," time-steps were kept \n",sep=""); + if(!is.null(WTxt) & !quiet){ warning(WTxt); } + } + + + ##DataAltiExtrapolation_HBAN + if("CemaNeige" %in% ObjectClass){ + RESULT <- DataAltiExtrapolation_HBAN(DatesR=DatesR,Precip=Precip,TempMean=TempMean,TempMin=TempMin,TempMax=TempMax,ZInputs=ZInputs,HypsoData=HypsoData,NLayers=NLayers,quiet=quiet); + if(!quiet){ if(NLayers==1){ cat(paste("\t Input series were successfully created on 1 elevation layer for use by CemaNeige \n",sep="")); + } else { cat(paste("\t Input series were successfully created on ",NLayers," elevation layers for use by CemaNeige \n",sep="")); } } + } + + + ##Create_InputsModel + InputsModel <- list(DatesR=DatesR); + if("GR" %in% ObjectClass){ + InputsModel <- c(InputsModel,list(Precip=as.double(Precip),PotEvap=as.double(PotEvap))); } + if("CemaNeige" %in% ObjectClass){ + InputsModel <- c(InputsModel,list(LayerPrecip=RESULT$LayerPrecip,LayerTempMean=RESULT$LayerTempMean, + LayerFracSolidPrecip=RESULT$LayerFracSolidPrecip,ZLayers=RESULT$ZLayers)); } + + class(InputsModel) <- c("InputsModel",ObjectClass); + return(InputsModel); + + +} + diff --git a/R/CreateRunOptions.R b/R/CreateRunOptions.R new file mode 100644 index 0000000000000000000000000000000000000000..35d930ee681fd9fbe966c2f30d65082fe13e6636 --- /dev/null +++ b/R/CreateRunOptions.R @@ -0,0 +1,295 @@ +#************************************************************************************************* +#' Creation of the RunOptions object required to the RunModel functions. +#' +#' Users wanting to use FUN_MOD functions that are not included in +#' the package must create their own RunOptions object accordingly. +#' +#' ##### Initialisation options ##### +#' +#' The model initialisation options can either be set to a default configuration or be defined by the user. +#' +#' This is done via three vectors: \cr \emph{IndPeriod_WarmUp}, \emph{IniStates}, \emph{IniResLevels}. \cr +#' A default configuration is used for initialisation if these vectors are not defined. +#' +#' (1) Default initialisation options: +#' +#' \itemize{ +#' \item \emph{IndPeriod_WarmUp} default setting ensures a one-year warm-up using the time-steps preceding the \emph{IndPeriod_Run}. +#' The actual length of this warm-up might be shorter depending on data availability (no missing value being allowed on model input series). +#' +#' \item \emph{IniStates} and \emph{IniResLevels} are automatically set to initialise all the model states at 0, except for the production and routing stores which are initialised at 50\% of their capacity. This initialisation is made at the very beginning of the model call (i.e. at the beginning of \emph{IndPeriod_WarmUp} or at the beginning of IndPeriod_Run if the warm-up period is disabled). +#' } +#' +#' (2) Customisation of initialisation options: +#' +#' \itemize{ +#' \item \emph{IndPeriod_WarmUp} can be used to specify the indices of the warm-up period (within the time-series prepared in InputsModel). \cr +#' - remark 1: for most common cases, indices corresponding to one or several years preceding \emph{IndPeriod_Run} are used (e.g. \emph{IndPeriod_WarmUp <- 1000:1365} and \emph{IndPeriod_Run <- 1366:5000)}. \cr +#' However, it is also possible to perform a long-term initialisation if other indices than the warm-up ones are set in \emph{IndPeriod_WarmUp} (e.g. \emph{IndPeriod_WarmUp <- c( 1:5000 , 1:5000 , 1:5000 ,1000:1365 )}). \cr +#' - remark 2: it is also possible to completely disable the warm-up period when using \emph{IndPeriod_WarmUp <- 0}. +#' +#' \item \emph{IniStates} and \emph{IniResLevels} can be used to specify the initial model states. \cr +#' - remark 1: if \emph{IniStates} is used, all model states must be provided (e.g. 60 floats [mm] are required for GR4J, GR5J and GR6J; 60+2*NLayers floats [mm] are required for CemaNeigeGR4J, CemaNeigeGR5J and CemaNeigeGR6J; see fortran source code for details). \cr +#' - remark 2: in addition to \emph{IniStates}, \emph{IniResLevels} allows to set the filling rate of the production and routing stores for the GR models. For instance for GR4J, GR5J and GR6J: \emph{IniResLevels <- c(0.3,0.5)} should be used to obtain initial fillings of 30\% and 50\% for the production and routing stores, respectively. \emph{IniResLevels} is optional and can only be used if \emph{IniStates} is also defined (the state values corresponding to these two stores in \emph{IniStates} are not used in such case). \cr \cr +#' } +#************************************************************************************************* +#' @title Creation of the RunOptions object required to the RunModel functions +#' @author Laurent Coron (June 2014) +#' @seealso \code{\link{RunModel}}, \code{\link{CreateInputsModel}}, \code{\link{CreateInputsCrit}}, \code{\link{CreateCalibOptions}} +#' @example tests/example_RunModel.R +#' @encoding UTF-8 +#' @export +#_FunctionInputs__________________________________________________________________________________ +#' @param FUN_MOD [function] hydrological model function (e.g. RunModel_GR4J, RunModel_CemaNeigeGR4J) +#' @param InputsModel [object of class \emph{InputsModel}] see \code{\link{CreateInputsModel}} for details +#' @param IndPeriod_WarmUp (optional) [numeric] index of period to be used for the model warm-up [-] +#' @param IndPeriod_Run [numeric] index of period to be used for the model run [-] +#' @param IniStates (optional) [numeric] vector of initial model states [mm] +#' @param IniResLevels (optional) [numeric] vector of initial filling rates for production and routing stores (2 values between 0 and 1) [-] +#' @param Outputs_Cal (optional) [character] vector giving the outputs needed for the calibration \cr (e.g. c("Qsim")), the least outputs the fastest the calibration +#' @param Outputs_Sim (optional) [character] vector giving the requested outputs \cr (e.g. c("DatesR","Qsim","SnowPack")), default="all" +#' @param RunSnowModule (optional) [boolean] option indicating whether CemaNeige should be activated, default=TRUE +#' @param MeanAnSolidPrecip (optional) [numeric] vector giving the annual mean of average solid precipitation for each layer (computed from InputsModel if not defined) [mm/y] +#' @param quiet (optional) [boolean] boolean indicating if the function is run in quiet mode or not, default=FALSE +#_FunctionOutputs_________________________________________________________________________________ +#' @return [list] object of class \emph{RunOptions} containing the data required to evaluate the model outputs; it can include the following: +#' \tabular{ll}{ +#' \emph{IndPeriod_WarmUp } \tab [numeric] index of period to be used for the model warm-up [-] \cr +#' \emph{IndPeriod_Run } \tab [numeric] index of period to be used for the model run [-] \cr +#' \emph{IniStates } \tab [numeric] vector of initial model states [mm] \cr +#' \emph{IniResLevels } \tab [numeric] vector of initial filling rates for production and routing stores [-] \cr +#' \emph{Outputs_Cal } \tab [character] character vector giving only the outputs needed for the calibration \cr +#' \emph{Outputs_Sim } \tab [character] character vector giving the requested outputs \cr +#' \emph{RunSnowModule } \tab [boolean] option indicating whether CemaNeige should be activated \cr +#' \emph{MeanAnSolidPrecip} \tab [numeric] vector giving the annual mean of average solid precipitation for each layer [mm/y] \cr +#' } +#**************************************************************************************************' +CreateRunOptions <- function(FUN_MOD,InputsModel,IndPeriod_WarmUp=NULL,IndPeriod_Run,IniStates=NULL,IniResLevels=NULL, + Outputs_Cal=NULL,Outputs_Sim="all",RunSnowModule=TRUE,MeanAnSolidPrecip=NULL,quiet=FALSE){ + + + ObjectClass <- NULL; + + ##check_FUN_MOD + BOOL <- FALSE; + if(identical(FUN_MOD,RunModel_GR4H)){ + ObjectClass <- c(ObjectClass,"GR","hourly"); + BOOL <- TRUE; + } + if(identical(FUN_MOD,RunModel_GR4J) | identical(FUN_MOD,RunModel_GR5J) | identical(FUN_MOD,RunModel_GR6J)){ + ObjectClass <- c(ObjectClass,"GR","daily"); + BOOL <- TRUE; + } + if(identical(FUN_MOD,RunModel_GR2M)){ + ObjectClass <- c(ObjectClass,"GR","monthly"); + BOOL <- TRUE; + } + if(identical(FUN_MOD,RunModel_GR1A)){ + ObjectClass <- c(ObjectClass,"GR","yearly"); + BOOL <- TRUE; + } + if(identical(FUN_MOD,RunModel_CemaNeige)){ + ObjectClass <- c(ObjectClass,"CemaNeige","daily"); + BOOL <- TRUE; + } + if(identical(FUN_MOD,RunModel_CemaNeigeGR4J) | identical(FUN_MOD,RunModel_CemaNeigeGR5J) | identical(FUN_MOD,RunModel_CemaNeigeGR6J)){ + ObjectClass <- c(ObjectClass,"GR","CemaNeige","daily"); + BOOL <- TRUE; + } + if(!BOOL){ stop("incorrect FUN_MOD for use in CreateRunOptions \n"); return(NULL); } + + + ##check_InputsModel + if(!inherits(InputsModel,"InputsModel")){ + stop("InputsModel must be of class 'InputsModel' \n"); return(NULL); } + if("GR" %in% ObjectClass & !inherits(InputsModel,"GR")){ + stop("InputsModel must be of class 'GR' \n"); return(NULL); } + if("CemaNeige" %in% ObjectClass & !inherits(InputsModel,"CemaNeige")){ + stop("InputsModel must be of class 'CemaNeige' \n"); return(NULL); } + if("hourly" %in% ObjectClass & !inherits(InputsModel,"hourly")){ + stop("InputsModel must be of class 'hourly' \n"); return(NULL); } + if("daily" %in% ObjectClass & !inherits(InputsModel,"daily")){ + stop("InputsModel must be of class 'daily' \n"); return(NULL); } + if("monthly" %in% ObjectClass & !inherits(InputsModel,"monthly")){ + stop("InputsModel must be of class 'monthly' \n"); return(NULL); } + if("yearly" %in% ObjectClass & !inherits(InputsModel,"yearly")){ + stop("InputsModel must be of class 'yearly' \n"); return(NULL); } + + + ##check_IndPeriod_Run + if(!is.vector( IndPeriod_Run)){ stop("IndPeriod_Run must be a vector of numeric values \n"); return(NULL); } + if(!is.numeric(IndPeriod_Run)){ stop("IndPeriod_Run must be a vector of numeric values \n"); return(NULL); } + if(identical(as.integer(IndPeriod_Run),as.integer(seq(from=IndPeriod_Run[1],to=tail(IndPeriod_Run,1),by=1)))==FALSE){ + stop("IndPeriod_Run must be a continuous sequence of integers \n"); return(NULL); } + if(storage.mode(IndPeriod_Run)!="integer"){ stop("IndPeriod_Run should be of type integer \n"); return(NULL); } + + + ##check_IndPeriod_WarmUp + WTxt <- NULL; + if(is.null(IndPeriod_WarmUp)){ + WTxt <- paste(WTxt,"\t Model warm-up period not defined -> default configuration used \n",sep=""); + ##If_the_run_period_starts_at_the_very_beginning_of_the_time_series + if(IndPeriod_Run[1]==as.integer(1)){ + IndPeriod_WarmUp <- as.integer(0); + WTxt <- paste(WTxt,"\t No data were found for model warm-up! \n",sep=""); + ##We_look_for_the_longest_period_preceeding_the_run_period_with_a_maximum_of_one_year + } else { + TmpDateR <- InputsModel$DatesR[IndPeriod_Run[1]] - 365*24*60*60; ### minimal date to start the warmup + IndPeriod_WarmUp <- which(InputsModel$DatesR==max(InputsModel$DatesR[1],TmpDateR)) : (IndPeriod_Run[1]-1); + if("hourly" %in% ObjectClass){ TimeStep <- as.integer( 60*60); } + if("daily" %in% ObjectClass){ TimeStep <- as.integer( 24*60*60); } + if("monthly" %in% ObjectClass){ TimeStep <- as.integer( 30.44*24*60*60); } + if("yearly" %in% ObjectClass){ TimeStep <- as.integer(365.25*24*60*60); } + if(length(IndPeriod_WarmUp)*TimeStep/(365*24*60*60)>=1){ + WTxt <- paste(WTxt,"\t The year preceding the run period is used \n",sep=""); + } else { + WTxt <- paste(WTxt,"\t Less than a year (without missing values) was found for model warm-up: \n",sep=""); + WTxt <- paste(WTxt,"\t (",length(IndPeriod_WarmUp)," time-steps are used for initialisation) \n",sep=""); + } + } + } + if(!is.null(IndPeriod_WarmUp)){ + if(!is.vector( IndPeriod_WarmUp)){ stop("IndPeriod_Run must be a vector of numeric values \n"); return(NULL); } + if(!is.numeric(IndPeriod_WarmUp)){ stop("IndPeriod_Run must be a vector of numeric values \n"); return(NULL); } + if(storage.mode(IndPeriod_WarmUp)!="integer"){ stop("IndPeriod_Run should be of type integer \n"); return(NULL); } + if(identical(IndPeriod_WarmUp,as.integer(0))){ + WTxt <- paste(WTxt,"\t No warm-up period is used! \n",sep=""); } + if((IndPeriod_Run[1]-1)!=tail(IndPeriod_WarmUp,1) & !identical(IndPeriod_WarmUp,as.integer(0))){ + WTxt <- paste(WTxt,"\t Model warm-up period is not directly before the model run period \n",sep=""); } + } + if(!is.null(WTxt) & !quiet){ warning(WTxt); } + + + ##check_IniStates_and_IniResLevels + if(is.null(IniStates) & is.null(IniResLevels) & !quiet){ + warning("\t Model states initialisation not defined -> default configuration used \n"); } + if("CemaNeige" %in% ObjectClass){ NLayers <- length(InputsModel$LayerPrecip); } else { NLayers <- 0; } + NState <- NULL; + if("GR" %in% ObjectClass | "CemaNeige" %in% ObjectClass){ + if("hourly" %in% ObjectClass){ NState <- 3*24*20; } + if("daily" %in% ObjectClass){ NState <- 3*20 + 2*NLayers; } + if("monthly" %in% ObjectClass){ NState <- 2; } + if("yearly" %in% ObjectClass){ NState <- 1; } + } + if(!is.null(IniStates)){ + if(!is.vector( IniStates) ){ stop("IniStates must be a vector of numeric values \n"); return(NULL); } + if(!is.numeric(IniStates) ){ stop("IniStates must be a vector of numeric values \n"); return(NULL); } + if(length(IniStates)!=NState){ stop(paste("The length of IniStates must be ",NState," for the chosen FUN_MOD \n",sep="")); return(NULL); } + } else { + IniStates <- as.double(rep(0.0,NState)); + } + if("GR" %in% ObjectClass & ("monthly" %in% ObjectClass | "daily" %in% ObjectClass | "hourly" %in% ObjectClass)){ + if(!is.null(IniResLevels)){ + if(!is.vector(IniResLevels) ){ stop("IniResLevels must be a vector of numeric values \n"); return(NULL); } + if(!is.numeric(IniResLevels)){ stop("IniResLevels must be a vector of numeric values \n"); return(NULL); } + if(length(IniResLevels)!=2 ) { stop("The length of IniStates must be 2 for the chosen FUN_MOD \n"); return(NULL); } + } else { + IniResLevels <- as.double(c(0.3,0.5)); + } + } else { + if(!is.null(IniResLevels)){ stop("IniResLevels can only be used with monthly or daily or hourly GR models \n") } + } + + + ##check_Outputs_Cal_and_Sim + + ##Outputs_all + Outputs_all <- NULL; + if(identical(FUN_MOD,RunModel_GR4H)){ + Outputs_all <- c(Outputs_all,"PotEvap","Precip","Prod","AE","Perc","PR","Q9","Q1","Rout","Exch","AExch","QR","QD","Qsim"); } + if(identical(FUN_MOD,RunModel_GR4J) | identical(FUN_MOD,RunModel_CemaNeigeGR4J)){ + Outputs_all <- c(Outputs_all,"PotEvap","Precip","Prod","AE","Perc","PR","Q9","Q1","Rout","Exch","AExch","QR","QD","Qsim"); } + if(identical(FUN_MOD,RunModel_GR5J) | identical(FUN_MOD,RunModel_CemaNeigeGR5J)){ + Outputs_all <- c(Outputs_all,"PotEvap","Precip","Prod","AE","Perc","PR","Q9","Q1","Rout","Exch","AExch","QR","QD","Qsim"); } + if(identical(FUN_MOD,RunModel_GR6J) | identical(FUN_MOD,RunModel_CemaNeigeGR6J)){ + Outputs_all <- c(Outputs_all,"PotEvap","Precip","Prod","AE","Perc","PR","Q9","Q1","Rout","Exch","AExch","QR","QR1","Exp","QD","Qsim"); } + if(identical(FUN_MOD,RunModel_GR2M)){ + Outputs_all <- c(Outputs_all,"PotEvap","Precip","Qsim"); } + if(identical(FUN_MOD,RunModel_GR1A)){ + Outputs_all <- c(Outputs_all,"PotEvap","Precip","Qsim"); } + if("CemaNeige" %in% ObjectClass){ + Outputs_all <- c(Outputs_all,"Pliq","Psol","SnowPack","ThermalState","Gratio","PotMelt","Melt","PliqAndMelt"); } + + ##check_Outputs_Sim + if(!is.vector( Outputs_Sim)){ stop("Outputs_Sim must be a vector of characters \n"); return(NULL); } + if(!is.character(Outputs_Sim)){ stop("Outputs_Sim must be a vector of characters \n"); return(NULL); } + if(sum(is.na(Outputs_Sim))!=0){ stop("Outputs_Sim must not contain NA \n"); return(NULL); } + if("all" %in% Outputs_Sim){ Outputs_Sim <- c("DatesR",Outputs_all,"StateEnd"); } + Test <- which(Outputs_Sim %in% c("DatesR",Outputs_all,"StateEnd") == FALSE); if(length(Test)!=0){ + stop(paste("Outputs_Sim is incorrectly defined: ",paste(Outputs_Sim[Test],collapse=", ")," not found \n",sep="")); return(NULL); } + Outputs_Sim <- Outputs_Sim[!duplicated(Outputs_Sim)]; + + ##check_Outputs_Cal + if(is.null(Outputs_Cal)){ + if("GR" %in% ObjectClass ){ Outputs_Cal <- c("Qsim"); } + if("CemaNeige" %in% ObjectClass ){ Outputs_Cal <- c("all"); } + if("GR" %in% ObjectClass & "CemaNeige" %in% ObjectClass){ Outputs_Cal <- c("PliqAndMelt","Qsim"); } + } else { + if(!is.vector( Outputs_Cal)){ stop("Outputs_Cal must be a vector of characters \n"); return(NULL); } + if(!is.character(Outputs_Cal)){ stop("Outputs_Cal must be a vector of characters \n"); return(NULL); } + if(sum(is.na(Outputs_Cal))!=0){ stop("Outputs_Cal must not contain NA \n"); return(NULL); } + } + if("all" %in% Outputs_Cal){ Outputs_Cal <- c("DatesR",Outputs_all,"StateEnd"); } + Test <- which(Outputs_Cal %in% c("DatesR",Outputs_all,"StateEnd") == FALSE); if(length(Test)!=0){ + stop(paste("Outputs_Cal is incorrectly defined: ",paste(Outputs_Cal[Test],collapse=", ")," not found \n",sep="")); return(NULL); } + Outputs_Cal <- Outputs_Cal[!duplicated(Outputs_Cal)]; + + + ##check_RunSnowModule + if("CemaNeige" %in% ObjectClass){ + if(!is.vector( RunSnowModule)){ stop("RunSnowModule must be a single boolean \n"); return(NULL); } + if(!is.logical(RunSnowModule)){ stop("RunSnowModule must be either TRUE or FALSE \n"); return(NULL); } + if(length(RunSnowModule)!=1 ){ stop("RunSnowModule must be either TRUE or FALSE \n"); return(NULL); } + } + + + ##check_MeanAnSolidPrecip + if("CemaNeige" %in% ObjectClass & is.null(MeanAnSolidPrecip)){ + NLayers <- length(InputsModel$LayerPrecip); + SolidPrecip <- NULL; for(iLayer in 1:NLayers){ + if(iLayer==1){ SolidPrecip <- InputsModel$LayerFracSolidPrecip[[1]]*InputsModel$LayerPrecip[[iLayer]]/NLayers; + } else { SolidPrecip <- SolidPrecip + InputsModel$LayerFracSolidPrecip[[iLayer]]*InputsModel$LayerPrecip[[iLayer]]/NLayers; } } + Factor <- NULL; + if(inherits(InputsModel,"hourly" )){ Factor <- 365.25*24; } + if(inherits(InputsModel,"daily" )){ Factor <- 365.25; } + if(inherits(InputsModel,"monthly")){ Factor <- 12; } + if(inherits(InputsModel,"yearly" )){ Factor <- 1; } + if(is.null(Factor)){ stop("InputsModel must be of class 'hourly', 'daily', 'monthly' or 'yearly' \n"); return(NULL); } + MeanAnSolidPrecip <- rep(mean(SolidPrecip)*Factor,NLayers); ### default value: same Gseuil for all layers + if(!quiet){ warning("\t MeanAnSolidPrecip not defined -> it was automatically set to c(",paste(round(MeanAnSolidPrecip),collapse=","),") \n"); } + } + if("CemaNeige" %in% ObjectClass & !is.null(MeanAnSolidPrecip)){ + if(!is.vector( MeanAnSolidPrecip) ){ stop(paste("MeanAnSolidPrecip must be a vector of numeric values \n",sep="")); return(NULL); } + if(!is.numeric(MeanAnSolidPrecip) ){ stop(paste("MeanAnSolidPrecip must be a vector of numeric values \n",sep="")); return(NULL); } + if(length(MeanAnSolidPrecip)!=NLayers){ stop(paste("MeanAnSolidPrecip must be a numeric vector of length ",NLayers," \n",sep="")); return(NULL); } + } + + + ##check_PliqAndMelt + if(RunSnowModule & "GR" %in% ObjectClass & "CemaNeige" %in% ObjectClass){ + if("PliqAndMelt" %in% Outputs_Cal == FALSE & "all" %in% Outputs_Cal == FALSE){ + WTxt <- NULL; + WTxt <- paste(WTxt,"\t PliqAndMelt was not defined in Outputs_Cal but is needed to feed the hydrological model with the snow module outputs \n",sep=""); + WTxt <- paste(WTxt,"\t -> it was automatically added \n",sep=""); + if(!is.null(WTxt) & !quiet){ warning(WTxt); } + Outputs_Cal <- c(Outputs_Cal,"PliqAndMelt"); } + if("PliqAndMelt" %in% Outputs_Sim == FALSE & "all" %in% Outputs_Sim == FALSE){ + WTxt <- NULL; + WTxt <- paste(WTxt,"\t PliqAndMelt was not defined in Outputs_Sim but is needed to feed the hydrological model with the snow module outputs \n",sep=""); + WTxt <- paste(WTxt,"\t -> it was automatically added \n",sep=""); + if(!is.null(WTxt) & !quiet){ warning(WTxt); } + Outputs_Sim <- c(Outputs_Sim,"PliqAndMelt"); } + } + + + ##Create_RunOptions + RunOptions <- list(IndPeriod_WarmUp=IndPeriod_WarmUp,IndPeriod_Run=IndPeriod_Run,IniStates=IniStates,IniResLevels=IniResLevels, + Outputs_Cal=Outputs_Cal,Outputs_Sim=Outputs_Sim); + if("CemaNeige" %in% ObjectClass){ + RunOptions <- c(RunOptions,list(RunSnowModule=RunSnowModule,MeanAnSolidPrecip=MeanAnSolidPrecip)); } + class(RunOptions) <- c("RunOptions",ObjectClass); + return(RunOptions); + + +} + diff --git a/R/DataAltiExtrapolation_HBAN.R b/R/DataAltiExtrapolation_HBAN.R new file mode 100644 index 0000000000000000000000000000000000000000..7a5354b615e6489fb339f9f5d0ca7797a0583da9 --- /dev/null +++ b/R/DataAltiExtrapolation_HBAN.R @@ -0,0 +1,540 @@ +#***************************************************************************************************************** +#' Function which extrapolates the precipitation and air temperature series for different elevation layers (method from Valery, 2010). +#' +#' Elevation layers of equal surface are created the 101 elevation quantiles (\emph{HypsoData}) +#' and the number requested elevation layers (\emph{NLayers}). \cr +#' Forcing data (precipitation and air temperature) are extrapolated using gradients from Valery (2010). +#' (e.g. gradP=0.0004 [m-1] for France and gradT=0.434 [degreC/100m] for January, 1st). \cr +#' This function is used by the \emph{CreateInputsModel} function. \cr +#***************************************************************************************************************** +#' @title Altitudinal extrapolation of precipitation and temperature series +#' @author Laurent Coron, Pierre Brigode (June 2014) +#' @references +#' Turcotte, R., L.-G. Fortin, V. Fortin, J.-P. Fortin and J.-P. Villeneuve (2007), +#' Operational analysis of the spatial distribution and the temporal evolution of the snowpack water equivalent +#' in southern Quebec, Canada, Nordic Hydrology, 38(3), 211, doi:10.2166/nh.2007.009. \cr +#' Valéry, A. (2010), Modélisation précipitations-débit sous influence nivale ? : Elaboration d'un module neige +#' et évaluation sur 380 bassins versants, PhD thesis (in french), AgroParisTech, Paris, France. \cr +#' USACE (1956), Snow Hydrology, pp. 437, U.S. Army Coprs of Engineers (USACE) North Pacific Division, Portland, Oregon, USA. +#' @seealso \code{\link{CreateInputsModel}}, \code{\link{RunModel_CemaNeigeGR4J}} +#' @encoding UTF-8 +#' @export +#_FunctionInputs__________________________________________________________________________________________________ +#' @param DatesR [POSIXlt] vector of dates +#' @param Precip [numeric] time series of daily total precipitation (catchment average) [mm] +#' @param TempMean [numeric] time series of daily mean air temperature [degC] +#' @param TempMin (optional) [numeric] time series of daily min air temperature [degC] +#' @param TempMax (optional) [numeric] time series of daily max air temperature [degC] +#' @param ZInputs [numeric] real giving the mean elevation of the Precip and Temp series (before extrapolation) [m] +#' @param HypsoData [numeric] vector of 101 reals: min, q01 to q99 and max of catchment elevation distribution [m] +#' @param NLayers [numeric] integer giving the number of elevation layers requested [-] +#' @param quiet (optional) [boolean] boolean indicating if the function is run in quiet mode or not, default=FALSE +#_FunctionOutputs_________________________________________________________________________________________________ +#' @return list containing the extrapolated series of precip. and air temp. on each elevation layer +#' \tabular{ll}{ +#' \emph{$LayerPrecip } \tab [list] list of time series of daily precipitation (layer average) [mm] \cr +#' \emph{$LayerTempMean } \tab [list] list of time series of daily mean air temperature (layer average) [degC] \cr +#' \emph{$LayerTempMin } \tab [list] list of time series of daily min air temperature (layer average) [degC] \cr +#' \emph{$LayerTempMax } \tab [list] list of time series of daily max air temperature (layer average) [degC] \cr +#' \emph{$LayerFracSolidPrecip} \tab [list] list of time series of daily solid precip. fract. (layer average) [-] \cr +#' \emph{$ZLayers } \tab [numeric] vector of median elevation for each layer \cr +#' } +#***************************************************************************************************************** +DataAltiExtrapolation_HBAN <- function(DatesR,Precip,TempMean,TempMin=NULL,TempMax=NULL,ZInputs,HypsoData,NLayers,quiet=FALSE){ + + + ##Altitudinal_gradient_functions_______________________________________________________________ + ##unique_gradient_for_precipitation + GradP_Valery2010 <- function(){ + return(0.00041); ### value from Val? PhD thesis page 126 + } + ##daily_gradients_for_mean_min_and_max_air_temperature + GradT_Valery2010 <- function(){ + RESULT <- matrix(c( + 1, 1, 0.434, 0.366, 0.498, + 2, 1, 0.434, 0.366, 0.500, + 3, 1, 0.435, 0.367, 0.501, + 4, 1, 0.436, 0.367, 0.503, + 5, 1, 0.437, 0.367, 0.504, + 6, 1, 0.439, 0.367, 0.506, + 7, 1, 0.440, 0.367, 0.508, + 8, 1, 0.441, 0.368, 0.510, + 9, 1, 0.442, 0.368, 0.512, + 10, 1, 0.444, 0.368, 0.514, + 11, 1, 0.445, 0.368, 0.517, + 12, 1, 0.446, 0.368, 0.519, + 13, 1, 0.448, 0.369, 0.522, + 14, 1, 0.450, 0.369, 0.525, + 15, 1, 0.451, 0.369, 0.527, + 16, 1, 0.453, 0.370, 0.530, + 17, 1, 0.455, 0.370, 0.533, + 18, 1, 0.456, 0.370, 0.537, + 19, 1, 0.458, 0.371, 0.540, + 20, 1, 0.460, 0.371, 0.543, + 21, 1, 0.462, 0.371, 0.547, + 22, 1, 0.464, 0.372, 0.550, + 23, 1, 0.466, 0.372, 0.554, + 24, 1, 0.468, 0.373, 0.558, + 25, 1, 0.470, 0.373, 0.561, + 26, 1, 0.472, 0.374, 0.565, + 27, 1, 0.474, 0.374, 0.569, + 28, 1, 0.476, 0.375, 0.573, + 29, 1, 0.478, 0.375, 0.577, + 30, 1, 0.480, 0.376, 0.582, + 31, 1, 0.483, 0.376, 0.586, + 1, 2, 0.485, 0.377, 0.590, + 2, 2, 0.487, 0.377, 0.594, + 3, 2, 0.489, 0.378, 0.599, + 4, 2, 0.492, 0.379, 0.603, + 5, 2, 0.494, 0.379, 0.607, + 6, 2, 0.496, 0.380, 0.612, + 7, 2, 0.498, 0.381, 0.616, + 8, 2, 0.501, 0.381, 0.621, + 9, 2, 0.503, 0.382, 0.625, + 10, 2, 0.505, 0.383, 0.630, + 11, 2, 0.508, 0.384, 0.634, + 12, 2, 0.510, 0.384, 0.639, + 13, 2, 0.512, 0.385, 0.643, + 14, 2, 0.515, 0.386, 0.648, + 15, 2, 0.517, 0.387, 0.652, + 16, 2, 0.519, 0.387, 0.657, + 17, 2, 0.522, 0.388, 0.661, + 18, 2, 0.524, 0.389, 0.666, + 19, 2, 0.526, 0.390, 0.670, + 20, 2, 0.528, 0.391, 0.674, + 21, 2, 0.530, 0.392, 0.679, + 22, 2, 0.533, 0.393, 0.683, + 23, 2, 0.535, 0.393, 0.687, + 24, 2, 0.537, 0.394, 0.691, + 25, 2, 0.539, 0.395, 0.695, + 26, 2, 0.541, 0.396, 0.699, + 27, 2, 0.543, 0.397, 0.703, + 28, 2, 0.545, 0.398, 0.707, + 29, 2, 0.546, 0.399, 0.709, + 1, 3, 0.547, 0.399, 0.711, + 2, 3, 0.549, 0.400, 0.715, + 3, 3, 0.551, 0.401, 0.718, + 4, 3, 0.553, 0.402, 0.722, + 5, 3, 0.555, 0.403, 0.726, + 6, 3, 0.557, 0.404, 0.729, + 7, 3, 0.559, 0.405, 0.732, + 8, 3, 0.560, 0.406, 0.736, + 9, 3, 0.562, 0.406, 0.739, + 10, 3, 0.564, 0.407, 0.742, + 11, 3, 0.566, 0.408, 0.745, + 12, 3, 0.567, 0.409, 0.748, + 13, 3, 0.569, 0.410, 0.750, + 14, 3, 0.570, 0.411, 0.753, + 15, 3, 0.572, 0.412, 0.756, + 16, 3, 0.573, 0.413, 0.758, + 17, 3, 0.575, 0.414, 0.761, + 18, 3, 0.576, 0.415, 0.763, + 19, 3, 0.577, 0.416, 0.765, + 20, 3, 0.579, 0.417, 0.767, + 21, 3, 0.580, 0.417, 0.769, + 22, 3, 0.581, 0.418, 0.771, + 23, 3, 0.582, 0.419, 0.773, + 24, 3, 0.583, 0.420, 0.774, + 25, 3, 0.584, 0.421, 0.776, + 26, 3, 0.585, 0.422, 0.777, + 27, 3, 0.586, 0.422, 0.779, + 28, 3, 0.587, 0.423, 0.780, + 29, 3, 0.588, 0.424, 0.781, + 30, 3, 0.589, 0.425, 0.782, + 31, 3, 0.590, 0.425, 0.783, + 1, 4, 0.591, 0.426, 0.784, + 2, 4, 0.591, 0.427, 0.785, + 3, 4, 0.592, 0.427, 0.785, + 4, 4, 0.593, 0.428, 0.786, + 5, 4, 0.593, 0.429, 0.787, + 6, 4, 0.594, 0.429, 0.787, + 7, 4, 0.595, 0.430, 0.787, + 8, 4, 0.595, 0.431, 0.788, + 9, 4, 0.596, 0.431, 0.788, + 10, 4, 0.596, 0.432, 0.788, + 11, 4, 0.597, 0.432, 0.788, + 12, 4, 0.597, 0.433, 0.788, + 13, 4, 0.597, 0.433, 0.788, + 14, 4, 0.598, 0.434, 0.788, + 15, 4, 0.598, 0.434, 0.788, + 16, 4, 0.598, 0.435, 0.787, + 17, 4, 0.599, 0.435, 0.787, + 18, 4, 0.599, 0.436, 0.787, + 19, 4, 0.599, 0.436, 0.786, + 20, 4, 0.599, 0.436, 0.786, + 21, 4, 0.600, 0.437, 0.785, + 22, 4, 0.600, 0.437, 0.785, + 23, 4, 0.600, 0.437, 0.784, + 24, 4, 0.600, 0.438, 0.784, + 25, 4, 0.600, 0.438, 0.783, + 26, 4, 0.601, 0.438, 0.783, + 27, 4, 0.601, 0.438, 0.782, + 28, 4, 0.601, 0.439, 0.781, + 29, 4, 0.601, 0.439, 0.781, + 30, 4, 0.601, 0.439, 0.780, + 1, 5, 0.601, 0.439, 0.779, + 2, 5, 0.601, 0.439, 0.778, + 3, 5, 0.601, 0.439, 0.778, + 4, 5, 0.601, 0.440, 0.777, + 5, 5, 0.601, 0.440, 0.776, + 6, 5, 0.601, 0.440, 0.775, + 7, 5, 0.601, 0.440, 0.775, + 8, 5, 0.601, 0.440, 0.774, + 9, 5, 0.601, 0.440, 0.773, + 10, 5, 0.602, 0.440, 0.772, + 11, 5, 0.602, 0.440, 0.772, + 12, 5, 0.602, 0.440, 0.771, + 13, 5, 0.602, 0.440, 0.770, + 14, 5, 0.602, 0.440, 0.770, + 15, 5, 0.602, 0.440, 0.769, + 16, 5, 0.602, 0.440, 0.768, + 17, 5, 0.602, 0.440, 0.768, + 18, 5, 0.602, 0.440, 0.767, + 19, 5, 0.602, 0.440, 0.767, + 20, 5, 0.602, 0.440, 0.766, + 21, 5, 0.602, 0.440, 0.766, + 22, 5, 0.602, 0.440, 0.765, + 23, 5, 0.602, 0.440, 0.765, + 24, 5, 0.602, 0.440, 0.764, + 25, 5, 0.602, 0.440, 0.764, + 26, 5, 0.602, 0.440, 0.764, + 27, 5, 0.602, 0.439, 0.763, + 28, 5, 0.602, 0.439, 0.763, + 29, 5, 0.602, 0.439, 0.763, + 30, 5, 0.602, 0.439, 0.762, + 31, 5, 0.602, 0.439, 0.762, + 1, 6, 0.602, 0.439, 0.762, + 2, 6, 0.602, 0.439, 0.762, + 3, 6, 0.602, 0.439, 0.762, + 4, 6, 0.602, 0.439, 0.762, + 5, 6, 0.602, 0.439, 0.762, + 6, 6, 0.602, 0.438, 0.761, + 7, 6, 0.602, 0.438, 0.761, + 8, 6, 0.602, 0.438, 0.761, + 9, 6, 0.602, 0.438, 0.761, + 10, 6, 0.602, 0.438, 0.761, + 11, 6, 0.602, 0.438, 0.762, + 12, 6, 0.602, 0.438, 0.762, + 13, 6, 0.602, 0.438, 0.762, + 14, 6, 0.602, 0.438, 0.762, + 15, 6, 0.602, 0.437, 0.762, + 16, 6, 0.602, 0.437, 0.762, + 17, 6, 0.602, 0.437, 0.762, + 18, 6, 0.602, 0.437, 0.762, + 19, 6, 0.602, 0.437, 0.763, + 20, 6, 0.602, 0.437, 0.763, + 21, 6, 0.602, 0.437, 0.763, + 22, 6, 0.602, 0.436, 0.763, + 23, 6, 0.602, 0.436, 0.763, + 24, 6, 0.602, 0.436, 0.764, + 25, 6, 0.602, 0.436, 0.764, + 26, 6, 0.601, 0.436, 0.764, + 27, 6, 0.601, 0.436, 0.764, + 28, 6, 0.601, 0.436, 0.764, + 29, 6, 0.601, 0.435, 0.765, + 30, 6, 0.601, 0.435, 0.765, + 1, 7, 0.601, 0.435, 0.765, + 2, 7, 0.600, 0.435, 0.765, + 3, 7, 0.600, 0.435, 0.765, + 4, 7, 0.600, 0.434, 0.766, + 5, 7, 0.600, 0.434, 0.766, + 6, 7, 0.599, 0.434, 0.766, + 7, 7, 0.599, 0.434, 0.766, + 8, 7, 0.599, 0.434, 0.766, + 9, 7, 0.598, 0.433, 0.766, + 10, 7, 0.598, 0.433, 0.766, + 11, 7, 0.598, 0.433, 0.766, + 12, 7, 0.597, 0.433, 0.766, + 13, 7, 0.597, 0.432, 0.767, + 14, 7, 0.597, 0.432, 0.767, + 15, 7, 0.596, 0.432, 0.767, + 16, 7, 0.596, 0.432, 0.766, + 17, 7, 0.595, 0.431, 0.766, + 18, 7, 0.595, 0.431, 0.766, + 19, 7, 0.594, 0.431, 0.766, + 20, 7, 0.594, 0.430, 0.766, + 21, 7, 0.593, 0.430, 0.766, + 22, 7, 0.593, 0.430, 0.766, + 23, 7, 0.592, 0.429, 0.765, + 24, 7, 0.592, 0.429, 0.765, + 25, 7, 0.591, 0.428, 0.765, + 26, 7, 0.590, 0.428, 0.765, + 27, 7, 0.590, 0.428, 0.764, + 28, 7, 0.589, 0.427, 0.764, + 29, 7, 0.588, 0.427, 0.764, + 30, 7, 0.588, 0.426, 0.763, + 31, 7, 0.587, 0.426, 0.763, + 1, 8, 0.586, 0.425, 0.762, + 2, 8, 0.586, 0.425, 0.762, + 3, 8, 0.585, 0.424, 0.761, + 4, 8, 0.584, 0.424, 0.761, + 5, 8, 0.583, 0.423, 0.760, + 6, 8, 0.583, 0.423, 0.760, + 7, 8, 0.582, 0.422, 0.759, + 8, 8, 0.581, 0.421, 0.758, + 9, 8, 0.580, 0.421, 0.758, + 10, 8, 0.579, 0.420, 0.757, + 11, 8, 0.578, 0.420, 0.756, + 12, 8, 0.578, 0.419, 0.755, + 13, 8, 0.577, 0.418, 0.754, + 14, 8, 0.576, 0.418, 0.754, + 15, 8, 0.575, 0.417, 0.753, + 16, 8, 0.574, 0.416, 0.752, + 17, 8, 0.573, 0.415, 0.751, + 18, 8, 0.572, 0.415, 0.750, + 19, 8, 0.571, 0.414, 0.749, + 20, 8, 0.570, 0.413, 0.748, + 21, 8, 0.569, 0.413, 0.747, + 22, 8, 0.569, 0.412, 0.746, + 23, 8, 0.568, 0.411, 0.745, + 24, 8, 0.567, 0.410, 0.744, + 25, 8, 0.566, 0.409, 0.743, + 26, 8, 0.565, 0.409, 0.742, + 27, 8, 0.564, 0.408, 0.741, + 28, 8, 0.563, 0.407, 0.740, + 29, 8, 0.562, 0.406, 0.738, + 30, 8, 0.561, 0.405, 0.737, + 31, 8, 0.560, 0.405, 0.736, + 1, 9, 0.558, 0.404, 0.735, + 2, 9, 0.557, 0.403, 0.734, + 3, 9, 0.556, 0.402, 0.732, + 4, 9, 0.555, 0.401, 0.731, + 5, 9, 0.554, 0.401, 0.730, + 6, 9, 0.553, 0.400, 0.728, + 7, 9, 0.552, 0.399, 0.727, + 8, 9, 0.551, 0.398, 0.725, + 9, 9, 0.550, 0.397, 0.724, + 10, 9, 0.549, 0.396, 0.723, + 11, 9, 0.548, 0.396, 0.721, + 12, 9, 0.546, 0.395, 0.720, + 13, 9, 0.545, 0.394, 0.718, + 14, 9, 0.544, 0.393, 0.717, + 15, 9, 0.543, 0.392, 0.715, + 16, 9, 0.542, 0.391, 0.713, + 17, 9, 0.541, 0.391, 0.712, + 18, 9, 0.540, 0.390, 0.710, + 19, 9, 0.538, 0.389, 0.709, + 20, 9, 0.537, 0.388, 0.707, + 21, 9, 0.536, 0.388, 0.705, + 22, 9, 0.535, 0.387, 0.703, + 23, 9, 0.533, 0.386, 0.702, + 24, 9, 0.532, 0.385, 0.700, + 25, 9, 0.531, 0.385, 0.698, + 26, 9, 0.530, 0.384, 0.696, + 27, 9, 0.528, 0.383, 0.694, + 28, 9, 0.527, 0.383, 0.692, + 29, 9, 0.526, 0.382, 0.690, + 30, 9, 0.525, 0.381, 0.688, + 1, 10, 0.523, 0.381, 0.686, + 2, 10, 0.522, 0.380, 0.684, + 3, 10, 0.521, 0.379, 0.682, + 4, 10, 0.519, 0.379, 0.680, + 5, 10, 0.518, 0.378, 0.678, + 6, 10, 0.517, 0.377, 0.676, + 7, 10, 0.515, 0.377, 0.674, + 8, 10, 0.514, 0.376, 0.671, + 9, 10, 0.512, 0.376, 0.669, + 10, 10, 0.511, 0.375, 0.667, + 11, 10, 0.510, 0.375, 0.664, + 12, 10, 0.508, 0.374, 0.662, + 13, 10, 0.507, 0.374, 0.659, + 14, 10, 0.505, 0.373, 0.657, + 15, 10, 0.504, 0.373, 0.654, + 16, 10, 0.502, 0.372, 0.652, + 17, 10, 0.501, 0.372, 0.649, + 18, 10, 0.499, 0.372, 0.647, + 19, 10, 0.498, 0.371, 0.644, + 20, 10, 0.496, 0.371, 0.641, + 21, 10, 0.495, 0.371, 0.639, + 22, 10, 0.493, 0.370, 0.636, + 23, 10, 0.492, 0.370, 0.633, + 24, 10, 0.490, 0.370, 0.630, + 25, 10, 0.489, 0.369, 0.628, + 26, 10, 0.487, 0.369, 0.625, + 27, 10, 0.485, 0.369, 0.622, + 28, 10, 0.484, 0.368, 0.619, + 29, 10, 0.482, 0.368, 0.616, + 30, 10, 0.481, 0.368, 0.613, + 31, 10, 0.479, 0.368, 0.610, + 1, 11, 0.478, 0.368, 0.607, + 2, 11, 0.476, 0.367, 0.604, + 3, 11, 0.475, 0.367, 0.601, + 4, 11, 0.473, 0.367, 0.598, + 5, 11, 0.471, 0.367, 0.595, + 6, 11, 0.470, 0.367, 0.592, + 7, 11, 0.468, 0.367, 0.589, + 8, 11, 0.467, 0.366, 0.586, + 9, 11, 0.465, 0.366, 0.583, + 10, 11, 0.464, 0.366, 0.580, + 11, 11, 0.462, 0.366, 0.577, + 12, 11, 0.461, 0.366, 0.574, + 13, 11, 0.459, 0.366, 0.571, + 14, 11, 0.458, 0.366, 0.568, + 15, 11, 0.456, 0.366, 0.565, + 16, 11, 0.455, 0.366, 0.562, + 17, 11, 0.454, 0.366, 0.559, + 18, 11, 0.452, 0.365, 0.556, + 19, 11, 0.451, 0.365, 0.553, + 20, 11, 0.450, 0.365, 0.550, + 21, 11, 0.448, 0.365, 0.547, + 22, 11, 0.447, 0.365, 0.544, + 23, 11, 0.446, 0.365, 0.542, + 24, 11, 0.445, 0.365, 0.539, + 25, 11, 0.443, 0.365, 0.536, + 26, 11, 0.442, 0.365, 0.533, + 27, 11, 0.441, 0.365, 0.531, + 28, 11, 0.440, 0.365, 0.528, + 29, 11, 0.439, 0.365, 0.526, + 30, 11, 0.438, 0.365, 0.523, + 1, 12, 0.437, 0.365, 0.521, + 2, 12, 0.436, 0.365, 0.519, + 3, 12, 0.435, 0.365, 0.517, + 4, 12, 0.434, 0.365, 0.515, + 5, 12, 0.434, 0.365, 0.513, + 6, 12, 0.433, 0.365, 0.511, + 7, 12, 0.432, 0.365, 0.509, + 8, 12, 0.431, 0.365, 0.507, + 9, 12, 0.431, 0.365, 0.505, + 10, 12, 0.430, 0.365, 0.504, + 11, 12, 0.430, 0.365, 0.502, + 12, 12, 0.429, 0.365, 0.501, + 13, 12, 0.429, 0.365, 0.500, + 14, 12, 0.429, 0.365, 0.498, + 15, 12, 0.428, 0.365, 0.497, + 16, 12, 0.428, 0.365, 0.496, + 17, 12, 0.428, 0.365, 0.496, + 18, 12, 0.428, 0.365, 0.495, + 19, 12, 0.428, 0.365, 0.494, + 20, 12, 0.428, 0.365, 0.494, + 21, 12, 0.428, 0.365, 0.494, + 22, 12, 0.428, 0.365, 0.493, + 23, 12, 0.429, 0.365, 0.493, + 24, 12, 0.429, 0.366, 0.493, + 25, 12, 0.429, 0.366, 0.493, + 26, 12, 0.430, 0.366, 0.494, + 27, 12, 0.430, 0.366, 0.494, + 28, 12, 0.431, 0.366, 0.495, + 29, 12, 0.431, 0.366, 0.495, + 30, 12, 0.432, 0.366, 0.496, + 31, 12, 0.433, 0.366, 0.497),ncol=5,byrow=TRUE); + dimnames(RESULT) <- list(1:366,c("day","month","grad_Tmean","grad_Tmin","grad_Tmax")); + return(RESULT); + } + + + + ##Format_______________________________________________________________________________________ + HypsoData <- as.double(HypsoData); + ZInputs <- as.double(ZInputs); + + + ##ElevationLayers_Creation_____________________________________________________________________ + ZLayers <- as.double(rep(NA,NLayers)); + if(!identical(HypsoData,as.double(rep(NA,101)))){ + nmoy <- 100 %/% NLayers; + nreste <- 100 %% NLayers; + ncont <- 0; + for(iLayer in 1:NLayers){ + if(nreste > 0){ nn <- nmoy+1; nreste <- nreste-1; } else { nn <- nmoy; } + if(nn==1){ ZLayers[iLayer] <- HypsoData[ncont+1]; } + if(nn==2){ ZLayers[iLayer] <- 0.5 * (HypsoData[ncont+1] + HypsoData[ncont+2]); } + if(nn>2 ){ ZLayers[iLayer] <- HypsoData[ncont+nn/2]; } + ncont <- ncont+nn; + } + } + + + ##Precipitation_extrapolation__________________________________________________________________ + ##Initialisation + LayerPrecip <- list(); + if(identical(ZInputs,HypsoData[51]) & NLayers==1){ + LayerPrecip[[1]] <- as.double(Precip); + } else { + ##Elevation_gradients_for_daily_mean_precipitation + GradP <- GradP_Valery2010(); ### single value + TabGradP <- rep(GradP,length(Precip)); + ##Extrapolation + ##Thresold_of_inputs_median_elevation + Zthreshold <- 4000; + ##_On_each_elevation_layer... + for(iLayer in 1:NLayers){ + ##If_layer_elevation_smaller_than_Zthreshold + if(ZLayers[iLayer] <= Zthreshold){ + LayerPrecip[[iLayer]] <- as.double(Precip*exp(TabGradP*(ZLayers[iLayer]-ZInputs))); + ##If_layer_elevation_greater_than_Zthreshold + } else { + ##If_inputs_median_elevation_smaller_than_Zthreshold + if(ZInputs <= Zthreshold){ LayerPrecip[[iLayer]] <- as.double(Precip*exp(TabGradP*(Zthreshold-ZInputs))); + ##If_inputs_median_elevation_greater_then_Zthreshold + } else { LayerPrecip[[iLayer]] <- as.double(Precip); } + } + } + } + + + + ##Temperature_extrapolation____________________________________________________________________ + ##Initialisation + LayerTempMean <- list(); LayerTempMin <- list(); LayerTempMax <- list(); + if(identical(ZInputs,HypsoData[51]) & NLayers==1){ + LayerTempMean[[1]] <- as.double(TempMean); + if(!is.null(TempMin) & !is.null(TempMax)){ LayerTempMin[[1]] <- as.double(TempMin); LayerTempMax[[1]] <- as.double(TempMax); } + } else { + ##Elevation_gradients_for_daily_mean_min_and_max_temperature + GradT <- GradT_Valery2010(); ### Day, Month, GradTmean, GradTmin and GradTmax for iCol=1,2,3,4,5, respectively + TabGradT <- matrix(NA,nrow=length(Precip),ncol=3); + for(iday in 1:366){ + ind <- which(as.numeric(format(DatesR,format="%d"))==GradT[iday,1] & as.numeric(format(DatesR,format="%m"))==GradT[iday,2]); + TabGradT[ind,1:3] <- GradT[iday,3:5]; + } + ##Extrapolation + ##On_each_elevation_layer... + for(iLayer in 1:NLayers){ + LayerTempMean[[iLayer]] <- as.double(TempMean + (ZInputs-ZLayers[iLayer])*abs(TabGradT[,1])/100); + if(!is.null(TempMin) & !is.null(TempMax)){ + LayerTempMin[[iLayer]] <- as.double(TempMin + (ZInputs-ZLayers[iLayer])*abs(TabGradT[,2])/100); + LayerTempMax[[iLayer]] <- as.double(TempMax + (ZInputs-ZLayers[iLayer])*abs(TabGradT[,3])/100); + } + } + } + + + + ##Solid_Fraction_for_each_elevation_layer______________________________________________________ + LayerFracSolidPrecip <- list(); + ##Thresold_of_inputs_median_elevation + Zthreshold <- 1500; + ##On_each_elevation_layer... + for(iLayer in 1:NLayers){ + Option <- "USACE"; + if(!is.na(ZInputs)){ if(ZInputs < Zthreshold & !is.null(TempMin) & !is.null(TempMax)){ Option <- "Hydrotel"; } } + ##Turcotte_formula_from_Hydrotel + if(Option=="Hydrotel"){ + TempMin <- LayerTempMin[[iLayer]]; + TempMax <- LayerTempMax[[iLayer]]; + SolidFraction <- 1 - TempMax/(TempMax - TempMin); + SolidFraction[TempMin >= 0] <- 0; + SolidFraction[TempMax <= 0] <- 1; + } + ##USACE_formula + if(Option=="USACE"){ + USACE_Tmin <- -1.0; + USACE_Tmax <- 3.0; + TempMean <- LayerTempMean[[iLayer]]; + SolidFraction <- 1- (TempMean - USACE_Tmin)/(USACE_Tmax - USACE_Tmin); + SolidFraction[TempMean > USACE_Tmax] <- 0; + SolidFraction[TempMean < USACE_Tmin] <- 1; + } + LayerFracSolidPrecip[[iLayer]] <- as.double(SolidFraction); + } + + + + + ##END__________________________________________________________________________________________ + return(list(LayerPrecip=LayerPrecip,LayerTempMean=LayerTempMean,LayerTempMin=LayerTempMin,LayerTempMax=LayerTempMax, + LayerFracSolidPrecip=LayerFracSolidPrecip,ZLayers=ZLayers)); + +} + + diff --git a/R/ErrorCrit.R b/R/ErrorCrit.R new file mode 100644 index 0000000000000000000000000000000000000000..fe874c83400ee80199235af8100a22900744cb42 --- /dev/null +++ b/R/ErrorCrit.R @@ -0,0 +1,22 @@ +#***************************************************************************************************************** +#' Function which computes an error criterion with the provided function. +#***************************************************************************************************************** +#' @title Error criterion using the provided function +#' @author Laurent Coron (June 2014) +#' @seealso \code{\link{ErrorCrit_RMSE}}, \code{\link{ErrorCrit_NSE}}, \code{\link{ErrorCrit_KGE}} +#' @example tests/example_ErrorCrit.R +#' @useDynLib airgr +#' @encoding UTF-8 +#' @export +#_FunctionInputs__________________________________________________________________________________________________ +#' @param InputsCrit [object of class \emph{InputsCrit}] see \code{\link{CreateInputsCrit}} for details +#' @param OutputsModel [object of class \emph{OutputsModel}] see \code{\link{RunModel_GR4J}} or \code{\link{RunModel_CemaNeigeGR4J}} for details +#' @param FUN_CRIT [function] error criterion function (e.g. ErrorCrit_RMSE, ErrorCrit_NSE) +#' @param quiet (optional) [boolean] boolean indicating if the function is run in quiet mode or not, default=FALSE +#_FunctionOutputs_________________________________________________________________________________________________ +#' @return [list] list containing the function outputs, see \code{\link{ErrorCrit_RMSE}} or \code{\link{ErrorCrit_NSE}} for details +#*****************************************************************************************************************' +ErrorCrit <- function(InputsCrit,OutputsModel,FUN_CRIT,quiet=FALSE){ + return( FUN_CRIT(InputsCrit,OutputsModel,quiet=quiet) ) +} + diff --git a/R/ErrorCrit_KGE.R b/R/ErrorCrit_KGE.R new file mode 100644 index 0000000000000000000000000000000000000000..b7d8972ba8b0d5f17c3e7e7fac6f1db86a0bb7ff --- /dev/null +++ b/R/ErrorCrit_KGE.R @@ -0,0 +1,128 @@ +#***************************************************************************************************************** +#' Function which computes an error criterion based on the KGE formula proposed by Gupta et al. (2009). +#' +#' In addition to the criterion value, the function outputs include a multiplier (-1 or +1) which allows +#' the use of the function for model calibration: the product CritValue*Multiplier is the criterion to be minimised +#' (e.g. Multiplier=+1 for RMSE, Multiplier=-1 for NSE). +#***************************************************************************************************************** +#' @title Error criterion based on the KGE formula +#' @author Laurent Coron (June 2014) +#' @references +#' Gupta, H. V., Kling, H., Yilmaz, K. K. and Martinez, G. F. (2009), +#' Decomposition of the mean squared error and NSE performance criteria: Implications +#' for improving hydrological modelling, Journal of Hydrology, 377(1-2), 80-91, doi:10.1016/j.jhydrol.2009.08.003. \cr +#' @seealso \code{\link{ErrorCrit_RMSE}}, \code{\link{ErrorCrit_NSE}}, \code{\link{ErrorCrit_KGE2}} +#' @examples ## see example of the ErrorCrit function +#' @encoding UTF-8 +#' @export +#_FunctionInputs__________________________________________________________________________________________________ +#' @param InputsCrit [object of class \emph{InputsCrit}] see \code{\link{CreateInputsCrit}} for details +#' @param OutputsModel [object of class \emph{OutputsModel}] see \code{\link{RunModel_GR4J}} or \code{\link{RunModel_CemaNeigeGR4J}} for details +#' @param quiet (optional) [boolean] boolean indicating if the function is run in quiet mode or not, default=FALSE +#_FunctionOutputs_________________________________________________________________________________________________ +#' @return [list] list containing the function outputs organised as follows: +#' \tabular{ll}{ +#' \emph{$CritValue } \tab [numeric] value of the criterion \cr +#' \emph{$CritName } \tab [character] name of the criterion \cr +#' \emph{$SubCritValues } \tab [numeric] values of the sub-criteria \cr +#' \emph{$SubCritNames } \tab [character] names of the sub-criteria \cr +#' \emph{$CritBestValue } \tab [numeric] theoretical best criterion value \cr +#' \emph{$Multiplier } \tab [numeric] integer indicating whether the criterion is indeed an error (+1) or an efficiency (-1) \cr +#' \emph{$Ind_notcomputed} \tab [numeric] indices of the time-steps where InputsCrit$BoolCrit=FALSE or no data is available \cr +#' } +#***************************************************************************************************************** +ErrorCrit_KGE <- function(InputsCrit,OutputsModel,quiet=FALSE){ + + +##Arguments_check________________________________ + if(inherits(InputsCrit,"InputsCrit")==FALSE){ stop("InputsCrit must be of class 'InputsCrit' \n"); return(NULL); } + if(inherits(OutputsModel,"OutputsModel")==FALSE){ stop("OutputsModel must be of class 'OutputsModel' \n"); return(NULL); } + + +##Initialisation_________________________________ + CritName <- NA; + if(InputsCrit$transfo=="" ){ CritName <- "KGE[Q]" ; } + if(InputsCrit$transfo=="sqrt"){ CritName <- "KGE[sqrt(Q)]"; } + if(InputsCrit$transfo=="log" ){ CritName <- "KGE[log(Q)]" ; } + if(InputsCrit$transfo=="inv" ){ CritName <- "KGE[1/Q]" ; } + if(InputsCrit$transfo=="sort"){ CritName <- "KGE[sort(Q)]"; } + CritValue <- NA; + CritBestValue <- +1; + Multiplier <- -1; ### must be equal to -1 or +1 only + + +##Data_preparation_______________________________ + VarObs <- InputsCrit$Qobs ; VarObs[!InputsCrit$BoolCrit] <- NA; + VarSim <- OutputsModel$Qsim; VarSim[!InputsCrit$BoolCrit] <- NA; + ##Data_transformation + if("Ind_zeroes" %in% names(InputsCrit) & "epsilon" %in% names(InputsCrit)){ if(length(InputsCrit$Ind_zeroes)>0){ + VarObs <- VarObs + InputsCrit$epsilon; + VarSim <- VarSim + InputsCrit$epsilon; + } } + if(InputsCrit$transfo=="sqrt"){ VarObs <- sqrt(VarObs); VarSim <- sqrt(VarSim); } + if(InputsCrit$transfo=="log" ){ VarObs <- log(VarObs) ; VarSim <- log(VarSim) ; VarSim[VarSim < -1E100] <- NA; } + if(InputsCrit$transfo=="inv" ){ VarObs <- 1/VarObs ; VarSim <- 1/VarSim ; VarSim[abs(VarSim) > 1E+100] <- NA; } + if(InputsCrit$transfo=="sort"){ VarObs <- sort(VarObs); VarSim <- sort(VarSim); } + ##TS_ignore + TS_ignore <- !is.finite(VarObs) | !is.finite(VarSim) | !InputsCrit$BoolCrit ; + Ind_TS_ignore <- which(TS_ignore); if(length(Ind_TS_ignore)==0){ Ind_TS_ignore <- NULL; } + if(sum(!TS_ignore)==0){ OutputsCrit <- list(NA); names(OutputsCrit) <- c("CritValue"); return(OutputsCrit); } + if(sum(!TS_ignore)==1){ OutputsCrit <- list(NA); names(OutputsCrit) <- c("CritValue"); return(OutputsCrit); } ### to avoid a problem in standard deviation computation + if(inherits(OutputsModel,"hourly" )){ WarningTS <- 365; } + if(inherits(OutputsModel,"daily" )){ WarningTS <- 365; } + if(inherits(OutputsModel,"monthly")){ WarningTS <- 12; } + if(inherits(OutputsModel,"yearly" )){ WarningTS <- 3; } + if(sum(!TS_ignore)<WarningTS & !quiet){ warning(paste("\t criterion computed on less than ",WarningTS," time-steps \n",sep="")); } + ##Other_variables_preparation + meanVarObs <- mean(VarObs[!TS_ignore]); + meanVarSim <- mean(VarSim[!TS_ignore]); + iCrit <- 0; + SubCritNames <- NULL; + SubCritValues <- NULL; + + + +##SubErrorCrit_____KGE_rPearson__________________ + iCrit <- iCrit+1; + SubCritNames[iCrit] <- paste(CritName," rPEARSON(sim vs. obs)",sep=""); + SubCritValues[iCrit] <- NA; + Numer <- sum( (VarObs[!TS_ignore]-meanVarObs)*(VarSim[!TS_ignore]-meanVarSim) ); + Deno1 <- sqrt( sum((VarObs[!TS_ignore]-meanVarObs)^2) ); + Deno2 <- sqrt( sum((VarSim[!TS_ignore]-meanVarSim)^2) ); + if(Numer==0){ if(Deno1==0 & Deno2==0){ Crit <- 1; } else { Crit <- 0; } + } else { Crit <- Numer/(Deno1*Deno2); } + if(is.numeric(Crit) & is.finite(Crit)){ SubCritValues[iCrit] <- Crit; } + + +##SubErrorCrit_____KGE_alpha_____________________ + iCrit <- iCrit+1; + SubCritNames[iCrit] <- paste(CritName," STDEVsim/STDEVobs",sep=""); + SubCritValues[iCrit] <- NA; + Numer <- sd(VarSim[!TS_ignore]); + Denom <- sd(VarObs[!TS_ignore]); + if(Numer==0 & Denom==0){ Crit <- 1; } else { Crit <- Numer/Denom ; } + if(is.numeric(Crit) & is.finite(Crit)){ SubCritValues[iCrit] <- Crit; } + + +##SubErrorCrit_____KGE_beta______________________ + iCrit <- iCrit+1; + SubCritNames[iCrit] <- paste(CritName," MEANsim/MEANobs",sep=""); + SubCritValues[iCrit] <- NA; + if(meanVarSim==0 & meanVarObs==0){ Crit <- 1; } else { Crit <- meanVarSim/meanVarObs ; } + if(is.numeric(Crit) & is.finite(Crit)){ SubCritValues[iCrit] <- Crit; } + + +##ErrorCrit______________________________________ + if(sum(is.na(SubCritValues))==0){ + CritValue <- ( 1 - sqrt( (SubCritValues[1]-1)^2 + (SubCritValues[2]-1)^2 + (SubCritValues[3]-1)^2 ) ); + } + + +##Output_________________________________________ + OutputsCrit <- list(CritValue,CritName,SubCritValues,SubCritNames,CritBestValue,Multiplier,Ind_TS_ignore); + names(OutputsCrit) <- c("CritValue","CritName","SubCritValues","SubCritNames","CritBestValue","Multiplier","Ind_notcomputed"); + return(OutputsCrit); + +} + + diff --git a/R/ErrorCrit_KGE2.R b/R/ErrorCrit_KGE2.R new file mode 100644 index 0000000000000000000000000000000000000000..4874132895423cab05a140062c0f5c15c460973b --- /dev/null +++ b/R/ErrorCrit_KGE2.R @@ -0,0 +1,130 @@ +#***************************************************************************************************************** +#' Function which computes an error criterion based on the KGE' formula proposed by Kling et al. (2012). +#' +#' In addition to the criterion value, the function outputs include a multiplier (-1 or +1) which allows +#' the use of the function for model calibration: the product CritValue*Multiplier is the criterion to be minimised +#' (e.g. Multiplier=+1 for RMSE, Multiplier=-1 for NSE). +#***************************************************************************************************************** +#' @title Error criterion based on the KGE' formula +#' @author Laurent Coron (June 2014) +#' @references +#' Gupta, H. V., Kling, H., Yilmaz, K. K. and Martinez, G. F. (2009), +#' Decomposition of the mean squared error and NSE performance criteria: Implications +#' for improving hydrological modelling, Journal of Hydrology, 377(1-2), 80-91, doi:10.1016/j.jhydrol.2009.08.003. \cr +#' Kling, H., Fuchs, M. and Paulin, M. (2012), +#' Runoff conditions in the upper Danube basin under an ensemble of climate change scenarios, +#' Journal of Hydrology, 424-425, 264-277, doi:10.1016/j.jhydrol.2012.01.011. +#' @seealso \code{\link{ErrorCrit_RMSE}}, \code{\link{ErrorCrit_NSE}}, \code{\link{ErrorCrit_KGE}} +#' @examples ## see example of the ErrorCrit function +#' @encoding UTF-8 +#' @export +#_FunctionInputs__________________________________________________________________________________________________ +#' @param InputsCrit [object of class \emph{InputsCrit}] see \code{\link{CreateInputsCrit}} for details +#' @param OutputsModel [object of class \emph{OutputsModel}] see \code{\link{RunModel_GR4J}} or \code{\link{RunModel_CemaNeigeGR4J}} for details +#' @param quiet (optional) [boolean] boolean indicating if the function is run in quiet mode or not, default=FALSE +#_FunctionOutputs_________________________________________________________________________________________________ +#' @return [list] list containing the function outputs organised as follows: +#' \tabular{ll}{ +#' \emph{$CritValue } \tab [numeric] value of the criterion \cr +#' \emph{$CritName } \tab [character] name of the criterion \cr +#' \emph{$SubCritValues } \tab [numeric] values of the sub-criteria \cr +#' \emph{$SubCritNames } \tab [character] names of the sub-criteria \cr +#' \emph{$CritBestValue } \tab [numeric] theoretical best criterion value \cr +#' \emph{$Multiplier } \tab [numeric] integer indicating whether the criterion is indeed an error (+1) or an efficiency (-1) \cr +#' \emph{$Ind_notcomputed} \tab [numeric] indices of the time-steps where InputsCrit$BoolCrit=FALSE or no data is available \cr +#' } +#*****************************************************************************************************************' +ErrorCrit_KGE2 <- function(InputsCrit,OutputsModel,quiet=FALSE){ + + +##Arguments_check________________________________ + if(inherits(InputsCrit,"InputsCrit")==FALSE){ stop("InputsCrit must be of class 'InputsCrit' \n"); return(NULL); } + if(inherits(OutputsModel,"OutputsModel")==FALSE){ stop("OutputsModel must be of class 'OutputsModel' \n"); return(NULL); } + + +##Initialisation_________________________________ + CritName <- NA; + if(InputsCrit$transfo=="" ){ CritName <- "KGE'[Q]" ; } + if(InputsCrit$transfo=="sqrt"){ CritName <- "KGE'[sqrt(Q)]"; } + if(InputsCrit$transfo=="log" ){ CritName <- "KGE'[log(Q)]" ; } + if(InputsCrit$transfo=="inv" ){ CritName <- "KGE'[1/Q]" ; } + if(InputsCrit$transfo=="sort"){ CritName <- "KGE'[sort(Q)]"; } + CritValue <- NA; + CritBestValue <- +1; + Multiplier <- -1; ### must be equal to -1 or +1 only + + +##Data_preparation_______________________________ + VarObs <- InputsCrit$Qobs ; VarObs[!InputsCrit$BoolCrit] <- NA; + VarSim <- OutputsModel$Qsim; VarSim[!InputsCrit$BoolCrit] <- NA; + ##Data_transformation + if("Ind_zeroes" %in% names(InputsCrit) & "epsilon" %in% names(InputsCrit)){ if(length(InputsCrit$Ind_zeroes)>0){ + VarObs <- VarObs + InputsCrit$epsilon; + VarSim <- VarSim + InputsCrit$epsilon; + } } + if(InputsCrit$transfo=="sqrt"){ VarObs <- sqrt(VarObs); VarSim <- sqrt(VarSim); } + if(InputsCrit$transfo=="log" ){ VarObs <- log(VarObs) ; VarSim <- log(VarSim) ; VarSim[VarSim < -1E100] <- NA; } + if(InputsCrit$transfo=="inv" ){ VarObs <- 1/VarObs ; VarSim <- 1/VarSim ; VarSim[abs(VarSim) > 1E+100] <- NA; } + if(InputsCrit$transfo=="sort"){ VarObs <- sort(VarObs); VarSim <- sort(VarSim); } + ##TS_ignore + TS_ignore <- !is.finite(VarObs) | !is.finite(VarSim) | !InputsCrit$BoolCrit ; + Ind_TS_ignore <- which(TS_ignore); if(length(Ind_TS_ignore)==0){ Ind_TS_ignore <- NULL; } + if(sum(!TS_ignore)==0){ OutputsCrit <- list(NA); names(OutputsCrit) <- c("CritValue"); return(OutputsCrit); } + if(sum(!TS_ignore)==1){ OutputsCrit <- list(NA); names(OutputsCrit) <- c("CritValue"); return(OutputsCrit); } ### to avoid a problem in standard deviation computation + if(inherits(OutputsModel,"hourly" )){ WarningTS <- 365; } + if(inherits(OutputsModel,"daily" )){ WarningTS <- 365; } + if(inherits(OutputsModel,"monthly")){ WarningTS <- 12; } + if(inherits(OutputsModel,"yearly" )){ WarningTS <- 3; } + if(sum(!TS_ignore)<WarningTS & !quiet){ warning(paste("\t criterion computed on less than ",WarningTS," time-steps \n",sep="")); } + ##Other_variables_preparation + meanVarObs <- mean(VarObs[!TS_ignore]); + meanVarSim <- mean(VarSim[!TS_ignore]); + iCrit <- 0; + SubCritNames <- NULL; + SubCritValues <- NULL; + + +##SubErrorCrit_____KGE_rPearson__________________ + iCrit <- iCrit+1; + SubCritNames[iCrit] <- paste(CritName," rPEARSON(sim vs. obs)",sep=""); + SubCritValues[iCrit] <- NA; + Numer <- sum( (VarObs[!TS_ignore]-meanVarObs)*(VarSim[!TS_ignore]-meanVarSim) ); + Deno1 <- sqrt( sum((VarObs[!TS_ignore]-meanVarObs)^2) ); + Deno2 <- sqrt( sum((VarSim[!TS_ignore]-meanVarSim)^2) ); + if(Numer==0){ if(Deno1==0 & Deno2==0){ Crit <- 1; } else { Crit <- 0; } + } else { Crit <- Numer/(Deno1*Deno2); } + if(is.numeric(Crit) & is.finite(Crit)){ SubCritValues[iCrit] <- Crit; } + + +##SubErrorCrit_____KGE_gama______________________ + iCrit <- iCrit+1; + SubCritNames[iCrit] <- paste(CritName," CVsim/CVobs",sep=""); + SubCritValues[iCrit] <- NA; + if(meanVarSim==0){ if(sd(VarSim[!TS_ignore])==0){ CVsim <- 1; } else { CVsim <- 99999; } } else { CVsim <- sd(VarSim[!TS_ignore])/meanVarSim; } + if(meanVarObs==0){ if(sd(VarObs[!TS_ignore])==0){ CVobs <- 1; } else { CVobs <- 99999; } } else { CVobs <- sd(VarObs[!TS_ignore])/meanVarObs; } + if(CVsim==0 & CVobs==0){ Crit <- 1; } else { Crit <- CVsim/CVobs ; } + if(is.numeric(Crit) & is.finite(Crit)){ SubCritValues[iCrit] <- Crit; } + + +##SubErrorCrit_____KGE_beta______________________ + iCrit <- iCrit+1; + SubCritNames[iCrit] <- paste(CritName," MEANsim/MEANobs",sep=""); + SubCritValues[iCrit] <- NA; + if(meanVarSim==0 & meanVarObs==0){ Crit <- 1; } else { Crit <- meanVarSim/meanVarObs ; } + if(is.numeric(Crit) & is.finite(Crit)){ SubCritValues[iCrit] <- Crit; } + + +##ErrorCrit______________________________________ + if(sum(is.na(SubCritValues))==0){ + CritValue <- ( 1 - sqrt( (SubCritValues[1]-1)^2 + (SubCritValues[2]-1)^2 + (SubCritValues[3]-1)^2 ) ); + } + + +##Output_________________________________________ + OutputsCrit <- list(CritValue,CritName,SubCritValues,SubCritNames,CritBestValue,Multiplier,Ind_TS_ignore); + names(OutputsCrit) <- c("CritValue","CritName","SubCritValues","SubCritNames","CritBestValue","Multiplier","Ind_notcomputed"); + return(OutputsCrit); + +} + + diff --git a/R/ErrorCrit_NSE.R b/R/ErrorCrit_NSE.R new file mode 100644 index 0000000000000000000000000000000000000000..3db43d1b16f53bfcaf3ccf34e01e970394d07384 --- /dev/null +++ b/R/ErrorCrit_NSE.R @@ -0,0 +1,92 @@ +#***************************************************************************************************************** +#' Function which computes an error criterion based on the NSE formula proposed by Nash & Sutcliffe (1970). +#' +#' In addition to the criterion value, the function outputs include a multiplier (-1 or +1) which allows +#' the use of the function for model calibration: the product CritValue*Multiplier is the criterion to be minimised +#' (e.g. Multiplier=+1 for RMSE, Multiplier=-1 for NSE). +#***************************************************************************************************************** +#' @title Error criterion based on the NSE formula +#' @author Laurent Coron (June 2014) +#' @references +#' Nash, J.E. and Sutcliffe, J.V. (1970), +#' River flow forecasting through conceptual models part 1. +#' A discussion of principles, Journal of Hydrology, 10(3), 282-290, doi:10.1016/0022-1694(70)90255-6. \cr +#' @seealso \code{\link{ErrorCrit_RMSE}}, \code{\link{ErrorCrit_KGE}}, \code{\link{ErrorCrit_KGE2}} +#' @examples ## see example of the ErrorCrit function +#' @encoding UTF-8 +#' @export +#_FunctionInputs__________________________________________________________________________________________________ +#' @param InputsCrit [object of class \emph{InputsCrit}] see \code{\link{CreateInputsCrit}} for details +#' @param OutputsModel [object of class \emph{OutputsModel}] see \code{\link{RunModel_GR4J}} or \code{\link{RunModel_CemaNeigeGR4J}} for details +#' @param quiet (optional) [boolean] boolean indicating if the function is run in quiet mode or not, default=FALSE +#_FunctionOutputs_________________________________________________________________________________________________ +#' @return [list] list containing the function outputs organised as follows: +#' \tabular{ll}{ +#' \emph{$CritValue } \tab [numeric] value of the criterion \cr +#' \emph{$CritName } \tab [character] name of the criterion \cr +#' \emph{$CritBestValue } \tab [numeric] theoretical best criterion value \cr +#' \emph{$Multiplier } \tab [numeric] integer indicating whether the criterion is indeed an error (+1) or an efficiency (-1) \cr +#' \emph{$Ind_notcomputed} \tab [numeric] indices of the time-steps where InputsCrit$BoolCrit=FALSE or no data is available \cr +#' } +#***************************************************************************************************************** +ErrorCrit_NSE <- function(InputsCrit,OutputsModel,quiet=FALSE){ + + +##Arguments_check________________________________ + if(inherits(InputsCrit,"InputsCrit")==FALSE){ stop("InputsCrit must be of class 'InputsCrit' \n"); return(NULL); } + if(inherits(OutputsModel,"OutputsModel")==FALSE){ stop("OutputsModel must be of class 'OutputsModel' \n"); return(NULL); } + + +##Initialisation_________________________________ + CritName <- NA; + if(InputsCrit$transfo=="" ){ CritName <- "NSE[Q]" ; } + if(InputsCrit$transfo=="sqrt"){ CritName <- "NSE[sqrt(Q)]"; } + if(InputsCrit$transfo=="log" ){ CritName <- "NSE[log(Q)]" ; } + if(InputsCrit$transfo=="inv" ){ CritName <- "NSE[1/Q]" ; } + if(InputsCrit$transfo=="sort"){ CritName <- "NSE[sort(Q)]"; } + CritValue <- NA; + CritBestValue <- +1; + Multiplier <- -1; ### must be equal to -1 or +1 only + + +##Data_preparation_______________________________ + VarObs <- InputsCrit$Qobs ; VarObs[!InputsCrit$BoolCrit] <- NA; + VarSim <- OutputsModel$Qsim; VarSim[!InputsCrit$BoolCrit] <- NA; + ##Data_transformation + if("Ind_zeroes" %in% names(InputsCrit) & "epsilon" %in% names(InputsCrit)){ if(length(InputsCrit$Ind_zeroes)>0){ + VarObs <- VarObs + InputsCrit$epsilon; + VarSim <- VarSim + InputsCrit$epsilon; + } } + if(InputsCrit$transfo=="sqrt"){ VarObs <- sqrt(VarObs); VarSim <- sqrt(VarSim); } + if(InputsCrit$transfo=="log" ){ VarObs <- log(VarObs) ; VarSim <- log(VarSim) ; VarSim[VarSim < -1E100] <- NA; } + if(InputsCrit$transfo=="inv" ){ VarObs <- 1/VarObs ; VarSim <- 1/VarSim ; VarSim[abs(VarSim) > 1E+100] <- NA; } + if(InputsCrit$transfo=="sort"){ VarObs <- sort(VarObs); VarSim <- sort(VarSim); } + ##TS_ignore + TS_ignore <- !is.finite(VarObs) | !is.finite(VarSim) | !InputsCrit$BoolCrit ; + Ind_TS_ignore <- which(TS_ignore); if(length(Ind_TS_ignore)==0){ Ind_TS_ignore <- NULL; } + if(sum(!TS_ignore)==0){ OutputsCrit <- list(NA); names(OutputsCrit) <- c("CritValue"); return(OutputsCrit); } + if(inherits(OutputsModel,"hourly" )){ WarningTS <- 365; } + if(inherits(OutputsModel,"daily" )){ WarningTS <- 365; } + if(inherits(OutputsModel,"monthly")){ WarningTS <- 12; } + if(inherits(OutputsModel,"yearly" )){ WarningTS <- 3; } + if(sum(!TS_ignore)<WarningTS & !quiet){ warning(paste("\t criterion computed on less than ",WarningTS," time-steps \n",sep="")); } + ##Other_variables_preparation + meanVarObs <- mean(VarObs[!TS_ignore]); + meanVarSim <- mean(VarSim[!TS_ignore]); + + +##ErrorCrit______________________________________ + Emod <- sum((VarSim[!TS_ignore]-VarObs[!TS_ignore])^2); + Eref <- sum((VarObs[!TS_ignore]-mean(VarObs[!TS_ignore]))^2); + if(Emod==0 & Eref==0){ Crit <- 0; } else { Crit <- (1-Emod/Eref); } + if(is.numeric(Crit) & is.finite(Crit)){ CritValue <- Crit; } + + +##Output_________________________________________ + OutputsCrit <- list(CritValue,CritName,CritBestValue,Multiplier,Ind_TS_ignore); + names(OutputsCrit) <- c("CritValue","CritName","CritBestValue","Multiplier","Ind_notcomputed"); + return(OutputsCrit); + +} + + diff --git a/R/ErrorCrit_RMSE.R b/R/ErrorCrit_RMSE.R new file mode 100644 index 0000000000000000000000000000000000000000..b4d1d93a6c98bc696d82422544c903ded153f24f --- /dev/null +++ b/R/ErrorCrit_RMSE.R @@ -0,0 +1,86 @@ +#***************************************************************************************************************** +#' Function which computes an error criterion based on the root mean square error (RMSE). +#' +#' In addition to the criterion value, the function outputs include a multiplier (-1 or +1) which allows +#' the use of the function for model calibration: the product CritValue*Multiplier is the criterion to be minimised +#' (e.g. Multiplier=+1 for RMSE, Multiplier=-1 for NSE). +#***************************************************************************************************************** +#' @title Error criterion based on the RMSE +#' @author Laurent Coron (June 2014) +#' @seealso \code{\link{ErrorCrit_NSE}}, \code{\link{ErrorCrit_KGE}}, \code{\link{ErrorCrit_KGE2}} +#' @examples ## see example of the ErrorCrit function +#' @encoding UTF-8 +#' @export +#_FunctionInputs__________________________________________________________________________________________________ +#' @param InputsCrit [object of class \emph{InputsCrit}] see \code{\link{CreateInputsCrit}} for details +#' @param OutputsModel [object of class \emph{OutputsModel}] see \code{\link{RunModel_GR4J}} or \code{\link{RunModel_CemaNeigeGR4J}} for details +#' @param quiet (optional) [boolean] boolean indicating if the function is run in quiet mode or not, default=FALSE +#_FunctionOutputs_________________________________________________________________________________________________ +#' @return [list] list containing the function outputs organised as follows: +#' \tabular{ll}{ +#' \emph{$CritValue } \tab [numeric] value of the criterion \cr +#' \emph{$CritName } \tab [character] name of the criterion \cr +#' \emph{$CritBestValue } \tab [numeric] theoretical best criterion value \cr +#' \emph{$Multiplier } \tab [numeric] integer indicating whether the criterion is indeed an error (+1) or an efficiency (-1) \cr +#' \emph{$Ind_notcomputed} \tab [numeric] indices of the time-steps where InputsCrit$BoolCrit=FALSE or no data is available \cr +#' } +#***************************************************************************************************************** +ErrorCrit_RMSE <- function(InputsCrit,OutputsModel,quiet=FALSE){ + + +##Arguments_check________________________________ + if(inherits(InputsCrit,"InputsCrit")==FALSE){ stop("InputsCrit must be of class 'InputsCrit' \n"); return(NULL); } + if(inherits(OutputsModel,"OutputsModel")==FALSE){ stop("OutputsModel must be of class 'OutputsModel' \n"); return(NULL); } + + +##Initialisation_________________________________ + CritName <- NA; + if(InputsCrit$transfo=="" ){ CritName <- "RMSE[Q]" ; } + if(InputsCrit$transfo=="sqrt"){ CritName <- "RMSE[sqrt(Q)]"; } + if(InputsCrit$transfo=="log" ){ CritName <- "RMSE[log(Q)]" ; } + if(InputsCrit$transfo=="inv" ){ CritName <- "RMSE[1/Q]" ; } + if(InputsCrit$transfo=="sort"){ CritName <- "RMSE[sort(Q)]"; } + + CritValue <- NA; + CritBestValue <- +1; + Multiplier <- +1; ### must be equal to -1 or +1 only + + +##Data_preparation_______________________________ + VarObs <- InputsCrit$Qobs ; VarObs[!InputsCrit$BoolCrit] <- NA; + VarSim <- OutputsModel$Qsim; VarSim[!InputsCrit$BoolCrit] <- NA; + ##Data_transformation + if("Ind_zeroes" %in% names(InputsCrit) & "epsilon" %in% names(InputsCrit)){ if(length(InputsCrit$Ind_zeroes)>0){ + VarObs <- VarObs + InputsCrit$epsilon; + VarSim <- VarSim + InputsCrit$epsilon; + } } + if(InputsCrit$transfo=="sqrt"){ VarObs <- sqrt(VarObs); VarSim <- sqrt(VarSim); } + if(InputsCrit$transfo=="log" ){ VarObs <- log(VarObs) ; VarSim <- log(VarSim) ; VarSim[VarSim < -1E100] <- NA; } + if(InputsCrit$transfo=="inv" ){ VarObs <- 1/VarObs ; VarSim <- 1/VarSim ; VarSim[abs(VarSim) > 1E+100] <- NA; } + if(InputsCrit$transfo=="sort"){ VarObs <- sort(VarObs); VarSim <- sort(VarSim); } + ##TS_ignore + TS_ignore <- !is.finite(VarObs) | !is.finite(VarSim) | !InputsCrit$BoolCrit ; + Ind_TS_ignore <- which(TS_ignore); if(length(Ind_TS_ignore)==0){ Ind_TS_ignore <- NULL; } + if(sum(!TS_ignore)==0){ OutputsCrit <- list(NA); names(OutputsCrit) <- c("CritValue"); return(OutputsCrit); } + if(inherits(OutputsModel,"hourly" )){ WarningTS <- 365; } + if(inherits(OutputsModel,"daily" )){ WarningTS <- 365; } + if(inherits(OutputsModel,"monthly")){ WarningTS <- 12; } + if(inherits(OutputsModel,"yearly" )){ WarningTS <- 3; } + if(sum(!TS_ignore)<WarningTS & !quiet){ warning(paste("\t criterion computed on less than ",WarningTS," time-steps \n",sep="")); } + + +##ErrorCrit______________________________________ + Numer <- sum((VarSim-VarObs)^2,na.rm=TRUE); + Denom <- sum(!is.na(VarObs)); + if(Numer==0){ Crit <- 0; } else { Crit <- sqrt(Numer/Denom); } + if(is.numeric(Crit) & is.finite(Crit)){ CritValue <- Crit; } + + +##Output_________________________________________ + OutputsCrit <- list(CritValue,CritName,CritBestValue,Multiplier,Ind_TS_ignore); + names(OutputsCrit) <- c("CritValue","CritName","CritBestValue","Multiplier","Ind_notcomputed"); + return(OutputsCrit); + +} + + diff --git a/R/PEdaily_Oudin.R b/R/PEdaily_Oudin.R new file mode 100644 index 0000000000000000000000000000000000000000..1f3b2c6d311a6b514459677e2772a0489961b80c --- /dev/null +++ b/R/PEdaily_Oudin.R @@ -0,0 +1,58 @@ +#***************************************************************************************************************** +#' Function which computes daily PE using the formula from Oudin et al. (2005). +#***************************************************************************************************************** +#' @title Computation of daily series of potential evapotranspiration with Oudin's formula +#' @author Laurent Coron (December 2013) +#' @references +#' Oudin, L., F. Hervieu, C. Michel, C. Perrin, V. Andréassian, F. Anctil and C. Loumagne (2005), +#' Which potential evapotranspiration input for a lumped rainfall-runoff model?: Part 2-Towards a +#' simple and efficient potential evapotranspiration model for rainfall-runoff modelling, Journal of Hydrology, +#' 303(1-4), 290-306, doi:10.1016/j.jhydrol.2004.08.026. +#' @examples +#' require(airGR) +#' data(L0123001) +#' PotEvap <- PEdaily_Oudin(JD=as.POSIXlt(BasinObs$DatesR)$yday,Temp=BasinObs$T,LatRad=0.8) +#' @encoding UTF-8 +#' @export +#_FunctionInputs__________________________________________________________________________________________________ +#' @param JD [numeric] time series of julian day [-] +#' @param Temp [numeric] time series of daily mean air temperature [degC] +#' @param LatRad [numeric] latitude of measurement for the temperature series [rad] +#_FunctionOutputs_________________________________________________________________________________________________ +#' @return [numeric] time series of daily potential evapotranspiration [mm/d] +#*****************************************************************************************************************' +PEdaily_Oudin <- function(JD,Temp,LatRad){ + + PE_Oudin_D <- rep(NA,length(Temp)); + for(k in 1:length(Temp)){ + + FI <- LatRad ### latitude in rad + ### FI <- LatDeg/(180/pi) ### conversion from deg to rad + COSFI <- cos(FI) + AFI <- abs(LatRad/42.) + + TETA <- 0.4093*sin(JD[k]/58.1-1.405) + COSTETA <- cos(TETA) + COSGZ <- max(0.001,cos(FI-TETA)) + GZ <- acos(COSGZ) + COSGZ2 <- COSGZ*COSGZ + if(COSGZ2 >= 1){ SINGZ <- 0. } else { SINGZ <- sqrt(1.-COSGZ2) } + COSOM <- 1.-COSGZ/COSFI/COSTETA + if(COSOM < -1.){ COSOM <- -1. } + if(COSOM > 1.){ COSOM <- 1. } + COSOM2 <- COSOM*COSOM + if(COSOM2 >= 1.){ SINOM <- 0. } else { SINOM <- sqrt(1.-COSOM2) } + OM <- acos(COSOM) + COSPZ <- COSGZ+COSFI*COSTETA*(SINOM/OM-1.) + if(COSPZ < 0.001){ COSPZ <- 0.001 } + ETA <- 1.+cos(JD[k]/58.1)/30. + GE <- 446.*OM*COSPZ*ETA + + if(Temp[k] >= -5.0) { PE_Oudin_D[k] <- GE*(Temp[k]+5.)/100./28.5 } else { PE_Oudin_D[k] <- 0 } + + } + + return(PE_Oudin_D); + +} + diff --git a/R/RunModel.R b/R/RunModel.R new file mode 100644 index 0000000000000000000000000000000000000000..4acfd1e28be3e73985aac908030b6ad6c86fe653 --- /dev/null +++ b/R/RunModel.R @@ -0,0 +1,22 @@ +#***************************************************************************************************************** +#' Function which performs a single model run with the provided function. +#***************************************************************************************************************** +#' @title Run with the provided hydrological model function +#' @author Laurent Coron (June 2014) +#' @seealso \code{\link{RunModel_GR4J}}, \code{\link{RunModel_CemaNeigeGR4J}}, \code{\link{CreateInputsModel}}, \code{\link{CreateRunOptions}}. +#' @example tests/example_RunModel.R +#' @useDynLib airgr +#' @encoding UTF-8 +#' @export +#_FunctionInputs__________________________________________________________________________________________________ +#' @param InputsModel [object of class \emph{InputsModel}] see \code{\link{CreateInputsModel}} for details +#' @param RunOptions [object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details +#' @param Param [numeric] vector of model parameters +#' @param FUN_MOD [function] hydrological model function (e.g. RunModel_GR4J, RunModel_CemaNeigeGR4J) +#_FunctionOutputs_________________________________________________________________________________________________ +#' @return [list] see \code{\link{RunModel_GR4J}} or \code{\link{RunModel_CemaNeigeGR4J}} for details +#*****************************************************************************************************************' +RunModel <- function(InputsModel,RunOptions,Param,FUN_MOD){ + return( FUN_MOD(InputsModel,RunOptions,Param) ) +} + diff --git a/R/RunModel_CemaNeige.R b/R/RunModel_CemaNeige.R new file mode 100644 index 0000000000000000000000000000000000000000..cfce9e20d99cf7037044062c60edf05730007e92 --- /dev/null +++ b/R/RunModel_CemaNeige.R @@ -0,0 +1,132 @@ +#***************************************************************************************************************** +#' Function which performs a single run for the CemaNeige daily snow module. +#' +#' For further details on the model, see the references section. +#' For further details on the argument structures and initialisation options, see \code{\link{CreateRunOptions}}. +#***************************************************************************************************************** +#' @title Run with the CemaNeige snow module +#' @author Laurent Coron (January 2014) +#' @references +#' Valéry, A., V. Andréassian and C. Perrin (2014), +#' "As simple as possible but not simpler": what is useful in a temperature-based snow-accounting routine? +#' Part 1 - Comparison of six snow accounting routines on 380 catchments, Journal of Hydrology, doi:10.1016/j.jhydrol.2014.04.059. \cr +#' Valéry, A., V. Andréassian and C. Perrin (2014), +#' "As simple as possible but not simpler": What is useful in a temperature-based snow-accounting routine? +#' Part 2 - Sensitivity analysis of the Cemaneige snow accounting routine on 380 catchments, Journal of Hydrology, doi:10.1016/j.jhydrol.2014.04.058. +#' @seealso \code{\link{RunModel_CemaNeigeGR4J}}, \code{\link{CreateInputsModel}}, \code{\link{CreateRunOptions}}. +#' @example tests/example_RunModel_CemaNeige.R +#' @useDynLib airgr +#' @encoding UTF-8 +#' @export +#_FunctionInputs__________________________________________________________________________________________________ +#' @param InputsModel [object of class \emph{InputsModel}] see \code{\link{CreateInputsModel}} for details +#' @param RunOptions [object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details +#' @param Param [numeric] vector of 2 parameters +#' \tabular{ll}{ +#' CemaNeige X1 \tab weighting coefficient for snow pack thermal state [-] \cr +#' CemaNeige X2 \tab degree-day melt coefficient [mm/degC/d] \cr +#' } +#_FunctionOutputs_________________________________________________________________________________________________ +#' @return [list] list containing the function outputs organised as follows: +#' \tabular{ll}{ +#' \emph{$DatesR } \tab [POSIXlt] series of dates \cr +#' \emph{$CemaNeigeLayers} \tab [list] list of CemaNeige outputs (1 list per layer) \cr +#' \emph{$CemaNeigeLayers[[iLayer]]$Pliq } \tab [numeric] series of liquid precip. [mm/d] \cr +#' \emph{$CemaNeigeLayers[[iLayer]]$Psol } \tab [numeric] series of solid precip. [mm/d] \cr +#' \emph{$CemaNeigeLayers[[iLayer]]$SnowPack } \tab [numeric] series of snow pack [mm] \cr +#' \emph{$CemaNeigeLayers[[iLayer]]$ThermalState } \tab [numeric] series of snow pack thermal state [degC] \cr +#' \emph{$CemaNeigeLayers[[iLayer]]$Gratio } \tab [numeric] series of Gratio [0-1] \cr +#' \emph{$CemaNeigeLayers[[iLayer]]$PotMelt } \tab [numeric] series of potential snow melt [mm] \cr +#' \emph{$CemaNeigeLayers[[iLayer]]$Melt } \tab [numeric] series of actual snow melt [mm] \cr +#' \emph{$CemaNeigeLayers[[iLayer]]$PliqAndMelt } \tab [numeric] series of liquid precip. + actual snow melt [mm] \cr +#' \emph{$StateEnd} \tab [numeric] states at the end of the run: CemaNeige states [mm & degC] \cr +#' } +#' (refer to the provided references or to the package source code for further details on these model outputs) +#***************************************************************************************************************** +RunModel_CemaNeige <- function(InputsModel,RunOptions,Param){ + + NParam <- 2; + FortranOutputsCemaNeige <- c("Pliq","Psol","SnowPack","ThermalState","Gratio","PotMelt","Melt","PliqAndMelt"); + + ##Arguments_check + if(inherits(InputsModel,"InputsModel")==FALSE){ stop("InputsModel must be of class 'InputsModel' \n"); return(NULL); } + if(inherits(InputsModel,"daily" )==FALSE){ stop("InputsModel must be of class 'daily' \n"); return(NULL); } + if(inherits(InputsModel,"CemaNeige" )==FALSE){ stop("InputsModel must be of class 'CemaNeige' \n"); return(NULL); } + if(inherits(RunOptions,"RunOptions" )==FALSE){ stop("RunOptions must be of class 'RunOptions' \n"); return(NULL); } + if(inherits(RunOptions,"CemaNeige" )==FALSE){ stop("RunOptions must be of class 'CemaNeige' \n"); return(NULL); } + if(!is.vector(Param)){ stop("Param must be a vector \n"); return(NULL); } + if(sum(!is.na(Param))!=NParam){ stop(paste("Param must be a vector of length ",NParam," and contain no NA \n",sep="")); return(NULL); } + Param <- as.double(Param); + + ##Input_data_preparation + if(identical(RunOptions$IndPeriod_WarmUp,0)){ RunOptions$IndPeriod_WarmUp <- NULL; } + IndPeriod1 <- c(RunOptions$IndPeriod_WarmUp,RunOptions$IndPeriod_Run); + IndPeriod2 <- (length(RunOptions$IndPeriod_WarmUp)+1):length(IndPeriod1); + ExportDatesR <- "DatesR" %in% RunOptions$Outputs_Sim; + ExportStateEnd <- "StateEnd" %in% RunOptions$Outputs_Sim; + + + + ##SNOW_MODULE________________________________________________________________________________## + ParamCemaNeige <- Param; + NLayers <- length(InputsModel$LayerPrecip); + if(sum(is.na(ParamCemaNeige))!=0){ stop("Param contains missing values \n"); return(NULL); } + if("all" %in% RunOptions$Outputs_Sim){ IndOutputsCemaNeige <- as.integer(1:length(FortranOutputsCemaNeige)); + } else { IndOutputsCemaNeige <- which(FortranOutputsCemaNeige %in% RunOptions$Outputs_Sim); } + CemaNeigeLayers <- list(); CemaNeigeStateEnd <- NULL; NameCemaNeigeLayers <- "CemaNeigeLayers"; + + ##Call_DLL_CemaNeige_________________________ + for(iLayer in 1:NLayers){ + StateStartCemaNeige <- RunOptions$IniStates[ (2*(iLayer-1)+1):(2*(iLayer-1)+2) ]; + RESULTS <- .Fortran("frun_cemaneige",PACKAGE="airgr", + ##inputs + LInputs=as.integer(length(IndPeriod1)), ### length of input and output series + InputsPrecip=InputsModel$LayerPrecip[[iLayer]][IndPeriod1], ### input series of total precipitation [mm/d] + 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] + MeanAnSolidPrecip=RunOptions$MeanAnSolidPrecip[iLayer], ### value of annual mean solid precip [mm/y] + NParam=as.integer(2), ### number of model parameter = 2 + Param=ParamCemaNeige, ### parameter set + NStates=as.integer(2), ### number of state variables used for model initialising = 2 + StateStart=StateStartCemaNeige, ### state variables used when the model run starts + NOutputs=as.integer(length(IndOutputsCemaNeige)), ### number of output series + IndOutputs=IndOutputsCemaNeige, ### indices of output series + ##outputs + Outputs=matrix(as.double(-999.999),nrow=length(IndPeriod1),ncol=length(IndOutputsCemaNeige)), ### output series [mm] + StateEnd=rep(as.double(-999.999),as.integer(2)) ### state variables at the end of the model run (reservoir levels [mm] and HU) + ) + RESULTS$Outputs[ round(RESULTS$Outputs ,3)==(-999.999)] <- NA; + RESULTS$StateEnd[round(RESULTS$StateEnd,3)==(-999.999)] <- NA; + + ##Data_storage + CemaNeigeLayers[[iLayer]] <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]); + names(CemaNeigeLayers[[iLayer]]) <- FortranOutputsCemaNeige[IndOutputsCemaNeige]; + if(ExportStateEnd){ CemaNeigeStateEnd <- c(CemaNeigeStateEnd,RESULTS$StateEnd); } + rm(RESULTS); + } ###ENDFOR_iLayer + names(CemaNeigeLayers) <- paste("Layer",formatC(1:NLayers,width=2,flag="0"),sep=""); + + ##Output_data_preparation + if(ExportDatesR==FALSE & ExportStateEnd==FALSE){ + OutputsModel <- list(CemaNeigeLayers); + names(OutputsModel) <- NameCemaNeigeLayers; } + if(ExportDatesR==TRUE & ExportStateEnd==FALSE){ + OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]), + list(CemaNeigeLayers) ); + names(OutputsModel) <- c("DatesR",NameCemaNeigeLayers); } + if(ExportDatesR==FALSE & ExportStateEnd==TRUE){ + OutputsModel <- c( list(CemaNeigeLayers), + CemaNeigeStateEnd ); + names(OutputsModel) <- c(NameCemaNeigeLayers,"StateEnd"); } + if(ExportDatesR==TRUE & ExportStateEnd==TRUE){ + OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]), + list(CemaNeigeLayers), + CemaNeigeStateEnd ); + names(OutputsModel) <- c("DatesR",NameCemaNeigeLayers,"StateEnd"); } + + ##End + class(OutputsModel) <- c("OutputsModel","daily","CemaNeige"); + return(OutputsModel); + +} + diff --git a/R/RunModel_CemaNeigeGR4J.R b/R/RunModel_CemaNeigeGR4J.R new file mode 100644 index 0000000000000000000000000000000000000000..abde24116bbaf9e7b0688f2a4d99b08252b621b4 --- /dev/null +++ b/R/RunModel_CemaNeigeGR4J.R @@ -0,0 +1,209 @@ +#***************************************************************************************************************** +#' Function which performs a single run for the CemaNeige-GR4J daily lumped model. +#' +#' For further details on the model, see the references section. +#' For further details on the argument structures and initialisation options, see \code{\link{CreateRunOptions}}. +#***************************************************************************************************************** +#' @title Run with the CemaNeigeGR4J hydrological model +#' @author Laurent Coron (December 2013) +#' @references +#' Perrin, C., C. Michel and V. Andréassian (2003), +#' Improvement of a parsimonious model for streamflow simulation, +#' Journal of Hydrology, 279(1-4), 275-289, doi:10.1016/S0022-1694(03)00225-7. \cr +#' Valéry, A., V. Andréassian and C. Perrin (2014), +#' "As simple as possible but not simpler": what is useful in a temperature-based snow-accounting routine? +#' Part 1 - Comparison of six snow accounting routines on 380 catchments, Journal of Hydrology, doi:10.1016/j.jhydrol.2014.04.059. \cr +#' Valéry, A., V. Andréassian and C. Perrin (2014), +#' "As simple as possible but not simpler": What is useful in a temperature-based snow-accounting routine? +#' Part 2 - Sensitivity analysis of the Cemaneige snow accounting routine on 380 catchments, Journal of Hydrology, doi:10.1016/j.jhydrol.2014.04.058. +#' @seealso \code{\link{RunModel_CemaNeigeGR5J}}, \code{\link{RunModel_CemaNeigeGR6J}}, \code{\link{RunModel_GR4J}}, +#' \code{\link{CreateInputsModel}}, \code{\link{CreateRunOptions}}. +#' @example tests/example_RunModel_CemaNeigeGR4J.R +#' @useDynLib airgr +#' @encoding UTF-8 +#' @export +#_FunctionInputs__________________________________________________________________________________________________ +#' @param InputsModel [object of class \emph{InputsModel}] see \code{\link{CreateInputsModel}} for details +#' @param RunOptions [object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details +#' @param Param [numeric] vector of 6 parameters +#' \tabular{ll}{ +#' GR4J X1 \tab production store capacity [mm] \cr +#' GR4J X2 \tab intercatchment exchange coefficient [mm/d] \cr +#' GR4J X3 \tab routing store capacity [mm] \cr +#' GR4J X4 \tab unit hydrograph time constant [d] \cr +#' CemaNeige X1 \tab weighting coefficient for snow pack thermal state [-] \cr +#' CemaNeige X2 \tab degree-day melt coefficient [mm/degC/d] \cr +#' } +#_FunctionOutputs_________________________________________________________________________________________________ +#' @return [list] list containing the function outputs organised as follows: +#' \tabular{ll}{ +#' \emph{$DatesR } \tab [POSIXlt] series of dates \cr +#' \emph{$PotEvap } \tab [numeric] series of input potential evapotranspiration [mm/d] \cr +#' \emph{$Precip } \tab [numeric] series of input total precipitation [mm/d] \cr +#' \emph{$Prod } \tab [numeric] series of production store level (X(2)) [mm] \cr +#' \emph{$AE } \tab [numeric] series of actual evapotranspiration [mm/d] \cr +#' \emph{$Perc } \tab [numeric] series of percolation (PERC) [mm/d] \cr +#' \emph{$PR } \tab [numeric] series of PR=PN-PS+PERC [mm/d] \cr +#' \emph{$Q9 } \tab [numeric] series of HU1 outflow (Q9) [mm/d] \cr +#' \emph{$Q1 } \tab [numeric] series of HU2 outflow (Q1) [mm/d] \cr +#' \emph{$Rout } \tab [numeric] series of routing store level (X(1)) [mm] \cr +#' \emph{$Exch } \tab [numeric] series of potential semi-exchange between catchments [mm/d] \cr +#' \emph{$AExch } \tab [numeric] series of actual exchange between catchments (1+2) [mm/d] \cr +#' \emph{$QR } \tab [numeric] series of routing store outflow (QR) [mm/d] \cr +#' \emph{$QD } \tab [numeric] series of direct flow from HU2 after exchange (QD) [mm/d] \cr +#' \emph{$Qsim } \tab [numeric] series of Qsim [mm/d] \cr +#' \emph{$CemaNeigeLayers} \tab [list] list of CemaNeige outputs (1 list per layer) \cr +#' \emph{$CemaNeigeLayers[[iLayer]]$Pliq } \tab [numeric] series of liquid precip. [mm/d] \cr +#' \emph{$CemaNeigeLayers[[iLayer]]$Psol } \tab [numeric] series of solid precip. [mm/d] \cr +#' \emph{$CemaNeigeLayers[[iLayer]]$SnowPack } \tab [numeric] series of snow pack [mm] \cr +#' \emph{$CemaNeigeLayers[[iLayer]]$ThermalState } \tab [numeric] series of snow pack thermal state [degC] \cr +#' \emph{$CemaNeigeLayers[[iLayer]]$Gratio } \tab [numeric] series of Gratio [0-1] \cr +#' \emph{$CemaNeigeLayers[[iLayer]]$PotMelt } \tab [numeric] series of potential snow melt [mm/d] \cr +#' \emph{$CemaNeigeLayers[[iLayer]]$Melt } \tab [numeric] series of actual snow melt [mm/d] \cr +#' \emph{$CemaNeigeLayers[[iLayer]]$PliqAndMelt } \tab [numeric] series of liquid precip. + actual snow melt [mm/d] \cr +#' \emph{$StateEnd} \tab [numeric] states at the end of the run: \cr\tab res. & HU levels [mm], CemaNeige states [mm & degC] \cr +#' } +#' (refer to the provided references or to the package source code for further details on these model outputs) +#***************************************************************************************************************** +RunModel_CemaNeigeGR4J <- function(InputsModel,RunOptions,Param){ + + NParam <- 6; + FortranOutputsCemaNeige <- c("Pliq","Psol","SnowPack","ThermalState","Gratio","PotMelt","Melt","PliqAndMelt"); + FortranOutputsMod <- c("PotEvap","Precip","Prod","AE","Perc","PR","Q9","Q1","Rout","Exch","AExch","QR","QD","Qsim"); + + ##Arguments_check + if(inherits(InputsModel,"InputsModel")==FALSE){ stop("InputsModel must be of class 'InputsModel' \n"); return(NULL); } + if(inherits(InputsModel,"daily" )==FALSE){ stop("InputsModel must be of class 'daily' \n"); return(NULL); } + if(inherits(InputsModel,"GR" )==FALSE){ stop("InputsModel must be of class 'GR' \n"); return(NULL); } + if(inherits(InputsModel,"CemaNeige" )==FALSE){ stop("InputsModel must be of class 'CemaNeige' \n"); return(NULL); } + if(inherits(RunOptions,"RunOptions" )==FALSE){ stop("RunOptions must be of class 'RunOptions' \n"); return(NULL); } + if(inherits(RunOptions,"GR" )==FALSE){ stop("RunOptions must be of class 'GR' \n"); return(NULL); } + if(inherits(RunOptions,"CemaNeige" )==FALSE){ stop("RunOptions must be of class 'CemaNeige' \n"); return(NULL); } + if(!is.vector(Param)){ stop("Param must be a vector \n"); return(NULL); } + if(sum(!is.na(Param))!=NParam){ stop(paste("Param must be a vector of length ",NParam," and contain no NA \n",sep="")); return(NULL); } + 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)) + IndPeriod2 <- (length(RunOptions$IndPeriod_WarmUp)+1):LInputSeries; + ParamCemaNeige <- Param[(length(Param)-1):length(Param)]; + NParamMod <- as.integer(length(Param)-2); + ParamMod <- Param[1:NParamMod]; + NLayers <- length(InputsModel$LayerPrecip); + NStatesMod <- as.integer(length(RunOptions$IniStates)-2*NLayers); + ExportDatesR <- "DatesR" %in% RunOptions$Outputs_Sim; + ExportStateEnd <- "StateEnd" %in% RunOptions$Outputs_Sim; + + + + ##SNOW_MODULE________________________________________________________________________________## + if(RunOptions$RunSnowModule==TRUE){ + if("all" %in% RunOptions$Outputs_Sim){ IndOutputsCemaNeige <- as.integer(1:length(FortranOutputsCemaNeige)); + } else { IndOutputsCemaNeige <- which(FortranOutputsCemaNeige %in% RunOptions$Outputs_Sim); } + CemaNeigeLayers <- list(); CemaNeigeStateEnd <- NULL; NameCemaNeigeLayers <- "CemaNeigeLayers"; + + ##Call_DLL_CemaNeige_________________________ + for(iLayer in 1:NLayers){ + StateStartCemaNeige <- RunOptions$IniStates[ (NStatesMod+2*(iLayer-1)+1):(NStatesMod+2*(iLayer-1)+2) ]; + RESULTS <- .Fortran("frun_cemaneige",PACKAGE="airgr", + ##inputs + LInputs=LInputSeries, ### length of input and output series + InputsPrecip=InputsModel$LayerPrecip[[iLayer]][IndPeriod1], ### input series of total precipitation [mm/d] + 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] + MeanAnSolidPrecip=RunOptions$MeanAnSolidPrecip[iLayer], ### value of annual mean solid precip [mm/y] + NParam=as.integer(2), ### number of model parameter = 2 + Param=ParamCemaNeige, ### parameter set + NStates=as.integer(2), ### number of state variables used for model initialising = 2 + StateStart=StateStartCemaNeige, ### state variables used when the model run starts + NOutputs=as.integer(length(IndOutputsCemaNeige)), ### number of output series + IndOutputs=IndOutputsCemaNeige, ### indices of output series + ##outputs + Outputs=matrix(as.double(-999.999),nrow=LInputSeries,ncol=length(IndOutputsCemaNeige)), ### output series [mm] + StateEnd=rep(as.double(-999.999),as.integer(2)) ### state variables at the end of the model run (reservoir levels [mm] and HU) + ) + RESULTS$Outputs[ round(RESULTS$Outputs ,3)==(-999.999)] <- NA; + RESULTS$StateEnd[round(RESULTS$StateEnd,3)==(-999.999)] <- NA; + + ##Data_storage + CemaNeigeLayers[[iLayer]] <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]); + names(CemaNeigeLayers[[iLayer]]) <- FortranOutputsCemaNeige[IndOutputsCemaNeige]; + IndPliqAndMelt <- which(names(CemaNeigeLayers[[iLayer]]) == "PliqAndMelt"); + if(iLayer==1){ CatchMeltAndPliq <- RESULTS$Outputs[,IndPliqAndMelt]/NLayers; } + if(iLayer >1){ CatchMeltAndPliq <- CatchMeltAndPliq + RESULTS$Outputs[,IndPliqAndMelt]/NLayers; } + if(ExportStateEnd){ CemaNeigeStateEnd <- c(CemaNeigeStateEnd,RESULTS$StateEnd); } + rm(RESULTS); + } ###ENDFOR_iLayer + names(CemaNeigeLayers) <- paste("Layer",formatC(1:NLayers,width=2,flag="0"),sep=""); + } ###ENDIF_RunSnowModule + if(RunOptions$RunSnowModule==FALSE){ + CemaNeigeLayers <- list(); CemaNeigeStateEnd <- NULL; NameCemaNeigeLayers <- NULL; + CatchMeltAndPliq <- InputsModel$Precip[IndPeriod1]; } + + + + ##MODEL______________________________________________________________________________________## + if("all" %in% RunOptions$Outputs_Sim){ IndOutputsMod <- as.integer(1:length(FortranOutputsMod)); + } else { IndOutputsMod <- which(FortranOutputsMod %in% RunOptions$Outputs_Sim); } + + ##Use_of_IniResLevels + if("IniResLevels" %in% RunOptions){ + RunOptions$IniStates[1] <- RunOptions$IniResLevels[2]*ParamMod[3]; ### routing store level (mm) + RunOptions$IniStates[2] <- RunOptions$IniResLevels[1]*ParamMod[1]; ### production store level (mm) + } + + ##Call_fortan + RESULTS <- .Fortran("frun_gr4j",PACKAGE="airgr", + ##inputs + LInputs=LInputSeries, ### length of input and output series + InputsPrecip=CatchMeltAndPliq, ### input series of total precipitation [mm/d] + InputsPE=InputsModel$PotEvap[IndPeriod1], ### input series potential evapotranspiration [mm/d] + NParam=NParamMod, ### number of model parameter + Param=ParamMod, ### parameter set + NStates=NStatesMod, ### number of state variables used for model initialising + StateStart=RunOptions$IniStates[1:NStatesMod], ### state variables used when the model run starts + NOutputs=as.integer(length(IndOutputsMod)), ### number of output series + IndOutputs=IndOutputsMod, ### indices of output series + ##outputs + Outputs=matrix(as.double(-999.999),nrow=LInputSeries,ncol=length(IndOutputsMod)), ### 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; + if(RunOptions$RunSnowModule & "Precip" %in% RunOptions$Outputs_Sim){ RESULTS$Outputs[,which(FortranOutputsMod[IndOutputsMod]=="Precip")] <- InputsModel$Precip[IndPeriod1]; } + + ##Output_data_preparation + ##OutputsModel_only + if(ExportDatesR==FALSE & ExportStateEnd==FALSE){ + OutputsModel <- c( lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]), + list(CemaNeigeLayers) ); + names(OutputsModel) <- c(FortranOutputsMod[IndOutputsMod],NameCemaNeigeLayers); } + ##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]), + list(CemaNeigeLayers) ); + names(OutputsModel) <- c("DatesR",FortranOutputsMod[IndOutputsMod],NameCemaNeigeLayers); } + ##OutputsModel_and_SateEnd_only + if(ExportDatesR==FALSE & ExportStateEnd==TRUE){ + OutputsModel <- c( lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]), + list(CemaNeigeLayers), + list(c(RESULTS$StateEnd,CemaNeigeStateEnd)) ); + names(OutputsModel) <- c(FortranOutputsMod[IndOutputsMod],NameCemaNeigeLayers,"StateEnd"); } + ##DatesR_and_OutputsModel_and_SateEnd + if(ExportDatesR==TRUE & ExportStateEnd==TRUE){ + OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]), + lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]), + list(CemaNeigeLayers), + list(c(RESULTS$StateEnd,CemaNeigeStateEnd)) ); + names(OutputsModel) <- c("DatesR",FortranOutputsMod[IndOutputsMod],NameCemaNeigeLayers,"StateEnd"); } + + ##End + rm(RESULTS); + class(OutputsModel) <- c("OutputsModel","daily","GR","CemaNeige"); + return(OutputsModel); + +} + diff --git a/R/RunModel_CemaNeigeGR5J.R b/R/RunModel_CemaNeigeGR5J.R new file mode 100644 index 0000000000000000000000000000000000000000..59c37e474a8a560d942fe59b568a5de2ef969e8f --- /dev/null +++ b/R/RunModel_CemaNeigeGR5J.R @@ -0,0 +1,211 @@ +#***************************************************************************************************************** +#' Function which performs a single run for the CemaNeige-GR5J daily lumped model. +#' +#' For further details on the model, see the references section. +#' For further details on the argument structures and initialisation options, see \code{\link{CreateRunOptions}}. +#***************************************************************************************************************** +#' @title Run with the CemaNeigeGR5J hydrological model +#' @author Laurent Coron (December 2013) +#' @references +#' Le Moine, N. (2008), Le bassin versant de surface vu par le souterrain : une voie d'amélioration des performances +#' et du réalisme des modèles pluie-débit ?, PhD thesis (french), UPMC, Paris, France. \cr +#' Pushpalatha, R., C. Perrin, N. Le Moine, T. Mathevet and V. Andréassian (2011), +#' A downward structural sensitivity analysis of hydrological models to improve low-flow simulation, +#' Journal of Hydrology, 411(1-2), 66-76, doi:10.1016/j.jhydrol.2011.09.034. \cr +#' Valéry, A., V. Andréassian and C. Perrin (2014), +#' "As simple as possible but not simpler": what is useful in a temperature-based snow-accounting routine? +#' Part 1 - Comparison of six snow accounting routines on 380 catchments, Journal of Hydrology, doi:10.1016/j.jhydrol.2014.04.059. \cr +#' Valéry, A., V. Andréassian and C. Perrin (2014), +#' "As simple as possible but not simpler": What is useful in a temperature-based snow-accounting routine? +#' Part 2 - Sensitivity analysis of the Cemaneige snow accounting routine on 380 catchments, Journal of Hydrology, doi:10.1016/j.jhydrol.2014.04.058. +#' @seealso \code{\link{RunModel_CemaNeigeGR4J}}, \code{\link{RunModel_CemaNeigeGR6J}}, \code{\link{RunModel_GR5J}}, +#' \code{\link{CreateInputsModel}}, \code{\link{CreateRunOptions}}. +#' @example tests/example_RunModel_CemaNeigeGR5J.R +#' @useDynLib airgr +#' @encoding UTF-8 +#' @export +#_FunctionInputs__________________________________________________________________________________________________ +#' @param InputsModel [object of class \emph{InputsModel}] see \code{\link{CreateInputsModel}} for details +#' @param RunOptions [object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details +#' @param Param [numeric] vector of 7 parameters +#' \tabular{ll}{ +#' GR5J X1 \tab production store capacity [mm] \cr +#' GR5J X2 \tab intercatchment exchange coefficient 1 [mm/d] \cr +#' GR5J X3 \tab routing store capacity [mm] \cr +#' GR5J X4 \tab unit hydrograph time constant [d] \cr +#' GR5J X5 \tab intercatchment exchange coefficient 2 [-] \cr +#' CemaNeige X1 \tab weighting coefficient for snow pack thermal state [-] \cr +#' CemaNeige X2 \tab degree-day melt coefficient [mm/degC/d] \cr +#' } +#_FunctionOutputs_________________________________________________________________________________________________ +#' @return [list] list containing the function outputs organised as follows: +#' \tabular{ll}{ +#' \emph{$DatesR } \tab [POSIXlt] series of dates \cr +#' \emph{$PotEvap } \tab [numeric] series of input potential evapotranspiration [mm/d] \cr +#' \emph{$Precip } \tab [numeric] series of input total precipitation [mm/d] \cr +#' \emph{$Prod } \tab [numeric] series of production store level (X(2)) [mm] \cr +#' \emph{$AE } \tab [numeric] series of actual evapotranspiration [mm/d] \cr +#' \emph{$Perc } \tab [numeric] series of percolation (PERC) [mm/d] \cr +#' \emph{$PR } \tab [numeric] series of PR=PN-PS+PERC [mm/d] \cr +#' \emph{$Q9 } \tab [numeric] series of HU1 outflow (Q9) [mm/d] \cr +#' \emph{$Q1 } \tab [numeric] series of HU2 outflow (Q1) [mm/d] \cr +#' \emph{$Rout } \tab [numeric] series of routing store level (X(1)) [mm] \cr +#' \emph{$Exch } \tab [numeric] series of potential semi-exchange between catchments [mm/d] \cr +#' \emph{$AExch } \tab [numeric] series of actual exchange between catchments (1+2) [mm/d] \cr +#' \emph{$QR } \tab [numeric] series of routing store outflow (QR) [mm/d] \cr +#' \emph{$QD } \tab [numeric] series of direct flow from HU2 after exchange (QD) [mm/d] \cr +#' \emph{$Qsim } \tab [numeric] series of Qsim [mm/d] \cr +#' \emph{$CemaNeigeLayers} \tab [list] list of CemaNeige outputs (1 list per layer) \cr +#' \emph{$CemaNeigeLayers[[iLayer]]$Pliq } \tab [numeric] series of liquid precip. [mm/d] \cr +#' \emph{$CemaNeigeLayers[[iLayer]]$Psol } \tab [numeric] series of solid precip. [mm/d] \cr +#' \emph{$CemaNeigeLayers[[iLayer]]$SnowPack } \tab [numeric] series of snow pack [mm] \cr +#' \emph{$CemaNeigeLayers[[iLayer]]$ThermalState } \tab [numeric] series of snow pack thermal state [degC] \cr +#' \emph{$CemaNeigeLayers[[iLayer]]$Gratio } \tab [numeric] series of Gratio [0-1] \cr +#' \emph{$CemaNeigeLayers[[iLayer]]$PotMelt } \tab [numeric] series of potential snow melt [mm/d] \cr +#' \emph{$CemaNeigeLayers[[iLayer]]$Melt } \tab [numeric] series of actual snow melt [mm/d] \cr +#' \emph{$CemaNeigeLayers[[iLayer]]$PliqAndMelt } \tab [numeric] series of liquid precip. + actual snow melt [mm/d] \cr +#' \emph{$StateEnd} \tab [numeric] states at the end of the run: \cr\tab res. & HU levels [mm], CemaNeige states [mm & degC] \cr +#' } +#' (refer to the provided references or to the package source code for further details on these model outputs) +#***************************************************************************************************************** +RunModel_CemaNeigeGR5J <- function(InputsModel,RunOptions,Param){ + + NParam <- 7; + FortranOutputsCemaNeige <- c("Pliq","Psol","SnowPack","ThermalState","Gratio","PotMelt","Melt","PliqAndMelt"); + FortranOutputsMod <- c("PotEvap","Precip","Prod","AE","Perc","PR","Q9","Q1","Rout","Exch","AExch","QR","QD","Qsim"); + + ##Arguments_check + if(inherits(InputsModel,"InputsModel")==FALSE){ stop("InputsModel must be of class 'InputsModel' \n"); return(NULL); } + if(inherits(InputsModel,"daily" )==FALSE){ stop("InputsModel must be of class 'daily' \n"); return(NULL); } + if(inherits(InputsModel,"GR" )==FALSE){ stop("InputsModel must be of class 'GR' \n"); return(NULL); } + if(inherits(InputsModel,"CemaNeige" )==FALSE){ stop("InputsModel must be of class 'CemaNeige' \n"); return(NULL); } + if(inherits(RunOptions,"RunOptions" )==FALSE){ stop("RunOptions must be of class 'RunOptions' \n"); return(NULL); } + if(inherits(RunOptions,"GR" )==FALSE){ stop("RunOptions must be of class 'GR' \n"); return(NULL); } + if(inherits(RunOptions,"CemaNeige" )==FALSE){ stop("RunOptions must be of class 'CemaNeige' \n"); return(NULL); } + if(!is.vector(Param)){ stop("Param must be a vector \n"); return(NULL); } + if(sum(!is.na(Param))!=NParam){ stop(paste("Param must be a vector of length ",NParam," and contain no NA \n",sep="")); return(NULL); } + 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)) + IndPeriod2 <- (length(RunOptions$IndPeriod_WarmUp)+1):LInputSeries; + ParamCemaNeige <- Param[(length(Param)-1):length(Param)]; + NParamMod <- as.integer(length(Param)-2); + ParamMod <- Param[1:NParamMod]; + NLayers <- length(InputsModel$LayerPrecip); + NStatesMod <- as.integer(length(RunOptions$IniStates)-2*NLayers); + ExportDatesR <- "DatesR" %in% RunOptions$Outputs_Sim; + ExportStateEnd <- "StateEnd" %in% RunOptions$Outputs_Sim; + + + ##SNOW_MODULE________________________________________________________________________________## + if(RunOptions$RunSnowModule==TRUE){ + if("all" %in% RunOptions$Outputs_Sim){ IndOutputsCemaNeige <- as.integer(1:length(FortranOutputsCemaNeige)); + } else { IndOutputsCemaNeige <- which(FortranOutputsCemaNeige %in% RunOptions$Outputs_Sim); } + CemaNeigeLayers <- list(); CemaNeigeStateEnd <- NULL; NameCemaNeigeLayers <- "CemaNeigeLayers"; + + ##Call_DLL_CemaNeige_________________________ + for(iLayer in 1:NLayers){ + StateStartCemaNeige <- RunOptions$IniStates[ (NStatesMod+2*(iLayer-1)+1):(NStatesMod+2*(iLayer-1)+2) ]; + RESULTS <- .Fortran("frun_cemaneige",PACKAGE="airgr", + ##inputs + LInputs=LInputSeries, ### length of input and output series + InputsPrecip=InputsModel$LayerPrecip[[iLayer]][IndPeriod1], ### input series of total precipitation [mm/d] + 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] + MeanAnSolidPrecip=RunOptions$MeanAnSolidPrecip[iLayer], ### value of annual mean solid precip [mm/y] + NParam=as.integer(2), ### number of model parameter = 2 + Param=ParamCemaNeige, ### parameter set + NStates=as.integer(2), ### number of state variables used for model initialising = 2 + StateStart=StateStartCemaNeige, ### state variables used when the model run starts + NOutputs=as.integer(length(IndOutputsCemaNeige)), ### number of output series + IndOutputs=IndOutputsCemaNeige, ### indices of output series + ##outputs + Outputs=matrix(as.double(-999.999),nrow=LInputSeries,ncol=length(IndOutputsCemaNeige)), ### output series [mm] + StateEnd=rep(as.double(-999.999),as.integer(2)) ### state variables at the end of the model run (reservoir levels [mm] and HU) + ) + RESULTS$Outputs[ round(RESULTS$Outputs ,3)==(-999.999)] <- NA; + RESULTS$StateEnd[round(RESULTS$StateEnd,3)==(-999.999)] <- NA; + + ##Data_storage + CemaNeigeLayers[[iLayer]] <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]); + names(CemaNeigeLayers[[iLayer]]) <- FortranOutputsCemaNeige[IndOutputsCemaNeige]; + IndPliqAndMelt <- which(names(CemaNeigeLayers[[iLayer]]) == "PliqAndMelt"); + if(iLayer==1){ CatchMeltAndPliq <- RESULTS$Outputs[,IndPliqAndMelt]/NLayers; } + if(iLayer >1){ CatchMeltAndPliq <- CatchMeltAndPliq + RESULTS$Outputs[,IndPliqAndMelt]/NLayers; } + if(ExportStateEnd){ CemaNeigeStateEnd <- c(CemaNeigeStateEnd,RESULTS$StateEnd); } + rm(RESULTS); + } ###ENDFOR_iLayer + names(CemaNeigeLayers) <- paste("Layer",formatC(1:NLayers,width=2,flag="0"),sep=""); + } ###ENDIF_RunSnowModule + if(RunOptions$RunSnowModule==FALSE){ + CemaNeigeLayers <- list(); CemaNeigeStateEnd <- NULL; NameCemaNeigeLayers <- NULL; + CatchMeltAndPliq <- InputsModel$Precip[IndPeriod1]; } + + + + ##MODEL______________________________________________________________________________________## + if("all" %in% RunOptions$Outputs_Sim){ IndOutputsMod <- as.integer(1:length(FortranOutputsMod)); + } else { IndOutputsMod <- which(FortranOutputsMod %in% RunOptions$Outputs_Sim); } + + ##Use_of_IniResLevels + if("IniResLevels" %in% RunOptions){ + RunOptions$IniStates[1] <- RunOptions$IniResLevels[2]*ParamMod[3]; ### routing store level (mm) + RunOptions$IniStates[2] <- RunOptions$IniResLevels[1]*ParamMod[1]; ### production store level (mm) + } + + ##Call_fortan + RESULTS <- .Fortran("frun_gr5j",PACKAGE="airgr", + ##inputs + LInputs=LInputSeries, ### length of input and output series + InputsPrecip=CatchMeltAndPliq, ### input series of total precipitation [mm/d] + InputsPE=InputsModel$PotEvap[IndPeriod1], ### input series potential evapotranspiration [mm/d] + NParam=NParamMod, ### number of model parameter + Param=ParamMod, ### parameter set + NStates=NStatesMod, ### number of state variables used for model initialising + StateStart=RunOptions$IniStates[1:NStatesMod], ### state variables used when the model run starts + NOutputs=as.integer(length(IndOutputsMod)), ### number of output series + IndOutputs=IndOutputsMod, ### indices of output series + ##outputs + Outputs=matrix(as.double(-999.999),nrow=LInputSeries,ncol=length(IndOutputsMod)), ### 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; + if(RunOptions$RunSnowModule & "Precip" %in% RunOptions$Outputs_Sim){ RESULTS$Outputs[,which(FortranOutputsMod[IndOutputsMod]=="Precip")] <- InputsModel$Precip[IndPeriod1]; } + + ##Output_data_preparation + ##OutputsModel_only + if(ExportDatesR==FALSE & ExportStateEnd==FALSE){ + OutputsModel <- c( lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]), + list(CemaNeigeLayers) ); + names(OutputsModel) <- c(FortranOutputsMod[IndOutputsMod],NameCemaNeigeLayers); } + ##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]), + list(CemaNeigeLayers) ); + names(OutputsModel) <- c("DatesR",FortranOutputsMod[IndOutputsMod],NameCemaNeigeLayers); } + ##OutputsModel_and_SateEnd_only + if(ExportDatesR==FALSE & ExportStateEnd==TRUE){ + OutputsModel <- c( lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]), + list(CemaNeigeLayers), + list(c(RESULTS$StateEnd,CemaNeigeStateEnd)) ); + names(OutputsModel) <- c(FortranOutputsMod[IndOutputsMod],NameCemaNeigeLayers,"StateEnd"); } + ##DatesR_and_OutputsModel_and_SateEnd + if(ExportDatesR==TRUE & ExportStateEnd==TRUE){ + OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]), + lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]), + list(CemaNeigeLayers), + list(c(RESULTS$StateEnd,CemaNeigeStateEnd)) ); + names(OutputsModel) <- c("DatesR",FortranOutputsMod[IndOutputsMod],NameCemaNeigeLayers,"StateEnd"); } + + ##End + rm(RESULTS); + class(OutputsModel) <- c("OutputsModel","daily","GR","CemaNeige"); + return(OutputsModel); + +} + diff --git a/R/RunModel_CemaNeigeGR6J.R b/R/RunModel_CemaNeigeGR6J.R new file mode 100644 index 0000000000000000000000000000000000000000..a572ea0a7ecc50f08cb9773d4642fcd4b015cdab --- /dev/null +++ b/R/RunModel_CemaNeigeGR6J.R @@ -0,0 +1,213 @@ +#***************************************************************************************************************** +#' Function which performs a single run for the CemaNeige-GR6J daily lumped model. +#' +#' For further details on the model, see the references section. +#' For further details on the argument structures and initialisation options, see \code{\link{CreateRunOptions}}. +#***************************************************************************************************************** +#' @title Run with the CemaNeigeGR6J hydrological model +#' @author Laurent Coron (December 2013) +#' @references +#' Pushpalatha, R., C. Perrin, N. Le Moine, T. Mathevet and V. Andréassian (2011), +#' A downward structural sensitivity analysis of hydrological models to improve low-flow simulation, +#' Journal of Hydrology, 411(1-2), 66-76, doi:10.1016/j.jhydrol.2011.09.034. \cr +#' Valéry, A., V. Andréassian and C. Perrin (2014), +#' "As simple as possible but not simpler": what is useful in a temperature-based snow-accounting routine? +#' Part 1 - Comparison of six snow accounting routines on 380 catchments, Journal of Hydrology, doi:10.1016/j.jhydrol.2014.04.059. \cr +#' Valéry, A., V. Andréassian and C. Perrin (2014), +#' "As simple as possible but not simpler": What is useful in a temperature-based snow-accounting routine? +#' Part 2 - Sensitivity analysis of the Cemaneige snow accounting routine on 380 catchments, Journal of Hydrology, doi:10.1016/j.jhydrol.2014.04.058. +#' @seealso \code{\link{RunModel_CemaNeigeGR4J}}, \code{\link{RunModel_CemaNeigeGR5J}}, \code{\link{RunModel_GR6J}}, +#' \code{\link{CreateInputsModel}}, \code{\link{CreateRunOptions}}. +#' @example tests/example_RunModel_CemaNeigeGR6J.R +#' @useDynLib airgr +#' @encoding UTF-8 +#' @export +#_FunctionInputs__________________________________________________________________________________________________ +#' @param InputsModel [object of class \emph{InputsModel}] see \code{\link{CreateInputsModel}} for details +#' @param RunOptions [object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details +#' @param Param [numeric] vector of 8 parameters +#' \tabular{ll}{ +#' GR6J X1 \tab production store capacity [mm] \cr +#' GR6J X2 \tab intercatchment exchange coefficient 1 [mm/d] \cr +#' GR6J X3 \tab routing store capacity [mm] \cr +#' GR6J X4 \tab unit hydrograph time constant [d] \cr +#' GR6J X5 \tab intercatchment exchange coefficient 2 [-] \cr +#' GR6J X6 \tab coefficient for emptying exponential store [-] \cr +#' CemaNeige X1 \tab weighting coefficient for snow pack thermal state [-] \cr +#' CemaNeige X2 \tab degree-day melt coefficient [mm/degC/d] \cr +#' } +#_FunctionOutputs_________________________________________________________________________________________________ +#' @return [list] list containing the function outputs organised as follows: +#' \tabular{ll}{ +#' \emph{$DatesR } \tab [POSIXlt] series of dates \cr +#' \emph{$PotEvap } \tab [numeric] series of input potential evapotranspiration [mm/d] \cr +#' \emph{$Precip } \tab [numeric] series of input total precipitation [mm/d] \cr +#' \emph{$Prod } \tab [numeric] series of production store level (X(2)) [mm] \cr +#' \emph{$AE } \tab [numeric] series of actual evapotranspiration [mm/d] \cr +#' \emph{$Perc } \tab [numeric] series of percolation (PERC) [mm/d] \cr +#' \emph{$PR } \tab [numeric] series of PR=PN-PS+PERC [mm/d] \cr +#' \emph{$Q9 } \tab [numeric] series of HU1 outflow (Q9) [mm/d] \cr +#' \emph{$Q1 } \tab [numeric] series of HU2 outflow (Q1) [mm/d] \cr +#' \emph{$Rout } \tab [numeric] series of routing store level (X(1)) [mm] \cr +#' \emph{$Exch } \tab [numeric] series of potential semi-exchange between catchments [mm/d] \cr +#' \emph{$AExch } \tab [numeric] series of actual exchange between catchments (1+2) [mm/d] \cr +#' \emph{$QR } \tab [numeric] series of routing store outflow (QR) [mm/d] \cr +#' \emph{$QR1 } \tab [numeric] series of exponential store outflow (QR1) [mm/d] \cr +#' \emph{$Exp } \tab [numeric] series of exponential store level (X(6)) (negative) [mm] \cr +#' \emph{$QD } \tab [numeric] series of direct flow from HU2 after exchange (QD) [mm/d] \cr +#' \emph{$Qsim } \tab [numeric] series of Qsim [mm/d] \cr +#' \emph{$CemaNeigeLayers} \tab [list] list of CemaNeige outputs (1 list per layer) \cr +#' \emph{$CemaNeigeLayers[[iLayer]]$Pliq } \tab [numeric] series of liquid precip. [mm/d] \cr +#' \emph{$CemaNeigeLayers[[iLayer]]$Psol } \tab [numeric] series of solid precip. [mm/d] \cr +#' \emph{$CemaNeigeLayers[[iLayer]]$SnowPack } \tab [numeric] series of snow pack [mm] \cr +#' \emph{$CemaNeigeLayers[[iLayer]]$ThermalState } \tab [numeric] series of snow pack thermal state [degC] \cr +#' \emph{$CemaNeigeLayers[[iLayer]]$Gratio } \tab [numeric] series of Gratio [0-1] \cr +#' \emph{$CemaNeigeLayers[[iLayer]]$PotMelt } \tab [numeric] series of potential snow melt [mm/d] \cr +#' \emph{$CemaNeigeLayers[[iLayer]]$Melt } \tab [numeric] series of actual snow melt [mm/d] \cr +#' \emph{$CemaNeigeLayers[[iLayer]]$PliqAndMelt } \tab [numeric] series of liquid precip. + actual snow melt [mm/d] \cr +#' \emph{$StateEnd} \tab [numeric] states at the end of the run: \cr\tab res. & HU levels [mm], CemaNeige states [mm & degC] \cr +#' } +#' (refer to the provided references or to the package source code for further details on these model outputs) +#***************************************************************************************************************** +RunModel_CemaNeigeGR6J <- function(InputsModel,RunOptions,Param){ + + NParam <- 8; + FortranOutputsCemaNeige <- c("Pliq","Psol","SnowPack","ThermalState","Gratio","PotMelt","Melt","PliqAndMelt"); + FortranOutputsMod <- c("PotEvap","Precip","Prod","AE","Perc","PR","Q9","Q1","Rout","Exch","AExch","QR","QR1","Exp","QD","Qsim"); + + ##Arguments_check + if(inherits(InputsModel,"InputsModel")==FALSE){ stop("InputsModel must be of class 'InputsModel' \n"); return(NULL); } + if(inherits(InputsModel,"daily" )==FALSE){ stop("InputsModel must be of class 'daily' \n"); return(NULL); } + if(inherits(InputsModel,"GR" )==FALSE){ stop("InputsModel must be of class 'GR' \n"); return(NULL); } + if(inherits(InputsModel,"CemaNeige" )==FALSE){ stop("InputsModel must be of class 'CemaNeige' \n"); return(NULL); } + if(inherits(RunOptions,"RunOptions" )==FALSE){ stop("RunOptions must be of class 'RunOptions' \n"); return(NULL); } + if(inherits(RunOptions,"GR" )==FALSE){ stop("RunOptions must be of class 'GR' \n"); return(NULL); } + if(inherits(RunOptions,"CemaNeige" )==FALSE){ stop("RunOptions must be of class 'CemaNeige' \n"); return(NULL); } + if(!is.vector(Param)){ stop("Param must be a vector \n"); return(NULL); } + if(sum(!is.na(Param))!=NParam){ stop(paste("Param must be a vector of length ",NParam," and contain no NA \n",sep="")); return(NULL); } + 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)) + IndPeriod2 <- (length(RunOptions$IndPeriod_WarmUp)+1):LInputSeries; + ParamCemaNeige <- Param[(length(Param)-1):length(Param)]; + NParamMod <- as.integer(length(Param)-2); + ParamMod <- Param[1:NParamMod]; + NLayers <- length(InputsModel$LayerPrecip); + NStatesMod <- as.integer(length(RunOptions$IniStates)-2*NLayers); + ExportDatesR <- "DatesR" %in% RunOptions$Outputs_Sim; + ExportStateEnd <- "StateEnd" %in% RunOptions$Outputs_Sim; + + + + ##SNOW_MODULE________________________________________________________________________________## + if(RunOptions$RunSnowModule==TRUE){ + if("all" %in% RunOptions$Outputs_Sim){ IndOutputsCemaNeige <- as.integer(1:length(FortranOutputsCemaNeige)); + } else { IndOutputsCemaNeige <- which(FortranOutputsCemaNeige %in% RunOptions$Outputs_Sim); } + CemaNeigeLayers <- list(); CemaNeigeStateEnd <- NULL; NameCemaNeigeLayers <- "CemaNeigeLayers"; + + ##Call_DLL_CemaNeige_________________________ + for(iLayer in 1:NLayers){ + StateStartCemaNeige <- RunOptions$IniStates[ (NStatesMod+2*(iLayer-1)+1):(NStatesMod+2*(iLayer-1)+2) ]; + RESULTS <- .Fortran("frun_cemaneige",PACKAGE="airgr", + ##inputs + LInputs=LInputSeries, ### length of input and output series + InputsPrecip=InputsModel$LayerPrecip[[iLayer]][IndPeriod1], ### input series of total precipitation [mm/d] + 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] + MeanAnSolidPrecip=RunOptions$MeanAnSolidPrecip[iLayer], ### value of annual mean solid precip [mm/y] + NParam=as.integer(2), ### number of model parameter = 2 + Param=ParamCemaNeige, ### parameter set + NStates=as.integer(2), ### number of state variables used for model initialising = 2 + StateStart=StateStartCemaNeige, ### state variables used when the model run starts + NOutputs=as.integer(length(IndOutputsCemaNeige)), ### number of output series + IndOutputs=IndOutputsCemaNeige, ### indices of output series + ##outputs + Outputs=matrix(as.double(-999.999),nrow=LInputSeries,ncol=length(IndOutputsCemaNeige)), ### output series [mm] + StateEnd=rep(as.double(-999.999),as.integer(2)) ### state variables at the end of the model run (reservoir levels [mm] and HU) + ) + RESULTS$Outputs[ round(RESULTS$Outputs ,3)==(-999.999)] <- NA; + RESULTS$StateEnd[round(RESULTS$StateEnd,3)==(-999.999)] <- NA; + + ##Data_storage + CemaNeigeLayers[[iLayer]] <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]); + names(CemaNeigeLayers[[iLayer]]) <- FortranOutputsCemaNeige[IndOutputsCemaNeige]; + IndPliqAndMelt <- which(names(CemaNeigeLayers[[iLayer]]) == "PliqAndMelt"); + if(iLayer==1){ CatchMeltAndPliq <- RESULTS$Outputs[,IndPliqAndMelt]/NLayers; } + if(iLayer >1){ CatchMeltAndPliq <- CatchMeltAndPliq + RESULTS$Outputs[,IndPliqAndMelt]/NLayers; } + if(ExportStateEnd){ CemaNeigeStateEnd <- c(CemaNeigeStateEnd,RESULTS$StateEnd); } + rm(RESULTS); + } ###ENDFOR_iLayer + names(CemaNeigeLayers) <- paste("Layer",formatC(1:NLayers,width=2,flag="0"),sep=""); + } ###ENDIF_RunSnowModule + if(RunOptions$RunSnowModule==FALSE){ + CemaNeigeLayers <- list(); CemaNeigeStateEnd <- NULL; NameCemaNeigeLayers <- NULL; + CatchMeltAndPliq <- InputsModel$Precip[IndPeriod1]; } + + + + ##MODEL______________________________________________________________________________________## + if("all" %in% RunOptions$Outputs_Sim){ IndOutputsMod <- as.integer(1:length(FortranOutputsMod)); + } else { IndOutputsMod <- which(FortranOutputsMod %in% RunOptions$Outputs_Sim); } + + ##Use_of_IniResLevels + if("IniResLevels" %in% RunOptions){ + RunOptions$IniStates[1] <- RunOptions$IniResLevels[2]*ParamMod[3]; ### routing store level (mm) + RunOptions$IniStates[2] <- RunOptions$IniResLevels[1]*ParamMod[1]; ### production store level (mm) + } + + ##Call_fortan + RESULTS <- .Fortran("frun_gr6j",PACKAGE="airgr", + ##inputs + LInputs=LInputSeries, ### length of input and output series + InputsPrecip=CatchMeltAndPliq, ### input series of total precipitation [mm/d] + InputsPE=InputsModel$PotEvap[IndPeriod1], ### input series potential evapotranspiration [mm/d] + NParam=NParamMod, ### number of model parameter + Param=ParamMod, ### parameter set + NStates=NStatesMod, ### number of state variables used for model initialising + StateStart=RunOptions$IniStates[1:NStatesMod], ### state variables used when the model run starts + NOutputs=as.integer(length(IndOutputsMod)), ### number of output series + IndOutputs=IndOutputsMod, ### indices of output series + ##outputs + Outputs=matrix(as.double(-999.999),nrow=LInputSeries,ncol=length(IndOutputsMod)), ### 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; + if(RunOptions$RunSnowModule & "Precip" %in% RunOptions$Outputs_Sim){ RESULTS$Outputs[,which(FortranOutputsMod[IndOutputsMod]=="Precip")] <- InputsModel$Precip[IndPeriod1]; } + + ##Output_data_preparation + ##OutputsModel_only + if(ExportDatesR==FALSE & ExportStateEnd==FALSE){ + OutputsModel <- c( lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]), + list(CemaNeigeLayers) ); + names(OutputsModel) <- c(FortranOutputsMod[IndOutputsMod],NameCemaNeigeLayers); } + ##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]), + list(CemaNeigeLayers) ); + names(OutputsModel) <- c("DatesR",FortranOutputsMod[IndOutputsMod],NameCemaNeigeLayers); } + ##OutputsModel_and_SateEnd_only + if(ExportDatesR==FALSE & ExportStateEnd==TRUE){ + OutputsModel <- c( lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]), + list(CemaNeigeLayers), + list(c(RESULTS$StateEnd,CemaNeigeStateEnd)) ); + names(OutputsModel) <- c(FortranOutputsMod[IndOutputsMod],NameCemaNeigeLayers,"StateEnd"); } + ##DatesR_and_OutputsModel_and_SateEnd + if(ExportDatesR==TRUE & ExportStateEnd==TRUE){ + OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]), + lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]), + list(CemaNeigeLayers), + list(c(RESULTS$StateEnd,CemaNeigeStateEnd)) ); + names(OutputsModel) <- c("DatesR",FortranOutputsMod[IndOutputsMod],NameCemaNeigeLayers,"StateEnd"); } + + ##End + rm(RESULTS); + class(OutputsModel) <- c("OutputsModel","daily","GR","CemaNeige"); + return(OutputsModel); + +} + diff --git a/R/RunModel_GR1A.R b/R/RunModel_GR1A.R new file mode 100644 index 0000000000000000000000000000000000000000..c0525db3e5f71ebdadde4316971538dda5e9385c --- /dev/null +++ b/R/RunModel_GR1A.R @@ -0,0 +1,123 @@ +#***************************************************************************************************************** +#' Function which performs a single run for the GR1A yearly lumped model. +#' +#' For further details on the model, see the references section. +#' For further details on the argument structures and initialisation options, see \code{\link{CreateRunOptions}}. +#***************************************************************************************************************** +#' @title Run with the GR1A hydrological model +#' @author Laurent Coron (March 2015) +#' @example tests/example_RunModel_GR1A.R +#' @references +#' Mouelhi S. (2003), +#' Vers une chaîne cohérente de modèles pluie-débit conceptuels globaux aux pas de temps pluriannuel, annuel, mensuel et journalier, +#' PhD thesis (in French), ENGREF, Cemagref Antony, France. \cr +#' @useDynLib airgr +#' @encoding UTF-8 +#' @export +#_FunctionInputs__________________________________________________________________________________________________ +#' @param InputsModel [object of class \emph{InputsModel}] see \code{\link{CreateInputsModel}} for details +#' @param RunOptions [object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details +#' @param Param [numeric] vector of 4 parameters +#' \tabular{ll}{ +#' GR1A X1 \tab model parameter [mm] \cr +#' } +#_FunctionOutputs_________________________________________________________________________________________________ +#' @return [list] list containing the function outputs organised as follows: +#' \tabular{ll}{ +#' \emph{$DatesR } \tab [POSIXlt] series of dates \cr +#' \emph{$PotEvap } \tab [numeric] series of input potential evapotranspiration [mm/h] \cr +#' \emph{$Precip } \tab [numeric] series of input total precipitation [mm/h] \cr +#' \emph{$Qsim } \tab [numeric] series of Qsim [mm/h] \cr +#' } +#' (refer to the provided references or to the package source code for further details on these model outputs) +#***************************************************************************************************************** +RunModel_GR1A <- function(InputsModel,RunOptions,Param){ + + NParam <- 1; + FortranOutputs <- c("PotEvap","Precip","Qsim"); + + ##Arguments_check + if(inherits(InputsModel,"InputsModel")==FALSE){ stop("InputsModel must be of class 'InputsModel' \n"); return(NULL); } + if(inherits(InputsModel,"yearly" )==FALSE){ stop("InputsModel must be of class 'yearly' \n"); return(NULL); } + if(inherits(InputsModel,"GR" )==FALSE){ stop("InputsModel must be of class 'GR' \n"); return(NULL); } + if(inherits(RunOptions,"RunOptions" )==FALSE){ stop("RunOptions must be of class 'RunOptions' \n"); return(NULL); } + if(inherits(RunOptions,"GR" )==FALSE){ stop("RunOptions must be of class 'GR' \n"); return(NULL); } + if(!is.vector(Param)){ stop("Param must be a vector \n"); return(NULL); } + if(sum(!is.na(Param))!=NParam){ stop(paste("Param must be a vector of length ",NParam," and contain no NA \n",sep="")); return(NULL); } + 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); } + + + BOOL_Fortran <- FALSE; if(BOOL_Fortran){ + ##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; + + } else { + ##R_version + L <- length(IndPeriod1) + P0 <- InputsModel$Precip[ IndPeriod1][1:(L-1)] + P1 <- InputsModel$Precip[ IndPeriod1][2: L ] + E1 <- InputsModel$PotEvap[IndPeriod1][2: L ] + Q1 <- P1*(1.-1./(1.+((0.7*P1+0.3*P0)/Param[1]/E1)^2.0)^0.5) + PEQ <- rbind(c(NA,NA,NA),cbind(P1,E1,Q1)) + Outputs <- PEQ[,IndOutputs] + if(is.vector(Outputs)){ Outputs <- cbind(Outputs); } + RESULTS <- list(NOutputs=length(IndOutputs),IndOutputs=IndOutputs,Outputs=Outputs,StatesEnd=NA) + } + + + ##Output_data_preparation + IndPeriod2 <- (length(RunOptions$IndPeriod_WarmUp)+1):LInputSeries; + ExportDatesR <- "DatesR" %in% RunOptions$Outputs_Sim; + ExportStateEnd <- "StateEnd" %in% RunOptions$Outputs_Sim; + ##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); + +} + diff --git a/R/RunModel_GR2M.R b/R/RunModel_GR2M.R new file mode 100644 index 0000000000000000000000000000000000000000..f21542a6e00f8c749128f901d6f673f2066ace7f --- /dev/null +++ b/R/RunModel_GR2M.R @@ -0,0 +1,128 @@ +#***************************************************************************************************************** +#' Function which performs a single run for the GR2M monthly lumped model. +#' +#' For further details on the model, see the references section. +#' For further details on the argument structures and initialisation options, see \code{\link{CreateRunOptions}}. +#***************************************************************************************************************** +#' @title Run with the GR2M hydrological model +#' @author Laurent Coron (March 2015) +#' @example tests/example_RunModel_GR2M.R +#' @references +#' Mouelhi S. (2003), +#' Vers une chaîne cohérente de modèles pluie-débit conceptuels globaux aux pas de temps pluriannuel, annuel, mensuel et journalier, +#' PhD thesis (in French), ENGREF, Cemagref Antony, France. \cr +#' Mouelhi, S., C. Michel, C. Perrin and V. Andréassian (2006), +#' Stepwise development of a two-parameter monthly water balance model, +#' Journal of Hydrology, 318(1-4), 200-214, doi:10.1016/j.jhydrol.2005.06.014. +#' @useDynLib airgr +#' @encoding UTF-8 +#' @export +#_FunctionInputs__________________________________________________________________________________________________ +#' @param InputsModel [object of class \emph{InputsModel}] see \code{\link{CreateInputsModel}} for details +#' @param RunOptions [object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details +#' @param Param [numeric] vector of 4 parameters +#' \tabular{ll}{ +#' GR2M X1 \tab production store capacity [mm] \cr +#' GR2M X2 \tab groundwater exchange coefficient [mm/month] \cr +#' } +#_FunctionOutputs_________________________________________________________________________________________________ +#' @return [list] list containing the function outputs organised as follows: +#' \tabular{ll}{ +#' \emph{$DatesR } \tab [POSIXlt] series of dates \cr +#' \emph{$PotEvap } \tab [numeric] series of input potential evapotranspiration [mm/h] \cr +#' \emph{$Precip } \tab [numeric] series of input total precipitation [mm/h] \cr +#' \emph{$Prod } \tab [numeric] series of production store level (X(2)) [mm] \cr +#' \emph{$AE } \tab [numeric] series of actual evapotranspiration [mm/h] \cr +#' \emph{$Perc } \tab [numeric] series of percolation (PERC) [mm/h] \cr +#' \emph{$PR } \tab [numeric] series of PR=PN-PS+PERC [mm/h] \cr +#' \emph{$Q9 } \tab [numeric] series of HU1 outflow (Q9) [mm/h] \cr +#' \emph{$Q1 } \tab [numeric] series of HU2 outflow (Q1) [mm/h] \cr +#' \emph{$Rout } \tab [numeric] series of routing store level (X(1)) [mm] \cr +#' \emph{$Exch } \tab [numeric] series of potential semi-exchange between catchments [mm/h] \cr +#' \emph{$AExch } \tab [numeric] series of actual exchange between catchments (1+2) [mm/h] \cr +#' \emph{$QR } \tab [numeric] series of routing store outflow (QR) [mm/h] \cr +#' \emph{$QD } \tab [numeric] series of direct flow from HU2 after exchange (QD) [mm/h] \cr +#' \emph{$Qsim } \tab [numeric] series of Qsim [mm/h] \cr +#' \emph{$StateEnd} \tab [numeric] states at the end of the run (res. levels, HU1 levels, HU2 levels) [mm] \cr +#' } +#' (refer to the provided references or to the package source code for further details on these model outputs) +#***************************************************************************************************************** +RunModel_GR2M <- function(InputsModel,RunOptions,Param){ + + NParam <- 2; + FortranOutputs <- c("PotEvap","Precip","Prod","Rout","Qsim"); + ### FortranOutputs <- c("PotEvap","Precip","Prod","AE","Perc","PR","Q9","Q1","Rout","Exch","AExch","QR","QD","Qsim"); + + ##Arguments_check + if(inherits(InputsModel,"InputsModel")==FALSE){ stop("InputsModel must be of class 'InputsModel' \n"); return(NULL); } + if(inherits(InputsModel,"monthly" )==FALSE){ stop("InputsModel must be of class 'monthly' \n"); return(NULL); } + if(inherits(InputsModel,"GR" )==FALSE){ stop("InputsModel must be of class 'GR' \n"); return(NULL); } + if(inherits(RunOptions,"RunOptions" )==FALSE){ stop("RunOptions must be of class 'RunOptions' \n"); return(NULL); } + if(inherits(RunOptions,"GR" )==FALSE){ stop("RunOptions must be of class 'GR' \n"); return(NULL); } + if(!is.vector(Param)){ stop("Param must be a vector \n"); return(NULL); } + if(sum(!is.na(Param))!=NParam){ stop(paste("Param must be a vector of length ",NParam," and contain no NA \n",sep="")); return(NULL); } + 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); } + + ##Use_of_IniResLevels + if("IniResLevels" %in% names(RunOptions)){ + RunOptions$IniStates[1] <- RunOptions$IniResLevels[1]*Param[1]; ### production store level (mm) + } + + ##Call_fortan + 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] + InputsPE=InputsModel$PotEvap[IndPeriod1], ### input series potential evapotranspiration [mm/month] + 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 + IndPeriod2 <- (length(RunOptions$IndPeriod_WarmUp)+1):LInputSeries; + ExportDatesR <- "DatesR" %in% RunOptions$Outputs_Sim; + ExportStateEnd <- "StateEnd" %in% RunOptions$Outputs_Sim; + ##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","monthly","GR"); + return(OutputsModel); + +} + diff --git a/R/RunModel_GR4H.R b/R/RunModel_GR4H.R new file mode 100644 index 0000000000000000000000000000000000000000..2befb604e7281a1f1286689f065b311a6f19bc24 --- /dev/null +++ b/R/RunModel_GR4H.R @@ -0,0 +1,129 @@ +#***************************************************************************************************************** +#' Function which performs a single run for the GR4H hourly lumped model. +#' +#' For further details on the model, see the references section. +#' For further details on the argument structures and initialisation options, see \code{\link{CreateRunOptions}}. +#***************************************************************************************************************** +#' @title Run with the GR4H hydrological model +#' @author Laurent Coron (July 2014) +#' @seealso \code{\link{RunModel_GR4J}}, +#' \code{\link{CreateInputsModel}}, \code{\link{CreateRunOptions}}. +#' @example tests/example_RunModel_GR4H.R +#' @references +#' Mathevet, T. (2005), +#' Quels modèles pluie-débit globaux pour le pas de temps horaire ? Développement empirique et comparaison de modèles sur un large échantillon de bassins versants, +#' PhD thesis (in French), ENGREF - Cemagref (Antony), Paris, France. +#' @useDynLib airgr +#' @encoding UTF-8 +#' @export +#_FunctionInputs__________________________________________________________________________________________________ +#' @param InputsModel [object of class \emph{InputsModel}] see \code{\link{CreateInputsModel}} for details +#' @param RunOptions [object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details +#' @param Param [numeric] vector of 4 parameters +#' \tabular{ll}{ +#' GR4H X1 \tab production store capacity [mm] \cr +#' GR4H X2 \tab groundwater exchange coefficient [mm/h] \cr +#' GR4H X3 \tab routing store capacity [mm] \cr +#' GR4H X4 \tab unit hydrograph time constant [h] \cr +#' } +#_FunctionOutputs_________________________________________________________________________________________________ +#' @return [list] list containing the function outputs organised as follows: +#' \tabular{ll}{ +#' \emph{$DatesR } \tab [POSIXlt] series of dates \cr +#' \emph{$PotEvap } \tab [numeric] series of input potential evapotranspiration [mm/h] \cr +#' \emph{$Precip } \tab [numeric] series of input total precipitation [mm/h] \cr +#' \emph{$Prod } \tab [numeric] series of production store level (X(2)) [mm] \cr +#' \emph{$AE } \tab [numeric] series of actual evapotranspiration [mm/h] \cr +#' \emph{$Perc } \tab [numeric] series of percolation (PERC) [mm/h] \cr +#' \emph{$PR } \tab [numeric] series of PR=PN-PS+PERC [mm/h] \cr +#' \emph{$Q9 } \tab [numeric] series of HU1 outflow (Q9) [mm/h] \cr +#' \emph{$Q1 } \tab [numeric] series of HU2 outflow (Q1) [mm/h] \cr +#' \emph{$Rout } \tab [numeric] series of routing store level (X(1)) [mm] \cr +#' \emph{$Exch } \tab [numeric] series of potential semi-exchange between catchments [mm/h] \cr +#' \emph{$AExch } \tab [numeric] series of actual exchange between catchments (1+2) [mm/h] \cr +#' \emph{$QR } \tab [numeric] series of routing store outflow (QR) [mm/h] \cr +#' \emph{$QD } \tab [numeric] series of direct flow from HU2 after exchange (QD) [mm/h] \cr +#' \emph{$Qsim } \tab [numeric] series of Qsim [mm/h] \cr +#' \emph{$StateEnd} \tab [numeric] states at the end of the run (res. levels, HU1 levels, HU2 levels) [mm] \cr +#' } +#' (refer to the provided references or to the package source code for further details on these model outputs) +#*****************************************************************************************************************' +RunModel_GR4H <- function(InputsModel,RunOptions,Param){ + + NParam <- 4; + FortranOutputs <- c("PotEvap","Precip","Prod","AE","Perc","PR","Q9","Q1","Rout","Exch","AExch","QR","QD","Qsim"); + + ##Arguments_check + if(inherits(InputsModel,"InputsModel")==FALSE){ stop("InputsModel must be of class 'InputsModel' \n"); return(NULL); } + if(inherits(InputsModel,"hourly" )==FALSE){ stop("InputsModel must be of class 'hourly' \n"); return(NULL); } + if(inherits(InputsModel,"GR" )==FALSE){ stop("InputsModel must be of class 'GR' \n"); return(NULL); } + if(inherits(RunOptions,"RunOptions" )==FALSE){ stop("RunOptions must be of class 'RunOptions' \n"); return(NULL); } + if(inherits(RunOptions,"GR" )==FALSE){ stop("RunOptions must be of class 'GR' \n"); return(NULL); } + if(!is.vector(Param)){ stop("Param must be a vector \n"); return(NULL); } + if(sum(!is.na(Param))!=NParam){ stop(paste("Param must be a vector of length ",NParam," and contain no NA \n",sep="")); return(NULL); } + 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); } + + ##Use_of_IniResLevels + if("IniResLevels" %in% names(RunOptions)){ + RunOptions$IniStates[1] <- RunOptions$IniResLevels[2]*Param[3]; ### routing store level (mm) + RunOptions$IniStates[2] <- RunOptions$IniResLevels[1]*Param[1]; ### production store level (mm) + } + + ##Call_fortan + 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] + InputsPE=InputsModel$PotEvap[IndPeriod1], ### input series potential evapotranspiration [mm/h] + 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 + IndPeriod2 <- (length(RunOptions$IndPeriod_WarmUp)+1):LInputSeries; + ExportDatesR <- "DatesR" %in% RunOptions$Outputs_Sim; + ExportStateEnd <- "StateEnd" %in% RunOptions$Outputs_Sim; + ##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","hourly","GR"); + return(OutputsModel); + +} + diff --git a/R/RunModel_GR4J.R b/R/RunModel_GR4J.R new file mode 100644 index 0000000000000000000000000000000000000000..50c7e373c1027bd1745145a5bb34191adcead7ba --- /dev/null +++ b/R/RunModel_GR4J.R @@ -0,0 +1,129 @@ +#***************************************************************************************************************** +#' Function which performs a single run for the GR4J daily lumped model. +#' +#' For further details on the model, see the references section. +#' For further details on the argument structures and initialisation options, see \code{\link{CreateRunOptions}}. +#***************************************************************************************************************** +#' @title Run with the GR4J hydrological model +#' @author Laurent Coron (December 2013) +#' @references +#' Perrin, C., C. Michel and V. Andréassian (2003), +#' Improvement of a parsimonious model for streamflow simulation, +#' Journal of Hydrology, 279(1-4), 275-289, doi:10.1016/S0022-1694(03)00225-7. +#' @seealso \code{\link{RunModel_GR5J}}, \code{\link{RunModel_GR6J}}, \code{\link{RunModel_CemaNeigeGR4J}}, +#' \code{\link{CreateInputsModel}}, \code{\link{CreateRunOptions}}. +#' @example tests/example_RunModel_GR4J.R +#' @useDynLib airgr +#' @encoding UTF-8 +#' @export +#_FunctionInputs__________________________________________________________________________________________________ +#' @param InputsModel [object of class \emph{InputsModel}] see \code{\link{CreateInputsModel}} for details +#' @param RunOptions [object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details +#' @param Param [numeric] vector of 4 parameters +#' \tabular{ll}{ +#' GR4J X1 \tab production store capacity [mm] \cr +#' GR4J X2 \tab intercatchment exchange coefficient [mm/d] \cr +#' GR4J X3 \tab routing store capacity [mm] \cr +#' GR4J X4 \tab unit hydrograph time constant [d] \cr +#' } +#_FunctionOutputs_________________________________________________________________________________________________ +#' @return [list] list containing the function outputs organised as follows: +#' \tabular{ll}{ +#' \emph{$DatesR } \tab [POSIXlt] series of dates \cr +#' \emph{$PotEvap } \tab [numeric] series of input potential evapotranspiration [mm/d] \cr +#' \emph{$Precip } \tab [numeric] series of input total precipitation [mm/d] \cr +#' \emph{$Prod } \tab [numeric] series of production store level (X(2)) [mm] \cr +#' \emph{$AE } \tab [numeric] series of actual evapotranspiration [mm/d] \cr +#' \emph{$Perc } \tab [numeric] series of percolation (PERC) [mm/d] \cr +#' \emph{$PR } \tab [numeric] series of PR=PN-PS+PERC [mm/d] \cr +#' \emph{$Q9 } \tab [numeric] series of HU1 outflow (Q9) [mm/d] \cr +#' \emph{$Q1 } \tab [numeric] series of HU2 outflow (Q1) [mm/d] \cr +#' \emph{$Rout } \tab [numeric] series of routing store level (X(1)) [mm] \cr +#' \emph{$Exch } \tab [numeric] series of potential semi-exchange between catchments [mm/d] \cr +#' \emph{$AExch } \tab [numeric] series of actual exchange between catchments (1+2) [mm/d] \cr +#' \emph{$QR } \tab [numeric] series of routing store outflow (QR) [mm/d] \cr +#' \emph{$QD } \tab [numeric] series of direct flow from HU2 after exchange (QD) [mm/d] \cr +#' \emph{$Qsim } \tab [numeric] series of Qsim [mm/d] \cr +#' \emph{$StateEnd} \tab [numeric] states at the end of the run (res. levels, HU1 levels, HU2 levels) [mm] \cr +#' } +#' (refer to the provided references or to the package source code for further details on these model outputs) +#*****************************************************************************************************************' +RunModel_GR4J <- function(InputsModel,RunOptions,Param){ + + NParam <- 4; + FortranOutputs <- c("PotEvap","Precip","Prod","AE","Perc","PR","Q9","Q1","Rout","Exch","AExch","QR","QD","Qsim"); + + ##Arguments_check + if(inherits(InputsModel,"InputsModel")==FALSE){ stop("InputsModel must be of class 'InputsModel' \n"); return(NULL); } + if(inherits(InputsModel,"daily" )==FALSE){ stop("InputsModel must be of class 'daily' \n"); return(NULL); } + if(inherits(InputsModel,"GR" )==FALSE){ stop("InputsModel must be of class 'GR' \n"); return(NULL); } + if(inherits(RunOptions,"RunOptions" )==FALSE){ stop("RunOptions must be of class 'RunOptions' \n"); return(NULL); } + if(inherits(RunOptions,"GR" )==FALSE){ stop("RunOptions must be of class 'GR' \n"); return(NULL); } + if(!is.vector(Param)){ stop("Param must be a vector \n"); return(NULL); } + if(sum(!is.na(Param))!=NParam){ stop(paste("Param must be a vector of length ",NParam," and contain no NA \n",sep="")); return(NULL); } + 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); } + + ##Use_of_IniResLevels + if("IniResLevels" %in% names(RunOptions)){ + RunOptions$IniStates[1] <- RunOptions$IniResLevels[2]*Param[3]; ### routing store level (mm) + RunOptions$IniStates[2] <- RunOptions$IniResLevels[1]*Param[1]; ### production store level (mm) + } + + ##Call_fortan + 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] + InputsPE=InputsModel$PotEvap[IndPeriod1], ### input series potential evapotranspiration [mm/d] + 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 + IndPeriod2 <- (length(RunOptions$IndPeriod_WarmUp)+1):LInputSeries; + ExportDatesR <- "DatesR" %in% RunOptions$Outputs_Sim; + ExportStateEnd <- "StateEnd" %in% RunOptions$Outputs_Sim; + ##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","daily","GR"); + return(OutputsModel); + +} + diff --git a/R/RunModel_GR5J.R b/R/RunModel_GR5J.R new file mode 100644 index 0000000000000000000000000000000000000000..7d3a60ea60ec31eec592bf4799e593f1bfd2a625 --- /dev/null +++ b/R/RunModel_GR5J.R @@ -0,0 +1,132 @@ +#***************************************************************************************************************** +#' Function which performs a single run for the GR5J daily lumped model. +#' +#' For further details on the model, see the references section. +#' For further details on the argument structures and initialisation options, see \code{\link{CreateRunOptions}}. +#***************************************************************************************************************** +#' @title Run with the GR5J hydrological model +#' @author Laurent Coron (December 2013) +#' @references +#' Le Moine, N. (2008), Le bassin versant de surface vu par le souterrain : une voie d'amélioration des performances +#' et du réalisme des modèles pluie-débit ?, PhD thesis (french), UPMC, Paris, France. \cr +#' Pushpalatha, R., C. Perrin, N. Le Moine, T. Mathevet, and V. Andréassian (2011), +#' A downward structural sensitivity analysis of hydrological models to improve low-flow simulation, +#' Journal of Hydrology, 411(1-2), 66-76, doi:10.1016/j.jhydrol.2011.09.034. \cr +#' @seealso \code{\link{RunModel_GR4J}}, \code{\link{RunModel_GR6J}}, \code{\link{RunModel_CemaNeigeGR5J}}, +#' \code{\link{CreateInputsModel}}, \code{\link{CreateRunOptions}}. +#' @example tests/example_RunModel_GR5J.R +#' @useDynLib airgr +#' @encoding UTF-8 +#' @export +#_FunctionInputs__________________________________________________________________________________________________ +#' @param InputsModel [object of class \emph{InputsModel}] see \code{\link{CreateInputsModel}} for details +#' @param RunOptions [object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details +#' @param Param [numeric] vector of 5 parameters +#' \tabular{ll}{ +#' GR5J X1 \tab production store capacity [mm] \cr +#' GR5J X2 \tab intercatchment exchange coefficient 1 [mm/d] \cr +#' GR5J X3 \tab routing store capacity [mm] \cr +#' GR5J X4 \tab unit hydrograph time constant [d] \cr +#' GR5J X5 \tab intercatchment exchange coefficient 2 [-] \cr +#' } +#_FunctionOutputs_________________________________________________________________________________________________ +#' @return [list] list containing the function outputs organised as follows: +#' \tabular{ll}{ +#' \emph{$DatesR } \tab [POSIXlt] series of dates \cr +#' \emph{$PotEvap } \tab [numeric] series of input potential evapotranspiration [mm/d] \cr +#' \emph{$Precip } \tab [numeric] series of input total precipitation [mm/d] \cr +#' \emph{$Prod } \tab [numeric] series of production store level (X(2)) [mm] \cr +#' \emph{$AE } \tab [numeric] series of actual evapotranspiration [mm/d] \cr +#' \emph{$Perc } \tab [numeric] series of percolation (PERC) [mm/d] \cr +#' \emph{$PR } \tab [numeric] series of PR=PN-PS+PERC [mm/d] \cr +#' \emph{$Q9 } \tab [numeric] series of HU1 outflow (Q9) [mm/d] \cr +#' \emph{$Q1 } \tab [numeric] series of HU2 outflow (Q1) [mm/d] \cr +#' \emph{$Rout } \tab [numeric] series of routing store level (X(1)) [mm] \cr +#' \emph{$Exch } \tab [numeric] series of potential semi-exchange between catchments [mm/d] \cr +#' \emph{$AExch } \tab [numeric] series of actual exchange between catchments (1+2) [mm/d] \cr +#' \emph{$QR } \tab [numeric] series of routing store outflow (QR) [mm/d] \cr +#' \emph{$QD } \tab [numeric] series of direct flow from HU2 after exchange (QD) [mm/d] \cr +#' \emph{$Qsim } \tab [numeric] series of Qsim [mm/d] \cr +#' \emph{$StateEnd} \tab [numeric] states at the end of the run (res. levels, HU1 levels, HU2 levels) [mm] \cr +#' } +#' (refer to the provided references or to the package source code for further details on these model outputs) +#*****************************************************************************************************************' +RunModel_GR5J <- function(InputsModel,RunOptions,Param){ + + NParam <- 5; + FortranOutputs <- c("PotEvap","Precip","Prod","AE","Perc","PR","Q9","Q1","Rout","Exch","AExch","QR","QD","Qsim"); + + ##Arguments_check + if(inherits(InputsModel,"InputsModel")==FALSE){ stop("InputsModel must be of class 'InputsModel' \n"); return(NULL); } + if(inherits(InputsModel,"daily" )==FALSE){ stop("InputsModel must be of class 'daily' \n"); return(NULL); } + if(inherits(InputsModel,"GR" )==FALSE){ stop("InputsModel must be of class 'GR' \n"); return(NULL); } + if(inherits(RunOptions,"RunOptions" )==FALSE){ stop("RunOptions must be of class 'RunOptions' \n"); return(NULL); } + if(inherits(RunOptions,"GR" )==FALSE){ stop("RunOptions must be of class 'GR' \n"); return(NULL); } + if(!is.vector(Param)){ stop("Param must be a vector \n"); return(NULL); } + if(sum(!is.na(Param))!=NParam){ stop(paste("Param must be a vector of length ",NParam," and contain no NA \n",sep="")); return(NULL); } + 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); } + + ##Use_of_IniResLevels + if("IniResLevels" %in% names(RunOptions)){ + RunOptions$IniStates[1] <- RunOptions$IniResLevels[2]*Param[3]; ### routing store level (mm) + RunOptions$IniStates[2] <- RunOptions$IniResLevels[1]*Param[1]; ### production store level (mm) + } + + ##Call_fortan + 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] + InputsPE=InputsModel$PotEvap[IndPeriod1], ### input series potential evapotranspiration [mm/d] + 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 + IndPeriod2 <- (length(RunOptions$IndPeriod_WarmUp)+1):LInputSeries; + ExportDatesR <- "DatesR" %in% RunOptions$Outputs_Sim; + ExportStateEnd <- "StateEnd" %in% RunOptions$Outputs_Sim; + ##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","daily","GR"); + return(OutputsModel); + +} + diff --git a/R/RunModel_GR6J.R b/R/RunModel_GR6J.R new file mode 100644 index 0000000000000000000000000000000000000000..b9e930a01f091191f7b364eb9ba4bd45280181cc --- /dev/null +++ b/R/RunModel_GR6J.R @@ -0,0 +1,133 @@ +#***************************************************************************************************************** +#' Function which performs a single run for the GR6J daily lumped model. +#' +#' For further details on the model, see the references section. +#' For further details on the argument structures and initialisation options, see \code{\link{CreateRunOptions}}. +#***************************************************************************************************************** +#' @title Run with the GR6J hydrological model +#' @author Laurent Coron (December 2013) +#' @references +#' Pushpalatha, R., C. Perrin, N. Le Moine, T. Mathevet and V. Andréassian (2011), +#' A downward structural sensitivity analysis of hydrological models to improve low-flow simulation, +#' Journal of Hydrology, 411(1-2), 66-76, doi:10.1016/j.jhydrol.2011.09.034. \cr +#' @seealso \code{\link{RunModel_GR4J}}, \code{\link{RunModel_GR5J}}, \code{\link{RunModel_CemaNeigeGR6J}}, +#' \code{\link{CreateInputsModel}}, \code{\link{CreateRunOptions}}. +#' @example tests/example_RunModel_GR6J.R +#' @useDynLib airgr +#' @encoding UTF-8 +#' @export +#_FunctionInputs__________________________________________________________________________________________________ +#' @param InputsModel [object of class \emph{InputsModel}] see \code{\link{CreateInputsModel}} for details +#' @param RunOptions [object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details +#' @param Param [numeric] vector of 6 parameters +#' \tabular{ll}{ +#' GR6J X1 \tab production store capacity [mm] \cr +#' GR6J X2 \tab intercatchment exchange coefficient 1 [mm/d] \cr +#' GR6J X3 \tab routing store capacity [mm] \cr +#' GR6J X4 \tab unit hydrograph time constant [d] \cr +#' GR6J X5 \tab intercatchment exchange coefficient 2 [-] \cr +#' GR6J X6 \tab coefficient for emptying exponential store [-] \cr +#' } +#_FunctionOutputs_________________________________________________________________________________________________ +#' @return [list] list containing the function outputs organised as follows: +#' \tabular{ll}{ +#' \emph{$DatesR } \tab [POSIXlt] series of dates \cr +#' \emph{$PotEvap } \tab [numeric] series of input potential evapotranspiration [mm/d] \cr +#' \emph{$Precip } \tab [numeric] series of input total precipitation [mm/d] \cr +#' \emph{$Prod } \tab [numeric] series of production store level (X(2)) [mm] \cr +#' \emph{$AE } \tab [numeric] series of actual evapotranspiration [mm/d] \cr +#' \emph{$Perc } \tab [numeric] series of percolation (PERC) [mm/d] \cr +#' \emph{$PR } \tab [numeric] series of PR=PN-PS+PERC [mm/d] \cr +#' \emph{$Q9 } \tab [numeric] series of HU1 outflow (Q9) [mm/d] \cr +#' \emph{$Q1 } \tab [numeric] series of HU2 outflow (Q1) [mm/d] \cr +#' \emph{$Rout } \tab [numeric] series of routing store level (X(1)) [mm] \cr +#' \emph{$Exch } \tab [numeric] series of potential semi-exchange between catchments [mm/d] \cr +#' \emph{$AExch } \tab [numeric] series of actual exchange between catchments (1+2) [mm/d] \cr +#' \emph{$QR } \tab [numeric] series of routing store outflow (QR) [mm/d] \cr +#' \emph{$QR1 } \tab [numeric] series of exponential store outflow (QR1) [mm/d] \cr +#' \emph{$Exp } \tab [numeric] series of exponential store level (X(6)) (negative) [mm] \cr +#' \emph{$QD } \tab [numeric] series of direct flow from HU2 after exchange (QD) [mm/d] \cr +#' \emph{$Qsim } \tab [numeric] series of Qsim [mm/d] \cr +#' \emph{$StateEnd} \tab [numeric] states at the end of the run (res. levels, HU1 levels, HU2 levels) [mm] \cr +#' } +#' (refer to the provided references or to the package source code for further details on these model outputs) +#*****************************************************************************************************************' +RunModel_GR6J <- function(InputsModel,RunOptions,Param){ + + NParam <- 6; + FortranOutputs <- c("PotEvap","Precip","Prod","AE","Perc","PR","Q9","Q1","Rout","Exch","AExch","QR","QR1","Exp","QD","Qsim"); + + ##Arguments_check + if(inherits(InputsModel,"InputsModel")==FALSE){ stop("InputsModel must be of class 'InputsModel' \n"); return(NULL); } + if(inherits(InputsModel,"daily" )==FALSE){ stop("InputsModel must be of class 'daily' \n"); return(NULL); } + if(inherits(InputsModel,"GR" )==FALSE){ stop("InputsModel must be of class 'GR' \n"); return(NULL); } + if(inherits(RunOptions,"RunOptions" )==FALSE){ stop("RunOptions must be of class 'RunOptions' \n"); return(NULL); } + if(inherits(RunOptions,"GR" )==FALSE){ stop("RunOptions must be of class 'GR' \n"); return(NULL); } + if(!is.vector(Param)){ stop("Param must be a vector \n"); return(NULL); } + if(sum(!is.na(Param))!=NParam){ stop(paste("Param must be a vector of length ",NParam," and contain no NA \n",sep="")); return(NULL); } + 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); } + + ##Use_of_IniResLevels + if("IniResLevels" %in% names(RunOptions)){ + RunOptions$IniStates[1] <- RunOptions$IniResLevels[2]*Param[3]; ### routing store level (mm) + RunOptions$IniStates[2] <- RunOptions$IniResLevels[1]*Param[1]; ### production store level (mm) + } + + ##Call_fortan + 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] + InputsPE=InputsModel$PotEvap[IndPeriod1], ### input series potential evapotranspiration [mm/d] + 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 + IndPeriod2 <- (length(RunOptions$IndPeriod_WarmUp)+1):LInputSeries; + ExportDatesR <- "DatesR" %in% RunOptions$Outputs_Sim; + ExportStateEnd <- "StateEnd" %in% RunOptions$Outputs_Sim; + ##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","daily","GR"); + return(OutputsModel); + +} + diff --git a/R/SeriesAggreg.R b/R/SeriesAggreg.R new file mode 100644 index 0000000000000000000000000000000000000000..ec67f7ac0929dc8c339e369334e4f621015c3c42 --- /dev/null +++ b/R/SeriesAggreg.R @@ -0,0 +1,134 @@ +#************************************************************************************************* +#' Conversion of time series to another time-step (aggregation only). +#' Warning : on the aggregated outputs, the dates correpond to the beginning ot the time-step +#' (e.g. for daily time-series 01/03/2005 00:00 = value for period 01/03/2005 00:00 - 01/03/2005 23:59 ) +#' (e.g. for monthly time-series 01/03/2005 00:00 = value for period 01/03/2005 00:00 - 31/03/2005 23:59 ) +#' (e.g. for yearly time-series 01/03/2005 00:00 = value for period 01/03/2005 00:00 - 28/02/2006 23:59 ) +#************************************************************************************************* +#' @title Conversion of time series to another time-step (aggregation only) +#' @author Laurent Coron (March 2015) +#' @example tests/example_SeriesAggreg.R +#' @encoding UTF-8 +#' @export +#_FunctionInputs__________________________________________________________________________________ +#' @param TabSeries [POSIXlt+numeric] dataframe containing the vector of dates and the time series values +#' @param TimeFormat [character] desired format (i.e. "hourly", "daily", "monthly" or "yearly") +#' @param NewTimeFormat [character] desired format (i.e. "hourly", "daily", "monthly" or "yearly") +#' @param ConvertFun [character] names of aggregation functions (e.g. for P[mm],T[deg],Q[mm] : ConvertFun=c("sum","mean","sum")) +#' @param YearFirstMonth (optional) [numeric] integer used when NewTimeFormat="yearly" to set when the starting month of the year (e.g. 01 for calendar year or 09 for hydrological year starting in september) +#' @param quiet (optional) [boolean] boolean indicating if the function is run in quiet mode or not, default=FALSE +#_FunctionOutputs_________________________________________________________________________________ +#' @return [POSIXlt+numeric] dataframe containing a vector of aggregated dates and time series values +#**************************************************************************************************' +SeriesAggreg <- function(TabSeries,TimeFormat,NewTimeFormat,ConvertFun,YearFirstMonth=01,quiet=FALSE){ + + + ##_Arguments_check + + ##check_TabSeries + if(is.null(TabSeries) ){ stop("TabSeries must be a dataframe containing the dates and data to be converted \n"); return(NULL); } + if(!is.data.frame(TabSeries)){ stop("TabSeries must be a dataframe containing the dates and data to be converted \n"); return(NULL); } + if(ncol(TabSeries)<2){ stop("TabSeries must contain at least two columns (including the coulmn of dates \n"); return(NULL); } + if("POSIXlt" %in% class(TabSeries[,1]) == FALSE & "POSIXct" %in% class(TabSeries[,1]) == FALSE){ stop("TabSeries first column must be a vector of class POSIXlt or POSIXct \n"); return(NULL); } + for(iCol in 2:ncol(TabSeries)){ + if(!is.numeric(TabSeries[,iCol])){ stop("TabSeries columns (other than the first one) be of numeric class \n"); return(NULL); } } + ##check_TimeFormat + if(is.null( TimeFormat)){ stop("TimeFormat must be 'hourly', 'daily', 'monthly' or 'yearly' \n"); return(NULL); } + if(!is.vector( TimeFormat)){ stop("TimeFormat must be 'hourly', 'daily', 'monthly' or 'yearly' \n"); return(NULL); } + if(!is.character(TimeFormat)){ stop("TimeFormat must be 'hourly', 'daily', 'monthly' or 'yearly' \n"); return(NULL); } + if(length(TimeFormat)!=1 ){ stop("TimeFormat must be 'hourly', 'daily', 'monthly' or 'yearly' \n"); return(NULL); } + if(TimeFormat %in% c("hourly","daily","monthly","yearly")==FALSE){ + stop("TimeFormat must be 'hourly', 'daily', 'monthly' or 'yearly' \n"); return(NULL); } + ##check_NewTimeFormat + if(is.null( NewTimeFormat)){ stop("NewTimeFormat must be 'hourly', 'daily', 'monthly' or 'yearly' \n"); return(NULL); } + if(!is.vector( NewTimeFormat)){ stop("NewTimeFormat must be 'hourly', 'daily', 'monthly' or 'yearly' \n"); return(NULL); } + if(!is.character(NewTimeFormat)){ stop("NewTimeFormat must be 'hourly', 'daily', 'monthly' or 'yearly' \n"); return(NULL); } + if(length(NewTimeFormat)!=1 ){ stop("NewTimeFormat must be 'hourly', 'daily', 'monthly' or 'yearly' \n"); return(NULL); } + if(NewTimeFormat %in% c("hourly","daily","monthly","yearly")==FALSE){ + stop("NewTimeFormat must be 'hourly', 'daily', 'monthly' or 'yearly' \n"); return(NULL); } + ##check_ConvertFun + if(is.null( ConvertFun)){ stop("ConvertFun must be a vector of character \n"); return(NULL); } + if(!is.vector( ConvertFun)){ stop("ConvertFun must be a vector of character \n"); return(NULL); } + if(!is.character(ConvertFun)){ stop("ConvertFun must be a vector of character \n"); return(NULL); } + if(length(ConvertFun)!=(ncol(TabSeries)-1)){ stop(paste("ConvertFun must be of length ",ncol(TabSeries)-1," (length=ncol(TabSeries)-1) \n",sep="")); return(NULL); } + if(sum(ConvertFun %in% c("sum","mean")==FALSE)!=0){ stop("ConvertFun elements must be either 'sum' or 'mean' \n"); return(NULL); } + ##check_YearFirstMonth + if(is.null( YearFirstMonth)){ stop("YearFirstMonth must be an integer between 1 and 12 \n"); return(NULL); } + if(!is.vector( YearFirstMonth)){ stop("YearFirstMonth must be an integer between 1 and 12 \n"); return(NULL); } + if(!is.numeric(YearFirstMonth)){ stop("YearFirstMonth must be an integer between 1 and 12 \n"); return(NULL); } + YearFirstMonth <- as.integer(YearFirstMonth); + if(length(YearFirstMonth)!=1){ stop(paste("YearFirstMonth must be only one integer between 1 and 12 \n",sep="")); return(NULL); } + if(YearFirstMonth %in% (1:12) == FALSE){ stop(paste("YearFirstMonth must be only one integer between 1 and 12 \n",sep="")); return(NULL); } + ##check_DatesR_integrity + if(TimeFormat=="hourly" ){ by <- "hours" ; } + if(TimeFormat=="daily" ){ by <- "days" ; } + if(TimeFormat=="monthly"){ by <- "months"; } + if(TimeFormat=="yearly" ){ by <- "years" ; } + TmpDatesR <- seq(from=TabSeries[1,1],to=tail(TabSeries[,1],1),by=by) + if(!identical(TabSeries[,1],TmpDatesR)){ stop("Problem detected in TabSeries dates vector (in comparison with seq(from=TabSeries[1,1],to=tail(TabSeries[,1],1))) \n"); return(NULL); } + ##check_conversion_direction + if((TimeFormat == "daily" & NewTimeFormat %in% c("hourly") ) | + (TimeFormat == "monthly" & NewTimeFormat %in% c("hourly","daily") ) | + (TimeFormat == "yearly" & NewTimeFormat %in% c("hourly","daily","monthly"))){ + stop("only time aggregation can be performed \n"); return(NULL); } + ##check_if_conversion_not_needed + if((TimeFormat == "hourly" & NewTimeFormat=="hourly" ) | + (TimeFormat == "daily" & NewTimeFormat=="daily" ) | + (TimeFormat == "monthly" & NewTimeFormat=="monthly") | + (TimeFormat == "yearly" & NewTimeFormat=="yearly" )){ + if(!quiet){ warning("\t The old and new format are identical \n\t -> no time-step conversion was performed \n"); return(TabSeries); } } + + + ##_Time_step_conversion + + ##_Handle_conventional_difference_between_hourly_series_and_others + TmpDatesR <- TabSeries[,1]; + if(TimeFormat=="hourly"){ TmpDatesR <- TmpDatesR - 60*60; } + Hmax <- "00"; if(TimeFormat=="hourly"){ Hmax <- "23" } + + ##_Identify_the_part_of_the_series_to_be_aggregated + NDaysInMonth <- list("31",c("28","29"),"31","30","31","30","31","31","30","31","30","31") + YearLastMonth <- YearFirstMonth+11; if(YearLastMonth>12){ YearLastMonth <- YearLastMonth-12; } + YearFirstMonthTxt <- formatC(YearFirstMonth,format="d",width=2,flag="0") + YearLastMonthTxt <- formatC(YearLastMonth,format="d",width=2,flag="0") + if(NewTimeFormat=="daily" ){ Ind1 <- which(format(TmpDatesR, "%H")=="00"); + Ind2 <- which(format(TmpDatesR, "%H")==Hmax); + if(Ind2[1]<Ind1[1]){ Ind2 <- Ind2[2:length(Ind2)]; } + if(tail(Ind1,1)>tail(Ind2,1)){ Ind1 <- Ind1[1:(length(Ind1)-1)]; } + ### Aggr <- NULL; iii <- 0; for(kkk in 1:length(Ind1)){ + ### iii <- iii+1; Aggr <- c(Aggr,rep(iii,length(Ind1[kkk]:Ind2[kkk]))); } + Aggr <- as.numeric(format(TmpDatesR[min(Ind1):max(Ind2)],"%Y%m%d")); ### more efficient + NewDatesR <- data.frame(seq(from=TmpDatesR[min(Ind1)],to=TmpDatesR[max(Ind2)],by="days")) + } + if(NewTimeFormat=="monthly"){ Ind1 <- which(format(TmpDatesR, "%d%H")=="0100"); + Ind2 <- which(format(TmpDatesR,"%m%d%H") %in% paste(c("0131","0228","0229","0331","0430","0531","0630","0731","0831","0930","1031","1130","1231"),Hmax,sep="")); + Ind2[1:(length(Ind2)-1)][diff(Ind2)==1] <- NA; Ind2 <- Ind2[!is.na(Ind2)]; ### to keep only feb 29 if both feb 28 and feb 29 exists + if(Ind2[1]<Ind1[1]){ Ind2 <- Ind2[2:length(Ind2)]; } + if(tail(Ind1,1)>tail(Ind2,1)){ Ind1 <- Ind1[1:(length(Ind1)-1)]; } + ### Aggr <- NULL; iii <- 0; for(kkk in 1:length(Ind1)){ + ### iii <- iii+1; Aggr <- c(Aggr,rep(iii,length(Ind1[kkk]:Ind2[kkk]))); } + Aggr <- as.numeric(format(TmpDatesR[min(Ind1):max(Ind2)],"%Y%m")); ### more efficient + NewDatesR <- data.frame(seq(from=TmpDatesR[min(Ind1)],to=TmpDatesR[max(Ind2)],by="months")) + } + if(NewTimeFormat=="yearly" ){ Ind1 <- which(format(TmpDatesR,"%m%d%H") %in% paste(YearFirstMonthTxt,"0100",sep="")); + Ind2 <- which(format(TmpDatesR,"%m%d%H") %in% paste(YearLastMonthTxt,NDaysInMonth[[YearLastMonth]],Hmax,sep="")); + Ind2[1:(length(Ind2)-1)][diff(Ind2)==1] <- NA; Ind2 <- Ind2[!is.na(Ind2)]; ### to keep only feb 29 if both feb 28 and feb 29 exists + if(Ind2[1]<Ind1[1]){ Ind2 <- Ind2[2:length(Ind2)]; } + if(tail(Ind1,1)>tail(Ind2,1)){ Ind1 <- Ind1[1:(length(Ind1)-1)]; } + Aggr <- NULL; iii <- 0; for(kkk in 1:length(Ind1)){ + iii <- iii+1; Aggr <- c(Aggr,rep(iii,length(Ind1[kkk]:Ind2[kkk]))); } + ### Aggr <- as.numeric(format(TmpDatesR[min(Ind1):max(Ind2)],"%Y")); ### not working if YearFirstMonth != 01 + NewDatesR <- data.frame(seq(from=TmpDatesR[min(Ind1)],to=TmpDatesR[max(Ind2)],by="years")) + } + ##_Aggreation_and_export + NewTabSeries <- data.frame(NewDatesR) + for(iCol in 2:ncol(TabSeries)){ + AggregData <- aggregate(TabSeries[min(Ind1):max(Ind2),iCol],by=list(Aggr),FUN=ConvertFun[iCol-1],na.rm=F)[,2] + NewTabSeries <- data.frame(NewTabSeries,AggregData) + } + names(NewTabSeries) <- names(TabSeries) + return(NewTabSeries); + + +} + diff --git a/R/TransfoParam.R b/R/TransfoParam.R new file mode 100644 index 0000000000000000000000000000000000000000..ae0da09cbbe560fc038fb2cde46cb8e18b31fe9d --- /dev/null +++ b/R/TransfoParam.R @@ -0,0 +1,19 @@ +#************************************************************************************************** +#' Function which transforms model parameters (from real to transformed parameters and vice versa) using the provided function. +#************************************************************************************************** +#' @title Transformation of the parameters using the provided function +#' @author Laurent Coron (June 2014) +#' @seealso \code{\link{TransfoParam_GR4J}}, \code{\link{TransfoParam_GR5J}}, \code{\link{TransfoParam_GR6J}}, \code{\link{TransfoParam_CemaNeige}} +#' @example tests/example_TransfoParam.R +#' @encoding UTF-8 +#' @export +#_FunctionInputsOutputs____________________________________________________________________________ +#' @param ParamIn [numeric] matrix of parameter sets (sets in line, parameter values in column) +#' @param Direction [character] direction of the transformation: use "RT" for Real->Transformed and "TR" for Transformed->Real +#' @param FUN_TRANSFO [function] model parameters transformation function (e.g. TransfoParam_GR4J, TransfoParam_CemaNeigeGR4J) +#' @return \emph{ParamOut} [numeric] matrix of parameter sets (sets in line, parameter values in column) +#**************************************************************************************************' +TransfoParam <- function(ParamIn,Direction,FUN_TRANSFO){ + return( FUN_TRANSFO(ParamIn,Direction) ) +} + diff --git a/R/TransfoParam_CemaNeige.R b/R/TransfoParam_CemaNeige.R new file mode 100644 index 0000000000000000000000000000000000000000..73ba2134c7f1a4708abdb7908582585e64ca6df9 --- /dev/null +++ b/R/TransfoParam_CemaNeige.R @@ -0,0 +1,37 @@ +#************************************************************************************************** +#' Function which transforms model parameters (from real to transformed parameters and vice versa). +#************************************************************************************************** +#' @title Transformation of the parameters from the CemaNeige module +#' @author Laurent Coron (December 2013) +#' @seealso \code{\link{TransfoParam}}, \code{\link{TransfoParam_GR4J}}, \code{\link{TransfoParam_GR5J}}, \code{\link{TransfoParam_GR6J}} +#' @example tests/example_TransfoParam_CemaNeige.R +#' @encoding UTF-8 +#' @export +#_FunctionInputsOutputs____________________________________________________________________________ +#' @param ParamIn [numeric] matrix of parameter sets (sets in line, parameter values in column) +#' @param Direction [character] direction of the transformation: use "RT" for Real->Transformed and "TR" for Transformed->Real +#' @return \emph{ParamOut} [numeric] matrix of parameter sets (sets in line, parameter values in column) +#************************************************************************************************** +TransfoParam_CemaNeige <- function(ParamIn,Direction){ + + NParam <- 2; + Bool <- is.matrix(ParamIn); + if(Bool==FALSE){ ParamIn <- rbind(ParamIn); } + if(ncol(ParamIn)!=NParam){ stop(paste("the CemaNeige module requires ",NParam," parameters \n",sep="")); return(NULL); } + + if(Direction=="TR"){ + ParamOut <- ParamIn; + ParamOut[,1] <- (ParamIn[,1]+9.99)/19.98; ### CemaNeige X1 (weighting coefficient for snow pack thermal state) + ParamOut[,2] <- exp(ParamIn[,2]); ### CemaNeige X2 (degree-day melt coefficient) + } + if(Direction=="RT"){ + ParamOut <- ParamIn; + ParamOut[,1] <- ParamIn[,1]*19.98-9.99; ### CemaNeige X1 (weighting coefficient for snow pack thermal state) + ParamOut[,2] <- log(ParamIn[,2]); ### CemaNeige X2 (degree-day melt coefficient) + } + + if(Bool==FALSE){ ParamOut <- ParamOut[1,]; } + return(ParamOut); + +} + diff --git a/R/TransfoParam_GR1A.R b/R/TransfoParam_GR1A.R new file mode 100644 index 0000000000000000000000000000000000000000..963d6bd4e3d950e7ddd6b3d6f6a44eae435bb788 --- /dev/null +++ b/R/TransfoParam_GR1A.R @@ -0,0 +1,31 @@ +#************************************************************************************************** +#' Function which transforms model parameters (from real to transformed parameters and vice versa). +#************************************************************************************************** +#' @title Transformation of the parameters from the GR1A model +#' @author Laurent Coron (March 2015) +#' @encoding UTF-8 +#' @export +#_FunctionInputsOutputs____________________________________________________________________________ +#' @param ParamIn [numeric] matrix of parameter sets (sets in line, parameter values in column) +#' @param Direction [character] direction of the transformation: use "RT" for Real->Transformed and "TR" for Transformed->Real +#' @return \emph{ParamOut} [numeric] matrix of parameter sets (sets in line, parameter values in column) +#************************************************************************************************** +TransfoParam_GR1A <- function(ParamIn,Direction){ + + NParam <- 1; + Bool <- is.matrix(ParamIn); + if(Bool==FALSE){ ParamIn <- rbind(ParamIn); } + if(ncol(ParamIn)!=NParam){ stop(paste("the GR1A model requires ",NParam," parameters \n",sep="")); return(NULL); } + + if(Direction=="TR"){ + ParamOut <- (ParamIn+10.0)/8; + } + if(Direction=="RT"){ + ParamOut <- ParamIn*8-10.0; + } + + if(Bool==FALSE){ ParamOut <- ParamOut[1,]; } + return(ParamOut); + +} + diff --git a/R/TransfoParam_GR2M.R b/R/TransfoParam_GR2M.R new file mode 100644 index 0000000000000000000000000000000000000000..e3fba4cd02634f5fd268c7c77cc701945bb4c99e --- /dev/null +++ b/R/TransfoParam_GR2M.R @@ -0,0 +1,35 @@ +#************************************************************************************************** +#' Function which transforms model parameters (from real to transformed parameters and vice versa). +#************************************************************************************************** +#' @title Transformation of the parameters from the GR2M model +#' @author Laurent Coron (March 2015) +#' @encoding UTF-8 +#' @export +#_FunctionInputsOutputs____________________________________________________________________________ +#' @param ParamIn [numeric] matrix of parameter sets (sets in line, parameter values in column) +#' @param Direction [character] direction of the transformation: use "RT" for Real->Transformed and "TR" for Transformed->Real +#' @return \emph{ParamOut} [numeric] matrix of parameter sets (sets in line, parameter values in column) +#************************************************************************************************** +TransfoParam_GR2M <- function(ParamIn,Direction){ + + NParam <- 2; + Bool <- is.matrix(ParamIn); + if(Bool==FALSE){ ParamIn <- rbind(ParamIn); } + if(ncol(ParamIn)!=NParam){ stop(paste("the GR2M model requires ",NParam," parameters \n",sep="")); return(NULL); } + + if(Direction=="TR"){ + ParamOut <- ParamIn; + ParamOut[,1] <- exp(1.5*ParamIn[,1]); + ParamOut[,2] <- ParamIn[,2]/5; + } + if(Direction=="RT"){ + ParamOut <- ParamIn; + ParamOut[,1] <- log(ParamIn[,1])/1.5; + ParamOut[,2] <- ParamIn[,2]*5; + } + + if(Bool==FALSE){ ParamOut <- ParamOut[1,]; } + return(ParamOut); + +} + diff --git a/R/TransfoParam_GR4H.R b/R/TransfoParam_GR4H.R new file mode 100644 index 0000000000000000000000000000000000000000..caa4ac6c9e75f8f07e1f2e89d341d4504cdb4139 --- /dev/null +++ b/R/TransfoParam_GR4H.R @@ -0,0 +1,39 @@ +#************************************************************************************************** +#' Function which transforms model parameters (from real to transformed parameters and vice versa). +#************************************************************************************************** +#' @title Transformation of the parameters from the GR4H model +#' @author Laurent Coron (July 2014) +#' @encoding UTF-8 +#' @export +#_FunctionInputsOutputs____________________________________________________________________________ +#' @param ParamIn [numeric] matrix of parameter sets (sets in line, parameter values in column) +#' @param Direction [character] direction of the transformation: use "RT" for Real->Transformed and "TR" for Transformed->Real +#' @return \emph{ParamOut} [numeric] matrix of parameter sets (sets in line, parameter values in column) +#************************************************************************************************** +TransfoParam_GR4H <- function(ParamIn,Direction){ + + NParam <- 4; + Bool <- is.matrix(ParamIn); + if(Bool==FALSE){ ParamIn <- rbind(ParamIn); } + if(ncol(ParamIn)!=NParam){ stop(paste("the GR4H model requires ",NParam," parameters \n",sep="")); return(NULL); } + + if(Direction=="TR"){ + ParamOut <- ParamIn; + ParamOut[,1] <- exp(1.5*ParamIn[,1]); ### GR4H X1 (production store capacity) + ParamOut[,2] <- sinh(ParamIn[,2]); ### GR4H X2 (groundwater exchange coefficient) + ParamOut[,3] <- exp(ParamIn[,3]); ### GR4H X3 (routing store capacity) + ParamOut[,4] <- 20+(19.5*24)*(ParamIn[,4]-9.99)/(19.98*24); ### GR4H X4 (unit hydrograph time constant) + } + if(Direction=="RT"){ + ParamOut <- ParamIn; + ParamOut[,1] <- log(ParamIn[,1])/1.5; ### GR4H X1 (production store capacity) + ParamOut[,2] <- asinh(ParamIn[,2]); ### GR4H X2 (groundwater exchange coefficient) + ParamOut[,3] <- log(ParamIn[,3]); ### GR4H X3 (routing store capacity) + ParamOut[,4] <- 9.99+(19.98*24)*(ParamIn[,4]-20)/(19.5*24); ### GR4H X4 (unit hydrograph time constant) + } + + if(Bool==FALSE){ ParamOut <- ParamOut[1,]; } + return(ParamOut); + +} + diff --git a/R/TransfoParam_GR4J.R b/R/TransfoParam_GR4J.R new file mode 100644 index 0000000000000000000000000000000000000000..2613179d3797eff0c8e0f171a60b8e6c7fc33fed --- /dev/null +++ b/R/TransfoParam_GR4J.R @@ -0,0 +1,41 @@ +#************************************************************************************************** +#' Function which transforms model parameters (from real to transformed parameters and vice versa). +#************************************************************************************************** +#' @title Transformation of the parameters from the GR4J model +#' @author Laurent Coron (December 2013) +#' @seealso \code{\link{TransfoParam}}, \code{\link{TransfoParam_GR5J}}, \code{\link{TransfoParam_GR6J}}, \code{\link{TransfoParam_CemaNeige}} +#' @example tests/example_TransfoParam_GR4J.R +#' @encoding UTF-8 +#' @export +#_FunctionInputsOutputs____________________________________________________________________________ +#' @param ParamIn [numeric] matrix of parameter sets (sets in line, parameter values in column) +#' @param Direction [character] direction of the transformation: use "RT" for Real->Transformed and "TR" for Transformed->Real +#' @return \emph{ParamOut} [numeric] matrix of parameter sets (sets in line, parameter values in column) +#************************************************************************************************** +TransfoParam_GR4J <- function(ParamIn,Direction){ + + NParam <- 4; + Bool <- is.matrix(ParamIn); + if(Bool==FALSE){ ParamIn <- rbind(ParamIn); } + if(ncol(ParamIn)!=NParam){ stop(paste("the GR4J model requires ",NParam," parameters \n",sep="")); return(NULL); } + + if(Direction=="TR"){ + ParamOut <- ParamIn; + ParamOut[,1] <- exp(1.5*ParamIn[,1]); ### GR4J X1 (production store capacity) + ParamOut[,2] <- sinh(ParamIn[,2]); ### GR4J X2 (groundwater exchange coefficient) + ParamOut[,3] <- exp(ParamIn[,3]); ### GR4J X3 (routing store capacity) + ParamOut[,4] <- 20+19.5*(ParamIn[,4]-9.99)/19.98; ### GR4J X4 (unit hydrograph time constant) + } + if(Direction=="RT"){ + ParamOut <- ParamIn; + ParamOut[,1] <- log(ParamIn[,1])/1.5; ### GR4J X1 (production store capacity) + ParamOut[,2] <- asinh(ParamIn[,2]); ### GR4J X2 (groundwater exchange coefficient) + ParamOut[,3] <- log(ParamIn[,3]); ### GR4J X3 (routing store capacity) + ParamOut[,4] <- 9.99+19.98*(ParamIn[,4]-20)/19.5; ### GR4J X4 (unit hydrograph time constant) + } + + if(Bool==FALSE){ ParamOut <- ParamOut[1,]; } + return(ParamOut); + +} + diff --git a/R/TransfoParam_GR5J.R b/R/TransfoParam_GR5J.R new file mode 100644 index 0000000000000000000000000000000000000000..126d25ba8597f8b17dd0f624c44075f52ab502d5 --- /dev/null +++ b/R/TransfoParam_GR5J.R @@ -0,0 +1,45 @@ +#************************************************************************************************** +#' Function which transforms model parameters (from real to transformed parameters and vice versa). +#************************************************************************************************** +#' @title Transformation of the parameters from the GR5J model +#' @author Laurent Coron (December 2013) +#' @seealso \code{\link{TransfoParam}}, \code{\link{TransfoParam_GR4J}}, \code{\link{TransfoParam_GR6J}}, \code{\link{TransfoParam_CemaNeige}} +#' @example tests/example_TransfoParam_GR5J.R +#' @encoding UTF-8 +#' @export +#_FunctionInputsOutputs____________________________________________________________________________ +#' @param ParamIn [numeric] matrix of parameter sets (sets in line, parameter values in column) +#' @param Direction [character] direction of the transformation: use "RT" for Real->Transformed and "TR" for Transformed->Real +#' @return \emph{ParamOut} [numeric] matrix of parameter sets (sets in line, parameter values in column) +#************************************************************************************************** +TransfoParam_GR5J <- function(ParamIn,Direction){ + + NParam <- 5; + Bool <- is.matrix(ParamIn); + if(Bool==FALSE){ ParamIn <- rbind(ParamIn); } + if(ncol(ParamIn)!=NParam){ stop(paste("the GR5J model requires ",NParam," parameters \n",sep="")); return(NULL); } + + if(Direction=="TR"){ + ParamOut <- ParamIn; + ParamOut[,1] <- exp(1.5*ParamIn[,1]); ### GR5J X1 (production store capacity) + ParamOut[,2] <- sinh(ParamIn[,2]); ### GR5J X2 (groundwater exchange coefficient 1) + ParamOut[,3] <- exp(ParamIn[,3]); ### GR5J X3 (routing store capacity) + ParamOut[,4] <- 20+19.5*(ParamIn[,4]-9.99)/19.98; ### GR5J X4 (unit hydrograph time constant) + ### ParamOut[,5] <- sinh(ParamIn[,5]); ### GR5J X5 (groundwater exchange coefficient 2) + ParamOut[,5] <- ParamIn[,5]/5; ### GR5J X5 (groundwater exchange coefficient 2) + } + if(Direction=="RT"){ + ParamOut <- ParamIn; + ParamOut[,1] <- log(ParamIn[,1]) / 1.5; ### GR5J X1 (production store capacity) + ParamOut[,2] <- asinh(ParamIn[,2]); ### GR5J X2 (groundwater exchange coefficient 1) + ParamOut[,3] <- log(ParamIn[,3]); ### GR5J X3 (routing store capacity) + ParamOut[,4] <- 9.99+19.98*(ParamIn[,4]-20)/19.5; ### GR5J X4 (unit hydrograph time constant) + ### ParamOut[,5] <- asinh(ParamIn[,5]); ### GR5J X5 (groundwater exchange coefficient 2) + ParamOut[,5] <- ParamIn[,5]*5; ### GR5J X5 (groundwater exchange coefficient 2) + } + + if(Bool==FALSE){ ParamOut <- ParamOut[1,]; } + return(ParamOut); + +} + diff --git a/R/TransfoParam_GR6J.R b/R/TransfoParam_GR6J.R new file mode 100644 index 0000000000000000000000000000000000000000..ed558b69f7af0b695884d170fbf7b2ee000560b0 --- /dev/null +++ b/R/TransfoParam_GR6J.R @@ -0,0 +1,47 @@ +#************************************************************************************************** +#' Function which transforms model parameters (from real to transformed parameters and vice versa). +#************************************************************************************************** +#' @title Transformation of the parameters from the GR6J model +#' @author Laurent Coron (December 2013) +#' @seealso \code{\link{TransfoParam}}, \code{\link{TransfoParam_GR4J}}, \code{\link{TransfoParam_GR5J}}, \code{\link{TransfoParam_CemaNeige}} +#' @example tests/example_TransfoParam_GR6J.R +#' @encoding UTF-8 +#' @export +#_FunctionInputsOutputs____________________________________________________________________________ +#' @param ParamIn [numeric] matrix of parameter sets (sets in line, parameter values in column) +#' @param Direction [character] direction of the transformation: use "RT" for Real->Transformed and "TR" for Transformed->Real +#' @return \emph{ParamOut} [numeric] matrix of parameter sets (sets in line, parameter values in column) +#************************************************************************************************** +TransfoParam_GR6J <- function(ParamIn,Direction){ + + NParam <- 6; + Bool <- is.matrix(ParamIn); + if(Bool==FALSE){ ParamIn <- rbind(ParamIn); } + if(ncol(ParamIn)!=NParam){ stop(paste("the GR6J model requires ",NParam," parameters \n",sep="")); return(NULL); } + + if(Direction=="TR"){ + ParamOut <- ParamIn; + ParamOut[,1] <- exp(1.5*ParamIn[,1]); ### GR6J X1 (production store capacity) + ParamOut[,2] <- sinh(ParamIn[,2]); ### GR6J X2 (groundwater exchange coefficient 1) + ParamOut[,3] <- exp(ParamIn[,3]); ### GR6J X3 (routing store capacity) + ParamOut[,4] <- 20+19.5*(ParamIn[,4]-9.99)/19.98; ### GR6J X4 (unit hydrograph time constant) + ### ParamOut[,5] <- sinh(ParamIn[,5]); ### GR6J X5 (groundwater exchange coefficient 2) + ParamOut[,5] <- ParamIn[,5]/5; ### GR6J X5 (groundwater exchange coefficient 2) + ParamOut[,6] <- exp(ParamIn[,6]); ### GR6J X6 (coefficient for emptying exponential store) + } + if(Direction=="RT"){ + ParamOut <- ParamIn; + ParamOut[,1] <- log(ParamIn[,1]) / 1.5; ### GR6J X1 (production store capacity) + ParamOut[,2] <- asinh(ParamIn[,2]); ### GR6J X2 (groundwater exchange coefficient 1) + ParamOut[,3] <- log(ParamIn[,3]); ### GR6J X3 (routing store capacity) + ParamOut[,4] <- 9.99+19.98*(ParamIn[,4]-20)/19.5; ### GR6J X4 (unit hydrograph time constant) + ### ParamOut[,5] <- asinh(ParamIn[,5]); ### GR6J X5 (groundwater exchange coefficient 2) + ParamOut[,5] <- ParamIn[,5]*5; ### GR6J X5 (groundwater exchange coefficient 2) + ParamOut[,6] <- log(ParamIn[,6]); ### GR6J X6 (coefficient for emptying exponential store) + } + + if(Bool==FALSE){ ParamOut <- ParamOut[1,]; } + return(ParamOut); + +} + diff --git a/R/airGR b/R/airGR deleted file mode 100644 index 3b65e3cbb872050f5dbcfacd3f2057d52d28ba0e..0000000000000000000000000000000000000000 --- a/R/airGR +++ /dev/null @@ -1,27 +0,0 @@ -# File share/R/nspackloader.R -# Part of the R package, http://www.R-project.org -# -# Copyright (C) 1995-2012 The R Core Team -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or -# (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# A copy of the GNU General Public License is available at -# http://www.r-project.org/Licenses/ - -local({ - info <- loadingNamespaceInfo() - pkg <- info$pkgname - ns <- .getNamespace(as.name(pkg)) - if (is.null(ns)) - stop("cannot find namespace environment for ", pkg, domain = NA); - dbbase <- file.path(info$libname, pkg, "R", pkg) - lazyLoad(dbbase, ns, filter = function(n) n != ".__NAMESPACE__.") -}) diff --git a/R/airGR.rdb b/R/airGR.rdb deleted file mode 100644 index f499c91aa680b1580687738478a2d764bcd9c0da..0000000000000000000000000000000000000000 Binary files a/R/airGR.rdb and /dev/null differ diff --git a/R/airGR.rdx b/R/airGR.rdx deleted file mode 100644 index 413f2cb20471dbd88745f64272c0ee51ad01a3a8..0000000000000000000000000000000000000000 Binary files a/R/airGR.rdx and /dev/null differ diff --git a/R/plot_OutputsModel.R b/R/plot_OutputsModel.R new file mode 100644 index 0000000000000000000000000000000000000000..0ef583f506607b21630698dad24df6bec8526e2e --- /dev/null +++ b/R/plot_OutputsModel.R @@ -0,0 +1,395 @@ +#***************************************************************************************************************** +#' Function which creates a screen plot giving an overview of the model outputs +#' +#' Dashboard of results including various graphs (depending on the model): +#' (1) time series of total precipitation and simulated flows (and observed flows if provided) +#' (2) interannual median monthly simulated flow (and observed flows if provided) +#' (3) correlation plot between simulated and observed flows (if observed flows provided) +#' (4) cumulative frequency plot for simulated flows (and observed flows if provided) +#***************************************************************************************************************** +#' @title Default preview of model outputs +#' @author Laurent Coron (June 2014) +## @example tests/example_plot_OutputsModel.R +#' @encoding UTF-8 +#' @export +#_FunctionInputs__________________________________________________________________________________________________ +#' @param OutputsModel [object of class \emph{OutputsModel}] list of model outputs (which must at least include DatesR, Precip and Qsim) [POSIXlt, mm, mm] +#' @param Qobs (optional) [numeric] time series of observed flow (for the same time-steps than simulated) [mm] +#' @param IndPeriod_Plot (optional) [numeric] indices of the time-steps to be plotted (among the OutputsModel series) +#' @param BasinArea (optional) [numeric] basin area [km2], used to plot flow axes in m3/s +#' @param PlotChoice (optional) [character] choice of plots \cr (e.g. c("Precip","SnowPack","Flows","Regime","CumFreq","CorQQ")), default="all" +#' @param quiet (optional) [boolean] boolean indicating if the function is run in quiet mode or not, default=FALSE +#_FunctionOutputs_________________________________________________________________________________________________ +#' @return screen plot window +#***************************************************************************************************************** +plot_OutputsModel <- function(OutputsModel,Qobs=NULL,IndPeriod_Plot=NULL,BasinArea=NULL,PlotChoice="all",quiet=FALSE){ + + + if(!inherits(OutputsModel,"GR") & !inherits(OutputsModel,"CemaNeige")){ stop(paste("OutputsModel not in the correct format for default plotting \n",sep="")); return(NULL); } + + BOOL_Dates <- FALSE; + if("DatesR" %in% names(OutputsModel)){ BOOL_Dates <- TRUE; } + BOOL_Pobs <- FALSE; + if("Precip" %in% names(OutputsModel)){ BOOL_Pobs <- TRUE; } + BOOL_Qsim <- FALSE; + if("Qsim" %in% names(OutputsModel)){ BOOL_Qsim <- TRUE; } + BOOL_Qobs <- FALSE; + if(BOOL_Qsim & length(Qobs)==length(OutputsModel$Qsim)){ if(sum(is.na(Qobs))!=length(Qobs)){ BOOL_Qobs <- TRUE; } } + BOOL_Snow <- FALSE; + if("CemaNeigeLayers" %in% names(OutputsModel)){ if("SnowPack" %in% names(OutputsModel$CemaNeigeLayers[[1]])){ BOOL_Snow <- TRUE; } } + BOOL_Psol <- FALSE; + if("CemaNeigeLayers" %in% names(OutputsModel)){ if("Psol" %in% names(OutputsModel$CemaNeigeLayers[[1]])){ BOOL_Psol <- TRUE; } } + + + if( is.null( PlotChoice)){ stop("PlotChoice must be a vector of character \n"); return(NULL); } + if(!is.vector( PlotChoice)){ stop("PlotChoice must be a vector of character \n"); return(NULL); } + if(!is.character(PlotChoice)){ stop("PlotChoice must be a vector of character \n"); return(NULL); } + if(sum(PlotChoice %in% c("all","Precip","SnowPack","Flows","Regime","CumFreq","CorQQ")==FALSE)!=0){ + cat("Incorrect element found in PlotChoice \n"); + stop("PlotChoice can only contain 'all', 'Precip', 'SnowPack', 'Flows', 'Regime', 'CumFreq' or 'CorQQ') \n"); + return(NULL); } + if("all" %in% PlotChoice){ PlotChoice <- c("Precip","SnowPack","Flows","Regime","CumFreq","CorQQ"); } + + if(!BOOL_Dates){ + stop(paste("OutputsModel must contain at least DatesR to allow plotting \n",sep="")); return(NULL); } + if(inherits(OutputsModel,"GR") & !BOOL_Qsim){ + stop(paste("OutputsModel must contain at least Qsim to allow plotting \n",sep="")); return(NULL); } + + if(BOOL_Dates){ + MyRollMean1 <- function(x,n){ + return(filter(x,rep(1/n,n),sides=2)); } + MyRollMean2 <- function(x,n){ + return(filter(c(tail(x,n%/%2),x,x[1:(n%/%2)]),rep(1/n,n),sides=2)[(n%/%2+1):(length(x)+n%/%2)]); } + BOOL_TS <- FALSE; + TimeStep <- difftime(tail(OutputsModel$DatesR,1),tail(OutputsModel$DatesR,2),units="secs")[[1]]; + if(inherits(OutputsModel,"hourly" ) & TimeStep %in% ( 60*60)){ BOOL_TS <- TRUE; NameTS <- "hour" ; plotunit <- "[mm/h]"; formatAxis <- "%m/%Y"; } + if(inherits(OutputsModel,"daily" ) & TimeStep %in% ( 24*60*60)){ BOOL_TS <- TRUE; NameTS <- "day" ; plotunit <- "[mm/d]"; formatAxis <- "%m/%Y"; } + if(inherits(OutputsModel,"monthly") & TimeStep %in% (c(28,29,30,31)*24*60*60)){ BOOL_TS <- TRUE; NameTS <- "month"; plotunit <- "[mm/month]"; formatAxis <- "%m/%Y"; } + if(inherits(OutputsModel,"yearly" ) & TimeStep %in% ( c(365,366)*24*60*60)){ BOOL_TS <- TRUE; NameTS <- "year" ; plotunit <- "[mm/y]"; formatAxis <- "%Y" ; } + if(!BOOL_TS){ stop(paste("the time step of the model inputs could not be found \n",sep="")); return(NULL); } + } + if(length(IndPeriod_Plot)==0){ IndPeriod_Plot <- 1:length(OutputsModel$DatesR); } + if(inherits(OutputsModel,"CemaNeige")){ NLayers <- length(OutputsModel$CemaNeigeLayers); } + PsolLayerMean <- NULL; if(BOOL_Psol){ + for(iLayer in 1:NLayers){ + if(iLayer==1){ PsolLayerMean <- OutputsModel$CemaNeigeLayers[[iLayer]]$Psol/NLayers; + } else { PsolLayerMean <- PsolLayerMean + OutputsModel$CemaNeigeLayers[[iLayer]]$Psol/NLayers; } } } + BOOL_QobsZero <- FALSE; if(BOOL_Qobs){ SelectQobsNotZero <- (round(Qobs[IndPeriod_Plot] ,4)!=0); BOOL_QobsZero <- sum(!SelectQobsNotZero,na.rm=TRUE)>0; } + BOOL_QsimZero <- FALSE; if(BOOL_Qsim){ SelectQsimNotZero <- (round(OutputsModel$Qsim[IndPeriod_Plot],4)!=0); BOOL_QsimZero <- sum(!SelectQsimNotZero,na.rm=TRUE)>0; } + if(BOOL_QobsZero & !quiet){ warning("\t zeroes detected in Qobs -> some plots in the log space will not be created using all time-steps \n"); } + if(BOOL_QsimZero & !quiet){ warning("\t zeroes detected in Qsim -> some plots in the log space will not be created using all time-steps \n"); } + BOOL_FilterZero <- TRUE; + + ##Plots_choices + BOOLPLOT_Precip <- ( "Precip" %in% PlotChoice & BOOL_Pobs ) + BOOLPLOT_SnowPack <- ( "SnowPack" %in% PlotChoice & BOOL_Snow ) + BOOLPLOT_Flows <- ( "Flows" %in% PlotChoice & (BOOL_Qsim | BOOL_Qobs) ) + BOOLPLOT_Regime <- ( "Regime" %in% PlotChoice & BOOL_TS & BOOL_Qsim & (NameTS %in% c("hour","day","month")) ) + BOOLPLOT_CumFreq <- ( "CumFreq" %in% PlotChoice & (BOOL_Qsim | BOOL_Qobs) & BOOL_FilterZero ) + BOOLPLOT_CorQQ <- ( "CorQQ" %in% PlotChoice & (BOOL_Qsim & BOOL_Qobs) & BOOL_FilterZero ) + + + ##Options + BLOC <- TRUE; if(BLOC){ + cexaxis <- 1.0; cexlab <- 0.9; cexleg=1.0; lwdLine=1.8; lineX=2.6; lineY=2.6; bgleg <- rgb(1,1,1,alpha=0.7); bgleg <- NA; + + matlayout <- NULL; iPlot <- 0; + Sum1 <- sum(c(BOOLPLOT_Precip,BOOLPLOT_SnowPack,BOOLPLOT_Flows)) + Sum2 <- sum(c(BOOLPLOT_Regime,BOOLPLOT_CumFreq,BOOLPLOT_CorQQ)) + if(BOOLPLOT_Precip){ + matlayout <- rbind(matlayout,c(iPlot+1,iPlot+1,iPlot+1)); iPlot <- iPlot+1; } + if(BOOLPLOT_SnowPack){ + matlayout <- rbind(matlayout,c(iPlot+1,iPlot+1,iPlot+1),c(iPlot+1,iPlot+1,iPlot+1)); iPlot <- iPlot+1; } + if(BOOLPLOT_Flows){ + matlayout <- rbind(matlayout,c(iPlot+1,iPlot+1,iPlot+1),c(iPlot+1,iPlot+1,iPlot+1)); iPlot <- iPlot+1; } + if((Sum1>=1 & Sum2!=0) | (Sum1==0 & Sum2==3)){ + matlayout <- rbind(matlayout,c(iPlot+1,iPlot+2,iPlot+3),c(iPlot+1,iPlot+2,iPlot+3)); iPlot <- iPlot+3; } + if(Sum1==0 & Sum2==2){ + matlayout <- rbind(matlayout,c(iPlot+1,iPlot+2)); iPlot <- iPlot+2; } + if(Sum1==0 & Sum2==1){ + matlayout <- rbind(matlayout,iPlot+1); iPlot <- iPlot+1; } + iPlotMax <- iPlot; + + isRStudio <- Sys.getenv("RSTUDIO") == "1"; + if(!isRStudio){ + if(Sum1==1 & Sum2==0){ width=10; height=05; } + if(Sum1==1 & Sum2!=0){ width=10; height=07; } + if(Sum1==2 & Sum2==0){ width=10; height=05; } + if(Sum1==2 & Sum2!=0){ width=10; height=07; } + if(Sum1==3 & Sum2==0){ width=10; height=07; } + if(Sum1==3 & Sum2!=0){ width=10; height=10; } + if(Sum1==0 & Sum2==1){ width=05; height=05; } + if(Sum1==0 & Sum2==2){ width=10; height=04; } + if(Sum1==0 & Sum2==3){ width=10; height=03; } + dev.new(width=width,height=height) + } + layout(matlayout); + + Xaxis <- 1:length(IndPeriod_Plot); + if(BOOL_Dates){ + if(NameTS %in% c("hour","day","month")){ + Seq1 <- which(OutputsModel$DatesR[IndPeriod_Plot]$mday==1 & OutputsModel$DatesR[IndPeriod_Plot]$mon %in% c(0,3,6,9)); + Seq2 <- which(OutputsModel$DatesR[IndPeriod_Plot]$mday==1 & OutputsModel$DatesR[IndPeriod_Plot]$mon==0); + Labels2 <- format(OutputsModel$DatesR[IndPeriod_Plot],format=formatAxis)[Seq2]; + } + if(NameTS %in% c("year")){ + Seq1 <- 1:length(OutputsModel$DatesR[IndPeriod_Plot]); + Seq2 <- 1:length(OutputsModel$DatesR[IndPeriod_Plot]); + Labels2 <- format(OutputsModel$DatesR[IndPeriod_Plot],format=formatAxis)[Seq2]; + } + } + + if(!is.null(BasinArea)){ + Factor_MMH_M3S <- BasinArea/( 60*60/1000); + Factor_MMD_M3S <- BasinArea/( 24*60*60/1000); + Factor_MMM_M3S <- BasinArea/(365.25/12*24*60*60/1000); + Factor_MMY_M3S <- BasinArea/( 365.25*24*60*60/1000); + if(NameTS=="hour" ){ Factor_UNIT_M3S <- Factor_MMH_M3S; } + if(NameTS=="day" ){ Factor_UNIT_M3S <- Factor_MMD_M3S; } + if(NameTS=="month"){ Factor_UNIT_M3S <- Factor_MMM_M3S; } + if(NameTS=="year" ){ Factor_UNIT_M3S <- Factor_MMY_M3S; } + } + } + + kPlot <- 0; + + ##Precip + if(BOOLPLOT_Precip){ + kPlot <- kPlot+1; mar <- c(3,5,1,5); + par(new=FALSE,mar=mar,las=0) + ylim1 <- range(OutputsModel$Precip[IndPeriod_Plot],na.rm=TRUE); ylim2 <- ylim1; ylim2 <- rev(ylim2); + lwdP <- 0.7; if(NameTS %in% c("month","year")){ lwdP <- 2; } + plot(Xaxis,OutputsModel$Precip[IndPeriod_Plot],type="h",ylim=ylim2,col="royalblue",lwd=lwdP,xaxt="n",yaxt="n",xlab="",ylab="",yaxs="i"); + axis(side=2,at=pretty(ylim1),labels=pretty(ylim1),cex.axis=cexaxis) + par(las=0); mtext(side=2,paste("precip. ",plotunit,sep=""),line=lineY,cex=cexlab,adj=1); par(las=0); + if(BOOL_Psol){ + par(new=TRUE); + plot(Xaxis,PsolLayerMean[IndPeriod_Plot],type="h",ylim=ylim2,col="lightblue",lwd=lwdP,xaxt="n",yaxt="n",xlab="",ylab="",yaxs="i"); + } + if(BOOL_Dates){ + axis(side=1,at=Seq1,labels=FALSE,cex.axis=cexaxis); + axis(side=1,at=Seq2,labels=Labels2,lwd.ticks=1.5,cex.axis=cexaxis); + } else { axis(side=1,at=pretty(Xaxis),labels=pretty(Xaxis),cex.axis=cexaxis); } + } + + + ##SnowPack + if(BOOLPLOT_SnowPack){ + kPlot <- kPlot+1; mar <- c(3,5,1,5); + par(new=FALSE,mar=mar,las=0) + ylim1 <- c(+99999,-99999) + for(iLayer in 1:NLayers){ + ylim1[1] <- min(ylim1[1],OutputsModel$CemaNeigeLayers[[iLayer]]$SnowPack); + ylim1[2] <- max(ylim1[2],OutputsModel$CemaNeigeLayers[[iLayer]]$SnowPack); + if(iLayer==1){ SnowPackLayerMean <- OutputsModel$CemaNeigeLayers[[iLayer]]$SnowPack/NLayers; + } else { SnowPackLayerMean <- SnowPackLayerMean + OutputsModel$CemaNeigeLayers[[iLayer]]$SnowPack/NLayers; } + } + plot(SnowPackLayerMean[IndPeriod_Plot],type="l",ylim=ylim1,lwd=lwdLine*1.2,col="royalblue",xlab="",ylab="",xaxt="n",yaxt="n") + for(iLayer in 1:NLayers){ lines(OutputsModel$CemaNeigeLayers[[iLayer]]$SnowPack[IndPeriod_Plot],lty=3,col="royalblue",lwd=lwdLine*0.8); } + axis(side=2,at=pretty(ylim1),labels=pretty(ylim1),cex.axis=cexaxis) + par(las=0); mtext(side=2,paste("snow pack ","[mm]",sep=""),line=lineY,cex=cexlab); par(las=0); + legend("topright",c(paste("mean snow pack",sep=""),paste("snow pack for each layer",sep="")),col=c("royalblue","royalblue"),lty=c(1,3),lwd=c(lwdLine*1.2,lwdLine*0.8),bty="o",bg=bgleg,box.col=bgleg,cex=cexleg) + box() + if(BOOL_Dates){ + axis(side=1,at=Seq1,labels=FALSE,cex.axis=cexaxis); + axis(side=1,at=Seq2,labels=Labels2,lwd.ticks=1.5,cex.axis=cexaxis); + } else { axis(side=1,at=pretty(Xaxis),labels=pretty(Xaxis),cex.axis=cexaxis); } + } + + + ##Flows + if(BOOLPLOT_Flows){ + kPlot <- kPlot+1; mar <- c(3,5,1,5); + par(new=FALSE,mar=mar,las=0) + ylim1 <- range(OutputsModel$Qsim[IndPeriod_Plot],na.rm=TRUE); + if(BOOL_Qobs){ ylim1 <- range(c(ylim1,Qobs[IndPeriod_Plot]),na.rm=TRUE); } + ylim2 <- c(ylim1[1],1.2*ylim1[2]); + plot(Xaxis,rep(NA,length(Xaxis)),type="n",ylim=ylim2,xlab="",ylab="",xaxt="n",yaxt="n"); + txtleg <- NULL; colleg <- NULL; + if(BOOL_Qobs){ lines(Xaxis,Qobs[IndPeriod_Plot],lwd=lwdLine,lty=1,col="black"); txtleg <- c(txtleg,"observed"); colleg <- c(colleg,"black"); } + if(BOOL_Qsim){ lines(Xaxis,OutputsModel$Qsim[IndPeriod_Plot],lwd=lwdLine,lty=1,col="orangered"); txtleg <- c(txtleg,"simulated"); colleg <- c(colleg,"orangered"); } + axis(side=2,at=pretty(ylim1),labels=pretty(ylim1),cex.axis=cexaxis) + par(las=0); mtext(side=2,paste("flow ",plotunit,sep=""),line=lineY,cex=cexlab); par(las=0); + if(!is.null(BasinArea)){ + Factor <- Factor_UNIT_M3S; + axis(side=4,at=pretty(ylim1*Factor)/Factor,labels=pretty(ylim1*Factor),cex.axis=cexaxis); + par(las=0); mtext(side=4,paste("flow ","m3/s",sep=""),line=lineY,cex=cexlab); par(las=0); } + if(BOOL_Dates){ + axis(side=1,at=Seq1,labels=FALSE,cex.axis=cexaxis); + axis(side=1,at=Seq2,labels=Labels2,lwd.ticks=1.5,cex.axis=cexaxis); + } else { axis(side=1,at=pretty(Xaxis),labels=pretty(Xaxis),cex.axis=cexaxis); } + legend("topright",txtleg,col=colleg,lty=1,lwd=lwdLine,bty="o",bg=bgleg,box.col=bgleg,cex=cexleg) + box() + } + + + ##Regime + if(BOOLPLOT_Regime){ + kPlot <- kPlot+1; mar <- c(6,5,1,5); plotunitregime <- "[mm/month]"; + par(new=FALSE,mar=mar,las=0) + ##Data_formating_as_table + DataModel <- as.data.frame(matrix(as.numeric(NA),nrow=length(IndPeriod_Plot),ncol=5)); + DataModel[,1] <- as.numeric(format(OutputsModel$DatesR[IndPeriod_Plot],format="%Y%m%d%H")); + if(BOOL_Pobs){ DataModel[,2] <- OutputsModel$Precip[IndPeriod_Plot]; } + if(BOOL_Psol){ DataModel[,3] <- PsolLayerMean[IndPeriod_Plot]; } + if(BOOL_Qobs){ DataModel[,4] <- Qobs[IndPeriod_Plot]; } + if(BOOL_Qsim){ DataModel[,5] <- OutputsModel$Qsim[IndPeriod_Plot]; } + colnames(DataModel) <- c("Dates","Precip","Psol","Qobs","Qsim"); + TxtDatesDataModel <- formatC(DataModel$Dates,format="d",width=8,flag="0"); + ##Building_of_daily_time_series_if_needed + if(NameTS=="month"){ DataDaily <- NULL; } + if(NameTS=="day" ){ DataDaily <- DataModel; } + if(NameTS=="hour" ){ DataDaily <- as.data.frame(aggregate(DataModel[,2:5],by=list(as.numeric(substr(TxtDatesDataModel,1,8))),FUN=sum,na.rm=T)); } + if(NameTS %in% c("hour","day")){ + colnames(DataDaily) <- c("Dates","Precip","Psol","Qobs","Qsim"); + TxtDatesDataDaily <- formatC(DataDaily$Dates,format="d",width=8,flag="0"); } + ##Building_of_monthly_time_series_if_needed + if(NameTS=="month"){ DataMonthly <- DataModel; } + if(NameTS=="day" ){ DataMonthly <- as.data.frame(aggregate(DataDaily[,2:5],by=list(as.numeric(substr(TxtDatesDataDaily,1,6))),FUN=sum,na.rm=T)); } + if(NameTS=="hour" ){ DataMonthly <- as.data.frame(aggregate(DataDaily[,2:5],by=list(as.numeric(substr(TxtDatesDataDaily,1,6))),FUN=sum,na.rm=T)); } + colnames(DataMonthly) <- c("Dates","Precip","Psol","Qobs","Qsim"); + TxtDatesDataMonthly <- formatC(DataMonthly$Dates,format="d",width=6,flag="0"); + ##Computation_of_interannual_mean_series + if(!is.null(DataDaily)){ + DataDailyInterAn <- as.data.frame(aggregate(DataDaily[,2:5],by=list(as.numeric(substr(TxtDatesDataDaily ,5,8))),FUN=mean,na.rm=T)); + colnames(DataDailyInterAn) <- c("Dates","Precip","Psol","Qobs","Qsim"); } + if(!is.null(DataMonthly)){ + DataMonthlyInterAn <- as.data.frame(aggregate(DataMonthly[,2:5],by=list(as.numeric(substr(TxtDatesDataMonthly,5,6))),FUN=mean,na.rm=T)); + colnames(DataMonthlyInterAn) <- c("Dates","Precip","Psol","Qobs","Qsim"); } + ##Smoothing_of_daily_series_and_scale_conversion_to_make_them_become_a_monthly_regime + if(!is.null(DataDaily)){ + ##Smoothing + NDaysWindow <- 30; + DataDailyInterAn <- as.data.frame(cbind(DataDailyInterAn$Dates, + MyRollMean2(DataDailyInterAn$Precip,NDaysWindow), MyRollMean2(DataDailyInterAn$Psol,NDaysWindow), + MyRollMean2(DataDailyInterAn$Qobs ,NDaysWindow), MyRollMean2(DataDailyInterAn$Qsim,NDaysWindow))); + colnames(DataDailyInterAn) <- c("Dates","Precip","Psol","Qobs","Qsim"); + ##Scale_conversion_to_make_them_become_a_monthly_regime + if(plotunitregime!="[mm/month]"){ stop(paste("incorrect unit for regime plot \n",sep="")); return(NULL); } + DataDailyInterAn <- as.data.frame(cbind(DataDailyInterAn[1],DataDailyInterAn[2:5]*30)); + } + ##Plot_preparation + DataPlotP <- DataMonthlyInterAn; + if(!is.null(DataDaily)){ + DataPlotQ <- DataDailyInterAn; + SeqX1 <- c( 1, 32, 61, 92,122,153,183,214,245,275,306,336,366); + SeqX2 <- c( 15, 46, 75,106,136,167,197,228,259,289,320,350); + labX <- "30-days rolling mean"; + } else { + DataPlotQ <- DataMonthlyInterAn; + SeqX1 <- seq(from=0.5,to=12.5,by=1); + SeqX2 <- seq(from=1 ,to=12 ,by=1); + labX <- ""; + } + xLabels1 <- rep("",13); + xLabels2 <- c("jan","feb","mar","apr","may","jun","jul","aug","sep","oct","nov","dec"); + ylimQ <- range(c(DataPlotQ$Qobs,DataPlotQ$Qsim),na.rm=TRUE); + if(BOOL_Pobs){ ylimP <- c(max(DataPlotP$Precip,na.rm=TRUE),0); } + txtleg <- NULL; colleg <- NULL; lwdleg <- NULL; lwdP=10; + ##Plot_forcings + if(BOOL_Pobs){ + plot(SeqX2,DataPlotP$Precip,type="h",xlim=range(SeqX1),ylim=c(3*ylimP[1],ylimP[2]),lwd=lwdP,lend=1,lty=1,col="royalblue",xlab="",ylab="",xaxt="n",yaxt="n",yaxs="i",bty="n") + txtleg <- c(txtleg,"Ptot" ); colleg <- c(colleg,"royalblue"); lwdleg <- c(lwdleg,lwdP/3); + axis(side=2,at=pretty(0.8*ylimP,n=3),labels=pretty(0.8*ylimP,n=3),cex.axis=cexaxis,col.axis="royalblue",col.ticks="royalblue"); + par(new=TRUE); } + if(BOOL_Psol){ + plot(SeqX2,DataPlotP$Psol,type="h",xlim=range(SeqX1),ylim=c(3*ylimP[1],ylimP[2]),lwd=lwdP,lend=1,lty=1,col="lightblue",xlab="",ylab="",xaxt="n",yaxt="n",yaxs="i",bty="n"); + txtleg <- c(txtleg,"Psol" ); colleg <- c(colleg,"lightblue"); lwdleg <- c(lwdleg,lwdP/3); + par(new=TRUE); } + ##Plot_flows + plot(NULL,type="n",xlim=range(SeqX1),ylim=c(ylimQ[1],2*ylimQ[2]),xlab="",ylab="",xaxt="n",yaxt="n") + if(BOOL_Qobs){ lines(1:nrow(DataPlotQ),DataPlotQ$Qobs,lwd=lwdLine,lty=1,col="black" ); txtleg <- c(txtleg,"Qobs" ); colleg <- c(colleg,"black" ); lwdleg <- c(lwdleg,lwdLine); } + if(BOOL_Qsim){ lines(1:nrow(DataPlotQ),DataPlotQ$Qsim,lwd=lwdLine,lty=1,col="orangered"); txtleg <- c(txtleg,"Qsim"); colleg <- c(colleg,"orangered"); lwdleg <- c(lwdleg,lwdLine); } + ##Axis_and_legend + axis(side=1,at=SeqX1,tick=TRUE ,labels=xLabels1,cex.axis=cexaxis) + axis(side=1,at=SeqX2,tick=FALSE,labels=xLabels2,cex.axis=cexaxis) + axis(side=2,at=pretty(ylimQ),labels=pretty(ylimQ),cex.axis=cexaxis) + par(las=0); mtext(side=1,labX,line=lineX,cex=cexlab); par(las=0); + posleg <- "topright"; txtlab <- "flow regime"; + if(BOOL_Pobs){ posleg <- "right"; txtlab <- "precip. & flow regime"; } + par(las=0); mtext(side=2,paste(txtlab," ",plotunitregime,sep=""),line=lineY,cex=cexlab); par(las=0); + if(!is.null(BasinArea)){ + Factor <- Factor_MMM_M3S; + axis(side=4,at=pretty(ylimQ*Factor)/Factor,labels=pretty(ylimQ*Factor),cex.axis=cexaxis); + par(las=0); mtext(side=4,paste("flow ","m3/s",sep=""),line=lineY,cex=cexlab); par(las=0); } + ### posleg <- "topright"; if(BOOL_Pobs){ posleg <- "right"; } + ### legend(posleg,txtleg,col=colleg,lty=1,lwd=lwdleg,bty="o",bg=bgleg,box.col=bgleg,cex=cexleg) + box() + } + + + + ##Cumulative_frequency + if(BOOLPLOT_CumFreq){ + kPlot <- kPlot+1; mar <- c(6,5,1,5); + par(new=FALSE,mar=mar,las=0) + xlim <- c(0,1); + if(BOOL_Qobs & !BOOL_Qsim){ SelectNotZero <- SelectQobsNotZero; + ylim <- range(log(Qobs[IndPeriod_Plot][SelectNotZero]),na.rm=TRUE); } + if(BOOL_Qsim & !BOOL_Qobs){ SelectNotZero <- SelectQsimNotZero; + ylim <- range(log(OutputsModel$Qsim[IndPeriod_Plot][SelectNotZero]),na.rm=TRUE); } + if(BOOL_Qobs & BOOL_Qsim){ SelectNotZero <- SelectQobsNotZero & SelectQsimNotZero; + ylim <- range(log(c(Qobs[IndPeriod_Plot][SelectNotZero],OutputsModel$Qsim[IndPeriod_Plot][SelectNotZero])),na.rm=TRUE); } + seqDATA1 <- log(c(0.01,0.02,0.05,0.1,0.2,0.5,1,2,5,10,20,50,100,200,500,1000,2000,5000,10000)); seqDATA2 <- exp(seqDATA1); + plot(0,0,type="n",xlim=xlim,ylim=ylim,xaxt="n",yaxt="n",xlab="",ylab="",main=""); + ### abline(h=0,lty=2,col=grey(0.5)); + ### abline(h=1,lty=2,col=grey(0.5)); + axis(side=1,at=pretty(xlim),labels=pretty(xlim),cex.axis=cexaxis); + par(las=0); mtext(side=1,text="non-exceedance prob. [-]",line=lineY,cex=cexlab); par(las=0); + axis(side=2,at=seqDATA1,labels=seqDATA2,cex.axis=cexaxis); + par(las=0); mtext(side=2,text=paste("flow ",plotunit,"",sep=""),line=lineY,cex=cexlab); par(las=0); + txtleg <- NULL; colleg <- NULL; + if(BOOL_Qobs){ + DATA2 <- log(Qobs[IndPeriod_Plot][SelectNotZero]); + SeqQuant <- seq(0,1,by=1/(length(DATA2))); Quant <- as.numeric(quantile(DATA2,SeqQuant,na.rm=TRUE)); + Fn <- ecdf(DATA2); YY <- DATA2; YY <- YY[order( Fn(DATA2) )]; XX <- Fn(DATA2); XX <- XX[order( Fn(DATA2) )]; + lines(XX,YY,lwd=1,col="black"); + txtleg <- c(txtleg,"observed"); colleg <- c(colleg,"black"); } + if(BOOL_Qsim){ + DATA2 <- log(OutputsModel$Qsim[IndPeriod_Plot][SelectNotZero]); + SeqQuant <- seq(0,1,by=1/(length(DATA2))); Quant <- as.numeric(quantile(DATA2,SeqQuant,na.rm=TRUE)); + Fn <- ecdf(DATA2); YY <- DATA2; YY <- YY[order( Fn(DATA2) )]; XX <- Fn(DATA2); XX <- XX[order( Fn(DATA2) )]; + lines(XX,YY,lwd=1,col="orangered"); + txtleg <- c(txtleg,"simulated"); colleg <- c(colleg,"orangered"); } + if(!is.null(BasinArea)){ + Factor <- Factor_UNIT_M3S; + axis(side=4,at=seqDATA1,labels=round(seqDATA2*Factor),cex.axis=cexaxis); + par(las=0); mtext(side=4,paste("flow ","m3/s",sep=""),line=lineY,cex=cexlab); par(las=0); } + legend("topleft",txtleg,col=colleg,lty=1,lwd=lwdLine,bty="o",bg=bgleg,box.col=bgleg,cex=cexleg) + legend("bottomright","log scale",lty=1,col=NA,bty="o",bg=bgleg,box.col=bgleg,cex=cexleg) + box() + } + + + ##Correlation_QQ + if(BOOLPLOT_CorQQ){ + kPlot <- kPlot+1; mar <- c(6,5,1,5); + par(new=FALSE,mar=mar,las=0) + ylim <- log(range(c(Qobs[IndPeriod_Plot][SelectQobsNotZero & SelectQsimNotZero],OutputsModel$Qsim[IndPeriod_Plot][SelectQobsNotZero & SelectQsimNotZero]),na.rm=TRUE)); + plot(log(Qobs[IndPeriod_Plot][SelectQobsNotZero & SelectQsimNotZero]),log(OutputsModel$Qsim[IndPeriod_Plot][SelectQobsNotZero & SelectQsimNotZero]),type="p",pch=1,cex=0.9,col="black",xlim=ylim,ylim=ylim,xaxt="n",yaxt="n",xlab="",ylab="") + abline(a=0,b=1,col="royalblue"); + seqDATA1 <- log(c(0.01,0.02,0.05,0.1,0.2,0.5,1,2,5,10,20,50,100,200,500,1000,2000,5000,10000)); seqDATA2 <- exp(seqDATA1); + axis(side=1,at=seqDATA1,labels=seqDATA2,cex=cexaxis); + axis(side=2,at=seqDATA1,labels=seqDATA2,cex=cexaxis); + par(las=0); mtext(side=1,paste("observed flow ",plotunit,"",sep=""),line=lineX,cex=cexlab); par(las=0); + par(las=0); mtext(side=2,paste("simulated flow ",plotunit,"",sep=""),line=lineY,cex=cexlab); par(las=0); + if(!is.null(BasinArea)){ + Factor <- Factor_UNIT_M3S; + axis(side=4,at=seqDATA1,labels=round(seqDATA2*Factor),cex.axis=cexaxis); + par(las=0); mtext(side=4,paste("flow ","m3/s",sep=""),line=lineY,cex=cexlab); par(las=0); } + legend("bottomright","log scale",lty=1,col=NA,bty="o",bg=bgleg,box.col=bgleg,cex=cexleg) + box() + } + + ##Empty_plots + while(kPlot < iPlotMax){ + kPlot <- kPlot+1; + par(new=FALSE) + plot(0,0,type="n",xlab="",ylab="",axes=FALSE) + } + + ##Restoring_layout_options + layout(1); + + +} diff --git a/help/AnIndex b/help/AnIndex deleted file mode 100644 index 31263de41c3457081ce01b262b1a77946e006071..0000000000000000000000000000000000000000 --- a/help/AnIndex +++ /dev/null @@ -1,38 +0,0 @@ -airGR airGR -BasinInfo BasinInfo -BasinObs BasinObs -Calibration Calibration -Calibration_HBAN Calibration_HBAN -Calibration_optim Calibration_optim -CreateCalibOptions CreateCalibOptions -CreateInputsCrit CreateInputsCrit -CreateInputsModel CreateInputsModel -CreateRunOptions CreateRunOptions -DataAltiExtrapolation_HBAN DataAltiExtrapolation_HBAN -ErrorCrit ErrorCrit -ErrorCrit_KGE ErrorCrit_KGE -ErrorCrit_KGE2 ErrorCrit_KGE2 -ErrorCrit_NSE ErrorCrit_NSE -ErrorCrit_RMSE ErrorCrit_RMSE -PEdaily_Oudin PEdaily_Oudin -plot_OutputsModel plot_OutputsModel -RunModel RunModel -RunModel_CemaNeige RunModel_CemaNeige -RunModel_CemaNeigeGR4J RunModel_CemaNeigeGR4J -RunModel_CemaNeigeGR5J RunModel_CemaNeigeGR5J -RunModel_CemaNeigeGR6J RunModel_CemaNeigeGR6J -RunModel_GR1A RunModel_GR1A -RunModel_GR2M RunModel_GR2M -RunModel_GR4H RunModel_GR4H -RunModel_GR4J RunModel_GR4J -RunModel_GR5J RunModel_GR5J -RunModel_GR6J RunModel_GR6J -SeriesAggreg SeriesAggreg -TransfoParam TransfoParam -TransfoParam_CemaNeige TransfoParam_CemaNeige -TransfoParam_GR1A TransfoParam_GR1A -TransfoParam_GR2M TransfoParam_GR2M -TransfoParam_GR4H TransfoParam_GR4H -TransfoParam_GR4J TransfoParam_GR4J -TransfoParam_GR5J TransfoParam_GR5J -TransfoParam_GR6J TransfoParam_GR6J diff --git a/help/airGR.rdb b/help/airGR.rdb deleted file mode 100644 index 61b7631bebb3429ffcdc2149403d869e9f75b41b..0000000000000000000000000000000000000000 Binary files a/help/airGR.rdb and /dev/null differ diff --git a/help/airGR.rdx b/help/airGR.rdx deleted file mode 100644 index 5edb7f54b192f60f0510967be6c0205bbba041e4..0000000000000000000000000000000000000000 Binary files a/help/airGR.rdx and /dev/null differ diff --git a/help/aliases.rds b/help/aliases.rds deleted file mode 100644 index f331e2e75a852bcd5be18d044d41847e0a3ae4a1..0000000000000000000000000000000000000000 Binary files a/help/aliases.rds and /dev/null differ diff --git a/help/paths.rds b/help/paths.rds deleted file mode 100644 index 7c123f5efb9656c1b5dcbf1b3a8dd0475d62af52..0000000000000000000000000000000000000000 Binary files a/help/paths.rds and /dev/null differ diff --git a/html/00Index.html b/html/00Index.html deleted file mode 100644 index 4d72ca1ec0c10a44e80ee81e71211e9e69709372..0000000000000000000000000000000000000000 --- a/html/00Index.html +++ /dev/null @@ -1,101 +0,0 @@ -<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"> -<html><head><title>R: Modelling tools used at Irstea-HBAN (France), including GR4J and -CemaNeige</title> -<meta http-equiv="Content-Type" content="text/html; charset=utf-8"> -<link rel="stylesheet" type="text/css" href="R.css"> -</head><body> -<h1> Modelling tools used at Irstea-HBAN (France), including GR4J and -CemaNeige -<img class="toplogo" src="../../../doc/html/logo.jpg" alt="[R logo]"> -</h1> -<hr> -<div align="center"> -<a href="../../../doc/html/packages.html"><img src="../../../doc/html/left.jpg" alt="[Up]" width="30" height="30" border="0"></a> -<a href="../../../doc/html/index.html"><img src="../../../doc/html/up.jpg" alt="[Top]" width="30" height="30" border="0"></a> -</div><h2>Documentation for package ‘airGR’ version 0.8.1.0</h2> - -<ul><li><a href="../DESCRIPTION">DESCRIPTION file</a>.</li> -</ul> - -<h2>Help Pages</h2> - - -<table width="100%"> -<tr><td width="25%"><a href="airGR.html">airGR</a></td> -<td>Modelling tools used at Irstea-HBAN (France), including GR4J and CemaNeige</td></tr> -<tr><td width="25%"><a href="BasinInfo.html">BasinInfo</a></td> -<td>Data sample: characteristics of a fictional catchment (L0123001, L0123002 or L0123003)</td></tr> -<tr><td width="25%"><a href="BasinObs.html">BasinObs</a></td> -<td>Data sample: time series of observations of a fictional catchment (L0123001, L0123002 or L0123003)</td></tr> -<tr><td width="25%"><a href="Calibration.html">Calibration</a></td> -<td>Calibration algorithm which minimises an error criterion on the model outputs using the provided functions</td></tr> -<tr><td width="25%"><a href="Calibration_HBAN.html">Calibration_HBAN</a></td> -<td>Calibration algorithm which minimises the error criterion using the Irstea-HBAN procedure</td></tr> -<tr><td width="25%"><a href="Calibration_optim.html">Calibration_optim</a></td> -<td>Calibration algorithm which minimises the error criterion using the stats::optim function</td></tr> -<tr><td width="25%"><a href="CreateCalibOptions.html">CreateCalibOptions</a></td> -<td>Creation of the CalibOptions object required to the Calibration functions</td></tr> -<tr><td width="25%"><a href="CreateInputsCrit.html">CreateInputsCrit</a></td> -<td>Creation of the InputsCrit object required to the ErrorCrit functions</td></tr> -<tr><td width="25%"><a href="CreateInputsModel.html">CreateInputsModel</a></td> -<td>Creation of the InputsModel object required to the RunModel functions</td></tr> -<tr><td width="25%"><a href="CreateRunOptions.html">CreateRunOptions</a></td> -<td>Creation of the RunOptions object required to the RunModel functions</td></tr> -<tr><td width="25%"><a href="DataAltiExtrapolation_HBAN.html">DataAltiExtrapolation_HBAN</a></td> -<td>Altitudinal extrapolation of precipitation and temperature series</td></tr> -<tr><td width="25%"><a href="ErrorCrit.html">ErrorCrit</a></td> -<td>Error criterion using the provided function</td></tr> -<tr><td width="25%"><a href="ErrorCrit_KGE.html">ErrorCrit_KGE</a></td> -<td>Error criterion based on the KGE formula</td></tr> -<tr><td width="25%"><a href="ErrorCrit_KGE2.html">ErrorCrit_KGE2</a></td> -<td>Error criterion based on the KGE' formula</td></tr> -<tr><td width="25%"><a href="ErrorCrit_NSE.html">ErrorCrit_NSE</a></td> -<td>Error criterion based on the NSE formula</td></tr> -<tr><td width="25%"><a href="ErrorCrit_RMSE.html">ErrorCrit_RMSE</a></td> -<td>Error criterion based on the RMSE</td></tr> -<tr><td width="25%"><a href="PEdaily_Oudin.html">PEdaily_Oudin</a></td> -<td>Computation of daily series of potential evapotranspiration with Oudin's formula</td></tr> -<tr><td width="25%"><a href="plot_OutputsModel.html">plot_OutputsModel</a></td> -<td>Default preview of model outputs</td></tr> -<tr><td width="25%"><a href="RunModel.html">RunModel</a></td> -<td>Run with the provided hydrological model function</td></tr> -<tr><td width="25%"><a href="RunModel_CemaNeige.html">RunModel_CemaNeige</a></td> -<td>Run with the CemaNeige snow module</td></tr> -<tr><td width="25%"><a href="RunModel_CemaNeigeGR4J.html">RunModel_CemaNeigeGR4J</a></td> -<td>Run with the CemaNeigeGR4J hydrological model</td></tr> -<tr><td width="25%"><a href="RunModel_CemaNeigeGR5J.html">RunModel_CemaNeigeGR5J</a></td> -<td>Run with the CemaNeigeGR5J hydrological model</td></tr> -<tr><td width="25%"><a href="RunModel_CemaNeigeGR6J.html">RunModel_CemaNeigeGR6J</a></td> -<td>Run with the CemaNeigeGR6J hydrological model</td></tr> -<tr><td width="25%"><a href="RunModel_GR1A.html">RunModel_GR1A</a></td> -<td>Run with the GR1A hydrological model</td></tr> -<tr><td width="25%"><a href="RunModel_GR2M.html">RunModel_GR2M</a></td> -<td>Run with the GR2M hydrological model</td></tr> -<tr><td width="25%"><a href="RunModel_GR4H.html">RunModel_GR4H</a></td> -<td>Run with the GR4H hydrological model</td></tr> -<tr><td width="25%"><a href="RunModel_GR4J.html">RunModel_GR4J</a></td> -<td>Run with the GR4J hydrological model</td></tr> -<tr><td width="25%"><a href="RunModel_GR5J.html">RunModel_GR5J</a></td> -<td>Run with the GR5J hydrological model</td></tr> -<tr><td width="25%"><a href="RunModel_GR6J.html">RunModel_GR6J</a></td> -<td>Run with the GR6J hydrological model</td></tr> -<tr><td width="25%"><a href="SeriesAggreg.html">SeriesAggreg</a></td> -<td>Conversion of time series to another time-step (aggregation only)</td></tr> -<tr><td width="25%"><a href="TransfoParam.html">TransfoParam</a></td> -<td>Transformation of the parameters using the provided function</td></tr> -<tr><td width="25%"><a href="TransfoParam_CemaNeige.html">TransfoParam_CemaNeige</a></td> -<td>Transformation of the parameters from the CemaNeige module</td></tr> -<tr><td width="25%"><a href="TransfoParam_GR1A.html">TransfoParam_GR1A</a></td> -<td>Transformation of the parameters from the GR1A model</td></tr> -<tr><td width="25%"><a href="TransfoParam_GR2M.html">TransfoParam_GR2M</a></td> -<td>Transformation of the parameters from the GR2M model</td></tr> -<tr><td width="25%"><a href="TransfoParam_GR4H.html">TransfoParam_GR4H</a></td> -<td>Transformation of the parameters from the GR4H model</td></tr> -<tr><td width="25%"><a href="TransfoParam_GR4J.html">TransfoParam_GR4J</a></td> -<td>Transformation of the parameters from the GR4J model</td></tr> -<tr><td width="25%"><a href="TransfoParam_GR5J.html">TransfoParam_GR5J</a></td> -<td>Transformation of the parameters from the GR5J model</td></tr> -<tr><td width="25%"><a href="TransfoParam_GR6J.html">TransfoParam_GR6J</a></td> -<td>Transformation of the parameters from the GR6J model</td></tr> -</table> -</body></html> diff --git a/html/R.css b/html/R.css deleted file mode 100644 index 6f058f3dc2e565aa48e2ad640123d3d69c9c5945..0000000000000000000000000000000000000000 --- a/html/R.css +++ /dev/null @@ -1,57 +0,0 @@ -BODY{ background: white; - color: black } - -A:link{ background: white; - color: blue } -A:visited{ background: white; - color: rgb(50%, 0%, 50%) } - -H1{ background: white; - color: rgb(55%, 55%, 55%); - font-family: monospace; - font-size: x-large; - text-align: center } - -H2{ background: white; - color: rgb(40%, 40%, 40%); - font-family: monospace; - font-size: large; - text-align: center } - -H3{ background: white; - color: rgb(40%, 40%, 40%); - font-family: monospace; - font-size: large } - -H4{ background: white; - color: rgb(40%, 40%, 40%); - font-family: monospace; - font-style: italic; - font-size: large } - -H5{ background: white; - color: rgb(40%, 40%, 40%); - font-family: monospace } - -H6{ background: white; - color: rgb(40%, 40%, 40%); - font-family: monospace; - font-style: italic } - -IMG.toplogo{ vertical-align: middle } - -IMG.arrow{ width: 30px; - height: 30px; - border: 0 } - -span.acronym{font-size: small} -span.env{font-family: monospace} -span.file{font-family: monospace} -span.option{font-family: monospace} -span.pkg{font-weight: bold} -span.samp{font-family: monospace} - -div.vignettes a:hover { - background: rgb(85%, 85%, 85%); -} - diff --git a/libs/i386/airGR.dll b/libs/i386/airGR.dll deleted file mode 100644 index b8c3468b7e5e304fcf53d4c549f8f3b885f7fa6d..0000000000000000000000000000000000000000 Binary files a/libs/i386/airGR.dll and /dev/null differ diff --git a/libs/x64/airGR.dll b/libs/x64/airGR.dll deleted file mode 100644 index e85955fa7881f30e194ba7e8da54e3a3833d068c..0000000000000000000000000000000000000000 Binary files a/libs/x64/airGR.dll and /dev/null differ diff --git a/man/BasinInfo.Rd b/man/BasinInfo.Rd new file mode 100644 index 0000000000000000000000000000000000000000..b951d6124bd959e1f99711d95a7642031e051ed8 --- /dev/null +++ b/man/BasinInfo.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/BasinData.R +\docType{data} +\encoding{UTF-8} +\name{BasinInfo} +\alias{BasinInfo} +\title{Data sample: characteristics of a fictional catchment (L0123001, L0123002 or L0123003)} +\format{List named 'BasinInfo' containing +\itemize{ +\item two strings: catchment's code and station's name +\item one float: catchment's area in km2 +\item one numeric vector: catchment's hypsometric curve (min, quantiles 01 to 99 and max) in metres +}} +\description{ +R-object containing the code, station's name, area and hypsometric curve of the catchment. +} +\examples{ +require(airGR) + data(L0123001) + str(BasinInfo) +} + diff --git a/man/BasinObs.Rd b/man/BasinObs.Rd new file mode 100644 index 0000000000000000000000000000000000000000..d06a1ebf33125101451a1bbafee7282d45873302 --- /dev/null +++ b/man/BasinObs.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/BasinData.R +\docType{data} +\encoding{UTF-8} +\name{BasinObs} +\alias{BasinObs} +\title{Data sample: time series of observations of a fictional catchment (L0123001, L0123002 or L0123003)} +\format{Data frame named 'BasinObs' containing +\itemize{ +\item one POSIXlt vector: time series dates in the POSIXlt format +\item five numeric vectors: time series of catchment average precipitation [mm], catchment average air temperature [degC], catchment average potential evapotranspiration [mm], outlet discharge [l/s], outlet discharge [mm] +}} +\description{ +R-object containing the times series of precipitation, temperature, potential evapotranspiration and discharges. \cr +Times series for L0123001 or L0123002 are at the daily time-step for use with daily models such as GR4J, GR5J, GR6J, CemaNeigeGR4J, CemaNeigeGR5J and CemaNeigeGR6J. +Times series for L0123003 are at the hourly time-step for use with hourly models such as GR4H. +} +\examples{ +require(airGR) + data(L0123001) + str(BasinObs) +} + diff --git a/man/Calibration.Rd b/man/Calibration.Rd new file mode 100644 index 0000000000000000000000000000000000000000..f97a41fdfb1bdce83349d2c9fc40bc980a4a2f45 --- /dev/null +++ b/man/Calibration.Rd @@ -0,0 +1,96 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/Calibration.R +\encoding{UTF-8} +\name{Calibration} +\alias{Calibration} +\title{Calibration algorithm which minimises an error criterion on the model outputs using the provided functions} +\usage{ +Calibration(InputsModel, RunOptions, InputsCrit, CalibOptions, FUN_MOD, + FUN_CRIT, FUN_CALIB = Calibration_HBAN, FUN_TRANSFO = NULL, + quiet = FALSE) +} +\arguments{ +\item{InputsModel}{[object of class \emph{InputsModel}] see \code{\link{CreateInputsModel}} for details} + +\item{RunOptions}{[object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details} + +\item{InputsCrit}{[object of class \emph{InputsCrit}] see \code{\link{CreateInputsCrit}} for details} + +\item{CalibOptions}{[object of class \emph{CalibOptions}] see \code{\link{CreateCalibOptions}} for details} + +\item{FUN_MOD}{[function] hydrological model function (e.g. RunModel_GR4J, RunModel_CemaNeigeGR4J)} + +\item{FUN_CRIT}{[function] error criterion function (e.g. ErrorCrit_RMSE, ErrorCrit_NSE)} + +\item{FUN_CALIB}{(optional) [function] calibration algorithm function (e.g. Calibration_HBAN, Calibration_optim), default=Calibration_HBAN} + +\item{FUN_TRANSFO}{(optional) [function] model parameters transformation function, if the FUN_MOD used is native in the package FUN_TRANSFO is automatically defined} + +\item{quiet}{(optional) [boolean] boolean indicating if the function is run in quiet mode or not, default=FALSE} +} +\value{ +[list] see \code{\link{Calibration_HBAN}} or \code{\link{Calibration_optim}} +} +\description{ +Calibration algorithm which minimises the error criterion using the provided functions. \cr +} +\examples{ +## load of catchment data +require(airGR) +data(L0123001) + +## preparation of InputsModel object +InputsModel <- CreateInputsModel(FUN_MOD=RunModel_GR4J,DatesR=BasinObs$DatesR, + Precip=BasinObs$P,PotEvap=BasinObs$E) + +## calibration period selection +Ind_Run <- seq(which(format(BasinObs$DatesR,format="\%d/\%m/\%Y \%H:\%M")=="01/01/1990 00:00"), + which(format(BasinObs$DatesR,format="\%d/\%m/\%Y \%H:\%M")=="31/12/1999 00:00")) + +## preparation of RunOptions object +RunOptions <- CreateRunOptions(FUN_MOD=RunModel_GR4J,InputsModel=InputsModel,IndPeriod_Run=Ind_Run) + +## calibration criterion: preparation of the InputsCrit object +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) + +## preparation of CalibOptions object +CalibOptions <- CreateCalibOptions(FUN_MOD=RunModel_GR4J,FUN_CALIB=Calibration_HBAN) + +## calibration +OutputsCalib <- Calibration(InputsModel=InputsModel,RunOptions=RunOptions,InputsCrit=InputsCrit, + CalibOptions=CalibOptions,FUN_MOD=RunModel_GR4J,FUN_CRIT=ErrorCrit_NSE, + FUN_CALIB=Calibration_HBAN) + +## simulation +Param <- OutputsCalib$ParamFinalR +OutputsModel <- RunModel(InputsModel=InputsModel,RunOptions=RunOptions, + Param=Param,FUN=RunModel_GR4J) + +## results preview +plot_OutputsModel(OutputsModel=OutputsModel,Qobs=BasinObs$Qmm[Ind_Run]) + +## efficiency criterion: Nash-Sutcliffe Efficiency +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) +OutputsCrit <- ErrorCrit_NSE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\\n",sep="")) + +## efficiency criterion: Kling-Gupta Efficiency +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_KGE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) +OutputsCrit <- ErrorCrit_KGE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\\n",sep="")) + + +} +\author{ +Laurent Coron (June 2014) +} +\seealso{ +\code{\link{Calibration_HBAN}}, \code{\link{Calibration_optim}}, + \code{\link{RunModel}}, \code{\link{ErrorCrit}}, \code{\link{TransfoParam}}, + \code{\link{CreateInputsModel}}, \code{\link{CreateRunOptions}}, + \code{\link{CreateInputsCrit}}, \code{\link{CreateCalibOptions}}. +} + diff --git a/man/Calibration_HBAN.Rd b/man/Calibration_HBAN.Rd new file mode 100644 index 0000000000000000000000000000000000000000..26f14de42b18b8470feae14b6fdf10dc511f97f1 --- /dev/null +++ b/man/Calibration_HBAN.Rd @@ -0,0 +1,128 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/Calibration_HBAN.R +\encoding{UTF-8} +\name{Calibration_HBAN} +\alias{Calibration_HBAN} +\title{Calibration algorithm which minimises the error criterion using the Irstea-HBAN procedure} +\usage{ +Calibration_HBAN(InputsModel, RunOptions, InputsCrit, CalibOptions, FUN_MOD, + FUN_CRIT, FUN_TRANSFO = NULL, quiet = FALSE) +} +\arguments{ +\item{InputsModel}{[object of class \emph{InputsModel}] see \code{\link{CreateInputsModel}} for details} + +\item{RunOptions}{[object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details} + +\item{InputsCrit}{[object of class \emph{InputsCrit}] see \code{\link{CreateInputsCrit}} for details} + +\item{CalibOptions}{[object of class \emph{CalibOptions}] see \code{\link{CreateCalibOptions}} for details} + +\item{FUN_MOD}{[function] hydrological model function (e.g. RunModel_GR4J, RunModel_CemaNeigeGR4J)} + +\item{FUN_CRIT}{[function] error criterion function (e.g. ErrorCrit_RMSE, ErrorCrit_NSE)} + +\item{FUN_TRANSFO}{(optional) [function] model parameters transformation function, if the FUN_MOD used is native in the package FUN_TRANSFO is automatically defined} + +\item{quiet}{(optional) [boolean] boolean indicating if the function is run in quiet mode or not, default=FALSE} +} +\value{ +[list] list containing the function outputs organised as follows: + \tabular{ll}{ + \emph{$ParamFinalR } \tab [numeric] parameter set obtained at the end of the calibration \cr + \emph{$CritFinal } \tab [numeric] error criterion obtained at the end of the calibration \cr + \emph{$NIter } \tab [numeric] number of iterations during the calibration \cr + \emph{$NRuns } \tab [numeric] number of model runs done during the calibration \cr + \emph{$HistParamR } \tab [numeric] table showing the progression steps in the search for optimal set: parameter values \cr + \emph{$HistCrit } \tab [numeric] table showing the progression steps in the search for optimal set: criterion values \cr + \emph{$MatBoolCrit } \tab [boolean] table giving the requested and actual time steps when the model is calibrated \cr + \emph{$CritName } \tab [character] name of the calibration criterion \cr + \emph{$CritBestValue} \tab [numeric] theoretical best criterion value \cr + } +} +\description{ +Calibration algorithm which minimises the error criterion. \cr +\cr +The algorithm is based on a local search procedure. +First, a screening is performed using either a rough predefined grid or a list of parameter sets +and then a simple steepest descent local search algorithm is performed. +} +\details{ +A screening is first performed either from a rough predefined grid (considering various initial +values for each paramete) or from a list of initial parameter sets. \cr +The best set identified in this screening is then used as a starting point for the steepest +descent local search algorithm. \cr +For this search, the parameters are used in a transformed version, to obtain uniform +variation ranges (and thus a similar pace), while the true ranges might be quite different. \cr +At each iteration, we start from a parameter set of NParam values (NParam being the number of +free parameters of the chosen hydrological model) and we determine the 2*NParam-1 new candidates +by changing one by one the different parameters (+/- pace). \cr +All these candidates are tested and the best one kept to be the starting point for the next +iteration. At the end of each iteration, the pace is either increased or decreased to adapt +the progression speed. A diagonal progress can occasionally be done. \cr +The calibration algorithm stops when the pace becomes too small. \cr + +To optimise the exploration of the parameter space, transformation functions are used to convert +the model parameters. This is done using the TransfoParam functions. +} +\examples{ +## load of catchment data +require(airGR) +data(L0123001) + +## preparation of InputsModel object +InputsModel <- CreateInputsModel(FUN_MOD=RunModel_GR4J,DatesR=BasinObs$DatesR, + Precip=BasinObs$P,PotEvap=BasinObs$E) + +## calibration period selection +Ind_Run <- seq(which(format(BasinObs$DatesR,format="\%d/\%m/\%Y \%H:\%M")=="01/01/1990 00:00"), + which(format(BasinObs$DatesR,format="\%d/\%m/\%Y \%H:\%M")=="31/12/1999 00:00")) + +## preparation of RunOptions object +RunOptions <- CreateRunOptions(FUN_MOD=RunModel_GR4J,InputsModel=InputsModel,IndPeriod_Run=Ind_Run) + +## calibration criterion: preparation of the InputsCrit object +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) + +## preparation of CalibOptions object +CalibOptions <- CreateCalibOptions(FUN_MOD=RunModel_GR4J,FUN_CALIB=Calibration_HBAN) + +## calibration +OutputsCalib <- Calibration_HBAN(InputsModel=InputsModel,RunOptions=RunOptions, + InputsCrit=InputsCrit,CalibOptions=CalibOptions, + FUN_MOD=RunModel_GR4J,FUN_CRIT=ErrorCrit_NSE) + +## simulation +Param <- OutputsCalib$ParamFinalR +OutputsModel <- RunModel_GR4J(InputsModel=InputsModel,RunOptions=RunOptions,Param=Param) + +## results preview +plot_OutputsModel(OutputsModel=OutputsModel,Qobs=BasinObs$Qmm[Ind_Run]) + +## efficiency criterion: Nash-Sutcliffe Efficiency +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) +OutputsCrit <- ErrorCrit_NSE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\\n",sep="")) + +## efficiency criterion: Kling-Gupta Efficiency +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_KGE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) +OutputsCrit <- ErrorCrit_KGE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\\n",sep="")) + +} +\author{ +Laurent Coron (August 2013) +} +\references{ +Michel, C. (1991), + Hydrologie appliquée aux petits bassins ruraux, Hydrology handout (in French), Cemagref, Antony, France. +} +\seealso{ +\code{\link{Calibration}}, \code{\link{Calibration_optim}}, + \code{\link{RunModel_GR4J}}, \code{\link{TransfoParam_GR4J}}, \code{\link{ErrorCrit_RMSE}}, + \code{\link{CreateInputsModel}}, \code{\link{CreateRunOptions}}, + \code{\link{CreateInputsCrit}}, \code{\link{CreateCalibOptions}}. +} + diff --git a/man/Calibration_optim.Rd b/man/Calibration_optim.Rd new file mode 100644 index 0000000000000000000000000000000000000000..aed6de48f1e9221a83f2cb45787c38e345f86b70 --- /dev/null +++ b/man/Calibration_optim.Rd @@ -0,0 +1,104 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/Calibration_optim.R +\encoding{UTF-8} +\name{Calibration_optim} +\alias{Calibration_optim} +\title{Calibration algorithm which minimises the error criterion using the stats::optim function} +\usage{ +Calibration_optim(InputsModel, RunOptions, InputsCrit, CalibOptions, FUN_MOD, + FUN_CRIT, FUN_TRANSFO = NULL, quiet = FALSE) +} +\arguments{ +\item{InputsModel}{[object of class \emph{InputsModel}] see \code{\link{CreateInputsModel}} for details} + +\item{RunOptions}{[object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details} + +\item{InputsCrit}{[object of class \emph{InputsCrit}] see \code{\link{CreateInputsCrit}} for details} + +\item{CalibOptions}{[object of class \emph{CalibOptions}] see \code{\link{CreateCalibOptions}} for details} + +\item{FUN_MOD}{[function] hydrological model function (e.g. RunModel_GR4J, RunModel_CemaNeigeGR4J)} + +\item{FUN_CRIT}{[function] error criterion function (e.g. ErrorCrit_RMSE, ErrorCrit_NSE)} + +\item{FUN_TRANSFO}{(optional) [function] model parameters transformation function, if the FUN_MOD used is native in the package FUN_TRANSFO is automatically defined} + +\item{quiet}{(optional) [boolean] boolean indicating if the function is run in quiet mode or not, default=FALSE} +} +\value{ +[list] list containing the function outputs organised as follows: + \tabular{ll}{ + \emph{$ParamFinalR } \tab [numeric] parameter set obtained at the end of the calibration \cr + \emph{$CritFinal } \tab [numeric] error criterion obtained at the end of the calibration \cr + \emph{$Nruns } \tab [numeric] number of model runs done during the calibration \cr + \emph{$CritName } \tab [character] name of the calibration criterion \cr + \emph{$CritBestValue} \tab [numeric] theoretical best criterion value \cr + } +} +\description{ +Calibration algorithm which minimises the error criterion. \cr +\cr +The algorithm is based on the "optim" function from the "stats" R-package +(using method="L-BFGS-B", i.e. a local optimization quasi-Newton method). +} +\details{ +To optimise the exploration of the parameter space, transformation functions are used to convert +the model parameters. This is done using the TransfoParam functions. +} +\examples{ +## load of catchment data +require(airGR) +data(L0123001) + +## preparation of InputsModel object +InputsModel <- CreateInputsModel(FUN_MOD=RunModel_GR4J,DatesR=BasinObs$DatesR, + Precip=BasinObs$P,PotEvap=BasinObs$E) + +## calibration period selection +Ind_Run <- seq(which(format(BasinObs$DatesR,format="\%d/\%m/\%Y \%H:\%M")=="01/01/1990 00:00"), + which(format(BasinObs$DatesR,format="\%d/\%m/\%Y \%H:\%M")=="31/12/1999 00:00")) + +## preparation of RunOptions object +RunOptions <- CreateRunOptions(FUN_MOD=RunModel_GR4J,InputsModel=InputsModel,IndPeriod_Run=Ind_Run) + +## calibration criterion: preparation of the InputsCrit object +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) + +## preparation of CalibOptions object +CalibOptions <- CreateCalibOptions(FUN_MOD=RunModel_GR4J,FUN_CALIB=Calibration_optim) + +## calibration +OutputsCalib <- Calibration_optim(InputsModel=InputsModel,RunOptions=RunOptions, + InputsCrit=InputsCrit,CalibOptions=CalibOptions, + FUN_MOD=RunModel_GR4J,FUN_CRIT=ErrorCrit_NSE) + +## simulation +Param <- OutputsCalib$ParamFinalR +OutputsModel <- RunModel_GR4J(InputsModel=InputsModel,RunOptions=RunOptions,Param=Param) + +## results preview +plot_OutputsModel(OutputsModel=OutputsModel,Qobs=BasinObs$Qmm[Ind_Run]) + +## efficiency criterion: Nash-Sutcliffe Efficiency +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) +OutputsCrit <- ErrorCrit_NSE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\\n",sep="")) + +## efficiency criterion: Kling-Gupta Efficiency +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_KGE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) +OutputsCrit <- ErrorCrit_KGE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\\n",sep="")) +} +\author{ +Laurent Coron (August 2013) +} +\seealso{ +\code{\link{Calibration}}, \code{\link{Calibration_HBAN}}, + \code{\link{RunModel_GR4J}}, \code{\link{TransfoParam_GR4J}}, \code{\link{ErrorCrit_RMSE}}, + \code{\link{CreateInputsModel}}, \code{\link{CreateRunOptions}}, + \code{\link{CreateInputsCrit}}, \code{\link{CreateCalibOptions}}. +} + diff --git a/man/CreateCalibOptions.Rd b/man/CreateCalibOptions.Rd new file mode 100644 index 0000000000000000000000000000000000000000..6a0676b55af50b05509a0194da48c4ff708237c8 --- /dev/null +++ b/man/CreateCalibOptions.Rd @@ -0,0 +1,128 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/CreateCalibOptions.R +\encoding{UTF-8} +\name{CreateCalibOptions} +\alias{CreateCalibOptions} +\title{Creation of the CalibOptions object required to the Calibration functions} +\usage{ +CreateCalibOptions(FUN_MOD, FUN_CALIB = Calibration_HBAN, + FUN_TRANSFO = NULL, OptimParam = NULL, FixedParam = NULL, + SearchRanges = NULL, StartParam = NULL, StartParamList = NULL, + StartParamDistrib = NULL) +} +\arguments{ +\item{FUN_MOD}{[function] hydrological model function (e.g. RunModel_GR4J, RunModel_CemaNeigeGR4J)} + +\item{FUN_CALIB}{(optional) [function] calibration algorithm function (e.g. Calibration_HBAN, Calibration_optim), default=Calibration_HBAN} + +\item{FUN_TRANSFO}{(optional) [function] model parameters transformation function, if the FUN_MOD used is native in the package FUN_TRANSFO is automatically defined} + +\item{OptimParam}{(optional) [boolean] vector of booleans indicating which parameters must be optimised (NParam columns, 1 line)} + +\item{FixedParam}{(optional) [numeric] vector giving the values to allocate to non-optimised parameter values (NParam columns, 1 line)} + +\item{SearchRanges}{(optional) [numeric] matrix giving the ranges of real parameters (NParam columns, 2 lines) +\tabular{llllll}{ + \tab [X1] \tab [X2] \tab [X3] \tab [...] \tab [Xi] \cr + [1,] \tab 0 \tab -1 \tab 0 \tab ... \tab 0.0 \cr + [2,] \tab 3000 \tab +1 \tab 100 \tab ... \tab 3.0 \cr +}} + +\item{StartParam}{(optional) [numeric] vector of parameter values used to start global search calibration procedure (e.g. Calibration_optim) +\tabular{llllll}{ + \tab [X1] \tab [X2] \tab [X3] \tab [...] \tab [Xi] \cr + \tab 1000 \tab -0.5 \tab 22 \tab ... \tab 1.1 \cr +}} + +\item{StartParamList}{(optional) [numeric] matrix of parameter sets used for grid-screening calibration procedure (values in columns, sets in line) +\tabular{llllll}{ + \tab [X1] \tab [X2] \tab [X3] \tab [...] \tab [Xi] \cr + [set1] \tab 800 \tab -0.7 \tab 25 \tab ... \tab 1.0 \cr + [set2] \tab 1000 \tab -0.5 \tab 22 \tab ... \tab 1.1 \cr + [...] \tab ... \tab ... \tab ... \tab ... \tab ... \cr + [set n] \tab 200 \tab -0.3 \tab 17 \tab ... \tab 1.0 \cr +}} + +\item{StartParamDistrib}{(optional) [numeric] matrix of parameter values used for grid-screening calibration procedure (values in columns, percentiles in line) \cr +\tabular{llllll}{ + \tab [X1] \tab [X2] \tab [X3] \tab [...] \tab [Xi] \cr + [value1] \tab 800 \tab -0.7 \tab 25 \tab ... \tab 1.0 \cr + [value2] \tab 1000 \tab NA \tab 50 \tab ... \tab 1.2 \cr + [value3] \tab 1200 \tab NA \tab NA \tab ... \tab 1.6 \cr +}} +} +\value{ +[list] object of class \emph{CalibOptions} containing the data required to evaluate the model outputs; it can include the following: + \tabular{ll}{ + \emph{$OptimParam } \tab [boolean] vector of booleans indicating which parameters must be optimised \cr + \emph{$FixedParam } \tab [numeric] vector giving the values to allocate to non-optimised parameter values \cr + \emph{$SearchRanges } \tab [numeric] matrix giving the ranges of real parameters \cr + \emph{$StartParam } \tab [numeric] vector of parameter values used to start global search calibration procedure \cr + \emph{$StartParamList } \tab [numeric] matrix of parameter sets used for grid-screening calibration procedure \cr + \emph{$StartParamDistrib} \tab [numeric] matrix of parameter values used for grid-screening calibration procedure \cr + } +} +\description{ +Creation of the CalibOptions object required to the Calibration functions. +} +\details{ +Users wanting to use FUN_MOD, FUN_CALIB or FUN_TRANSFO functions that are not included in +the package must create their own CalibOptions object accordingly. +} +\examples{ +## load of catchment data +require(airGR) +data(L0123001) + +## preparation of InputsModel object +InputsModel <- CreateInputsModel(FUN_MOD=RunModel_GR4J,DatesR=BasinObs$DatesR, + Precip=BasinObs$P,PotEvap=BasinObs$E) + +## calibration period selection +Ind_Run <- seq(which(format(BasinObs$DatesR,format="\%d/\%m/\%Y \%H:\%M")=="01/01/1990 00:00"), + which(format(BasinObs$DatesR,format="\%d/\%m/\%Y \%H:\%M")=="31/12/1999 00:00")) + +## preparation of RunOptions object +RunOptions <- CreateRunOptions(FUN_MOD=RunModel_GR4J,InputsModel=InputsModel,IndPeriod_Run=Ind_Run) + +## calibration criterion: preparation of the InputsCrit object +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) + +## preparation of CalibOptions object +CalibOptions <- CreateCalibOptions(FUN_MOD=RunModel_GR4J,FUN_CALIB=Calibration_HBAN) + +## calibration +OutputsCalib <- Calibration(InputsModel=InputsModel,RunOptions=RunOptions,InputsCrit=InputsCrit, + CalibOptions=CalibOptions,FUN_MOD=RunModel_GR4J,FUN_CRIT=ErrorCrit_NSE, + FUN_CALIB=Calibration_HBAN) + +## simulation +Param <- OutputsCalib$ParamFinalR +OutputsModel <- RunModel(InputsModel=InputsModel,RunOptions=RunOptions, + Param=Param,FUN=RunModel_GR4J) + +## results preview +plot_OutputsModel(OutputsModel=OutputsModel,Qobs=BasinObs$Qmm[Ind_Run]) + +## efficiency criterion: Nash-Sutcliffe Efficiency +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) +OutputsCrit <- ErrorCrit_NSE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\\n",sep="")) + +## efficiency criterion: Kling-Gupta Efficiency +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_KGE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) +OutputsCrit <- ErrorCrit_KGE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\\n",sep="")) + + +} +\author{ +Laurent Coron (June 2014) +} +\seealso{ +\code{\link{Calibration}}, \code{\link{RunModel}} +} + diff --git a/man/CreateInputsCrit.Rd b/man/CreateInputsCrit.Rd new file mode 100644 index 0000000000000000000000000000000000000000..fd7176cc7908418cf67c1e97778480b2b0fdeffe --- /dev/null +++ b/man/CreateInputsCrit.Rd @@ -0,0 +1,114 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/CreateInputsCrit.R +\encoding{UTF-8} +\name{CreateInputsCrit} +\alias{CreateInputsCrit} +\title{Creation of the InputsCrit object required to the ErrorCrit functions} +\usage{ +CreateInputsCrit(FUN_CRIT, InputsModel, RunOptions, Qobs, BoolCrit = NULL, + transfo = "", Ind_zeroes = NULL, epsilon = NULL) +} +\arguments{ +\item{FUN_CRIT}{[function] error criterion function (e.g. ErrorCrit_RMSE, ErrorCrit_NSE)} + +\item{InputsModel}{[object of class \emph{InputsModel}] see \code{\link{CreateInputsModel}} for details} + +\item{RunOptions}{[object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details} + +\item{Qobs}{[numeric] series of observed discharges [mm]} + +\item{BoolCrit}{(optional) [boolean] boolean giving the time steps to consider in the computation (all time steps are consider by default)} + +\item{transfo}{(optional) [character] name of the transformation (e.g. "", "sqrt", "log", "inv", "sort")} + +\item{Ind_zeroes}{(optional) [numeric] indices of the time-steps where zeroes are observed} + +\item{epsilon}{(optional) [numeric] epsilon to add to all Qobs and Qsim if \emph{$Ind_zeroes} is not empty} +} +\value{ +[list] object of class \emph{InputsCrit} containing the data required to evaluate the model outputs; it can include the following: + \tabular{ll}{ + \emph{$BoolCrit } \tab [boolean] boolean giving the time steps to consider in the computation \cr + \emph{$Qobs } \tab [numeric] series of observed discharges [mm] \cr + \emph{$transfo } \tab [character] name of the transformation (e.g. "", "sqrt", "log", "inv", "sort") \cr + \emph{$Ind_zeroes} \tab [numeric] indices of the time-steps where zeroes are observed \cr + \emph{$epsilon } \tab [numeric] epsilon to add to all Qobs and Qsim if \emph{$Ind_zeroes} is not empty \cr + } +} +\description{ +Creation of the InputsCrit object required to the ErrorCrit functions. +} +\details{ +Users wanting to use FUN_CRIT functions that are not included in +the package must create their own InputsCrit object accordingly. +} +\examples{ +## load of catchment data +require(airGR) +data(L0123001) + +## preparation of the InputsModel object +InputsModel <- CreateInputsModel(FUN_MOD=RunModel_GR4J,DatesR=BasinObs$DatesR, + Precip=BasinObs$P,PotEvap=BasinObs$E) + +## run period selection +Ind_Run <- seq(which(format(BasinObs$DatesR,format="\%d/\%m/\%Y \%H:\%M")=="01/01/1990 00:00"), + which(format(BasinObs$DatesR,format="\%d/\%m/\%Y \%H:\%M")=="31/12/1999 00:00")) + +## preparation of the RunOptions object +RunOptions <- CreateRunOptions(FUN_MOD=RunModel_GR4J,InputsModel=InputsModel,IndPeriod_Run=Ind_Run) + +## simulation +Param <- c(734.568,-0.840,109.809,1.971) +OutputsModel <- RunModel(InputsModel=InputsModel,RunOptions=RunOptions, + Param=Param,FUN=RunModel_GR4J) + +## efficiency criterion: Nash-Sutcliffe Efficiency +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) +OutputsCrit <- ErrorCrit_NSE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\\n",sep="")) + +## efficiency criterion: Nash-Sutcliffe Efficiency on log-transformed flows +transfo <- "log" +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run],transfo=transfo) +OutputsCrit <- ErrorCrit_NSE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\\n",sep="")) + +## efficiency criterion: Nash-Sutcliffe Efficiency above a threshold (q75\%) +BoolCrit <- rep(TRUE,length(BasinObs$Qmm[Ind_Run])); +BoolCrit[BasinObs$Qmm[Ind_Run]<quantile(BasinObs$Qmm[Ind_Run],0.75,na.rm=TRUE)] <- FALSE; +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run],BoolCrit=BoolCrit) +OutputsCrit <- ErrorCrit_NSE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\\n",sep="")) + +## efficiency criterion: Kling-Gupta Efficiency +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_KGE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) +OutputsCrit <- ErrorCrit_KGE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\\n",sep="")) +cat(paste("SubCrit ",OutputsCrit$SubCritNames," ",round(OutputsCrit$SubCritValues,4),"\\n",sep="")) + +## efficiency criterion: Kling-Gupta Efficiency below a threshold (q10\%) on log-trqansformed flows +transfo <- "log" +BoolCrit <- rep(TRUE,length(BasinObs$Qmm[Ind_Run])); +BoolCrit[BasinObs$Qmm[Ind_Run]>quantile(BasinObs$Qmm[Ind_Run],0.10,na.rm=TRUE)] <- FALSE; +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_KGE,InputsModel=InputsModel,RunOptions=RunOptions, + Qobs=BasinObs$Qmm[Ind_Run],BoolCrit=BoolCrit,transfo=transfo) +OutputsCrit <- ErrorCrit_KGE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\\n",sep="")) +cat(paste("SubCrit ",OutputsCrit$SubCritNames," ",round(OutputsCrit$SubCritValues,4),"\\n",sep="")) + + + + +} +\author{ +Laurent Coron (June 2014) +} +\seealso{ +\code{\link{RunModel}}, \code{\link{CreateInputsModel}}, \code{\link{CreateRunOptions}}, \code{\link{CreateCalibOptions}} +} + diff --git a/man/CreateInputsModel.Rd b/man/CreateInputsModel.Rd new file mode 100644 index 0000000000000000000000000000000000000000..c741da3fac4a1bdcb9994832dc86c73bd06f13c4 --- /dev/null +++ b/man/CreateInputsModel.Rd @@ -0,0 +1,90 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/CreateInputsModel.R +\encoding{UTF-8} +\name{CreateInputsModel} +\alias{CreateInputsModel} +\title{Creation of the InputsModel object required to the RunModel functions} +\usage{ +CreateInputsModel(FUN_MOD, DatesR, Precip, PotEvap = NULL, TempMean = NULL, + TempMin = NULL, TempMax = NULL, ZInputs = NULL, HypsoData = NULL, + NLayers = 5, quiet = FALSE) +} +\arguments{ +\item{FUN_MOD}{[function] hydrological model function (e.g. RunModel_GR4J, RunModel_CemaNeigeGR4J)} + +\item{DatesR}{[POSIXlt] vector of dates required to create the GR model and CemaNeige module inputs} + +\item{Precip}{[numeric] time series of total precipitation (catchment average) [mm], required to create the GR model and CemaNeige module inputs} + +\item{PotEvap}{[numeric] time series of potential evapotranspiration (catchment average) [mm], required to create the GR model inputs} + +\item{TempMean}{(optional) [numeric] time series of mean air temperature [degC], required to create the CemaNeige module inputs} + +\item{TempMin}{(optional) [numeric] time series of min air temperature [degC], possibly used to create the CemaNeige module inputs} + +\item{TempMax}{(optional) [numeric] time series of max air temperature [degC], possibly used to create the CemaNeige module inputs} + +\item{ZInputs}{(optional) [numeric] real giving the mean elevation of the Precip and Temp series (before extrapolation) [m]} + +\item{HypsoData}{(optional) [numeric] vector of 101 reals: min, q01 to q99 and max of catchment elevation distribution [m], required to create the GR model inputs, if not defined a single elevation is used for CemaNeige} + +\item{NLayers}{(optional) [numeric] integer giving the number of elevation layers requested [-], required to create the GR model inputs, default=5} + +\item{quiet}{(optional) [boolean] boolean indicating if the function is run in quiet mode or not, default=FALSE} +} +\value{ +[list] object of class \emph{InputsModel} containing the data required to evaluate the model outputs; it can include the following: + \tabular{ll}{ + \emph{$DatesR } \tab [POSIXlt] vector of dates \cr + \emph{$Precip } \tab [numeric] time series of total precipitation (catchment average) [mm] \cr + \emph{$PotEvap } \tab [numeric] time series of potential evapotranspiration (catchment average) [mm], \cr\tab defined if FUN_MOD includes GR4H, GR4J, GR5J, GR6J, GR2M or GR1A \cr \cr + \emph{$LayerPrecip } \tab [list] list of time series of precipitation (layer average) [mm], \cr\tab defined if FUN_MOD includes CemaNeige \cr \cr + \emph{$LayerTempMean } \tab [list] list of time series of mean air temperature (layer average) [degC], \cr\tab defined if FUN_MOD includes CemaNeige \cr \cr + \emph{$LayerFracSolidPrecip} \tab [list] list of time series of solid precip. fract. (layer average) [-], \cr\tab defined if FUN_MOD includes CemaNeige \cr \cr + } +} +\description{ +Creation of the InputsModel object required to the RunModel functions. +} +\details{ +Users wanting to use FUN_MOD functions that are not included in +the package must create their own InputsModel object accordingly. +} +\examples{ +## load of catchment data +require(airGR) +data(L0123001) + +## preparation of the InputsModel object +InputsModel <- CreateInputsModel(FUN_MOD=RunModel_GR4J,DatesR=BasinObs$DatesR, + Precip=BasinObs$P,PotEvap=BasinObs$E) + +## run period selection +Ind_Run <- seq(which(format(BasinObs$DatesR,format="\%d/\%m/\%Y \%H:\%M")=="01/01/1990 00:00"), + which(format(BasinObs$DatesR,format="\%d/\%m/\%Y \%H:\%M")=="31/12/1999 00:00")) + +## preparation of the RunOptions object +RunOptions <- CreateRunOptions(FUN_MOD=RunModel_GR4J,InputsModel=InputsModel,IndPeriod_Run=Ind_Run) + +## simulation +Param <- c(734.568,-0.840,109.809,1.971) +OutputsModel <- RunModel(InputsModel=InputsModel,RunOptions=RunOptions,Param=Param, + FUN_MOD=RunModel_GR4J) + +## results preview +plot_OutputsModel(OutputsModel=OutputsModel,Qobs=BasinObs$Qmm[Ind_Run]) + +## efficiency criterion: Nash-Sutcliffe Efficiency +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) +OutputsCrit <- ErrorCrit_NSE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\\n",sep="")) + +} +\author{ +Laurent Coron (June 2014) +} +\seealso{ +\code{\link{RunModel}}, \code{\link{CreateRunOptions}}, \code{\link{CreateInputsCrit}}, \code{\link{CreateCalibOptions}}, \code{\link{DataAltiExtrapolation_HBAN}} +} + diff --git a/man/CreateRunOptions.Rd b/man/CreateRunOptions.Rd new file mode 100644 index 0000000000000000000000000000000000000000..3ab14bc59d355d91e1203c214a37ea79a5e391ed --- /dev/null +++ b/man/CreateRunOptions.Rd @@ -0,0 +1,122 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/CreateRunOptions.R +\encoding{UTF-8} +\name{CreateRunOptions} +\alias{CreateRunOptions} +\title{Creation of the RunOptions object required to the RunModel functions} +\usage{ +CreateRunOptions(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndPeriod_Run, + IniStates = NULL, IniResLevels = NULL, Outputs_Cal = NULL, + Outputs_Sim = "all", RunSnowModule = TRUE, MeanAnSolidPrecip = NULL, + quiet = FALSE) +} +\arguments{ +\item{FUN_MOD}{[function] hydrological model function (e.g. RunModel_GR4J, RunModel_CemaNeigeGR4J)} + +\item{InputsModel}{[object of class \emph{InputsModel}] see \code{\link{CreateInputsModel}} for details} + +\item{IndPeriod_WarmUp}{(optional) [numeric] index of period to be used for the model warm-up [-]} + +\item{IndPeriod_Run}{[numeric] index of period to be used for the model run [-]} + +\item{IniStates}{(optional) [numeric] vector of initial model states [mm]} + +\item{IniResLevels}{(optional) [numeric] vector of initial filling rates for production and routing stores (2 values between 0 and 1) [-]} + +\item{Outputs_Cal}{(optional) [character] vector giving the outputs needed for the calibration \cr (e.g. c("Qsim")), the least outputs the fastest the calibration} + +\item{Outputs_Sim}{(optional) [character] vector giving the requested outputs \cr (e.g. c("DatesR","Qsim","SnowPack")), default="all"} + +\item{RunSnowModule}{(optional) [boolean] option indicating whether CemaNeige should be activated, default=TRUE} + +\item{MeanAnSolidPrecip}{(optional) [numeric] vector giving the annual mean of average solid precipitation for each layer (computed from InputsModel if not defined) [mm/y]} + +\item{quiet}{(optional) [boolean] boolean indicating if the function is run in quiet mode or not, default=FALSE} +} +\value{ +[list] object of class \emph{RunOptions} containing the data required to evaluate the model outputs; it can include the following: + \tabular{ll}{ + \emph{IndPeriod_WarmUp } \tab [numeric] index of period to be used for the model warm-up [-] \cr + \emph{IndPeriod_Run } \tab [numeric] index of period to be used for the model run [-] \cr + \emph{IniStates } \tab [numeric] vector of initial model states [mm] \cr + \emph{IniResLevels } \tab [numeric] vector of initial filling rates for production and routing stores [-] \cr + \emph{Outputs_Cal } \tab [character] character vector giving only the outputs needed for the calibration \cr + \emph{Outputs_Sim } \tab [character] character vector giving the requested outputs \cr + \emph{RunSnowModule } \tab [boolean] option indicating whether CemaNeige should be activated \cr + \emph{MeanAnSolidPrecip} \tab [numeric] vector giving the annual mean of average solid precipitation for each layer [mm/y] \cr + } +} +\description{ +Creation of the RunOptions object required to the RunModel functions. +} +\details{ +Users wanting to use FUN_MOD functions that are not included in +the package must create their own RunOptions object accordingly. + +##### Initialisation options ##### + +The model initialisation options can either be set to a default configuration or be defined by the user. + +This is done via three vectors: \cr \emph{IndPeriod_WarmUp}, \emph{IniStates}, \emph{IniResLevels}. \cr +A default configuration is used for initialisation if these vectors are not defined. + +(1) Default initialisation options: + +\itemize{ +\item \emph{IndPeriod_WarmUp} default setting ensures a one-year warm-up using the time-steps preceding the \emph{IndPeriod_Run}. +The actual length of this warm-up might be shorter depending on data availability (no missing value being allowed on model input series). + +\item \emph{IniStates} and \emph{IniResLevels} are automatically set to initialise all the model states at 0, except for the production and routing stores which are initialised at 50\% of their capacity. This initialisation is made at the very beginning of the model call (i.e. at the beginning of \emph{IndPeriod_WarmUp} or at the beginning of IndPeriod_Run if the warm-up period is disabled). +} + +(2) Customisation of initialisation options: + +\itemize{ +\item \emph{IndPeriod_WarmUp} can be used to specify the indices of the warm-up period (within the time-series prepared in InputsModel). \cr +- remark 1: for most common cases, indices corresponding to one or several years preceding \emph{IndPeriod_Run} are used (e.g. \emph{IndPeriod_WarmUp <- 1000:1365} and \emph{IndPeriod_Run <- 1366:5000)}. \cr +However, it is also possible to perform a long-term initialisation if other indices than the warm-up ones are set in \emph{IndPeriod_WarmUp} (e.g. \emph{IndPeriod_WarmUp <- c( 1:5000 , 1:5000 , 1:5000 ,1000:1365 )}). \cr +- remark 2: it is also possible to completely disable the warm-up period when using \emph{IndPeriod_WarmUp <- 0}. + +\item \emph{IniStates} and \emph{IniResLevels} can be used to specify the initial model states. \cr +- remark 1: if \emph{IniStates} is used, all model states must be provided (e.g. 60 floats [mm] are required for GR4J, GR5J and GR6J; 60+2*NLayers floats [mm] are required for CemaNeigeGR4J, CemaNeigeGR5J and CemaNeigeGR6J; see fortran source code for details). \cr +- remark 2: in addition to \emph{IniStates}, \emph{IniResLevels} allows to set the filling rate of the production and routing stores for the GR models. For instance for GR4J, GR5J and GR6J: \emph{IniResLevels <- c(0.3,0.5)} should be used to obtain initial fillings of 30\% and 50\% for the production and routing stores, respectively. \emph{IniResLevels} is optional and can only be used if \emph{IniStates} is also defined (the state values corresponding to these two stores in \emph{IniStates} are not used in such case). \cr \cr +} +} +\examples{ +## load of catchment data +require(airGR) +data(L0123001) + +## preparation of the InputsModel object +InputsModel <- CreateInputsModel(FUN_MOD=RunModel_GR4J,DatesR=BasinObs$DatesR, + Precip=BasinObs$P,PotEvap=BasinObs$E) + +## run period selection +Ind_Run <- seq(which(format(BasinObs$DatesR,format="\%d/\%m/\%Y \%H:\%M")=="01/01/1990 00:00"), + which(format(BasinObs$DatesR,format="\%d/\%m/\%Y \%H:\%M")=="31/12/1999 00:00")) + +## preparation of the RunOptions object +RunOptions <- CreateRunOptions(FUN_MOD=RunModel_GR4J,InputsModel=InputsModel,IndPeriod_Run=Ind_Run) + +## simulation +Param <- c(734.568,-0.840,109.809,1.971) +OutputsModel <- RunModel(InputsModel=InputsModel,RunOptions=RunOptions,Param=Param, + FUN_MOD=RunModel_GR4J) + +## results preview +plot_OutputsModel(OutputsModel=OutputsModel,Qobs=BasinObs$Qmm[Ind_Run]) + +## efficiency criterion: Nash-Sutcliffe Efficiency +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) +OutputsCrit <- ErrorCrit_NSE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\\n",sep="")) + +} +\author{ +Laurent Coron (June 2014) +} +\seealso{ +\code{\link{RunModel}}, \code{\link{CreateInputsModel}}, \code{\link{CreateInputsCrit}}, \code{\link{CreateCalibOptions}} +} + diff --git a/man/DataAltiExtrapolation_HBAN.Rd b/man/DataAltiExtrapolation_HBAN.Rd new file mode 100644 index 0000000000000000000000000000000000000000..e2ad3cc39f58bbe43b0c262805ad77affec206db --- /dev/null +++ b/man/DataAltiExtrapolation_HBAN.Rd @@ -0,0 +1,65 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/DataAltiExtrapolation_HBAN.R +\encoding{UTF-8} +\name{DataAltiExtrapolation_HBAN} +\alias{DataAltiExtrapolation_HBAN} +\title{Altitudinal extrapolation of precipitation and temperature series} +\usage{ +DataAltiExtrapolation_HBAN(DatesR, Precip, TempMean, TempMin = NULL, + TempMax = NULL, ZInputs, HypsoData, NLayers, quiet = FALSE) +} +\arguments{ +\item{DatesR}{[POSIXlt] vector of dates} + +\item{Precip}{[numeric] time series of daily total precipitation (catchment average) [mm]} + +\item{TempMean}{[numeric] time series of daily mean air temperature [degC]} + +\item{TempMin}{(optional) [numeric] time series of daily min air temperature [degC]} + +\item{TempMax}{(optional) [numeric] time series of daily max air temperature [degC]} + +\item{ZInputs}{[numeric] real giving the mean elevation of the Precip and Temp series (before extrapolation) [m]} + +\item{HypsoData}{[numeric] vector of 101 reals: min, q01 to q99 and max of catchment elevation distribution [m]} + +\item{NLayers}{[numeric] integer giving the number of elevation layers requested [-]} + +\item{quiet}{(optional) [boolean] boolean indicating if the function is run in quiet mode or not, default=FALSE} +} +\value{ +list containing the extrapolated series of precip. and air temp. on each elevation layer + \tabular{ll}{ + \emph{$LayerPrecip } \tab [list] list of time series of daily precipitation (layer average) [mm] \cr + \emph{$LayerTempMean } \tab [list] list of time series of daily mean air temperature (layer average) [degC] \cr + \emph{$LayerTempMin } \tab [list] list of time series of daily min air temperature (layer average) [degC] \cr + \emph{$LayerTempMax } \tab [list] list of time series of daily max air temperature (layer average) [degC] \cr + \emph{$LayerFracSolidPrecip} \tab [list] list of time series of daily solid precip. fract. (layer average) [-] \cr + \emph{$ZLayers } \tab [numeric] vector of median elevation for each layer \cr + } +} +\description{ +Function which extrapolates the precipitation and air temperature series for different elevation layers (method from Valery, 2010). +} +\details{ +Elevation layers of equal surface are created the 101 elevation quantiles (\emph{HypsoData}) +and the number requested elevation layers (\emph{NLayers}). \cr +Forcing data (precipitation and air temperature) are extrapolated using gradients from Valery (2010). +(e.g. gradP=0.0004 [m-1] for France and gradT=0.434 [degreC/100m] for January, 1st). \cr +This function is used by the \emph{CreateInputsModel} function. \cr +} +\author{ +Laurent Coron, Pierre Brigode (June 2014) +} +\references{ +Turcotte, R., L.-G. Fortin, V. Fortin, J.-P. Fortin and J.-P. Villeneuve (2007), + Operational analysis of the spatial distribution and the temporal evolution of the snowpack water equivalent + in southern Quebec, Canada, Nordic Hydrology, 38(3), 211, doi:10.2166/nh.2007.009. \cr + Valéry, A. (2010), Modélisation précipitations-débit sous influence nivale ? : Elaboration d'un module neige + et évaluation sur 380 bassins versants, PhD thesis (in french), AgroParisTech, Paris, France. \cr + USACE (1956), Snow Hydrology, pp. 437, U.S. Army Coprs of Engineers (USACE) North Pacific Division, Portland, Oregon, USA. +} +\seealso{ +\code{\link{CreateInputsModel}}, \code{\link{RunModel_CemaNeigeGR4J}} +} + diff --git a/man/ErrorCrit.Rd b/man/ErrorCrit.Rd new file mode 100644 index 0000000000000000000000000000000000000000..3a09b9d048accea0b91000e66b5e55b05488d843 --- /dev/null +++ b/man/ErrorCrit.Rd @@ -0,0 +1,94 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/ErrorCrit.R +\encoding{UTF-8} +\name{ErrorCrit} +\alias{ErrorCrit} +\title{Error criterion using the provided function} +\usage{ +ErrorCrit(InputsCrit, OutputsModel, FUN_CRIT, quiet = FALSE) +} +\arguments{ +\item{InputsCrit}{[object of class \emph{InputsCrit}] see \code{\link{CreateInputsCrit}} for details} + +\item{OutputsModel}{[object of class \emph{OutputsModel}] see \code{\link{RunModel_GR4J}} or \code{\link{RunModel_CemaNeigeGR4J}} for details} + +\item{FUN_CRIT}{[function] error criterion function (e.g. ErrorCrit_RMSE, ErrorCrit_NSE)} + +\item{quiet}{(optional) [boolean] boolean indicating if the function is run in quiet mode or not, default=FALSE} +} +\value{ +[list] list containing the function outputs, see \code{\link{ErrorCrit_RMSE}} or \code{\link{ErrorCrit_NSE}} for details +} +\description{ +Function which computes an error criterion with the provided function. +} +\examples{ +## load of catchment data +require(airGR) +data(L0123001) + +## preparation of the InputsModel object +InputsModel <- CreateInputsModel(FUN_MOD=RunModel_GR4J,DatesR=BasinObs$DatesR, + Precip=BasinObs$P,PotEvap=BasinObs$E) + +## run period selection +Ind_Run <- seq(which(format(BasinObs$DatesR,format="\%d/\%m/\%Y \%H:\%M")=="01/01/1990 00:00"), + which(format(BasinObs$DatesR,format="\%d/\%m/\%Y \%H:\%M")=="31/12/1999 00:00")) + +## preparation of the RunOptions object +RunOptions <- CreateRunOptions(FUN_MOD=RunModel_GR4J,InputsModel=InputsModel,IndPeriod_Run=Ind_Run) + +## simulation +Param <- c(734.568,-0.840,109.809,1.971) +OutputsModel <- RunModel(InputsModel=InputsModel,RunOptions=RunOptions, + Param=Param,FUN=RunModel_GR4J) + +## efficiency criterion: Nash-Sutcliffe Efficiency +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) +OutputsCrit <- ErrorCrit_NSE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\\n",sep="")) + +## efficiency criterion: Nash-Sutcliffe Efficiency on log-transformed flows +transfo <- "log" +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run],transfo=transfo) +OutputsCrit <- ErrorCrit_NSE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\\n",sep="")) + +## efficiency criterion: Nash-Sutcliffe Efficiency above a threshold (q75\%) +BoolCrit <- rep(TRUE,length(BasinObs$Qmm[Ind_Run])); +BoolCrit[BasinObs$Qmm[Ind_Run]<quantile(BasinObs$Qmm[Ind_Run],0.75,na.rm=TRUE)] <- FALSE; +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run],BoolCrit=BoolCrit) +OutputsCrit <- ErrorCrit_NSE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\\n",sep="")) + +## efficiency criterion: Kling-Gupta Efficiency +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_KGE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) +OutputsCrit <- ErrorCrit_KGE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\\n",sep="")) +cat(paste("SubCrit ",OutputsCrit$SubCritNames," ",round(OutputsCrit$SubCritValues,4),"\\n",sep="")) + +## efficiency criterion: Kling-Gupta Efficiency below a threshold (q10\%) on log-trqansformed flows +transfo <- "log" +BoolCrit <- rep(TRUE,length(BasinObs$Qmm[Ind_Run])); +BoolCrit[BasinObs$Qmm[Ind_Run]>quantile(BasinObs$Qmm[Ind_Run],0.10,na.rm=TRUE)] <- FALSE; +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_KGE,InputsModel=InputsModel,RunOptions=RunOptions, + Qobs=BasinObs$Qmm[Ind_Run],BoolCrit=BoolCrit,transfo=transfo) +OutputsCrit <- ErrorCrit_KGE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\\n",sep="")) +cat(paste("SubCrit ",OutputsCrit$SubCritNames," ",round(OutputsCrit$SubCritValues,4),"\\n",sep="")) + + + + +} +\author{ +Laurent Coron (June 2014) +} +\seealso{ +\code{\link{ErrorCrit_RMSE}}, \code{\link{ErrorCrit_NSE}}, \code{\link{ErrorCrit_KGE}} +} + diff --git a/man/ErrorCrit_KGE.Rd b/man/ErrorCrit_KGE.Rd new file mode 100644 index 0000000000000000000000000000000000000000..31574db44a6bd4f8f0bb227c46f150d57ffc4ac8 --- /dev/null +++ b/man/ErrorCrit_KGE.Rd @@ -0,0 +1,51 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/ErrorCrit_KGE.R +\encoding{UTF-8} +\name{ErrorCrit_KGE} +\alias{ErrorCrit_KGE} +\title{Error criterion based on the KGE formula} +\usage{ +ErrorCrit_KGE(InputsCrit, OutputsModel, quiet = FALSE) +} +\arguments{ +\item{InputsCrit}{[object of class \emph{InputsCrit}] see \code{\link{CreateInputsCrit}} for details} + +\item{OutputsModel}{[object of class \emph{OutputsModel}] see \code{\link{RunModel_GR4J}} or \code{\link{RunModel_CemaNeigeGR4J}} for details} + +\item{quiet}{(optional) [boolean] boolean indicating if the function is run in quiet mode or not, default=FALSE} +} +\value{ +[list] list containing the function outputs organised as follows: + \tabular{ll}{ + \emph{$CritValue } \tab [numeric] value of the criterion \cr + \emph{$CritName } \tab [character] name of the criterion \cr + \emph{$SubCritValues } \tab [numeric] values of the sub-criteria \cr + \emph{$SubCritNames } \tab [character] names of the sub-criteria \cr + \emph{$CritBestValue } \tab [numeric] theoretical best criterion value \cr + \emph{$Multiplier } \tab [numeric] integer indicating whether the criterion is indeed an error (+1) or an efficiency (-1) \cr + \emph{$Ind_notcomputed} \tab [numeric] indices of the time-steps where InputsCrit$BoolCrit=FALSE or no data is available \cr + } +} +\description{ +Function which computes an error criterion based on the KGE formula proposed by Gupta et al. (2009). +} +\details{ +In addition to the criterion value, the function outputs include a multiplier (-1 or +1) which allows +the use of the function for model calibration: the product CritValue*Multiplier is the criterion to be minimised +(e.g. Multiplier=+1 for RMSE, Multiplier=-1 for NSE). +} +\examples{ +## see example of the ErrorCrit function +} +\author{ +Laurent Coron (June 2014) +} +\references{ +Gupta, H. V., Kling, H., Yilmaz, K. K. and Martinez, G. F. (2009), + Decomposition of the mean squared error and NSE performance criteria: Implications + for improving hydrological modelling, Journal of Hydrology, 377(1-2), 80-91, doi:10.1016/j.jhydrol.2009.08.003. \cr +} +\seealso{ +\code{\link{ErrorCrit_RMSE}}, \code{\link{ErrorCrit_NSE}}, \code{\link{ErrorCrit_KGE2}} +} + diff --git a/man/ErrorCrit_KGE2.Rd b/man/ErrorCrit_KGE2.Rd new file mode 100644 index 0000000000000000000000000000000000000000..58369b76e9dc1e6bdb720cdfe69f3818aa53ba86 --- /dev/null +++ b/man/ErrorCrit_KGE2.Rd @@ -0,0 +1,54 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/ErrorCrit_KGE2.R +\encoding{UTF-8} +\name{ErrorCrit_KGE2} +\alias{ErrorCrit_KGE2} +\title{Error criterion based on the KGE' formula} +\usage{ +ErrorCrit_KGE2(InputsCrit, OutputsModel, quiet = FALSE) +} +\arguments{ +\item{InputsCrit}{[object of class \emph{InputsCrit}] see \code{\link{CreateInputsCrit}} for details} + +\item{OutputsModel}{[object of class \emph{OutputsModel}] see \code{\link{RunModel_GR4J}} or \code{\link{RunModel_CemaNeigeGR4J}} for details} + +\item{quiet}{(optional) [boolean] boolean indicating if the function is run in quiet mode or not, default=FALSE} +} +\value{ +[list] list containing the function outputs organised as follows: + \tabular{ll}{ + \emph{$CritValue } \tab [numeric] value of the criterion \cr + \emph{$CritName } \tab [character] name of the criterion \cr + \emph{$SubCritValues } \tab [numeric] values of the sub-criteria \cr + \emph{$SubCritNames } \tab [character] names of the sub-criteria \cr + \emph{$CritBestValue } \tab [numeric] theoretical best criterion value \cr + \emph{$Multiplier } \tab [numeric] integer indicating whether the criterion is indeed an error (+1) or an efficiency (-1) \cr + \emph{$Ind_notcomputed} \tab [numeric] indices of the time-steps where InputsCrit$BoolCrit=FALSE or no data is available \cr + } +} +\description{ +Function which computes an error criterion based on the KGE' formula proposed by Kling et al. (2012). +} +\details{ +In addition to the criterion value, the function outputs include a multiplier (-1 or +1) which allows +the use of the function for model calibration: the product CritValue*Multiplier is the criterion to be minimised +(e.g. Multiplier=+1 for RMSE, Multiplier=-1 for NSE). +} +\examples{ +## see example of the ErrorCrit function +} +\author{ +Laurent Coron (June 2014) +} +\references{ +Gupta, H. V., Kling, H., Yilmaz, K. K. and Martinez, G. F. (2009), + Decomposition of the mean squared error and NSE performance criteria: Implications + for improving hydrological modelling, Journal of Hydrology, 377(1-2), 80-91, doi:10.1016/j.jhydrol.2009.08.003. \cr + Kling, H., Fuchs, M. and Paulin, M. (2012), + Runoff conditions in the upper Danube basin under an ensemble of climate change scenarios, + Journal of Hydrology, 424-425, 264-277, doi:10.1016/j.jhydrol.2012.01.011. +} +\seealso{ +\code{\link{ErrorCrit_RMSE}}, \code{\link{ErrorCrit_NSE}}, \code{\link{ErrorCrit_KGE}} +} + diff --git a/man/ErrorCrit_NSE.Rd b/man/ErrorCrit_NSE.Rd new file mode 100644 index 0000000000000000000000000000000000000000..29c27b8e631990b348555e7ae96c6583df1142b7 --- /dev/null +++ b/man/ErrorCrit_NSE.Rd @@ -0,0 +1,49 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/ErrorCrit_NSE.R +\encoding{UTF-8} +\name{ErrorCrit_NSE} +\alias{ErrorCrit_NSE} +\title{Error criterion based on the NSE formula} +\usage{ +ErrorCrit_NSE(InputsCrit, OutputsModel, quiet = FALSE) +} +\arguments{ +\item{InputsCrit}{[object of class \emph{InputsCrit}] see \code{\link{CreateInputsCrit}} for details} + +\item{OutputsModel}{[object of class \emph{OutputsModel}] see \code{\link{RunModel_GR4J}} or \code{\link{RunModel_CemaNeigeGR4J}} for details} + +\item{quiet}{(optional) [boolean] boolean indicating if the function is run in quiet mode or not, default=FALSE} +} +\value{ +[list] list containing the function outputs organised as follows: + \tabular{ll}{ + \emph{$CritValue } \tab [numeric] value of the criterion \cr + \emph{$CritName } \tab [character] name of the criterion \cr + \emph{$CritBestValue } \tab [numeric] theoretical best criterion value \cr + \emph{$Multiplier } \tab [numeric] integer indicating whether the criterion is indeed an error (+1) or an efficiency (-1) \cr + \emph{$Ind_notcomputed} \tab [numeric] indices of the time-steps where InputsCrit$BoolCrit=FALSE or no data is available \cr + } +} +\description{ +Function which computes an error criterion based on the NSE formula proposed by Nash & Sutcliffe (1970). +} +\details{ +In addition to the criterion value, the function outputs include a multiplier (-1 or +1) which allows +the use of the function for model calibration: the product CritValue*Multiplier is the criterion to be minimised +(e.g. Multiplier=+1 for RMSE, Multiplier=-1 for NSE). +} +\examples{ +## see example of the ErrorCrit function +} +\author{ +Laurent Coron (June 2014) +} +\references{ +Nash, J.E. and Sutcliffe, J.V. (1970), + River flow forecasting through conceptual models part 1. + A discussion of principles, Journal of Hydrology, 10(3), 282-290, doi:10.1016/0022-1694(70)90255-6. \cr +} +\seealso{ +\code{\link{ErrorCrit_RMSE}}, \code{\link{ErrorCrit_KGE}}, \code{\link{ErrorCrit_KGE2}} +} + diff --git a/man/ErrorCrit_RMSE.Rd b/man/ErrorCrit_RMSE.Rd new file mode 100644 index 0000000000000000000000000000000000000000..271648604fa5569c6385e87086fc3d034633599e --- /dev/null +++ b/man/ErrorCrit_RMSE.Rd @@ -0,0 +1,44 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/ErrorCrit_RMSE.R +\encoding{UTF-8} +\name{ErrorCrit_RMSE} +\alias{ErrorCrit_RMSE} +\title{Error criterion based on the RMSE} +\usage{ +ErrorCrit_RMSE(InputsCrit, OutputsModel, quiet = FALSE) +} +\arguments{ +\item{InputsCrit}{[object of class \emph{InputsCrit}] see \code{\link{CreateInputsCrit}} for details} + +\item{OutputsModel}{[object of class \emph{OutputsModel}] see \code{\link{RunModel_GR4J}} or \code{\link{RunModel_CemaNeigeGR4J}} for details} + +\item{quiet}{(optional) [boolean] boolean indicating if the function is run in quiet mode or not, default=FALSE} +} +\value{ +[list] list containing the function outputs organised as follows: + \tabular{ll}{ + \emph{$CritValue } \tab [numeric] value of the criterion \cr + \emph{$CritName } \tab [character] name of the criterion \cr + \emph{$CritBestValue } \tab [numeric] theoretical best criterion value \cr + \emph{$Multiplier } \tab [numeric] integer indicating whether the criterion is indeed an error (+1) or an efficiency (-1) \cr + \emph{$Ind_notcomputed} \tab [numeric] indices of the time-steps where InputsCrit$BoolCrit=FALSE or no data is available \cr + } +} +\description{ +Function which computes an error criterion based on the root mean square error (RMSE). +} +\details{ +In addition to the criterion value, the function outputs include a multiplier (-1 or +1) which allows +the use of the function for model calibration: the product CritValue*Multiplier is the criterion to be minimised +(e.g. Multiplier=+1 for RMSE, Multiplier=-1 for NSE). +} +\examples{ +## see example of the ErrorCrit function +} +\author{ +Laurent Coron (June 2014) +} +\seealso{ +\code{\link{ErrorCrit_NSE}}, \code{\link{ErrorCrit_KGE}}, \code{\link{ErrorCrit_KGE2}} +} + diff --git a/man/PEdaily_Oudin.Rd b/man/PEdaily_Oudin.Rd new file mode 100644 index 0000000000000000000000000000000000000000..ffdc7635f306a1f6fdd96d6dcaf4ed89170fc430 --- /dev/null +++ b/man/PEdaily_Oudin.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/PEdaily_Oudin.R +\encoding{UTF-8} +\name{PEdaily_Oudin} +\alias{PEdaily_Oudin} +\title{Computation of daily series of potential evapotranspiration with Oudin's formula} +\usage{ +PEdaily_Oudin(JD, Temp, LatRad) +} +\arguments{ +\item{JD}{[numeric] time series of julian day [-]} + +\item{Temp}{[numeric] time series of daily mean air temperature [degC]} + +\item{LatRad}{[numeric] latitude of measurement for the temperature series [rad]} +} +\value{ +[numeric] time series of daily potential evapotranspiration [mm/d] +} +\description{ +Function which computes daily PE using the formula from Oudin et al. (2005). +} +\examples{ +require(airGR) + data(L0123001) + PotEvap <- PEdaily_Oudin(JD=as.POSIXlt(BasinObs$DatesR)$yday,Temp=BasinObs$T,LatRad=0.8) +} +\author{ +Laurent Coron (December 2013) +} +\references{ +Oudin, L., F. Hervieu, C. Michel, C. Perrin, V. Andréassian, F. Anctil and C. Loumagne (2005), + Which potential evapotranspiration input for a lumped rainfall-runoff model?: Part 2-Towards a + simple and efficient potential evapotranspiration model for rainfall-runoff modelling, Journal of Hydrology, + 303(1-4), 290-306, doi:10.1016/j.jhydrol.2004.08.026. +} + diff --git a/man/RunModel.Rd b/man/RunModel.Rd new file mode 100644 index 0000000000000000000000000000000000000000..c814a9e463586e4fb4b487b0937113f9e168caa9 --- /dev/null +++ b/man/RunModel.Rd @@ -0,0 +1,62 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/RunModel.R +\encoding{UTF-8} +\name{RunModel} +\alias{RunModel} +\title{Run with the provided hydrological model function} +\usage{ +RunModel(InputsModel, RunOptions, Param, FUN_MOD) +} +\arguments{ +\item{InputsModel}{[object of class \emph{InputsModel}] see \code{\link{CreateInputsModel}} for details} + +\item{RunOptions}{[object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details} + +\item{Param}{[numeric] vector of model parameters} + +\item{FUN_MOD}{[function] hydrological model function (e.g. RunModel_GR4J, RunModel_CemaNeigeGR4J)} +} +\value{ +[list] see \code{\link{RunModel_GR4J}} or \code{\link{RunModel_CemaNeigeGR4J}} for details +} +\description{ +Function which performs a single model run with the provided function. +} +\examples{ +## load of catchment data +require(airGR) +data(L0123001) + +## preparation of the InputsModel object +InputsModel <- CreateInputsModel(FUN_MOD=RunModel_GR4J,DatesR=BasinObs$DatesR, + Precip=BasinObs$P,PotEvap=BasinObs$E) + +## run period selection +Ind_Run <- seq(which(format(BasinObs$DatesR,format="\%d/\%m/\%Y \%H:\%M")=="01/01/1990 00:00"), + which(format(BasinObs$DatesR,format="\%d/\%m/\%Y \%H:\%M")=="31/12/1999 00:00")) + +## preparation of the RunOptions object +RunOptions <- CreateRunOptions(FUN_MOD=RunModel_GR4J,InputsModel=InputsModel,IndPeriod_Run=Ind_Run) + +## simulation +Param <- c(734.568,-0.840,109.809,1.971) +OutputsModel <- RunModel(InputsModel=InputsModel,RunOptions=RunOptions,Param=Param, + FUN_MOD=RunModel_GR4J) + +## results preview +plot_OutputsModel(OutputsModel=OutputsModel,Qobs=BasinObs$Qmm[Ind_Run]) + +## efficiency criterion: Nash-Sutcliffe Efficiency +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) +OutputsCrit <- ErrorCrit_NSE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\\n",sep="")) + +} +\author{ +Laurent Coron (June 2014) +} +\seealso{ +\code{\link{RunModel_GR4J}}, \code{\link{RunModel_CemaNeigeGR4J}}, \code{\link{CreateInputsModel}}, \code{\link{CreateRunOptions}}. +} + diff --git a/man/RunModel_CemaNeige.Rd b/man/RunModel_CemaNeige.Rd new file mode 100644 index 0000000000000000000000000000000000000000..ec08a9681e2870f0658f17e1b27f9124450e0d1f --- /dev/null +++ b/man/RunModel_CemaNeige.Rd @@ -0,0 +1,86 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/RunModel_CemaNeige.R +\encoding{UTF-8} +\name{RunModel_CemaNeige} +\alias{RunModel_CemaNeige} +\title{Run with the CemaNeige snow module} +\usage{ +RunModel_CemaNeige(InputsModel, RunOptions, Param) +} +\arguments{ +\item{InputsModel}{[object of class \emph{InputsModel}] see \code{\link{CreateInputsModel}} for details} + +\item{RunOptions}{[object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details} + +\item{Param}{[numeric] vector of 2 parameters +\tabular{ll}{ +CemaNeige X1 \tab weighting coefficient for snow pack thermal state [-] \cr +CemaNeige X2 \tab degree-day melt coefficient [mm/degC/d] \cr +}} +} +\value{ +[list] list containing the function outputs organised as follows: + \tabular{ll}{ + \emph{$DatesR } \tab [POSIXlt] series of dates \cr + \emph{$CemaNeigeLayers} \tab [list] list of CemaNeige outputs (1 list per layer) \cr + \emph{$CemaNeigeLayers[[iLayer]]$Pliq } \tab [numeric] series of liquid precip. [mm/d] \cr + \emph{$CemaNeigeLayers[[iLayer]]$Psol } \tab [numeric] series of solid precip. [mm/d] \cr + \emph{$CemaNeigeLayers[[iLayer]]$SnowPack } \tab [numeric] series of snow pack [mm] \cr + \emph{$CemaNeigeLayers[[iLayer]]$ThermalState } \tab [numeric] series of snow pack thermal state [degC] \cr + \emph{$CemaNeigeLayers[[iLayer]]$Gratio } \tab [numeric] series of Gratio [0-1] \cr + \emph{$CemaNeigeLayers[[iLayer]]$PotMelt } \tab [numeric] series of potential snow melt [mm] \cr + \emph{$CemaNeigeLayers[[iLayer]]$Melt } \tab [numeric] series of actual snow melt [mm] \cr + \emph{$CemaNeigeLayers[[iLayer]]$PliqAndMelt } \tab [numeric] series of liquid precip. + actual snow melt [mm] \cr + \emph{$StateEnd} \tab [numeric] states at the end of the run: CemaNeige states [mm & degC] \cr + } + (refer to the provided references or to the package source code for further details on these model outputs) +} +\description{ +Function which performs a single run for the CemaNeige daily snow module. +} +\details{ +For further details on the model, see the references section. +For further details on the argument structures and initialisation options, see \code{\link{CreateRunOptions}}. +} +\examples{ +## load of catchment data +require(airGR) +data(L0123002) + +## preparation of the InputsModel object +InputsModel <- CreateInputsModel(FUN_MOD=RunModel_CemaNeige,DatesR=BasinObs$DatesR, + Precip=BasinObs$P,TempMean=BasinObs$T, + ZInputs=BasinInfo$HypsoData[51],HypsoData=BasinInfo$HypsoData, + NLayers=5) + +## run period selection +Ind_Run <- seq(which(format(BasinObs$DatesR,format="\%d/\%m/\%Y \%H:\%M")=="01/01/1990 00:00"), + which(format(BasinObs$DatesR,format="\%d/\%m/\%Y \%H:\%M")=="31/12/1999 00:00")) + +## preparation of the RunOptions object +RunOptions <- CreateRunOptions(FUN_MOD=RunModel_CemaNeige,InputsModel=InputsModel, + IndPeriod_Run=Ind_Run) + +## simulation +Param <- c(0.962,2.249) +OutputsModel <- RunModel_CemaNeige(InputsModel=InputsModel,RunOptions=RunOptions,Param=Param) + +## results preview +plot_OutputsModel(OutputsModel=OutputsModel) + +} +\author{ +Laurent Coron (January 2014) +} +\references{ +Valéry, A., V. Andréassian and C. Perrin (2014), + "As simple as possible but not simpler": what is useful in a temperature-based snow-accounting routine? + Part 1 - Comparison of six snow accounting routines on 380 catchments, Journal of Hydrology, doi:10.1016/j.jhydrol.2014.04.059. \cr + Valéry, A., V. Andréassian and C. Perrin (2014), + "As simple as possible but not simpler": What is useful in a temperature-based snow-accounting routine? + Part 2 - Sensitivity analysis of the Cemaneige snow accounting routine on 380 catchments, Journal of Hydrology, doi:10.1016/j.jhydrol.2014.04.058. +} +\seealso{ +\code{\link{RunModel_CemaNeigeGR4J}}, \code{\link{CreateInputsModel}}, \code{\link{CreateRunOptions}}. +} + diff --git a/man/RunModel_CemaNeigeGR4J.Rd b/man/RunModel_CemaNeigeGR4J.Rd new file mode 100644 index 0000000000000000000000000000000000000000..33a4af322cf2e759891434255b33d5531925d203 --- /dev/null +++ b/man/RunModel_CemaNeigeGR4J.Rd @@ -0,0 +1,114 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/RunModel_CemaNeigeGR4J.R +\encoding{UTF-8} +\name{RunModel_CemaNeigeGR4J} +\alias{RunModel_CemaNeigeGR4J} +\title{Run with the CemaNeigeGR4J hydrological model} +\usage{ +RunModel_CemaNeigeGR4J(InputsModel, RunOptions, Param) +} +\arguments{ +\item{InputsModel}{[object of class \emph{InputsModel}] see \code{\link{CreateInputsModel}} for details} + +\item{RunOptions}{[object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details} + +\item{Param}{[numeric] vector of 6 parameters +\tabular{ll}{ +GR4J X1 \tab production store capacity [mm] \cr +GR4J X2 \tab intercatchment exchange coefficient [mm/d] \cr +GR4J X3 \tab routing store capacity [mm] \cr +GR4J X4 \tab unit hydrograph time constant [d] \cr +CemaNeige X1 \tab weighting coefficient for snow pack thermal state [-] \cr +CemaNeige X2 \tab degree-day melt coefficient [mm/degC/d] \cr +}} +} +\value{ +[list] list containing the function outputs organised as follows: + \tabular{ll}{ + \emph{$DatesR } \tab [POSIXlt] series of dates \cr + \emph{$PotEvap } \tab [numeric] series of input potential evapotranspiration [mm/d] \cr + \emph{$Precip } \tab [numeric] series of input total precipitation [mm/d] \cr + \emph{$Prod } \tab [numeric] series of production store level (X(2)) [mm] \cr + \emph{$AE } \tab [numeric] series of actual evapotranspiration [mm/d] \cr + \emph{$Perc } \tab [numeric] series of percolation (PERC) [mm/d] \cr + \emph{$PR } \tab [numeric] series of PR=PN-PS+PERC [mm/d] \cr + \emph{$Q9 } \tab [numeric] series of HU1 outflow (Q9) [mm/d] \cr + \emph{$Q1 } \tab [numeric] series of HU2 outflow (Q1) [mm/d] \cr + \emph{$Rout } \tab [numeric] series of routing store level (X(1)) [mm] \cr + \emph{$Exch } \tab [numeric] series of potential semi-exchange between catchments [mm/d] \cr + \emph{$AExch } \tab [numeric] series of actual exchange between catchments (1+2) [mm/d] \cr + \emph{$QR } \tab [numeric] series of routing store outflow (QR) [mm/d] \cr + \emph{$QD } \tab [numeric] series of direct flow from HU2 after exchange (QD) [mm/d] \cr + \emph{$Qsim } \tab [numeric] series of Qsim [mm/d] \cr + \emph{$CemaNeigeLayers} \tab [list] list of CemaNeige outputs (1 list per layer) \cr + \emph{$CemaNeigeLayers[[iLayer]]$Pliq } \tab [numeric] series of liquid precip. [mm/d] \cr + \emph{$CemaNeigeLayers[[iLayer]]$Psol } \tab [numeric] series of solid precip. [mm/d] \cr + \emph{$CemaNeigeLayers[[iLayer]]$SnowPack } \tab [numeric] series of snow pack [mm] \cr + \emph{$CemaNeigeLayers[[iLayer]]$ThermalState } \tab [numeric] series of snow pack thermal state [degC] \cr + \emph{$CemaNeigeLayers[[iLayer]]$Gratio } \tab [numeric] series of Gratio [0-1] \cr + \emph{$CemaNeigeLayers[[iLayer]]$PotMelt } \tab [numeric] series of potential snow melt [mm/d] \cr + \emph{$CemaNeigeLayers[[iLayer]]$Melt } \tab [numeric] series of actual snow melt [mm/d] \cr + \emph{$CemaNeigeLayers[[iLayer]]$PliqAndMelt } \tab [numeric] series of liquid precip. + actual snow melt [mm/d] \cr + \emph{$StateEnd} \tab [numeric] states at the end of the run: \cr\tab res. & HU levels [mm], CemaNeige states [mm & degC] \cr + } + (refer to the provided references or to the package source code for further details on these model outputs) +} +\description{ +Function which performs a single run for the CemaNeige-GR4J daily lumped model. +} +\details{ +For further details on the model, see the references section. +For further details on the argument structures and initialisation options, see \code{\link{CreateRunOptions}}. +} +\examples{ +## load of catchment data +require(airGR) +data(L0123002) + +## preparation of the InputsModel object +InputsModel <- CreateInputsModel(FUN_MOD=RunModel_CemaNeigeGR4J,DatesR=BasinObs$DatesR, + Precip=BasinObs$P,PotEvap=BasinObs$E,TempMean=BasinObs$T, + ZInputs=BasinInfo$HypsoData[51],HypsoData=BasinInfo$HypsoData, + NLayers=5) + +## run period selection +Ind_Run <- seq(which(format(BasinObs$DatesR,format="\%d/\%m/\%Y \%H:\%M")=="01/01/1990 00:00"), + which(format(BasinObs$DatesR,format="\%d/\%m/\%Y \%H:\%M")=="31/12/1999 00:00")) + +## preparation of the RunOptions object +RunOptions <- CreateRunOptions(FUN_MOD=RunModel_CemaNeigeGR4J,InputsModel=InputsModel, + IndPeriod_Run=Ind_Run) + +## simulation +Param <- c(408.774,2.646,131.264,1.174,0.962,2.249) +OutputsModel <- RunModel_CemaNeigeGR4J(InputsModel=InputsModel,RunOptions=RunOptions,Param=Param) + +## results preview +plot_OutputsModel(OutputsModel=OutputsModel,Qobs=BasinObs$Qmm[Ind_Run]) + +## efficiency criterion: Nash-Sutcliffe Efficiency +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) +OutputsCrit <- ErrorCrit_NSE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\\n",sep="")) + +} +\author{ +Laurent Coron (December 2013) +} +\references{ +Perrin, C., C. Michel and V. Andréassian (2003), + Improvement of a parsimonious model for streamflow simulation, + Journal of Hydrology, 279(1-4), 275-289, doi:10.1016/S0022-1694(03)00225-7. \cr + Valéry, A., V. Andréassian and C. Perrin (2014), + "As simple as possible but not simpler": what is useful in a temperature-based snow-accounting routine? + Part 1 - Comparison of six snow accounting routines on 380 catchments, Journal of Hydrology, doi:10.1016/j.jhydrol.2014.04.059. \cr + Valéry, A., V. Andréassian and C. Perrin (2014), + "As simple as possible but not simpler": What is useful in a temperature-based snow-accounting routine? + Part 2 - Sensitivity analysis of the Cemaneige snow accounting routine on 380 catchments, Journal of Hydrology, doi:10.1016/j.jhydrol.2014.04.058. +} +\seealso{ +\code{\link{RunModel_CemaNeigeGR5J}}, \code{\link{RunModel_CemaNeigeGR6J}}, \code{\link{RunModel_GR4J}}, + \code{\link{CreateInputsModel}}, \code{\link{CreateRunOptions}}. +} + diff --git a/man/RunModel_CemaNeigeGR5J.Rd b/man/RunModel_CemaNeigeGR5J.Rd new file mode 100644 index 0000000000000000000000000000000000000000..1d0cf524115c0c2734758753227f921f1a0f8e4b --- /dev/null +++ b/man/RunModel_CemaNeigeGR5J.Rd @@ -0,0 +1,117 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/RunModel_CemaNeigeGR5J.R +\encoding{UTF-8} +\name{RunModel_CemaNeigeGR5J} +\alias{RunModel_CemaNeigeGR5J} +\title{Run with the CemaNeigeGR5J hydrological model} +\usage{ +RunModel_CemaNeigeGR5J(InputsModel, RunOptions, Param) +} +\arguments{ +\item{InputsModel}{[object of class \emph{InputsModel}] see \code{\link{CreateInputsModel}} for details} + +\item{RunOptions}{[object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details} + +\item{Param}{[numeric] vector of 7 parameters +\tabular{ll}{ +GR5J X1 \tab production store capacity [mm] \cr +GR5J X2 \tab intercatchment exchange coefficient 1 [mm/d] \cr +GR5J X3 \tab routing store capacity [mm] \cr +GR5J X4 \tab unit hydrograph time constant [d] \cr +GR5J X5 \tab intercatchment exchange coefficient 2 [-] \cr +CemaNeige X1 \tab weighting coefficient for snow pack thermal state [-] \cr +CemaNeige X2 \tab degree-day melt coefficient [mm/degC/d] \cr +}} +} +\value{ +[list] list containing the function outputs organised as follows: + \tabular{ll}{ + \emph{$DatesR } \tab [POSIXlt] series of dates \cr + \emph{$PotEvap } \tab [numeric] series of input potential evapotranspiration [mm/d] \cr + \emph{$Precip } \tab [numeric] series of input total precipitation [mm/d] \cr + \emph{$Prod } \tab [numeric] series of production store level (X(2)) [mm] \cr + \emph{$AE } \tab [numeric] series of actual evapotranspiration [mm/d] \cr + \emph{$Perc } \tab [numeric] series of percolation (PERC) [mm/d] \cr + \emph{$PR } \tab [numeric] series of PR=PN-PS+PERC [mm/d] \cr + \emph{$Q9 } \tab [numeric] series of HU1 outflow (Q9) [mm/d] \cr + \emph{$Q1 } \tab [numeric] series of HU2 outflow (Q1) [mm/d] \cr + \emph{$Rout } \tab [numeric] series of routing store level (X(1)) [mm] \cr + \emph{$Exch } \tab [numeric] series of potential semi-exchange between catchments [mm/d] \cr + \emph{$AExch } \tab [numeric] series of actual exchange between catchments (1+2) [mm/d] \cr + \emph{$QR } \tab [numeric] series of routing store outflow (QR) [mm/d] \cr + \emph{$QD } \tab [numeric] series of direct flow from HU2 after exchange (QD) [mm/d] \cr + \emph{$Qsim } \tab [numeric] series of Qsim [mm/d] \cr + \emph{$CemaNeigeLayers} \tab [list] list of CemaNeige outputs (1 list per layer) \cr + \emph{$CemaNeigeLayers[[iLayer]]$Pliq } \tab [numeric] series of liquid precip. [mm/d] \cr + \emph{$CemaNeigeLayers[[iLayer]]$Psol } \tab [numeric] series of solid precip. [mm/d] \cr + \emph{$CemaNeigeLayers[[iLayer]]$SnowPack } \tab [numeric] series of snow pack [mm] \cr + \emph{$CemaNeigeLayers[[iLayer]]$ThermalState } \tab [numeric] series of snow pack thermal state [degC] \cr + \emph{$CemaNeigeLayers[[iLayer]]$Gratio } \tab [numeric] series of Gratio [0-1] \cr + \emph{$CemaNeigeLayers[[iLayer]]$PotMelt } \tab [numeric] series of potential snow melt [mm/d] \cr + \emph{$CemaNeigeLayers[[iLayer]]$Melt } \tab [numeric] series of actual snow melt [mm/d] \cr + \emph{$CemaNeigeLayers[[iLayer]]$PliqAndMelt } \tab [numeric] series of liquid precip. + actual snow melt [mm/d] \cr + \emph{$StateEnd} \tab [numeric] states at the end of the run: \cr\tab res. & HU levels [mm], CemaNeige states [mm & degC] \cr + } + (refer to the provided references or to the package source code for further details on these model outputs) +} +\description{ +Function which performs a single run for the CemaNeige-GR5J daily lumped model. +} +\details{ +For further details on the model, see the references section. +For further details on the argument structures and initialisation options, see \code{\link{CreateRunOptions}}. +} +\examples{ +## load of catchment data +require(airGR) +data(L0123002) + +## preparation of the InputsModel object +InputsModel <- CreateInputsModel(FUN_MOD=RunModel_CemaNeigeGR5J,DatesR=BasinObs$DatesR, + Precip=BasinObs$P,PotEvap=BasinObs$E,TempMean=BasinObs$T, + ZInputs=BasinInfo$HypsoData[51],HypsoData=BasinInfo$HypsoData, + NLayers=5) + +## run period selection +Ind_Run <- seq(which(format(BasinObs$DatesR,format="\%d/\%m/\%Y \%H:\%M")=="01/01/1990 00:00"), + which(format(BasinObs$DatesR,format="\%d/\%m/\%Y \%H:\%M")=="31/12/1999 00:00")) + +## preparation of the RunOptions object +RunOptions <- CreateRunOptions(FUN_MOD=RunModel_CemaNeigeGR5J,InputsModel=InputsModel, + IndPeriod_Run=Ind_Run) + +## simulation +Param <- c(179.139,-0.100,203.815,1.174,2.478,0.977,2.774) +OutputsModel <- RunModel_CemaNeigeGR5J(InputsModel=InputsModel,RunOptions=RunOptions,Param=Param) + +## results preview +plot_OutputsModel(OutputsModel=OutputsModel,Qobs=BasinObs$Qmm[Ind_Run]) + +## efficiency criterion: Nash-Sutcliffe Efficiency +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) +OutputsCrit <- ErrorCrit_NSE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\\n",sep="")) + +} +\author{ +Laurent Coron (December 2013) +} +\references{ +Le Moine, N. (2008), Le bassin versant de surface vu par le souterrain : une voie d'amélioration des performances + et du réalisme des modèles pluie-débit ?, PhD thesis (french), UPMC, Paris, France. \cr + Pushpalatha, R., C. Perrin, N. Le Moine, T. Mathevet and V. Andréassian (2011), + A downward structural sensitivity analysis of hydrological models to improve low-flow simulation, + Journal of Hydrology, 411(1-2), 66-76, doi:10.1016/j.jhydrol.2011.09.034. \cr + Valéry, A., V. Andréassian and C. Perrin (2014), + "As simple as possible but not simpler": what is useful in a temperature-based snow-accounting routine? + Part 1 - Comparison of six snow accounting routines on 380 catchments, Journal of Hydrology, doi:10.1016/j.jhydrol.2014.04.059. \cr + Valéry, A., V. Andréassian and C. Perrin (2014), + "As simple as possible but not simpler": What is useful in a temperature-based snow-accounting routine? + Part 2 - Sensitivity analysis of the Cemaneige snow accounting routine on 380 catchments, Journal of Hydrology, doi:10.1016/j.jhydrol.2014.04.058. +} +\seealso{ +\code{\link{RunModel_CemaNeigeGR4J}}, \code{\link{RunModel_CemaNeigeGR6J}}, \code{\link{RunModel_GR5J}}, + \code{\link{CreateInputsModel}}, \code{\link{CreateRunOptions}}. +} + diff --git a/man/RunModel_CemaNeigeGR6J.Rd b/man/RunModel_CemaNeigeGR6J.Rd new file mode 100644 index 0000000000000000000000000000000000000000..cbf4f2cb97654807e506181a6c15b010985f2bc7 --- /dev/null +++ b/man/RunModel_CemaNeigeGR6J.Rd @@ -0,0 +1,118 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/RunModel_CemaNeigeGR6J.R +\encoding{UTF-8} +\name{RunModel_CemaNeigeGR6J} +\alias{RunModel_CemaNeigeGR6J} +\title{Run with the CemaNeigeGR6J hydrological model} +\usage{ +RunModel_CemaNeigeGR6J(InputsModel, RunOptions, Param) +} +\arguments{ +\item{InputsModel}{[object of class \emph{InputsModel}] see \code{\link{CreateInputsModel}} for details} + +\item{RunOptions}{[object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details} + +\item{Param}{[numeric] vector of 8 parameters +\tabular{ll}{ +GR6J X1 \tab production store capacity [mm] \cr +GR6J X2 \tab intercatchment exchange coefficient 1 [mm/d] \cr +GR6J X3 \tab routing store capacity [mm] \cr +GR6J X4 \tab unit hydrograph time constant [d] \cr +GR6J X5 \tab intercatchment exchange coefficient 2 [-] \cr +GR6J X6 \tab coefficient for emptying exponential store [-] \cr +CemaNeige X1 \tab weighting coefficient for snow pack thermal state [-] \cr +CemaNeige X2 \tab degree-day melt coefficient [mm/degC/d] \cr +}} +} +\value{ +[list] list containing the function outputs organised as follows: + \tabular{ll}{ + \emph{$DatesR } \tab [POSIXlt] series of dates \cr + \emph{$PotEvap } \tab [numeric] series of input potential evapotranspiration [mm/d] \cr + \emph{$Precip } \tab [numeric] series of input total precipitation [mm/d] \cr + \emph{$Prod } \tab [numeric] series of production store level (X(2)) [mm] \cr + \emph{$AE } \tab [numeric] series of actual evapotranspiration [mm/d] \cr + \emph{$Perc } \tab [numeric] series of percolation (PERC) [mm/d] \cr + \emph{$PR } \tab [numeric] series of PR=PN-PS+PERC [mm/d] \cr + \emph{$Q9 } \tab [numeric] series of HU1 outflow (Q9) [mm/d] \cr + \emph{$Q1 } \tab [numeric] series of HU2 outflow (Q1) [mm/d] \cr + \emph{$Rout } \tab [numeric] series of routing store level (X(1)) [mm] \cr + \emph{$Exch } \tab [numeric] series of potential semi-exchange between catchments [mm/d] \cr + \emph{$AExch } \tab [numeric] series of actual exchange between catchments (1+2) [mm/d] \cr + \emph{$QR } \tab [numeric] series of routing store outflow (QR) [mm/d] \cr + \emph{$QR1 } \tab [numeric] series of exponential store outflow (QR1) [mm/d] \cr + \emph{$Exp } \tab [numeric] series of exponential store level (X(6)) (negative) [mm] \cr + \emph{$QD } \tab [numeric] series of direct flow from HU2 after exchange (QD) [mm/d] \cr + \emph{$Qsim } \tab [numeric] series of Qsim [mm/d] \cr + \emph{$CemaNeigeLayers} \tab [list] list of CemaNeige outputs (1 list per layer) \cr + \emph{$CemaNeigeLayers[[iLayer]]$Pliq } \tab [numeric] series of liquid precip. [mm/d] \cr + \emph{$CemaNeigeLayers[[iLayer]]$Psol } \tab [numeric] series of solid precip. [mm/d] \cr + \emph{$CemaNeigeLayers[[iLayer]]$SnowPack } \tab [numeric] series of snow pack [mm] \cr + \emph{$CemaNeigeLayers[[iLayer]]$ThermalState } \tab [numeric] series of snow pack thermal state [degC] \cr + \emph{$CemaNeigeLayers[[iLayer]]$Gratio } \tab [numeric] series of Gratio [0-1] \cr + \emph{$CemaNeigeLayers[[iLayer]]$PotMelt } \tab [numeric] series of potential snow melt [mm/d] \cr + \emph{$CemaNeigeLayers[[iLayer]]$Melt } \tab [numeric] series of actual snow melt [mm/d] \cr + \emph{$CemaNeigeLayers[[iLayer]]$PliqAndMelt } \tab [numeric] series of liquid precip. + actual snow melt [mm/d] \cr + \emph{$StateEnd} \tab [numeric] states at the end of the run: \cr\tab res. & HU levels [mm], CemaNeige states [mm & degC] \cr + } + (refer to the provided references or to the package source code for further details on these model outputs) +} +\description{ +Function which performs a single run for the CemaNeige-GR6J daily lumped model. +} +\details{ +For further details on the model, see the references section. +For further details on the argument structures and initialisation options, see \code{\link{CreateRunOptions}}. +} +\examples{ +## load of catchment data +require(airGR) +data(L0123002) + +## preparation of the InputsModel object +InputsModel <- CreateInputsModel(FUN_MOD=RunModel_CemaNeigeGR6J,DatesR=BasinObs$DatesR, + Precip=BasinObs$P,PotEvap=BasinObs$E,TempMean=BasinObs$T, + ZInputs=BasinInfo$HypsoData[51],HypsoData=BasinInfo$HypsoData, + NLayers=5) + +## run period selection +Ind_Run <- seq(which(format(BasinObs$DatesR,format="\%d/\%m/\%Y \%H:\%M")=="01/01/1990 00:00"), + which(format(BasinObs$DatesR,format="\%d/\%m/\%Y \%H:\%M")=="31/12/1999 00:00")) + +## preparation of the RunOptions object +RunOptions <- CreateRunOptions(FUN_MOD=RunModel_CemaNeigeGR6J,InputsModel=InputsModel, + IndPeriod_Run=Ind_Run) + +## simulation +Param <- c(116.482,0.500,72.733,1.224,0.278,30.333,0.977,2.776) +OutputsModel <- RunModel_CemaNeigeGR6J(InputsModel=InputsModel,RunOptions=RunOptions,Param=Param) + +## results preview +plot_OutputsModel(OutputsModel=OutputsModel,Qobs=BasinObs$Qmm[Ind_Run]) + +## efficiency criterion: Nash-Sutcliffe Efficiency +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) +OutputsCrit <- ErrorCrit_NSE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\\n",sep="")) + +} +\author{ +Laurent Coron (December 2013) +} +\references{ +Pushpalatha, R., C. Perrin, N. Le Moine, T. Mathevet and V. Andréassian (2011), + A downward structural sensitivity analysis of hydrological models to improve low-flow simulation, + Journal of Hydrology, 411(1-2), 66-76, doi:10.1016/j.jhydrol.2011.09.034. \cr + Valéry, A., V. Andréassian and C. Perrin (2014), + "As simple as possible but not simpler": what is useful in a temperature-based snow-accounting routine? + Part 1 - Comparison of six snow accounting routines on 380 catchments, Journal of Hydrology, doi:10.1016/j.jhydrol.2014.04.059. \cr + Valéry, A., V. Andréassian and C. Perrin (2014), + "As simple as possible but not simpler": What is useful in a temperature-based snow-accounting routine? + Part 2 - Sensitivity analysis of the Cemaneige snow accounting routine on 380 catchments, Journal of Hydrology, doi:10.1016/j.jhydrol.2014.04.058. +} +\seealso{ +\code{\link{RunModel_CemaNeigeGR4J}}, \code{\link{RunModel_CemaNeigeGR5J}}, \code{\link{RunModel_GR6J}}, + \code{\link{CreateInputsModel}}, \code{\link{CreateRunOptions}}. +} + diff --git a/man/RunModel_GR1A.Rd b/man/RunModel_GR1A.Rd new file mode 100644 index 0000000000000000000000000000000000000000..17644fc1a37497c41fd0278f54f18c1498ccd6c9 --- /dev/null +++ b/man/RunModel_GR1A.Rd @@ -0,0 +1,87 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/RunModel_GR1A.R +\encoding{UTF-8} +\name{RunModel_GR1A} +\alias{RunModel_GR1A} +\title{Run with the GR1A hydrological model} +\usage{ +RunModel_GR1A(InputsModel, RunOptions, Param) +} +\arguments{ +\item{InputsModel}{[object of class \emph{InputsModel}] see \code{\link{CreateInputsModel}} for details} + +\item{RunOptions}{[object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details} + +\item{Param}{[numeric] vector of 4 parameters +\tabular{ll}{ +GR1A X1 \tab model parameter [mm] \cr +}} +} +\value{ +[list] list containing the function outputs organised as follows: + \tabular{ll}{ + \emph{$DatesR } \tab [POSIXlt] series of dates \cr + \emph{$PotEvap } \tab [numeric] series of input potential evapotranspiration [mm/h] \cr + \emph{$Precip } \tab [numeric] series of input total precipitation [mm/h] \cr + \emph{$Qsim } \tab [numeric] series of Qsim [mm/h] \cr + } + (refer to the provided references or to the package source code for further details on these model outputs) +} +\description{ +Function which performs a single run for the GR1A yearly lumped model. +} +\details{ +For further details on the model, see the references section. +For further details on the argument structures and initialisation options, see \code{\link{CreateRunOptions}}. +} +\examples{ +## load of catchment data +require(airGR) +data(L0123001) + +## conversion of example data from daily to yearly time-step +TabSeries <- data.frame(BasinObs$DatesR,BasinObs$P,BasinObs$E,BasinObs$T,BasinObs$Qmm) +TimeFormat <- "daily" +NewTimeFormat <- "yearly" +ConvertFun <- c("sum","sum","mean","sum") +YearFirstMonth <- 09; +NewTabSeries <- SeriesAggreg(TabSeries=TabSeries,TimeFormat=TimeFormat, + NewTimeFormat=NewTimeFormat,ConvertFun=ConvertFun, + YearFirstMonth=YearFirstMonth) +BasinObs <- NewTabSeries +names(BasinObs) <- c("DatesR","P","E","T","Qmm") + +## preparation of the InputsModel object +InputsModel <- CreateInputsModel(FUN_MOD=RunModel_GR1A,DatesR=BasinObs$DatesR, + Precip=BasinObs$P,PotEvap=BasinObs$E) + +## run period selection +Ind_Run <- seq(which(format(BasinObs$DatesR,format="\%Y")=="1990"), + which(format(BasinObs$DatesR,format="\%Y")=="1999")) + +## preparation of the RunOptions object +RunOptions <- CreateRunOptions(FUN_MOD=RunModel_GR1A,InputsModel=InputsModel,IndPeriod_Run=Ind_Run) + +## simulation +Param <- c(0.840) +OutputsModel <- RunModel_GR1A(InputsModel=InputsModel,RunOptions=RunOptions,Param=Param) + +## results preview +plot_OutputsModel(OutputsModel=OutputsModel,Qobs=BasinObs$Qmm[Ind_Run]) + +## efficiency criterion: Nash-Sutcliffe Efficiency +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) +OutputsCrit <- ErrorCrit_NSE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\\n",sep="")) + +} +\author{ +Laurent Coron (March 2015) +} +\references{ +Mouelhi S. (2003), + Vers une chaîne cohérente de modèles pluie-débit conceptuels globaux aux pas de temps pluriannuel, annuel, mensuel et journalier, + PhD thesis (in French), ENGREF, Cemagref Antony, France. \cr +} + diff --git a/man/RunModel_GR2M.Rd b/man/RunModel_GR2M.Rd new file mode 100644 index 0000000000000000000000000000000000000000..5103fc1e43f8ae89da01f8e77677651b84c8789b --- /dev/null +++ b/man/RunModel_GR2M.Rd @@ -0,0 +1,101 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/RunModel_GR2M.R +\encoding{UTF-8} +\name{RunModel_GR2M} +\alias{RunModel_GR2M} +\title{Run with the GR2M hydrological model} +\usage{ +RunModel_GR2M(InputsModel, RunOptions, Param) +} +\arguments{ +\item{InputsModel}{[object of class \emph{InputsModel}] see \code{\link{CreateInputsModel}} for details} + +\item{RunOptions}{[object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details} + +\item{Param}{[numeric] vector of 4 parameters +\tabular{ll}{ +GR2M X1 \tab production store capacity [mm] \cr +GR2M X2 \tab groundwater exchange coefficient [mm/month] \cr +}} +} +\value{ +[list] list containing the function outputs organised as follows: + \tabular{ll}{ + \emph{$DatesR } \tab [POSIXlt] series of dates \cr + \emph{$PotEvap } \tab [numeric] series of input potential evapotranspiration [mm/h] \cr + \emph{$Precip } \tab [numeric] series of input total precipitation [mm/h] \cr + \emph{$Prod } \tab [numeric] series of production store level (X(2)) [mm] \cr + \emph{$AE } \tab [numeric] series of actual evapotranspiration [mm/h] \cr + \emph{$Perc } \tab [numeric] series of percolation (PERC) [mm/h] \cr + \emph{$PR } \tab [numeric] series of PR=PN-PS+PERC [mm/h] \cr + \emph{$Q9 } \tab [numeric] series of HU1 outflow (Q9) [mm/h] \cr + \emph{$Q1 } \tab [numeric] series of HU2 outflow (Q1) [mm/h] \cr + \emph{$Rout } \tab [numeric] series of routing store level (X(1)) [mm] \cr + \emph{$Exch } \tab [numeric] series of potential semi-exchange between catchments [mm/h] \cr + \emph{$AExch } \tab [numeric] series of actual exchange between catchments (1+2) [mm/h] \cr + \emph{$QR } \tab [numeric] series of routing store outflow (QR) [mm/h] \cr + \emph{$QD } \tab [numeric] series of direct flow from HU2 after exchange (QD) [mm/h] \cr + \emph{$Qsim } \tab [numeric] series of Qsim [mm/h] \cr + \emph{$StateEnd} \tab [numeric] states at the end of the run (res. levels, HU1 levels, HU2 levels) [mm] \cr + } + (refer to the provided references or to the package source code for further details on these model outputs) +} +\description{ +Function which performs a single run for the GR2M monthly lumped model. +} +\details{ +For further details on the model, see the references section. +For further details on the argument structures and initialisation options, see \code{\link{CreateRunOptions}}. +} +\examples{ +## load of catchment data +require(airGR) +data(L0123001) + +## conversion of example data from daily to monthly time-step +TabSeries <- data.frame(BasinObs$DatesR,BasinObs$P,BasinObs$E,BasinObs$T,BasinObs$Qmm) +TimeFormat <- "daily" +NewTimeFormat <- "monthly" +ConvertFun <- c("sum","sum","mean","sum") +NewTabSeries <- SeriesAggreg(TabSeries=TabSeries,TimeFormat=TimeFormat, + NewTimeFormat=NewTimeFormat,ConvertFun=ConvertFun) +BasinObs <- NewTabSeries +names(BasinObs) <- c("DatesR","P","E","T","Qmm") + +## preparation of the InputsModel object +InputsModel <- CreateInputsModel(FUN_MOD=RunModel_GR2M,DatesR=BasinObs$DatesR, + Precip=BasinObs$P,PotEvap=BasinObs$E) + +## run period selection +Ind_Run <- seq(which(format(BasinObs$DatesR,format="\%m/\%Y")=="01/1990"), + which(format(BasinObs$DatesR,format="\%m/\%Y")=="12/1999")) + +## preparation of the RunOptions object +RunOptions <- CreateRunOptions(FUN_MOD=RunModel_GR2M,InputsModel=InputsModel,IndPeriod_Run=Ind_Run) + +## simulation +Param <- c(265.072,1.040) +OutputsModel <- RunModel_GR2M(InputsModel=InputsModel,RunOptions=RunOptions,Param=Param) + +## results preview +plot_OutputsModel(OutputsModel=OutputsModel,Qobs=BasinObs$Qmm[Ind_Run]) + +## efficiency criterion: Nash-Sutcliffe Efficiency +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) +OutputsCrit <- ErrorCrit_NSE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\\n",sep="")) + +} +\author{ +Laurent Coron (March 2015) +} +\references{ +Mouelhi S. (2003), + Vers une chaîne cohérente de modèles pluie-débit conceptuels globaux aux pas de temps pluriannuel, annuel, mensuel et journalier, + PhD thesis (in French), ENGREF, Cemagref Antony, France. \cr + Mouelhi, S., C. Michel, C. Perrin and V. Andréassian (2006), + Stepwise development of a two-parameter monthly water balance model, + Journal of Hydrology, 318(1-4), 200-214, doi:10.1016/j.jhydrol.2005.06.014. +} + diff --git a/man/RunModel_GR4H.Rd b/man/RunModel_GR4H.Rd new file mode 100644 index 0000000000000000000000000000000000000000..b9d7a4a7c5d64224587ab3fd6cf6c2235fe25f12 --- /dev/null +++ b/man/RunModel_GR4H.Rd @@ -0,0 +1,94 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/RunModel_GR4H.R +\encoding{UTF-8} +\name{RunModel_GR4H} +\alias{RunModel_GR4H} +\title{Run with the GR4H hydrological model} +\usage{ +RunModel_GR4H(InputsModel, RunOptions, Param) +} +\arguments{ +\item{InputsModel}{[object of class \emph{InputsModel}] see \code{\link{CreateInputsModel}} for details} + +\item{RunOptions}{[object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details} + +\item{Param}{[numeric] vector of 4 parameters +\tabular{ll}{ +GR4H X1 \tab production store capacity [mm] \cr +GR4H X2 \tab groundwater exchange coefficient [mm/h] \cr +GR4H X3 \tab routing store capacity [mm] \cr +GR4H X4 \tab unit hydrograph time constant [h] \cr +}} +} +\value{ +[list] list containing the function outputs organised as follows: + \tabular{ll}{ + \emph{$DatesR } \tab [POSIXlt] series of dates \cr + \emph{$PotEvap } \tab [numeric] series of input potential evapotranspiration [mm/h] \cr + \emph{$Precip } \tab [numeric] series of input total precipitation [mm/h] \cr + \emph{$Prod } \tab [numeric] series of production store level (X(2)) [mm] \cr + \emph{$AE } \tab [numeric] series of actual evapotranspiration [mm/h] \cr + \emph{$Perc } \tab [numeric] series of percolation (PERC) [mm/h] \cr + \emph{$PR } \tab [numeric] series of PR=PN-PS+PERC [mm/h] \cr + \emph{$Q9 } \tab [numeric] series of HU1 outflow (Q9) [mm/h] \cr + \emph{$Q1 } \tab [numeric] series of HU2 outflow (Q1) [mm/h] \cr + \emph{$Rout } \tab [numeric] series of routing store level (X(1)) [mm] \cr + \emph{$Exch } \tab [numeric] series of potential semi-exchange between catchments [mm/h] \cr + \emph{$AExch } \tab [numeric] series of actual exchange between catchments (1+2) [mm/h] \cr + \emph{$QR } \tab [numeric] series of routing store outflow (QR) [mm/h] \cr + \emph{$QD } \tab [numeric] series of direct flow from HU2 after exchange (QD) [mm/h] \cr + \emph{$Qsim } \tab [numeric] series of Qsim [mm/h] \cr + \emph{$StateEnd} \tab [numeric] states at the end of the run (res. levels, HU1 levels, HU2 levels) [mm] \cr + } + (refer to the provided references or to the package source code for further details on these model outputs) +} +\description{ +Function which performs a single run for the GR4H hourly lumped model. +} +\details{ +For further details on the model, see the references section. +For further details on the argument structures and initialisation options, see \code{\link{CreateRunOptions}}. +} +\examples{ +## load of catchment data +require(airGR) +data(L0123003) + +## preparation of the InputsModel object +InputsModel <- CreateInputsModel(FUN_MOD=RunModel_GR4H,DatesR=BasinObs$DatesR, + Precip=BasinObs$P,PotEvap=BasinObs$E) + +## run period selection +Ind_Run <- seq(which(format(BasinObs$DatesR,format="\%d/\%m/\%Y \%H:\%M")=="01/03/2004 00:00"), + which(format(BasinObs$DatesR,format="\%d/\%m/\%Y \%H:\%M")=="31/12/2008 00:00")) + +## preparation of the RunOptions object +RunOptions <- CreateRunOptions(FUN_MOD=RunModel_GR4H,InputsModel=InputsModel,IndPeriod_Run=Ind_Run) + +## simulation +Param <- c(521.113,-2.918,218.009,4.124) +OutputsModel <- RunModel_GR4H(InputsModel=InputsModel,RunOptions=RunOptions,Param=Param) + +## results preview +plot_OutputsModel(OutputsModel=OutputsModel,Qobs=BasinObs$Qmm[Ind_Run]) + +## efficiency criterion: Nash-Sutcliffe Efficiency +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) +OutputsCrit <- ErrorCrit_NSE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\\n",sep="")) + +} +\author{ +Laurent Coron (July 2014) +} +\references{ +Mathevet, T. (2005), + Quels modèles pluie-débit globaux pour le pas de temps horaire ? Développement empirique et comparaison de modèles sur un large échantillon de bassins versants, + PhD thesis (in French), ENGREF - Cemagref (Antony), Paris, France. +} +\seealso{ +\code{\link{RunModel_GR4J}}, + \code{\link{CreateInputsModel}}, \code{\link{CreateRunOptions}}. +} + diff --git a/man/RunModel_GR4J.Rd b/man/RunModel_GR4J.Rd new file mode 100644 index 0000000000000000000000000000000000000000..3e79c8ab2974378506357c3a8952c54c38adda16 --- /dev/null +++ b/man/RunModel_GR4J.Rd @@ -0,0 +1,94 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/RunModel_GR4J.R +\encoding{UTF-8} +\name{RunModel_GR4J} +\alias{RunModel_GR4J} +\title{Run with the GR4J hydrological model} +\usage{ +RunModel_GR4J(InputsModel, RunOptions, Param) +} +\arguments{ +\item{InputsModel}{[object of class \emph{InputsModel}] see \code{\link{CreateInputsModel}} for details} + +\item{RunOptions}{[object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details} + +\item{Param}{[numeric] vector of 4 parameters +\tabular{ll}{ +GR4J X1 \tab production store capacity [mm] \cr +GR4J X2 \tab intercatchment exchange coefficient [mm/d] \cr +GR4J X3 \tab routing store capacity [mm] \cr +GR4J X4 \tab unit hydrograph time constant [d] \cr +}} +} +\value{ +[list] list containing the function outputs organised as follows: + \tabular{ll}{ + \emph{$DatesR } \tab [POSIXlt] series of dates \cr + \emph{$PotEvap } \tab [numeric] series of input potential evapotranspiration [mm/d] \cr + \emph{$Precip } \tab [numeric] series of input total precipitation [mm/d] \cr + \emph{$Prod } \tab [numeric] series of production store level (X(2)) [mm] \cr + \emph{$AE } \tab [numeric] series of actual evapotranspiration [mm/d] \cr + \emph{$Perc } \tab [numeric] series of percolation (PERC) [mm/d] \cr + \emph{$PR } \tab [numeric] series of PR=PN-PS+PERC [mm/d] \cr + \emph{$Q9 } \tab [numeric] series of HU1 outflow (Q9) [mm/d] \cr + \emph{$Q1 } \tab [numeric] series of HU2 outflow (Q1) [mm/d] \cr + \emph{$Rout } \tab [numeric] series of routing store level (X(1)) [mm] \cr + \emph{$Exch } \tab [numeric] series of potential semi-exchange between catchments [mm/d] \cr + \emph{$AExch } \tab [numeric] series of actual exchange between catchments (1+2) [mm/d] \cr + \emph{$QR } \tab [numeric] series of routing store outflow (QR) [mm/d] \cr + \emph{$QD } \tab [numeric] series of direct flow from HU2 after exchange (QD) [mm/d] \cr + \emph{$Qsim } \tab [numeric] series of Qsim [mm/d] \cr + \emph{$StateEnd} \tab [numeric] states at the end of the run (res. levels, HU1 levels, HU2 levels) [mm] \cr + } + (refer to the provided references or to the package source code for further details on these model outputs) +} +\description{ +Function which performs a single run for the GR4J daily lumped model. +} +\details{ +For further details on the model, see the references section. +For further details on the argument structures and initialisation options, see \code{\link{CreateRunOptions}}. +} +\examples{ +## load of catchment data +require(airGR) +data(L0123001) + +## preparation of the InputsModel object +InputsModel <- CreateInputsModel(FUN_MOD=RunModel_GR4J,DatesR=BasinObs$DatesR, + Precip=BasinObs$P,PotEvap=BasinObs$E) + +## run period selection +Ind_Run <- seq(which(format(BasinObs$DatesR,format="\%d/\%m/\%Y \%H:\%M")=="01/01/1990 00:00"), + which(format(BasinObs$DatesR,format="\%d/\%m/\%Y \%H:\%M")=="31/12/1999 00:00")) + +## preparation of the RunOptions object +RunOptions <- CreateRunOptions(FUN_MOD=RunModel_GR4J,InputsModel=InputsModel,IndPeriod_Run=Ind_Run) + +## simulation +Param <- c(257.238,1.012,88.235,2.208) +OutputsModel <- RunModel_GR4J(InputsModel=InputsModel,RunOptions=RunOptions,Param=Param) + +## results preview +plot_OutputsModel(OutputsModel=OutputsModel,Qobs=BasinObs$Qmm[Ind_Run]) + +## efficiency criterion: Nash-Sutcliffe Efficiency +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) +OutputsCrit <- ErrorCrit_NSE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\\n",sep="")) + +} +\author{ +Laurent Coron (December 2013) +} +\references{ +Perrin, C., C. Michel and V. Andréassian (2003), + Improvement of a parsimonious model for streamflow simulation, + Journal of Hydrology, 279(1-4), 275-289, doi:10.1016/S0022-1694(03)00225-7. +} +\seealso{ +\code{\link{RunModel_GR5J}}, \code{\link{RunModel_GR6J}}, \code{\link{RunModel_CemaNeigeGR4J}}, + \code{\link{CreateInputsModel}}, \code{\link{CreateRunOptions}}. +} + diff --git a/man/RunModel_GR5J.Rd b/man/RunModel_GR5J.Rd new file mode 100644 index 0000000000000000000000000000000000000000..a67da9d6325eca0bb025ce2da2d1bf25793a4868 --- /dev/null +++ b/man/RunModel_GR5J.Rd @@ -0,0 +1,97 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/RunModel_GR5J.R +\encoding{UTF-8} +\name{RunModel_GR5J} +\alias{RunModel_GR5J} +\title{Run with the GR5J hydrological model} +\usage{ +RunModel_GR5J(InputsModel, RunOptions, Param) +} +\arguments{ +\item{InputsModel}{[object of class \emph{InputsModel}] see \code{\link{CreateInputsModel}} for details} + +\item{RunOptions}{[object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details} + +\item{Param}{[numeric] vector of 5 parameters +\tabular{ll}{ +GR5J X1 \tab production store capacity [mm] \cr +GR5J X2 \tab intercatchment exchange coefficient 1 [mm/d] \cr +GR5J X3 \tab routing store capacity [mm] \cr +GR5J X4 \tab unit hydrograph time constant [d] \cr +GR5J X5 \tab intercatchment exchange coefficient 2 [-] \cr +}} +} +\value{ +[list] list containing the function outputs organised as follows: + \tabular{ll}{ + \emph{$DatesR } \tab [POSIXlt] series of dates \cr + \emph{$PotEvap } \tab [numeric] series of input potential evapotranspiration [mm/d] \cr + \emph{$Precip } \tab [numeric] series of input total precipitation [mm/d] \cr + \emph{$Prod } \tab [numeric] series of production store level (X(2)) [mm] \cr + \emph{$AE } \tab [numeric] series of actual evapotranspiration [mm/d] \cr + \emph{$Perc } \tab [numeric] series of percolation (PERC) [mm/d] \cr + \emph{$PR } \tab [numeric] series of PR=PN-PS+PERC [mm/d] \cr + \emph{$Q9 } \tab [numeric] series of HU1 outflow (Q9) [mm/d] \cr + \emph{$Q1 } \tab [numeric] series of HU2 outflow (Q1) [mm/d] \cr + \emph{$Rout } \tab [numeric] series of routing store level (X(1)) [mm] \cr + \emph{$Exch } \tab [numeric] series of potential semi-exchange between catchments [mm/d] \cr + \emph{$AExch } \tab [numeric] series of actual exchange between catchments (1+2) [mm/d] \cr + \emph{$QR } \tab [numeric] series of routing store outflow (QR) [mm/d] \cr + \emph{$QD } \tab [numeric] series of direct flow from HU2 after exchange (QD) [mm/d] \cr + \emph{$Qsim } \tab [numeric] series of Qsim [mm/d] \cr + \emph{$StateEnd} \tab [numeric] states at the end of the run (res. levels, HU1 levels, HU2 levels) [mm] \cr + } + (refer to the provided references or to the package source code for further details on these model outputs) +} +\description{ +Function which performs a single run for the GR5J daily lumped model. +} +\details{ +For further details on the model, see the references section. +For further details on the argument structures and initialisation options, see \code{\link{CreateRunOptions}}. +} +\examples{ +## load of catchment data +require(airGR) +data(L0123001) + +## preparation of the InputsModel object +InputsModel <- CreateInputsModel(FUN_MOD=RunModel_GR5J,DatesR=BasinObs$DatesR, + Precip=BasinObs$P,PotEvap=BasinObs$E) + +## run period selection +Ind_Run <- seq(which(format(BasinObs$DatesR,format="\%d/\%m/\%Y \%H:\%M")=="01/01/1990 00:00"), + which(format(BasinObs$DatesR,format="\%d/\%m/\%Y \%H:\%M")=="31/12/1999 00:00")) + +## preparation of the RunOptions object +RunOptions <- CreateRunOptions(FUN_MOD=RunModel_GR5J,InputsModel=InputsModel,IndPeriod_Run=Ind_Run) + +## simulation +Param <- c(245.918,1.027,90.017,2.198,0.434) +OutputsModel <- RunModel_GR5J(InputsModel=InputsModel,RunOptions=RunOptions,Param=Param) + +## results preview +plot_OutputsModel(OutputsModel=OutputsModel,Qobs=BasinObs$Qmm[Ind_Run]) + +## efficiency criterion: Nash-Sutcliffe Efficiency +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) +OutputsCrit <- ErrorCrit_NSE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\\n",sep="")) + +} +\author{ +Laurent Coron (December 2013) +} +\references{ +Le Moine, N. (2008), Le bassin versant de surface vu par le souterrain : une voie d'amélioration des performances + et du réalisme des modèles pluie-débit ?, PhD thesis (french), UPMC, Paris, France. \cr + Pushpalatha, R., C. Perrin, N. Le Moine, T. Mathevet, and V. Andréassian (2011), + A downward structural sensitivity analysis of hydrological models to improve low-flow simulation, + Journal of Hydrology, 411(1-2), 66-76, doi:10.1016/j.jhydrol.2011.09.034. \cr +} +\seealso{ +\code{\link{RunModel_GR4J}}, \code{\link{RunModel_GR6J}}, \code{\link{RunModel_CemaNeigeGR5J}}, + \code{\link{CreateInputsModel}}, \code{\link{CreateRunOptions}}. +} + diff --git a/man/RunModel_GR6J.Rd b/man/RunModel_GR6J.Rd new file mode 100644 index 0000000000000000000000000000000000000000..4fe20c625a05d1ffddc701f3e8a0750bd75e6054 --- /dev/null +++ b/man/RunModel_GR6J.Rd @@ -0,0 +1,98 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/RunModel_GR6J.R +\encoding{UTF-8} +\name{RunModel_GR6J} +\alias{RunModel_GR6J} +\title{Run with the GR6J hydrological model} +\usage{ +RunModel_GR6J(InputsModel, RunOptions, Param) +} +\arguments{ +\item{InputsModel}{[object of class \emph{InputsModel}] see \code{\link{CreateInputsModel}} for details} + +\item{RunOptions}{[object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details} + +\item{Param}{[numeric] vector of 6 parameters +\tabular{ll}{ +GR6J X1 \tab production store capacity [mm] \cr +GR6J X2 \tab intercatchment exchange coefficient 1 [mm/d] \cr +GR6J X3 \tab routing store capacity [mm] \cr +GR6J X4 \tab unit hydrograph time constant [d] \cr +GR6J X5 \tab intercatchment exchange coefficient 2 [-] \cr +GR6J X6 \tab coefficient for emptying exponential store [-] \cr +}} +} +\value{ +[list] list containing the function outputs organised as follows: + \tabular{ll}{ + \emph{$DatesR } \tab [POSIXlt] series of dates \cr + \emph{$PotEvap } \tab [numeric] series of input potential evapotranspiration [mm/d] \cr + \emph{$Precip } \tab [numeric] series of input total precipitation [mm/d] \cr + \emph{$Prod } \tab [numeric] series of production store level (X(2)) [mm] \cr + \emph{$AE } \tab [numeric] series of actual evapotranspiration [mm/d] \cr + \emph{$Perc } \tab [numeric] series of percolation (PERC) [mm/d] \cr + \emph{$PR } \tab [numeric] series of PR=PN-PS+PERC [mm/d] \cr + \emph{$Q9 } \tab [numeric] series of HU1 outflow (Q9) [mm/d] \cr + \emph{$Q1 } \tab [numeric] series of HU2 outflow (Q1) [mm/d] \cr + \emph{$Rout } \tab [numeric] series of routing store level (X(1)) [mm] \cr + \emph{$Exch } \tab [numeric] series of potential semi-exchange between catchments [mm/d] \cr + \emph{$AExch } \tab [numeric] series of actual exchange between catchments (1+2) [mm/d] \cr + \emph{$QR } \tab [numeric] series of routing store outflow (QR) [mm/d] \cr + \emph{$QR1 } \tab [numeric] series of exponential store outflow (QR1) [mm/d] \cr + \emph{$Exp } \tab [numeric] series of exponential store level (X(6)) (negative) [mm] \cr + \emph{$QD } \tab [numeric] series of direct flow from HU2 after exchange (QD) [mm/d] \cr + \emph{$Qsim } \tab [numeric] series of Qsim [mm/d] \cr + \emph{$StateEnd} \tab [numeric] states at the end of the run (res. levels, HU1 levels, HU2 levels) [mm] \cr + } + (refer to the provided references or to the package source code for further details on these model outputs) +} +\description{ +Function which performs a single run for the GR6J daily lumped model. +} +\details{ +For further details on the model, see the references section. +For further details on the argument structures and initialisation options, see \code{\link{CreateRunOptions}}. +} +\examples{ +## load of catchment data +require(airGR) +data(L0123001) + +## preparation of the InputsModel object +InputsModel <- CreateInputsModel(FUN_MOD=RunModel_GR6J,DatesR=BasinObs$DatesR, + Precip=BasinObs$P,PotEvap=BasinObs$E) + +## run period selection +Ind_Run <- seq(which(format(BasinObs$DatesR,format="\%d/\%m/\%Y \%H:\%M")=="01/01/1990 00:00"), + which(format(BasinObs$DatesR,format="\%d/\%m/\%Y \%H:\%M")=="31/12/1999 00:00")) + +## preparation of the RunOptions object +RunOptions <- CreateRunOptions(FUN_MOD=RunModel_GR6J,InputsModel=InputsModel,IndPeriod_Run=Ind_Run) + +## simulation +Param <- c(242.257,0.637,53.517,2.218,0.424,4.759) +OutputsModel <- RunModel_GR6J(InputsModel=InputsModel,RunOptions=RunOptions,Param=Param) + +## results preview +plot_OutputsModel(OutputsModel=OutputsModel,Qobs=BasinObs$Qmm[Ind_Run]) + +## efficiency criterion: Nash-Sutcliffe Efficiency +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) +OutputsCrit <- ErrorCrit_NSE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\\n",sep="")) + +} +\author{ +Laurent Coron (December 2013) +} +\references{ +Pushpalatha, R., C. Perrin, N. Le Moine, T. Mathevet and V. Andréassian (2011), + A downward structural sensitivity analysis of hydrological models to improve low-flow simulation, + Journal of Hydrology, 411(1-2), 66-76, doi:10.1016/j.jhydrol.2011.09.034. \cr +} +\seealso{ +\code{\link{RunModel_GR4J}}, \code{\link{RunModel_GR5J}}, \code{\link{RunModel_CemaNeigeGR6J}}, + \code{\link{CreateInputsModel}}, \code{\link{CreateRunOptions}}. +} + diff --git a/man/SeriesAggreg.Rd b/man/SeriesAggreg.Rd new file mode 100644 index 0000000000000000000000000000000000000000..dc1e84fe5dd8ef94896ddbcfb888e18143fd9b9a --- /dev/null +++ b/man/SeriesAggreg.Rd @@ -0,0 +1,57 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/SeriesAggreg.R +\encoding{UTF-8} +\name{SeriesAggreg} +\alias{SeriesAggreg} +\title{Conversion of time series to another time-step (aggregation only)} +\usage{ +SeriesAggreg(TabSeries, TimeFormat, NewTimeFormat, ConvertFun, + YearFirstMonth = 1, quiet = FALSE) +} +\arguments{ +\item{TabSeries}{[POSIXlt+numeric] dataframe containing the vector of dates and the time series values} + +\item{TimeFormat}{[character] desired format (i.e. "hourly", "daily", "monthly" or "yearly")} + +\item{NewTimeFormat}{[character] desired format (i.e. "hourly", "daily", "monthly" or "yearly")} + +\item{ConvertFun}{[character] names of aggregation functions (e.g. for P[mm],T[deg],Q[mm] : ConvertFun=c("sum","mean","sum"))} + +\item{YearFirstMonth}{(optional) [numeric] integer used when NewTimeFormat="yearly" to set when the starting month of the year (e.g. 01 for calendar year or 09 for hydrological year starting in september)} + +\item{quiet}{(optional) [boolean] boolean indicating if the function is run in quiet mode or not, default=FALSE} +} +\value{ +[POSIXlt+numeric] dataframe containing a vector of aggregated dates and time series values +} +\description{ +Conversion of time series to another time-step (aggregation only). +Warning : on the aggregated outputs, the dates correpond to the beginning ot the time-step +(e.g. for daily time-series 01/03/2005 00:00 = value for period 01/03/2005 00:00 - 01/03/2005 23:59 ) +(e.g. for monthly time-series 01/03/2005 00:00 = value for period 01/03/2005 00:00 - 31/03/2005 23:59 ) +(e.g. for yearly time-series 01/03/2005 00:00 = value for period 01/03/2005 00:00 - 28/02/2006 23:59 ) +} +\examples{ +## load of catchment data +require(airGR) + +## preparation of the initial time series data frame at the daily time-step +data(L0123002) +TabSeries <- data.frame(BasinObs$DatesR,BasinObs$P,BasinObs$E,BasinObs$T,BasinObs$Qmm) +TimeFormat <- "daily" + +## conversion at the monthly time-step +NewTimeFormat <- "monthly" +ConvertFun <- c("sum","sum","mean","sum") +NewTabSeries <- SeriesAggreg(TabSeries=TabSeries,TimeFormat,NewTimeFormat,ConvertFun) + +## conversion at the yearly time-step +NewTimeFormat <- "yearly" +ConvertFun <- c("sum","sum","mean","sum") +NewTabSeries <- SeriesAggreg(TabSeries=TabSeries,TimeFormat,NewTimeFormat,ConvertFun) + +} +\author{ +Laurent Coron (March 2015) +} + diff --git a/man/TransfoParam.Rd b/man/TransfoParam.Rd new file mode 100644 index 0000000000000000000000000000000000000000..8124b307654d2ca0894024bb9c54656e05a82fbe --- /dev/null +++ b/man/TransfoParam.Rd @@ -0,0 +1,46 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/TransfoParam.R +\encoding{UTF-8} +\name{TransfoParam} +\alias{TransfoParam} +\title{Transformation of the parameters using the provided function} +\usage{ +TransfoParam(ParamIn, Direction, FUN_TRANSFO) +} +\arguments{ +\item{ParamIn}{[numeric] matrix of parameter sets (sets in line, parameter values in column)} + +\item{Direction}{[character] direction of the transformation: use "RT" for Real->Transformed and "TR" for Transformed->Real} + +\item{FUN_TRANSFO}{[function] model parameters transformation function (e.g. TransfoParam_GR4J, TransfoParam_CemaNeigeGR4J)} +} +\value{ +\emph{ParamOut} [numeric] matrix of parameter sets (sets in line, parameter values in column) +} +\description{ +Function which transforms model parameters (from real to transformed parameters and vice versa) using the provided function. +} +\examples{ +require(airGR) + +## transformation Real->Transformed for the GR4J model + Xreal <- matrix( c( 221.41, -3.63, 30.00, 1.37, + 347.23, -1.03, 60.34, 1.76, + 854.06, -0.10, 148.41, 2.34), + ncol=4,byrow=TRUE) + Xtran <- TransfoParam(ParamIn=Xreal,Direction="RT",FUN_TRANSFO=TransfoParam_GR4J) + +## transformation Transformed->Real for the GR4J model + Xtran <- matrix( c( +3.60, -2.00, +3.40, -9.10, + +3.90, -0.90, +4.10, -8.70, + +4.50, -0.10, +5.00, -8.10), + ncol=4,byrow=TRUE) + Xreal <- TransfoParam(ParamIn=Xtran,Direction="TR",FUN_TRANSFO=TransfoParam_GR4J) +} +\author{ +Laurent Coron (June 2014) +} +\seealso{ +\code{\link{TransfoParam_GR4J}}, \code{\link{TransfoParam_GR5J}}, \code{\link{TransfoParam_GR6J}}, \code{\link{TransfoParam_CemaNeige}} +} + diff --git a/man/TransfoParam_CemaNeige.Rd b/man/TransfoParam_CemaNeige.Rd new file mode 100644 index 0000000000000000000000000000000000000000..0dd630f4df47ca92709a68b366ad76d6d0479907 --- /dev/null +++ b/man/TransfoParam_CemaNeige.Rd @@ -0,0 +1,44 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/TransfoParam_CemaNeige.R +\encoding{UTF-8} +\name{TransfoParam_CemaNeige} +\alias{TransfoParam_CemaNeige} +\title{Transformation of the parameters from the CemaNeige module} +\usage{ +TransfoParam_CemaNeige(ParamIn, Direction) +} +\arguments{ +\item{ParamIn}{[numeric] matrix of parameter sets (sets in line, parameter values in column)} + +\item{Direction}{[character] direction of the transformation: use "RT" for Real->Transformed and "TR" for Transformed->Real} +} +\value{ +\emph{ParamOut} [numeric] matrix of parameter sets (sets in line, parameter values in column) +} +\description{ +Function which transforms model parameters (from real to transformed parameters and vice versa). +} +\examples{ +require(airGR) + +## transformation Real->Transformed for the CemaNeige module + Xreal <- matrix( c( 0.19, 1.73, + 0.39, 2.51, + 0.74, 4.06), + ncol=2,byrow=TRUE) + Xtran <- TransfoParam_CemaNeige(ParamIn=Xreal,Direction="RT") + +## transformation Transformed->Real for the CemaNeige module + Xtran <- matrix( c( -6.26, +0.55, + -2.13, +0.92, + +4.86, +1.40) + ,ncol=2,byrow=TRUE) + Xreal <- TransfoParam_CemaNeige(ParamIn=Xtran,Direction="TR") +} +\author{ +Laurent Coron (December 2013) +} +\seealso{ +\code{\link{TransfoParam}}, \code{\link{TransfoParam_GR4J}}, \code{\link{TransfoParam_GR5J}}, \code{\link{TransfoParam_GR6J}} +} + diff --git a/man/TransfoParam_GR1A.Rd b/man/TransfoParam_GR1A.Rd new file mode 100644 index 0000000000000000000000000000000000000000..d9067e79faeb5b93ec082a36d94e23ec1a56f97f --- /dev/null +++ b/man/TransfoParam_GR1A.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/TransfoParam_GR1A.R +\encoding{UTF-8} +\name{TransfoParam_GR1A} +\alias{TransfoParam_GR1A} +\title{Transformation of the parameters from the GR1A model} +\usage{ +TransfoParam_GR1A(ParamIn, Direction) +} +\arguments{ +\item{ParamIn}{[numeric] matrix of parameter sets (sets in line, parameter values in column)} + +\item{Direction}{[character] direction of the transformation: use "RT" for Real->Transformed and "TR" for Transformed->Real} +} +\value{ +\emph{ParamOut} [numeric] matrix of parameter sets (sets in line, parameter values in column) +} +\description{ +Function which transforms model parameters (from real to transformed parameters and vice versa). +} +\author{ +Laurent Coron (March 2015) +} + diff --git a/man/TransfoParam_GR2M.Rd b/man/TransfoParam_GR2M.Rd new file mode 100644 index 0000000000000000000000000000000000000000..d031bfa47b889f33ad9aa507c0375fe6e3751e30 --- /dev/null +++ b/man/TransfoParam_GR2M.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/TransfoParam_GR2M.R +\encoding{UTF-8} +\name{TransfoParam_GR2M} +\alias{TransfoParam_GR2M} +\title{Transformation of the parameters from the GR2M model} +\usage{ +TransfoParam_GR2M(ParamIn, Direction) +} +\arguments{ +\item{ParamIn}{[numeric] matrix of parameter sets (sets in line, parameter values in column)} + +\item{Direction}{[character] direction of the transformation: use "RT" for Real->Transformed and "TR" for Transformed->Real} +} +\value{ +\emph{ParamOut} [numeric] matrix of parameter sets (sets in line, parameter values in column) +} +\description{ +Function which transforms model parameters (from real to transformed parameters and vice versa). +} +\author{ +Laurent Coron (March 2015) +} + diff --git a/man/TransfoParam_GR4H.Rd b/man/TransfoParam_GR4H.Rd new file mode 100644 index 0000000000000000000000000000000000000000..9529ebc322d7a7c006b05682f19cc2804ea6d74a --- /dev/null +++ b/man/TransfoParam_GR4H.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/TransfoParam_GR4H.R +\encoding{UTF-8} +\name{TransfoParam_GR4H} +\alias{TransfoParam_GR4H} +\title{Transformation of the parameters from the GR4H model} +\usage{ +TransfoParam_GR4H(ParamIn, Direction) +} +\arguments{ +\item{ParamIn}{[numeric] matrix of parameter sets (sets in line, parameter values in column)} + +\item{Direction}{[character] direction of the transformation: use "RT" for Real->Transformed and "TR" for Transformed->Real} +} +\value{ +\emph{ParamOut} [numeric] matrix of parameter sets (sets in line, parameter values in column) +} +\description{ +Function which transforms model parameters (from real to transformed parameters and vice versa). +} +\author{ +Laurent Coron (July 2014) +} + diff --git a/man/TransfoParam_GR4J.Rd b/man/TransfoParam_GR4J.Rd new file mode 100644 index 0000000000000000000000000000000000000000..329af7908f7314ba7bef3ed4fd4993308b3c670e --- /dev/null +++ b/man/TransfoParam_GR4J.Rd @@ -0,0 +1,44 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/TransfoParam_GR4J.R +\encoding{UTF-8} +\name{TransfoParam_GR4J} +\alias{TransfoParam_GR4J} +\title{Transformation of the parameters from the GR4J model} +\usage{ +TransfoParam_GR4J(ParamIn, Direction) +} +\arguments{ +\item{ParamIn}{[numeric] matrix of parameter sets (sets in line, parameter values in column)} + +\item{Direction}{[character] direction of the transformation: use "RT" for Real->Transformed and "TR" for Transformed->Real} +} +\value{ +\emph{ParamOut} [numeric] matrix of parameter sets (sets in line, parameter values in column) +} +\description{ +Function which transforms model parameters (from real to transformed parameters and vice versa). +} +\examples{ +require(airGR) + +## transformation Real->Transformed for the GR4J model + Xreal <- matrix( c( 221.41, -3.63, 30.00, 1.37, + 347.23, -1.03, 60.34, 1.76, + 854.06, -0.10, 148.41, 2.34), + ncol=4,byrow=TRUE) + Xtran <- TransfoParam_GR4J(ParamIn=Xreal,Direction="RT") + +## transformation Transformed->Real for the GR4J model + Xtran <- matrix( c( +3.60, -2.00, +3.40, -9.10, + +3.90, -0.90, +4.10, -8.70, + +4.50, -0.10, +5.00, -8.10), + ncol=4,byrow=TRUE) + Xreal <- TransfoParam_GR4J(ParamIn=Xtran,Direction="TR") +} +\author{ +Laurent Coron (December 2013) +} +\seealso{ +\code{\link{TransfoParam}}, \code{\link{TransfoParam_GR5J}}, \code{\link{TransfoParam_GR6J}}, \code{\link{TransfoParam_CemaNeige}} +} + diff --git a/man/TransfoParam_GR5J.Rd b/man/TransfoParam_GR5J.Rd new file mode 100644 index 0000000000000000000000000000000000000000..667851df384f2120d5fe1ddc6823b1823b138efb --- /dev/null +++ b/man/TransfoParam_GR5J.Rd @@ -0,0 +1,44 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/TransfoParam_GR5J.R +\encoding{UTF-8} +\name{TransfoParam_GR5J} +\alias{TransfoParam_GR5J} +\title{Transformation of the parameters from the GR5J model} +\usage{ +TransfoParam_GR5J(ParamIn, Direction) +} +\arguments{ +\item{ParamIn}{[numeric] matrix of parameter sets (sets in line, parameter values in column)} + +\item{Direction}{[character] direction of the transformation: use "RT" for Real->Transformed and "TR" for Transformed->Real} +} +\value{ +\emph{ParamOut} [numeric] matrix of parameter sets (sets in line, parameter values in column) +} +\description{ +Function which transforms model parameters (from real to transformed parameters and vice versa). +} +\examples{ +require(airGR) + +## transformation Real->Transformed for the GR5J model + Xreal <- matrix( c( 221.41, -2.65, 27.11, 1.37, -0.76, + 347.23, -0.64, 60.34, 1.76, 0.30, + 854.01, -0.10, 148.41, 2.34, 0.52), + ncol=5,byrow=TRUE) + Xtran <- TransfoParam_GR5J(ParamIn=Xreal,Direction="RT") + +## transformation Transformed->Real for the GR5J model + Xtran <- matrix( c( +3.60, -1.70, +3.30, -9.10, -0.70, + +3.90, -0.60, +4.10, -8.70, +0.30, + +4.50, -0.10, +5.00, -8.10, +0.50), + ncol=5,byrow=TRUE) + Xreal <- TransfoParam_GR5J(ParamIn=Xtran,Direction="TR") +} +\author{ +Laurent Coron (December 2013) +} +\seealso{ +\code{\link{TransfoParam}}, \code{\link{TransfoParam_GR4J}}, \code{\link{TransfoParam_GR6J}}, \code{\link{TransfoParam_CemaNeige}} +} + diff --git a/man/TransfoParam_GR6J.Rd b/man/TransfoParam_GR6J.Rd new file mode 100644 index 0000000000000000000000000000000000000000..a8e761e671e435f0d226b317059aade5c7e0588f --- /dev/null +++ b/man/TransfoParam_GR6J.Rd @@ -0,0 +1,44 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/TransfoParam_GR6J.R +\encoding{UTF-8} +\name{TransfoParam_GR6J} +\alias{TransfoParam_GR6J} +\title{Transformation of the parameters from the GR6J model} +\usage{ +TransfoParam_GR6J(ParamIn, Direction) +} +\arguments{ +\item{ParamIn}{[numeric] matrix of parameter sets (sets in line, parameter values in column)} + +\item{Direction}{[character] direction of the transformation: use "RT" for Real->Transformed and "TR" for Transformed->Real} +} +\value{ +\emph{ParamOut} [numeric] matrix of parameter sets (sets in line, parameter values in column) +} +\description{ +Function which transforms model parameters (from real to transformed parameters and vice versa). +} +\examples{ +require(airGR) + +## transformation Real->Transformed for the GR6J model + Xreal <- matrix( c( 221.41, -1.18, 27.11, 1.37, -0.18, 20.09, + 347.23, -0.52, 60.34, 1.76, 0.02, 54.60, + 854.06, 0.52, 148.41, 2.34, 0.22, 148.41), + ncol=6,byrow=TRUE) + Xtran <- TransfoParam_GR6J(ParamIn=Xreal,Direction="RT") + +## transformation Transformed->Real for the GR6J model + Xtran <- matrix( c( +3.60, -1.00, +3.30, -9.10, -0.90, +3.00, + +3.90, -0.50, +4.10, -8.70, +0.10, +4.00, + +4.50, +0.50, +5.00, -8.10, +1.10, +5.00), + ncol=6,byrow=TRUE) + Xreal <- TransfoParam_GR6J(ParamIn=Xtran,Direction="TR") +} +\author{ +Laurent Coron (December 2013) +} +\seealso{ +\code{\link{TransfoParam}}, \code{\link{TransfoParam_GR4J}}, \code{\link{TransfoParam_GR5J}}, \code{\link{TransfoParam_CemaNeige}} +} + diff --git a/man/airGR.Rd b/man/airGR.Rd new file mode 100644 index 0000000000000000000000000000000000000000..e5aa8c4b60022fb4f758c84179e10dba5e0f1f70 --- /dev/null +++ b/man/airGR.Rd @@ -0,0 +1,71 @@ +\name{airGR} +\alias{airGR} +\docType{package} +\encoding{UTF-8} +\title{Modelling tools used at Irstea-HBAN (France), including GR4J and CemaNeige} +\description{ +This package brings into R the hydrological modelling tools used at Irstea-HBAN (France), including GR4H, GR4J, GR5J, GR6J, GR2M, GR1A and CemaNeige. Each model core is coded in FORTRAN to ensure low computational time. The other package functions (i.e. mainly the calibration algorithm and the efficiency criteria) are coded in R. \cr + +##### Functions and objects ##### + +The airGR package has been designed to fulfil two major requirements: facilitate the use by non-expert users and allow flexibility regarding the addition of external criteria, models or calibration algorithms. The names of the functions and their arguments were chosen to this end. + +The package is mostly based on three families of functions: \cr +- the functions belonging to the \code{\link{RunModel}} family require three arguments: \emph{InputsModel}, \emph{RunOptions} and \emph{Param}; please refer to help pages \code{\link{CreateInputsModel}} and \code{\link{CreateRunOptions}} for further details and examples; \cr +- the functions belonging to the \code{\link{ErrorCrit}} family require two arguments: \emph{InputsCrit} and \emph{OutputsModel}; please refer to help pages \code{\link{CreateInputsCrit}} and \code{\link{RunModel}} for further details and examples; \cr +- the functions belonging to the \code{\link{Calibration}} family require four arguments: \emph{InputsModel}, \emph{RunOptions}, \emph{InputsCrit} and \emph{CalibOptions}; please refer to help pages \code{\link{CreateInputsModel}}, \code{\link{CreateRunOptions}}, \code{\link{CreateInputsCrit}} and \code{\link{CreateCalibOptions}} for further details and examples. + +In order to limit the risk of mis-use and increase the flexibility of these main functions, we imposed the structure of their arguments and defined their class. Most users will not need to worry about these imposed structures since functions are provided to prepare these arguments for them: \code{\link{CreateInputsModel}}, \code{\link{CreateRunOptions}}, \code{\link{CreateInputsCrit}}, \code{\link{CreateCalibOptions}}. However, advanced users wishing to supplement the package with their own models will need to comply with these imposed structures and refer to the package source codes to get all the specification requirements. \cr + +##### Models ##### + +Three hydrological models and one snow melt and accumulation module are implemented in airGR. The snow module can also be used alone and each hydrological model can either be used alone or together with the snow module. \cr +These models can be called within airGR using the following functions: \cr +- \code{\link{RunModel_GR4H}}: four-parameter hourly lumped conceptual model (Mathevet, 2005) \cr +- \code{\link{RunModel_GR4J}}: four-parameter daily lumped conceptual model (Perrin et al., 2003) \cr +- \code{\link{RunModel_GR5J}}: five-parameter daily lumped conceptual model (Le Moine, 2008) \cr +- \code{\link{RunModel_GR6J}}: six-parameter daily lumped conceptual model (Pushpalatha, 2013) \cr +- \code{\link{RunModel_GR2M}}: two-parameter monthly lumped conceptual model (Mouelhi, 2003) \cr +- \code{\link{RunModel_GR1A}}: one-parameter yearly lumped conceptual model (Mouelhi, 2003, 2006) \cr +- \code{\link{RunModel_CemaNeige}}: two-parameter degree-day snow melt and accumulation daily module (Valéry et al., 2014) \cr +- \code{\link{RunModel_CemaNeigeGR4J}}: combined use of GR4J and CemaNeige \cr +- \code{\link{RunModel_CemaNeigeGR5J}}: combined use of GR5J and CemaNeige \cr +- \code{\link{RunModel_CemaNeigeGR6J}}: combined use of GR6J and CemaNeige + +##### How to get started ##### + +To learn how to use the functions from the airGR package, it is recommended to follow the five steps described below: \cr +1. refer to the help for \code{\link{RunModel_GR4H}} then run the provided example to assess how to make a simulation ; \cr +2. refer to the help for \code{\link{CreateInputsModel}} to understand how the inputs of a model are prepared/organised ; \cr +3. refer to the help for \code{\link{CreateRunOptions}} to understand how the run options of a model are parametrised/organised ; \cr +4. refer to the help for \code{\link{ErrorCrit_NSE}} and \code{\link{CreateInputsCrit}} to understand how the computation of an error criterion is prepared/made ; \cr +5. refer to the help for \code{\link{Calibration_HBAN}}, run the provided example and then refer to the help for \code{\link{CreateCalibOptions}} to understand how a model calibration is prepared/made ; + +##### References ##### + +- Le Moine, N. (2008), Le bassin versant de surface vu par le souterrain : une voie d'amélioration des performances et du réalisme des modèles pluie-débit ?, PhD thesis (in French), UPMC, Paris, France. \cr +- Mathevet, T. (2005), Quels modèles pluie-débit globaux pour le pas de temps horaire ? Développement empirique et comparaison de modèles sur un large échantillon de bassins versants, PhD thesis (in French), ENGREF - Cemagref (Antony), Paris, France. \cr +- Mouelhi S. (2003), Vers une chaîne cohérente de modèles pluie-débit conceptuels globaux aux pas de temps pluriannuel, annuel, mensuel et journalier, PhD thesis (in French), ENGREF - Cemagref Antony, Paris, France. \cr +- Mouelhi, S., C. Michel, C. Perrin and V. Andréassian (2006), Stepwise development of a two-parameter monthly water balance model, Journal of Hydrology, 318(1-4), 200-214, doi:10.1016/j.jhydrol.2005.06.014. \cr +- Perrin, C., C. Michel and V. Andréassian (2003), Improvement of a parsimonious model for streamflow simulation, Journal of Hydrology, 279(1-4), 275-289, doi:10.1016/S0022-1694(03)00225-7. \cr +- Pushpalatha, R., C. Perrin, N. Le Moine, T. Mathevet and V. Andréassian (2011), A downward structural sensitivity analysis of hydrological models to improve low-flow simulation, Journal of Hydrology, 411(1-2), 66-76, doi:10.1016/j.jhydrol.2011.09.034. \cr +- Valéry, A., V. Andréassian and C. Perrin (2014), "As simple as possible but not simpler": What is useful in a temperature-based snow-accounting routine? Part 2 - Sensitivity analysis of the Cemaneige snow accounting routine on 380 catchments, Journal of Hydrology, doi:10.1016/j.jhydrol.2014.04.058. \cr + +} + + +\details{ +\tabular{ll}{ +Package: \tab airGR\cr +Type: \tab Package\cr +Version: \tab 0.8.1.0\cr +Date: \tab 2015-10-27\cr +License: \tab GPL-2\cr +} +} +\author{ +Author: Laurent CORON \cr +Maintainer: Laurent CORON, Olivier DELAIGUE <olivier.delaigue@irstea.fr> +} + +\keyword{package, hydrology, modelling} diff --git a/man/plot_OutputsModel.Rd b/man/plot_OutputsModel.Rd new file mode 100644 index 0000000000000000000000000000000000000000..be75d3088cfc1f53d119ec46f7dd1c1e14fee077 --- /dev/null +++ b/man/plot_OutputsModel.Rd @@ -0,0 +1,40 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/plot_OutputsModel.R +\encoding{UTF-8} +\name{plot_OutputsModel} +\alias{plot_OutputsModel} +\title{Default preview of model outputs} +\usage{ +plot_OutputsModel(OutputsModel, Qobs = NULL, IndPeriod_Plot = NULL, + BasinArea = NULL, PlotChoice = "all", quiet = FALSE) +} +\arguments{ +\item{OutputsModel}{[object of class \emph{OutputsModel}] list of model outputs (which must at least include DatesR, Precip and Qsim) [POSIXlt, mm, mm]} + +\item{Qobs}{(optional) [numeric] time series of observed flow (for the same time-steps than simulated) [mm]} + +\item{IndPeriod_Plot}{(optional) [numeric] indices of the time-steps to be plotted (among the OutputsModel series)} + +\item{BasinArea}{(optional) [numeric] basin area [km2], used to plot flow axes in m3/s} + +\item{PlotChoice}{(optional) [character] choice of plots \cr (e.g. c("Precip","SnowPack","Flows","Regime","CumFreq","CorQQ")), default="all"} + +\item{quiet}{(optional) [boolean] boolean indicating if the function is run in quiet mode or not, default=FALSE} +} +\value{ +screen plot window +} +\description{ +Function which creates a screen plot giving an overview of the model outputs +} +\details{ +Dashboard of results including various graphs (depending on the model): +(1) time series of total precipitation and simulated flows (and observed flows if provided) +(2) interannual median monthly simulated flow (and observed flows if provided) +(3) correlation plot between simulated and observed flows (if observed flows provided) +(4) cumulative frequency plot for simulated flows (and observed flows if provided) +} +\author{ +Laurent Coron (June 2014) +} + diff --git a/src/frun_CEMANEIGE.f b/src/frun_CEMANEIGE.f new file mode 100644 index 0000000000000000000000000000000000000000..77984f8e8aa0bbf2f43e05037c877c4e93d74115 --- /dev/null +++ b/src/frun_CEMANEIGE.f @@ -0,0 +1,135 @@ + + + SUBROUTINE frun_CEMANEIGE( + !inputs + & LInputs , ! [integer] length of input and output series + & InputsPrecip , ! [double] input series of total precipitation [mm] + & InputsFracSolidPrecip, ! [double] input series of fraction of solid precipitation [0-1] + & InputsTemp , ! [double] input series of air mean temperature [degC] + & MeanAnSolidPrecip , ! [double] value of annual mean solid precip [mm/y] + & NParam , ! [integer] number of model parameter + & Param , ! [double] parameter set + & NStates , ! [integer] number of state variables used for model initialising = 2 + & StateStart , ! [double] state variables used when the model run starts + & NOutputs , ! [integer] number of output series + & IndOutputs , ! [integer] indices of output series + !outputs + & Outputs , ! [double] output series + & StateEnd ) ! [double] state variables at the end of the model run + + + !DEC$ ATTRIBUTES DLLEXPORT :: frun_cemaneige + + + Implicit None + !### input and output variables + integer, intent(in) :: LInputs,NParam,NStates,NOutputs + doubleprecision, intent(in) :: MeanAnSolidPrecip + doubleprecision, dimension(LInputs) :: InputsPrecip + doubleprecision, dimension(LInputs) :: InputsFracSolidPrecip + doubleprecision, dimension(LInputs) :: InputsTemp + doubleprecision, dimension(NParam) :: Param + doubleprecision, dimension(NStates) :: StateStart + doubleprecision, dimension(NStates) :: StateEnd + integer, dimension(NOutputs) :: IndOutputs + doubleprecision, dimension(LInputs,NOutputs) :: Outputs + + !parameters, internal states and variables + doubleprecision CTG,Kf + doubleprecision G,eTG,PliqAndMelt + doubleprecision Tmelt,Gthreshold,MinSpeed + doubleprecision Pliq,Psol,Gratio,PotMelt,Melt + integer I,K + + !-------------------------------------------------------------- + !Initialisations + !-------------------------------------------------------------- + + !initilisation des constantes + Tmelt=0 + Gthreshold=0.9*MeanAnSolidPrecip + MinSpeed=0.1 + + !initilisation of model states using StateStart + G=StateStart(1) + eTG=StateStart(2) + PliqAndMelt=0 + + !setting parameter values + CTG=Param(1) + Kf=Param(2) + + !initialisation of model outputs +c StateEnd = -999.999 !initialisation made in R +c Outputs = -999.999 !initialisation made in R + + + + !-------------------------------------------------------------- + !Time loop + !-------------------------------------------------------------- + DO k=1,LInputs + + !SolidPrecip and LiquidPrecip + Pliq=(1-InputsFracSolidPrecip(k))*InputsPrecip(k) + Psol=InputsFracSolidPrecip(k)*InputsPrecip(k) + + !Snow pack volume before melt + G=G+Psol + + !Snow pack thermal state before melt + eTG=CTG*eTG + (1-CTG)*InputsTemp(k) + IF(eTG.GT.0) eTG=0 + + !Potential melt + IF(eTG.EQ.0.AND.InputsTemp(k).GT.Tmelt) THEN + PotMelt=Kf*(InputsTemp(k)-Tmelt) + IF(PotMelt.GT.G) PotMelt=G + ELSE + PotMelt=0 + ENDIF + + !Gratio + IF(G.LT.Gthreshold) THEN + Gratio=G/Gthreshold + ELSE + Gratio=1 + ENDIF + + !Actual melt + Melt=((1-MinSpeed)*Gratio+MinSpeed)*PotMelt + + !Update of snow pack volume + G=G-Melt + + !Update of Gratio + IF(G.LT.Gthreshold) THEN + Gratio=G/Gthreshold + ELSE + Gratio=1 + ENDIF + + !Water volume to pass to the hydrological model + PliqAndMelt=Pliq+Melt + + !Storage of outputs + DO I=1,NOutputs + IF(IndOutputs(I).EQ.1) Outputs(k,I)=Pliq + IF(IndOutputs(I).EQ.2) Outputs(k,I)=Psol + IF(IndOutputs(I).EQ.3) Outputs(k,I)=G + IF(IndOutputs(I).EQ.4) Outputs(k,I)=eTG + IF(IndOutputs(I).EQ.5) Outputs(k,I)=Gratio + IF(IndOutputs(I).EQ.6) Outputs(k,I)=PotMelt + IF(IndOutputs(I).EQ.7) Outputs(k,I)=Melt + IF(IndOutputs(I).EQ.8) Outputs(k,I)=PliqAndMelt + ENDDO + + ENDDO + + StateEnd(1)=G + StateEnd(2)=eTG + + RETURN + + ENDSUBROUTINE + diff --git a/src/frun_GR1A.f b/src/frun_GR1A.f new file mode 100644 index 0000000000000000000000000000000000000000..f9d34dae30e7e4eb42d510371882bdad3236ea3b --- /dev/null +++ b/src/frun_GR1A.f @@ -0,0 +1,116 @@ + + + SUBROUTINE frun_GR1A( + !inputs + & LInputs , ! [numeric] length of input and output series + & InputsPrecip , ! [numeric] input series of total precipitation [mm] + & InputsPE , ! [numeric] input series PE [mm] + & NParam , ! [numeric] number of model parameter + & Param , ! [numeric] parameter set + & NStates , ! [numeric] number of state variables used for model initialising + & StateStart , ! [numeric] state variables used when the model run starts (none here) + & NOutputs , ! [numeric] number of output series + & IndOutputs , ! [numeric] indices of output series + !outputs + & Outputs , ! [numeric] output series + & StateEnd ) ! [numeric] state variables at the end of the model run (none here) + + + !DEC$ ATTRIBUTES DLLEXPORT :: frun_gr1a + + + Implicit None + !### input and output variables + integer, intent(in) :: LInputs,NParam,NStates,NOutputs + doubleprecision, dimension(LInputs) :: InputsPrecip + doubleprecision, dimension(LInputs) :: InputsPE + doubleprecision, dimension(NParam) :: Param + doubleprecision, dimension(NStates) :: StateStart + doubleprecision, dimension(NStates) :: StateEnd + integer, dimension(NOutputs) :: IndOutputs + doubleprecision, dimension(LInputs,NOutputs) :: Outputs + + !parameters, internal states and variables + integer NMISC + parameter (NMISC=3) + doubleprecision MISC(NMISC) + doubleprecision P0,P1,E1,Q + integer I,K + + !-------------------------------------------------------------- + !Initialisations + !-------------------------------------------------------------- + + !parameter values + !Param(1) : fonction parameter [mm] + + !initialisation of model outputs + Q = -999.999 + MISC = -999.999 +c Outputs = -999.999 !initialisation made in R + + + + !-------------------------------------------------------------- + !Time loop + !-------------------------------------------------------------- + DO k=2,LInputs + P0=InputsPrecip(k-1) + P1=InputsPrecip(k) + E1=InputsPE(k) +c Q = -999.999 +c MISC = -999.999 + !model run on one time-step + CALL MOD_GR1A(Param,P0,P1,E1,Q,MISC) + !storage of outputs + DO I=1,NOutputs + Outputs(k,I)=MISC(IndOutputs(I)) + ENDDO + ENDDO + + RETURN + + ENDSUBROUTINE + + + + + +c################################################################################################################################ + + + + +C********************************************************************** + SUBROUTINE MOD_GR1A(Param,P0,P1,E1,Q,MISC) +C Run on a single time-step with the GR4H model +C Inputs: +C Param Vector of model parameters [mm] +C P0 Value of rainfall during the previous time-step [mm] +C P1 Value of rainfall during the time-step [mm] +C E1 Value of potential evapotranspiration during the time-step [mm] +C Outputs: +C Q Value of simulated flow at the catchment outlet for the time-step [mm] +C MISC Vector of model outputs for the time-step [mm] +C********************************************************************** + Implicit None + INTEGER NMISC,NParam + PARAMETER (NMISC=3) + PARAMETER (NParam=1) + DOUBLEPRECISION Param(NParam) + DOUBLEPRECISION MISC(NMISC) + DOUBLEPRECISION P0,P1,E1,Q + +C Runoff + Q=P1*(1.-1./(1.+((0.7*P1+0.3*P0)/Param(1)/E1)**2.)**0.5) + + +C Variables storage + MISC( 1)=E1 ! PE ! [numeric] potential evapotranspiration [mm/year] + MISC( 2)=P1 ! Precip ! [numeric] total precipitation [mm/year] + MISC( 3)=Q ! Qsim ! [numeric] outflow at catchment outlet [mm/year] + + + ENDSUBROUTINE + + diff --git a/src/frun_GR2M.f b/src/frun_GR2M.f new file mode 100644 index 0000000000000000000000000000000000000000..a7ae201ceb708455f88cb41e8d84dea19ba59f9d --- /dev/null +++ b/src/frun_GR2M.f @@ -0,0 +1,175 @@ + + + SUBROUTINE frun_GR2M( + !inputs + & LInputs , ! [numeric] length of input and output series + & InputsPrecip , ! [numeric] input series of total precipitation [mm] + & InputsPE , ! [numeric] input series PE [mm] + & NParam , ! [numeric] number of model parameter + & Param , ! [numeric] parameter set + & NStates , ! [numeric] number of state variables used for model initialising + & StateStart , ! [numeric] state variables used when the model run starts (reservoir levels [mm]) + & NOutputs , ! [numeric] number of output series + & IndOutputs , ! [numeric] indices of output series + !outputs + & Outputs , ! [numeric] output series + & StateEnd ) ! [numeric] state variables at the end of the model run (reservoir levels [mm]) + + + !DEC$ ATTRIBUTES DLLEXPORT :: frun_gr2m + + + Implicit None + !### input and output variables + integer, intent(in) :: LInputs,NParam,NStates,NOutputs + doubleprecision, dimension(LInputs) :: InputsPrecip + doubleprecision, dimension(LInputs) :: InputsPE + doubleprecision, dimension(NParam) :: Param + doubleprecision, dimension(NStates) :: StateStart + doubleprecision, dimension(NStates) :: StateEnd + integer, dimension(NOutputs) :: IndOutputs + doubleprecision, dimension(LInputs,NOutputs) :: Outputs + + !parameters, internal states and variables + integer NMISC + parameter (NMISC=30) + doubleprecision X(2) + doubleprecision MISC(NMISC) + doubleprecision P,E,Q + integer I,K + + !-------------------------------------------------------------- + !Initialisations + !-------------------------------------------------------------- + + !initilisation of model states to zero + X=0. + + !initilisation of model states using StateStart + X(1)=StateStart(1) + X(2)=StateStart(2) + + !parameter values + !Param(1) : production store capacity [mm] + !Param(2) : groundwater exchange coefficient [mm/month] + + !initialisation of model outputs + Q = -999.999 + MISC = -999.999 +c StateEnd = -999.999 !initialisation made in R +c Outputs = -999.999 !initialisation made in R + + + + !-------------------------------------------------------------- + !Time loop + !-------------------------------------------------------------- + DO k=1,LInputs + P =InputsPrecip(k) + E =InputsPE(k) +c Q = -999.999 +c MISC = -999.999 + !model run on one time-step + CALL MOD_GR2M(X,Param,P,E,Q,MISC) + !storage of outputs + DO I=1,NOutputs + Outputs(k,I)=MISC(IndOutputs(I)) + ENDDO + ENDDO + !model states at the end of the run + StateEnd(1)=X(1) + StateEnd(2)=X(2) + + RETURN + + ENDSUBROUTINE + + + + + +c################################################################################################################################ + + + + +C********************************************************************** + SUBROUTINE MOD_GR2M(X,Param,P,E,Q,MISC) +C Run on a single time-step with the GR4H model +C Inputs: +C X Vector of model states at the beginning of the time-step [mm] +C Param Vector of model parameters [mixed units] +C P Value of rainfall during the time-step [mm] +C E Value of potential evapotranspiration during the time-step [mm] +C Outputs: +C X Vector of model states at the end of the time-step [mm] +C Q Value of simulated flow at the catchment outlet for the time-step [mm] +C MISC Vector of model outputs for the time-step [mm] +C********************************************************************** + Implicit None + INTEGER NMISC,NParam + PARAMETER (NMISC=30) + PARAMETER (NParam=2) + DOUBLEPRECISION X(2) + DOUBLEPRECISION Param(NParam) + DOUBLEPRECISION MISC(NMISC) + DOUBLEPRECISION P,E,Q + DOUBLEPRECISION WS,tanHyp,S1,S2 + DOUBLEPRECISION P1,P2,P3,R1,R2 + + +C Production store + WS=P/Param(1) + IF(WS.GT.13)WS=13 + S1=(X(1)+Param(1)*tanHyp(WS))/(1.+X(1)/Param(1)*tanHyp(WS)) + P1=P+X(1)-S1 + WS=E/Param(1) + IF(WS.GT.13)WS=13 + S2=S1*(1.-tanHyp(WS))/(1.+(1.-S1/Param(1))*tanHyp(WS)) + +C Percolation + X(1)=S2/(1+(S2/Param(1))**3.)**(1./3.) + P2=S2-X(1) + P3=P1+P2 + +C QR calculation (routing store) + R1=X(2)+P3 + +C Water exchange + R2=Param(2)*R1 + +C Total runoff + Q=R2*R2/(R2+60.) + +C Updating store level + X(2)=R2-Q + + +C Variables storage + MISC( 1)=E ! PE ! [numeric] potential evapotranspiration [mm/month] + MISC( 2)=P1 ! Precip ! [numeric] total precipitation [mm/month] + MISC( 3)=X(1) ! Prod ! [numeric] production store level (X(2)) [mm] + MISC( 4)=X(2) ! Rout ! [numeric] routing store level (X(1)) [mm] + MISC( 5)=Q ! Qsim ! [numeric] outflow at catchment outlet [mm/month] + + +C MISC( 1)=E ! PE ! potential evapotranspiration [mm/d] +C MISC( 2)=P1 ! Precip ! total precipitation [mm/d] +C MISC( 3)=X(2) ! Prod ! production store level (X(2)) [mm] +C MISC( 4)=AE ! AE ! actual evapotranspiration [mm/d] +C MISC( 5)=PERC ! Perc ! percolation (PERC) [mm] +C MISC( 6)=PR ! PR ! PR=PN-PS+PERC [mm] +C MISC( 7)=X(8) ! Q9 ! outflow from HU1 (Q9) [mm/d] +C MISC( 8)=X(8+NH) ! Q1 ! outflow from HU2 (Q1) [mm/d] +C MISC( 9)=X(1) ! Rout ! routing store level (X(1)) [mm] +C MISC(10)=EXCH ! Exch ! potential semi-exchange between catchments (EXCH) [mm/d] +C MISC(11)=AEXCH1+AEXCH2 ! AExch ! actual total exchange between catchments (AEXCH1+AEXCH2) [mm/d] +C MISC(12)=QR ! QR ! outflow from routing store (QR) [mm/d] +C MISC(13)=QD ! QD ! outflow from HU2 branch after exchange (QD) [mm/d] +C MISC(14)=Q ! Qsim ! outflow at catchment outlet [mm/d] + + + + ENDSUBROUTINE + + diff --git a/src/frun_GR4H.f b/src/frun_GR4H.f new file mode 100644 index 0000000000000000000000000000000000000000..773bdd47dd9f310f04e776a632cd14e06ed14348 --- /dev/null +++ b/src/frun_GR4H.f @@ -0,0 +1,225 @@ + + + SUBROUTINE frun_GR4H( + !inputs + & LInputs , ! [numeric] length of input and output series + & InputsPrecip , ! [numeric] input series of total precipitation [mm] + & InputsPE , ! [numeric] input series PE [mm] + & NParam , ! [numeric] number of model parameter + & Param , ! [numeric] parameter set + & NStates , ! [numeric] number of state variables used for model initialising + & StateStart , ! [numeric] state variables used when the model run starts (reservoir levels [mm] and HU) + & NOutputs , ! [numeric] number of output series + & IndOutputs , ! [numeric] indices of output series + !outputs + & Outputs , ! [numeric] output series + & StateEnd ) ! [numeric] state variables at the end of the model run (reservoir levels [mm] and HU) + + + !DEC$ ATTRIBUTES DLLEXPORT :: frun_gr4h + + + Implicit None + !### input and output variables + integer, intent(in) :: LInputs,NParam,NStates,NOutputs + doubleprecision, dimension(LInputs) :: InputsPrecip + doubleprecision, dimension(LInputs) :: InputsPE + doubleprecision, dimension(NParam) :: Param + doubleprecision, dimension(NStates) :: StateStart + doubleprecision, dimension(NStates) :: StateEnd + integer, dimension(NOutputs) :: IndOutputs + doubleprecision, dimension(LInputs,NOutputs) :: Outputs + + !parameters, internal states and variables + integer NPX,NH,NMISC + parameter (NPX=14,NH=480,NMISC=30) + doubleprecision X(5*NH+7),XV(3*NPX+5*NH) + doubleprecision MISC(NMISC) + doubleprecision D + doubleprecision P1,E,Q + integer I,K + + !-------------------------------------------------------------- + !Initialisations + !-------------------------------------------------------------- + + !initilisation of model states to zero + X=0. + XV=0. + + !initilisation of model states using StateStart + DO I=1,3*NH + X(I)=StateStart(I) + ENDDO + + !parameter values + !Param(1) : production store capacity (X1 - PROD) [mm] + !Param(2) : intercatchment exchange constant (X2 - CES) [mm/h] + !Param(3) : routing store capacity (X3 - ROUT) [mm] + !Param(4) : time constant of unit hydrograph (X4 - TB) [h] + + !computation of HU ordinates + D=1.25 + CALL HU1_H(XV,Param(4),D) + CALL HU2_H(XV,Param(4),D) + + !initialisation of model outputs + Q = -999.999 + MISC = -999.999 +c StateEnd = -999.999 !initialisation made in R +c Outputs = -999.999 !initialisation made in R + + + + !-------------------------------------------------------------- + !Time loop + !-------------------------------------------------------------- + DO k=1,LInputs + P1=InputsPrecip(k) + E =InputsPE(k) +c Q = -999.999 +c MISC = -999.999 + !model run on one time-step + CALL MOD_GR4H(X,XV,Param,P1,E,Q,MISC) + !storage of outputs + DO I=1,NOutputs + Outputs(k,I)=MISC(IndOutputs(I)) + ENDDO + ENDDO + !model states at the end of the run + DO K=1,3*NH + StateEnd(K)=X(K) + ENDDO + + RETURN + + ENDSUBROUTINE + + + + + +c################################################################################################################################ + + + + +C********************************************************************** + SUBROUTINE MOD_GR4H(X,XV,Param,P1,E,Q,MISC) +C Run on a single time-step with the GR4H model +C Inputs: +C X Vector of model states at the beginning of the time-step [mm] +C XV Vector of model states at the beginning of the time-step [mm] +C Param Vector of model parameters [mixed units] +C P1 Value of rainfall during the time-step [mm] +C E Value of potential evapotranspiration during the time-step [mm] +C Outputs: +C X Vector of model states at the end of the time-step [mm] +C XV Vector of model states at the end of the time-step [mm] +C Q Value of simulated flow at the catchment outlet for the time-step [mm] +C MISC Vector of model outputs for the time-step [mm] +C********************************************************************** + Implicit None + INTEGER NPX,NH,NMISC,NParam + PARAMETER (NPX=14,NH=480,NMISC=30) + PARAMETER (NParam=4) + DOUBLEPRECISION X(5*NH+7),XV(3*NPX+5*NH) + DOUBLEPRECISION Param(NParam) + DOUBLEPRECISION MISC(NMISC) + DOUBLEPRECISION P1,E,Q + DOUBLEPRECISION A,B,EN,ER,PN,PR,PS,WS,tanHyp + DOUBLEPRECISION PERC,PRHU1,PRHU2,EXCH,QR,QD + DOUBLEPRECISION AE,AEXCH1,AEXCH2 + INTEGER K + + DATA B/0.9/ + + A=Param(1) + + +C Production store + IF(P1.LE.E) THEN + EN=E-P1 + PN=0. + WS=EN/A + IF(WS.GT.13)WS=13. + ER=X(2)*(2.-X(2)/A)*tanHyp(WS)/(1.+(1.-X(2)/A)*tanHyp(WS)) + AE=ER+P1 + IF(X(2).LT.ER) AE=X(2)+P1 + X(2)=X(2)-ER + PR=0. + ELSE + EN=0. + AE=E + PN=P1-E + WS=PN/A + IF(WS.GT.13)WS=13. + PS=A*(1.-(X(2)/A)**2.)*tanHyp(WS)/(1.+X(2)/A*tanHyp(WS)) + PR=PN-PS + X(2)=X(2)+PS + ENDIF + +C Percolation from production store + IF(X(2).LT.0.)X(2)=0. + PERC=X(2)*(1.-(1.+(X(2)/(21./4.*Param(1)))**4.)**(-0.25)) + X(2)=X(2)-PERC + + PR=PR+PERC + + PRHU1=PR*B + PRHU2=PR*(1.-B) + +C Unit hydrograph HU1 + DO K=1,MAX(1,MIN(NH-1,INT(Param(4)+1))) + X(7+K)=X(8+K)+XV(3*NPX+K)*PRHU1 + ENDDO + X(7+NH)=XV(3*NPX+NH)*PRHU1 + +C Unit hydrograph HU2 + DO K=1,MAX(1,MIN(2*NH-1,2*INT(Param(4)+1))) + X(7+NH+K)=X(8+NH+K)+XV(3*NPX+NH+K)*PRHU2 + ENDDO + X(7+3*NH)=XV(3*NPX+3*NH)*PRHU2 + +C Potential intercatchment semi-exchange + EXCH=Param(2)*(X(1)/Param(3))**3.5 + +C Routing store + AEXCH1=EXCH + IF((X(1)+X(8)+EXCH).LT.0) AEXCH1=-X(1)-X(8) + X(1)=X(1)+X(8)+EXCH + IF(X(1).LT.0.)X(1)=0. + QR=X(1)*(1.-(1.+(X(1)/Param(3))**4.)**(-1./4.)) + X(1)=X(1)-QR + +C Runoff from direct branch QD + AEXCH2=EXCH + IF((X(8+NH)+EXCH).LT.0) AEXCH2=-X(8+NH) + QD=MAX(0.,X(8+NH)+EXCH) + +C Total runoff + Q=QR+QD + IF(Q.LT.0.) Q=0. + +C Variables storage + MISC( 1)=E ! PE ! [numeric] potential evapotranspiration [mm/h] + MISC( 2)=P1 ! Precip ! [numeric] total precipitation [mm/h] + MISC( 3)=X(2) ! Prod ! [numeric] production store level (X(2)) [mm] + MISC( 4)=AE ! AE ! [numeric] actual evapotranspiration [mm/h] + MISC( 5)=PERC ! Perc ! [numeric] percolation (PERC) [mm] + MISC( 6)=PR ! PR ! [numeric] PR=PN-PS+PERC [mm] + MISC( 7)=X(8) ! Q9 ! [numeric] outflow from HU1 (Q9) [mm/h] + MISC( 8)=X(8+NH) ! Q1 ! [numeric] outflow from HU2 (Q1) [mm/h] + MISC( 9)=X(1) ! Rout ! [numeric] routing store level (X(1)) [mm] + MISC(10)=EXCH ! Exch ! [numeric] potential semi-exchange between catchments (EXCH) [mm/h] + MISC(11)=AEXCH1+AEXCH2 ! AExch ! [numeric] actual total exchange between catchments (AEXCH1+AEXCH2) [mm/h] + MISC(12)=QR ! QR ! [numeric] outflow from routing store (QR) [mm/h] + MISC(13)=QD ! QD ! [numeric] outflow from HU2 branch after exchange (QD) [mm/h] + MISC(14)=Q ! Qsim ! [numeric] outflow at catchment outlet [mm/h] + + + + + ENDSUBROUTINE + + diff --git a/src/frun_GR4J.f b/src/frun_GR4J.f new file mode 100644 index 0000000000000000000000000000000000000000..953e7647eb4dcf2fed539bf9543f96b4fb30ce50 --- /dev/null +++ b/src/frun_GR4J.f @@ -0,0 +1,225 @@ + + + SUBROUTINE frun_GR4J( + !inputs + & LInputs , ! [integer] length of input and output series + & InputsPrecip , ! [double] input series of total precipitation [mm] + & InputsPE , ! [double] input series PE [mm] + & NParam , ! [integer] number of model parameter + & Param , ! [double] parameter set + & NStates , ! [integer] number of state variables used for model initialising + & StateStart , ! [double] state variables used when the model run starts (reservoir levels [mm] and HU) + & NOutputs , ! [integer] number of output series + & IndOutputs , ! [integer] indices of output series + !outputs + & Outputs , ! [double] output series + & StateEnd ) ! [double] state variables at the end of the model run (reservoir levels [mm] and HU) + + + !DEC$ ATTRIBUTES DLLEXPORT :: frun_gr4j + + + Implicit None + !### input and output variables + integer, intent(in) :: LInputs,NParam,NStates,NOutputs + doubleprecision, dimension(LInputs) :: InputsPrecip + doubleprecision, dimension(LInputs) :: InputsPE + doubleprecision, dimension(NParam) :: Param + doubleprecision, dimension(NStates) :: StateStart + doubleprecision, dimension(NStates) :: StateEnd + integer, dimension(NOutputs) :: IndOutputs + doubleprecision, dimension(LInputs,NOutputs) :: Outputs + + !parameters, internal states and variables + integer NPX,NH,NMISC + parameter (NPX=14,NH=20,NMISC=30) + doubleprecision X(5*NH+7),XV(3*NPX+5*NH) + doubleprecision MISC(NMISC) + doubleprecision D + doubleprecision P1,E,Q + integer I,K + + !-------------------------------------------------------------- + !Initialisations + !-------------------------------------------------------------- + + !initilisation of model states to zero + X=0. + XV=0. + + !initilisation of model states using StateStart + DO I=1,3*NH + X(I)=StateStart(I) + ENDDO + + !parameter values + !Param(1) : production store capacity (X1 - PROD) [mm] + !Param(2) : intercatchment exchange constant (X2 - CES) [mm/d] + !Param(3) : routing store capacity (X3 - ROUT) [mm] + !Param(4) : time constant of unit hydrograph (X4 - TB) [d] + + !computation of HU ordinates + D=2.5 + CALL HU1(XV,Param(4),D) + CALL HU2(XV,Param(4),D) + + !initialisation of model outputs + Q = -999.999 + MISC = -999.999 +c StateEnd = -999.999 !initialisation made in R +c Outputs = -999.999 !initialisation made in R + + + + !-------------------------------------------------------------- + !Time loop + !-------------------------------------------------------------- + DO k=1,LInputs + P1=InputsPrecip(k) + E =InputsPE(k) +c Q = -999.999 +c MISC = -999.999 + !model run on one time-step + CALL MOD_GR4J(X,XV,Param,P1,E,Q,MISC) + !storage of outputs + DO I=1,NOutputs + Outputs(k,I)=MISC(IndOutputs(I)) + ENDDO + ENDDO + !model states at the end of the run + DO K=1,3*NH + StateEnd(K)=X(K) + ENDDO + + RETURN + + ENDSUBROUTINE + + + + + +c################################################################################################################################ + + + + +C********************************************************************** + SUBROUTINE MOD_GR4J(X,XV,Param,P1,E,Q,MISC) +C Run on a single time-step with the GR4J model +C Inputs: +C X Vector of model states at the beginning of the time-step [mm] +C XV Vector of model states at the beginning of the time-step [mm] +C Param Vector of model parameters [mixed units] +C P1 Value of rainfall during the time-step [mm] +C E Value of potential evapotranspiration during the time-step [mm] +C Outputs: +C X Vector of model states at the end of the time-step [mm] +C XV Vector of model states at the end of the time-step [mm] +C Q Value of simulated flow at the catchment outlet for the time-step [mm] +C MISC Vector of model outputs for the time-step [mm] +C********************************************************************** + Implicit None + INTEGER NPX,NH,NMISC,NParam + PARAMETER (NPX=14,NH=20,NMISC=30) + PARAMETER (NParam=4) + DOUBLEPRECISION X(5*NH+7),XV(3*NPX+5*NH) + DOUBLEPRECISION Param(NParam) + DOUBLEPRECISION MISC(NMISC) + DOUBLEPRECISION P1,E,Q + DOUBLEPRECISION A,B,EN,ER,PN,PR,PS,WS,tanHyp + DOUBLEPRECISION PERC,PRHU1,PRHU2,EXCH,QR,QD + DOUBLEPRECISION AE,AEXCH1,AEXCH2 + INTEGER K + + DATA B/0.9/ + + A=Param(1) + + +C Production store + IF(P1.LE.E) THEN + EN=E-P1 + PN=0. + WS=EN/A + IF(WS.GT.13)WS=13. + ER=X(2)*(2.-X(2)/A)*tanHyp(WS)/(1.+(1.-X(2)/A)*tanHyp(WS)) + AE=ER+P1 + IF(X(2).LT.ER) AE=X(2)+P1 + X(2)=X(2)-ER + PR=0. + ELSE + EN=0. + AE=E + PN=P1-E + WS=PN/A + IF(WS.GT.13)WS=13. + PS=A*(1.-(X(2)/A)**2.)*tanHyp(WS)/(1.+X(2)/A*tanHyp(WS)) + PR=PN-PS + X(2)=X(2)+PS + ENDIF + +C Percolation from production store + IF(X(2).LT.0.)X(2)=0. + PERC=X(2)*(1.-(1.+(X(2)/(9./4.*Param(1)))**4.)**(-0.25)) + X(2)=X(2)-PERC + + PR=PR+PERC + + PRHU1=PR*B + PRHU2=PR*(1.-B) + +C Unit hydrograph HU1 + DO K=1,MAX(1,MIN(NH-1,INT(Param(4)+1))) + X(7+K)=X(8+K)+XV(3*NPX+K)*PRHU1 + ENDDO + X(7+NH)=XV(3*NPX+NH)*PRHU1 + +C Unit hydrograph HU2 + DO K=1,MAX(1,MIN(2*NH-1,2*INT(Param(4)+1))) + X(7+NH+K)=X(8+NH+K)+XV(3*NPX+NH+K)*PRHU2 + ENDDO + X(7+3*NH)=XV(3*NPX+3*NH)*PRHU2 + +C Potential intercatchment semi-exchange + EXCH=Param(2)*(X(1)/Param(3))**3.5 + +C Routing store + AEXCH1=EXCH + IF((X(1)+X(8)+EXCH).LT.0) AEXCH1=-X(1)-X(8) + X(1)=X(1)+X(8)+EXCH + IF(X(1).LT.0.)X(1)=0. + QR=X(1)*(1.-(1.+(X(1)/Param(3))**4.)**(-1./4.)) + X(1)=X(1)-QR + +C Runoff from direct branch QD + AEXCH2=EXCH + IF((X(8+NH)+EXCH).LT.0) AEXCH2=-X(8+NH) + QD=MAX(0.,X(8+NH)+EXCH) + +C Total runoff + Q=QR+QD + IF(Q.LT.0.) Q=0. + +C Variables storage + MISC( 1)=E ! PE ! potential evapotranspiration [mm/d] + MISC( 2)=P1 ! Precip ! total precipitation [mm/d] + MISC( 3)=X(2) ! Prod ! production store level (X(2)) [mm] + MISC( 4)=AE ! AE ! actual evapotranspiration [mm/d] + MISC( 5)=PERC ! Perc ! percolation (PERC) [mm] + MISC( 6)=PR ! PR ! PR=PN-PS+PERC [mm] + MISC( 7)=X(8) ! Q9 ! outflow from HU1 (Q9) [mm/d] + MISC( 8)=X(8+NH) ! Q1 ! outflow from HU2 (Q1) [mm/d] + MISC( 9)=X(1) ! Rout ! routing store level (X(1)) [mm] + MISC(10)=EXCH ! Exch ! potential semi-exchange between catchments (EXCH) [mm/d] + MISC(11)=AEXCH1+AEXCH2 ! AExch ! actual total exchange between catchments (AEXCH1+AEXCH2) [mm/d] + MISC(12)=QR ! QR ! outflow from routing store (QR) [mm/d] + MISC(13)=QD ! QD ! outflow from HU2 branch after exchange (QD) [mm/d] + MISC(14)=Q ! Qsim ! outflow at catchment outlet [mm/d] + + + + + ENDSUBROUTINE + + diff --git a/src/frun_GR5J.f b/src/frun_GR5J.f new file mode 100644 index 0000000000000000000000000000000000000000..4b7b73515685d0ebeaf68a0b43cfc70d3978b320 --- /dev/null +++ b/src/frun_GR5J.f @@ -0,0 +1,226 @@ + + + SUBROUTINE frun_GR5J( + !inputs + & LInputs , ! [integer] length of input and output series + & InputsPrecip , ! [double] input series of total precipitation [mm] + & InputsPE , ! [double] input series PE [mm] + & NParam , ! [integer] number of model parameter + & Param , ! [double] parameter set + & NStates , ! [integer] number of state variables used for model initialising + & StateStart , ! [double] state variables used when the model run starts (reservoir levels [mm] and HU) + & NOutputs , ! [integer] number of output series + & IndOutputs , ! [integer] indices of output series + !outputs + & Outputs , ! [double] output series + & StateEnd ) ! [double] state variables at the end of the model run (reservoir levels [mm] and HU) + + + !DEC$ ATTRIBUTES DLLEXPORT :: frun_gr5j + + + Implicit None + !### input and output variables + integer, intent(in) :: LInputs,NParam,NStates,NOutputs + doubleprecision, dimension(LInputs) :: InputsPrecip + doubleprecision, dimension(LInputs) :: InputsPE + doubleprecision, dimension(NParam) :: Param + doubleprecision, dimension(NStates) :: StateStart + doubleprecision, dimension(NStates) :: StateEnd + integer, dimension(NOutputs) :: IndOutputs + doubleprecision, dimension(LInputs,NOutputs) :: Outputs + + !parameters, internal states and variables + integer NPX,NH,NMISC + parameter (NPX=14,NH=20,NMISC=30) + doubleprecision X(5*NH+7),XV(3*NPX+5*NH) + doubleprecision MISC(NMISC) + doubleprecision D + doubleprecision P1,E,Q + integer I,K + + !-------------------------------------------------------------- + !Initialisations + !-------------------------------------------------------------- + + !initilisation of model states to zero + X=0. + XV=0. + + !initilisation of model states using StateStart + DO I=1,3*NH + X(I)=StateStart(I) + ENDDO + + !parameter values + !Param(1) : production store capacity (X1 - PROD) [mm] + !Param(2) : intercatchment exchange constant (X2 - CES1) [mm/d] + !Param(3) : routing store capacity (X3 - ROUT) [mm] + !Param(4) : time constant of unit hydrograph (X4 - TB) [d] + !Param(5) : intercatchment exchange constant (X5 - CES2) [-] + + !computation of HU ordinates + D=2.5 + CALL HU1(XV,Param(4),D) + CALL HU2(XV,Param(4),D) + + !initialisation of model outputs + Q = -999.999 + MISC = -999.999 +c StateEnd = -999.999 !initialisation made in R +c Outputs = -999.999 !initialisation made in R + + + + !-------------------------------------------------------------- + !Time loop + !-------------------------------------------------------------- + DO k=1,LInputs + P1=InputsPrecip(k) + E =InputsPE(k) +c Q = -999.999 +c MISC = -999.999 + !model run on one time-step + CALL MOD_GR5J(X,XV,Param,P1,E,Q,MISC) + !storage of outputs + DO I=1,NOutputs + Outputs(k,I)=MISC(IndOutputs(I)) + ENDDO + ENDDO + !model states at the end of the run + DO K=1,3*NH + StateEnd(K)=X(K) + ENDDO + + RETURN + + ENDSUBROUTINE + + + + + +c################################################################################################################################ + + + + +C********************************************************************** + SUBROUTINE MOD_GR5J(X,XV,Param,P1,E,Q,MISC) +C Run on a single time-step with the GR5J model +C Inputs: +C X Vector of model states at the beginning of the time-step [mm] +C XV Vector of model states at the beginning of the time-step [mm] +C Param Vector of model parameters [mixed units] +C P1 Value of rainfall during the time-step [mm] +C E Value of potential evapotranspiration during the time-step [mm] +C Outputs: +C X Vector of model states at the end of the time-step [mm] +C XV Vector of model states at the end of the time-step [mm] +C Q Value of simulated flow at the catchment outlet for the time-step [mm] +C MISC Vector of model outputs for the time-step [mm] +C********************************************************************** + Implicit None + INTEGER NPX,NH,NMISC,NParam + PARAMETER (NPX=14,NH=20,NMISC=30) + PARAMETER (NParam=5) + DOUBLEPRECISION X(5*NH+7),XV(3*NPX+5*NH) + DOUBLEPRECISION Param(NParam) + DOUBLEPRECISION MISC(NMISC) + DOUBLEPRECISION P1,E,Q + DOUBLEPRECISION A,B,EN,ER,PN,PR,PS,WS,tanHyp + DOUBLEPRECISION PERC,PRHU1,PRHU2,EXCH,QR,QD + DOUBLEPRECISION AE,AEXCH1,AEXCH2 + INTEGER K + + DATA B/0.9/ + + A=Param(1) + + +C Production store + IF(P1.LE.E) THEN + EN=E-P1 + PN=0. + WS=EN/A + IF(WS.GT.13)WS=13. + ER=X(2)*(2.-X(2)/A)*tanHyp(WS)/(1.+(1.-X(2)/A)*tanHyp(WS)) + AE=ER+P1 + IF(X(2).LT.ER) AE=X(2)+P1 + X(2)=X(2)-ER + PR=0. + ELSE + EN=0. + AE=E + PN=P1-E + WS=PN/A + IF(WS.GT.13)WS=13. + PS=A*(1.-(X(2)/A)**2.)*tanHyp(WS)/(1.+X(2)/A*tanHyp(WS)) + PR=PN-PS + X(2)=X(2)+PS + ENDIF + +C Percolation from production store + IF(X(2).LT.0.)X(2)=0. + PERC=X(2)*(1.-(1.+(X(2)/(9./4.*Param(1)))**4.)**(-0.25)) + X(2)=X(2)-PERC + + PR=PR+PERC + + PRHU1=PR*B + PRHU2=PR*(1.-B) + +C Unit hydrograph HU1 + DO K=1,MAX(1,MIN(NH-1,INT(Param(4)+1))) + X(7+K)=X(8+K)+XV(3*NPX+K)*PRHU1 + ENDDO + X(7+NH)=XV(3*NPX+NH)*PRHU1 + +C Unit hydrograph HU2 + DO K=1,MAX(1,MIN(2*NH-1,2*INT(Param(4)+1))) + X(7+NH+K)=X(8+NH+K)+XV(3*NPX+NH+K)*PRHU2 + ENDDO + X(7+3*NH)=XV(3*NPX+3*NH)*PRHU2 + +C Potential intercatchment semi-exchange + EXCH=Param(2)*(X(1)/Param(3)-Param(5)) + +C Routing store + AEXCH1=EXCH + IF((X(1)+X(8)+EXCH).LT.0) AEXCH1=-X(1)-X(8) + X(1)=X(1)+X(8)+EXCH + IF(X(1).LT.0.)X(1)=0. + QR=X(1)*(1.-(1.+(X(1)/Param(3))**4.)**(-1./4.)) + X(1)=X(1)-QR + +C Runoff from direct branch QD + AEXCH2=EXCH + IF((X(8+NH)+EXCH).LT.0) AEXCH2=-X(8+NH) + QD=MAX(0.,X(8+NH)+EXCH) + +C Total runoff + Q=QR+QD + IF(Q.LT.0.) Q=0. + +C Variables storage + MISC( 1)=E ! PE ! potential evapotranspiration [mm/d] + MISC( 2)=P1 ! Precip ! total precipitation [mm/d] + MISC( 3)=X(2) ! Prod ! production store level (X(2)) [mm] + MISC( 4)=AE ! AE ! actual evapotranspiration [mm/d] + MISC( 5)=PERC ! Perc ! percolation (PERC) [mm] + MISC( 6)=PR ! PR ! PR=PN-PS+PERC [mm] + MISC( 7)=X(8) ! Q9 ! outflow from HU1 (Q9) [mm/d] + MISC( 8)=X(8+NH) ! Q1 ! outflow from HU2 (Q1) [mm/d] + MISC( 9)=X(1) ! Rout ! routing store level (X(1)) [mm] + MISC(10)=EXCH ! Exch ! potential semi-exchange between catchments (EXCH) [mm/d] + MISC(11)=AEXCH1+AEXCH2 ! AExch ! actual total exchange between catchments (AEXCH1+AEXCH2) [mm/d] + MISC(12)=QR ! QR ! outflow from routing store (QR) [mm/d] + MISC(13)=QD ! QD ! outflow from HU2 branch after exchange (QD) [mm/d] + MISC(14)=Q ! Qsim ! outflow at catchment outlet [mm/d] + + + + + ENDSUBROUTINE + + diff --git a/src/frun_GR6J.f b/src/frun_GR6J.f new file mode 100644 index 0000000000000000000000000000000000000000..9d7f9373ffb61bb0850481dd3c92ad132aa999de --- /dev/null +++ b/src/frun_GR6J.f @@ -0,0 +1,249 @@ + + + SUBROUTINE frun_GR6J( + !inputs + & LInputs , ! [integer] length of input and output series + & InputsPrecip , ! [double] input series of total precipitation [mm] + & InputsPE , ! [double] input series PE [mm] + & NParam , ! [integer] number of model parameter + & Param , ! [double] parameter set + & NStates , ! [integer] number of state variables used for model initialising + & StateStart , ! [double] state variables used when the model run starts (reservoir levels [mm] and HU) + & NOutputs , ! [integer] number of output series + & IndOutputs , ! [integer] indices of output series + !outputs + & Outputs , ! [double] output series + & StateEnd ) ! [double] state variables at the end of the model run (reservoir levels [mm] and HU) + + + !DEC$ ATTRIBUTES DLLEXPORT :: frun_gr6j + + + Implicit None + !### input and output variables + integer, intent(in) :: LInputs,NParam,NStates,NOutputs + doubleprecision, dimension(LInputs) :: InputsPrecip + doubleprecision, dimension(LInputs) :: InputsPE + doubleprecision, dimension(NParam) :: Param + doubleprecision, dimension(NStates) :: StateStart + doubleprecision, dimension(NStates) :: StateEnd + integer, dimension(NOutputs) :: IndOutputs + doubleprecision, dimension(LInputs,NOutputs) :: Outputs + + !parameters, internal states and variables + integer NPX,NH,NMISC + parameter (NPX=14,NH=20,NMISC=30) + doubleprecision X(5*NH+7),XV(3*NPX+5*NH) + doubleprecision MISC(NMISC) + doubleprecision D + doubleprecision P1,E,Q + integer I,K + + !-------------------------------------------------------------- + !Initialisations + !-------------------------------------------------------------- + + !initilisation of model states to zero + X=0. + XV=0. + + !initilisation of model states using StateStart + DO I=1,3*NH + X(I)=StateStart(I) + ENDDO + + !parameter values + !Param(1) : production store capacity (X1 - PROD) [mm] + !Param(2) : intercatchment exchange constant (X2 - CES1) [mm/d] + !Param(3) : routing store capacity (X3 - ROUT) [mm] + !Param(4) : time constant of unit hydrograph (X4 - TB) [d] + !Param(5) : intercatchment exchange constant (X5 - CES2) [-] + !Param(6) : time constant of exponential store (X6 - EXP) [d] + + !computation of HU ordinates + D=2.5 + CALL HU1(XV,Param(4),D) + CALL HU2(XV,Param(4),D) + + !initialisation of model outputs + Q = -999.999 + MISC = -999.999 +c StateEnd = -999.999 !initialisation made in R +c Outputs = -999.999 !initialisation made in R + + + + !-------------------------------------------------------------- + !Time loop + !-------------------------------------------------------------- + DO k=1,LInputs + P1=InputsPrecip(k) + E =InputsPE(k) +c Q = -999.999 +c MISC = -999.999 + !model run on one time-step + CALL MOD_GR6J(X,XV,Param,P1,E,Q,MISC) + !storage of outputs + DO I=1,NOutputs + Outputs(k,I)=MISC(IndOutputs(I)) + ENDDO + ENDDO + !model states at the end of the run + DO K=1,3*NH + StateEnd(K)=X(K) + ENDDO + + RETURN + + ENDSUBROUTINE + + + + + +c################################################################################################################################ + + + + +C********************************************************************** + SUBROUTINE MOD_GR6J(X,XV,Param,P1,E,Q,MISC) +C Run on a single time-step with the GR6J model +C Inputs: +C X Vector of model states at the beginning of the time-step [mm] +C XV Vector of model states at the beginning of the time-step [mm] +C Param Vector of model parameters [mixed units] +C P1 Value of rainfall during the time-step [mm] +C E Value of potential evapotranspiration during the time-step [mm] +C Outputs: +C X Vector of model states at the end of the time-step [mm] +C XV Vector of model states at the end of the time-step [mm] +C Q Value of simulated flow at the catchment outlet for the time-step [mm] +C MISC Vector of model outputs for the time-step [mm] +C********************************************************************** + Implicit None + INTEGER NPX,NH,NMISC,NParam + PARAMETER (NPX=14,NH=20,NMISC=30) + PARAMETER (NParam=6) + DOUBLEPRECISION X(5*NH+7),XV(3*NPX+5*NH) + DOUBLEPRECISION Param(NParam) + DOUBLEPRECISION MISC(NMISC) + DOUBLEPRECISION P1,E,Q + DOUBLEPRECISION A,B,C,EN,ER,PN,PR,PS,WS,tanHyp,AR + DOUBLEPRECISION PERC,PRHU1,PRHU2,EXCH,QR,QD,QR1 + DOUBLEPRECISION AE,AEXCH1,AEXCH2 + INTEGER K + + DATA B/0.9/ + DATA C/0.4/ + + A=Param(1) + + +C Production store + IF(P1.LE.E) THEN + EN=E-P1 + PN=0. + WS=EN/A + IF(WS.GT.13)WS=13. + ER=X(2)*(2.-X(2)/A)*tanHyp(WS)/(1.+(1.-X(2)/A)*tanHyp(WS)) + AE=ER+P1 + IF(X(2).LT.ER) AE=X(2)+P1 + X(2)=X(2)-ER + PR=0. + ELSE + EN=0. + AE=E + PN=P1-E + WS=PN/A + IF(WS.GT.13)WS=13. + PS=A*(1.-(X(2)/A)**2.)*tanHyp(WS)/(1.+X(2)/A*tanHyp(WS)) + PR=PN-PS + X(2)=X(2)+PS + ENDIF + +C Percolation from production store + IF(X(2).LT.0.)X(2)=0. + PERC=X(2)*(1.-(1.+(X(2)/(9./4.*Param(1)))**4.)**(-0.25)) + X(2)=X(2)-PERC + + PR=PR+PERC + + PRHU1=PR*B + PRHU2=PR*(1.-B) + +C Unit hydrograph HU1 + DO K=1,MAX(1,MIN(NH-1,INT(Param(4)+1))) + X(7+K)=X(8+K)+XV(3*NPX+K)*PRHU1 + ENDDO + X(7+NH)=XV(3*NPX+NH)*PRHU1 + +C Unit hydrograph HU2 + DO K=1,MAX(1,MIN(2*NH-1,2*INT(Param(4)+1))) + X(7+NH+K)=X(8+NH+K)+XV(3*NPX+NH+K)*PRHU2 + ENDDO + X(7+3*NH)=XV(3*NPX+3*NH)*PRHU2 + +C Potential intercatchment semi-exchange + EXCH=Param(2)*(X(1)/Param(3)-Param(5)) + +C Routing store + AEXCH1=EXCH + IF((X(1)+X(8)+EXCH).LT.0) AEXCH1=-X(1)-X(8) + X(1)=X(1)+(1-C)*X(8)+EXCH + IF(X(1).LT.0.)X(1)=0. + QR=X(1)*(1.-(1.+(X(1)/Param(3))**4.)**(-1./4.)) + X(1)=X(1)-QR + +C Update of exponential store + X(6)=X(6)+C*X(8)+EXCH + AR=X(6)/Param(6) + IF(AR.GT.33.)AR=33. + IF(AR.LT.-33.)AR=-33. + + IF(AR.GT.7.)THEN + QR1=X(6)+Param(6)/EXP(AR) + GOTO 3 + ENDIF + + IF(AR.LT.-7.)THEN + QR1=Param(6)*EXP(AR) + GOTO 3 + ENDIF + + QR1=Param(6)*LOG(EXP(AR)+1.) + 3 CONTINUE + + X(6)=X(6)-QR1 + +C Runoff from direct branch QD + AEXCH2=EXCH + IF((X(8+NH)+EXCH).LT.0) AEXCH2=-X(8+NH) + QD=MAX(0.,X(8+NH)+EXCH) + +C Total runoff + Q=QR+QD+QR1 + IF(Q.LT.0.) Q=0. + +C Variables storage + MISC( 1)=E ! PE ! potential evapotranspiration [mm/d] + MISC( 2)=P1 ! Precip ! total precipitation [mm/d] + MISC( 3)=X(2) ! Prod ! production store level (X(2)) [mm] + MISC( 4)=AE ! AE ! actual evapotranspiration [mm/d] + MISC( 5)=PERC ! Perc ! percolation (PERC) [mm] + MISC( 6)=PR ! PR ! PR=PN-PS+PERC [mm] + MISC( 7)=X(8) ! Q9 ! outflow from HU1 (Q9) [mm/d] + MISC( 8)=X(8+NH) ! Q1 ! outflow from HU2 (Q1) [mm/d] + MISC( 9)=X(1) ! Rout ! routing store level (X(1)) [mm] + MISC(10)=EXCH ! Exch ! potential semi-exchange between catchments (EXCH) [mm/d] + MISC(11)=AEXCH1+AEXCH2 ! AExch ! actual total exchange between catchments (AEXCH1+AEXCH2) [mm/d] + MISC(12)=QR ! QR ! outflow from routing store (QR) [mm/d] + MISC(13)=QR1 ! QR1 ! outflow from exponential store (QR1) [mm/d] + MISC(14)=X(6) ! Exp ! exponential store level (X(6)) (negative) [mm] + MISC(15)=QD ! QD ! outflow from HU2 branch after exchange (QD) [mm/d] + MISC(16)=Q ! Qsim ! outflow at catchment outlet [mm/d] + + + ENDSUBROUTINE + + diff --git a/src/utils_D.f b/src/utils_D.f new file mode 100644 index 0000000000000000000000000000000000000000..2028bc71f5cd42b3941f3113a5c438b80b8198c0 --- /dev/null +++ b/src/utils_D.f @@ -0,0 +1,272 @@ + + +C********************************************************************** + SUBROUTINE HU1(XV,C,D) +C Computation of ordinates of GR unit hydrograph HU1 using successives differences on the S curve SS1 +C Inputs: +C C: time constant +C D: exponent +C Outputs: +C XV(3*NPX+1) to XV(3*NPX+NH): NH ordinates of discrete hydrograph +C********************************************************************** + Implicit None + INTEGER NPX,NH + PARAMETER (NPX=14,NH=20) + DOUBLEPRECISION XV(3*NPX+5*NH) + DOUBLEPRECISION C,D,SS1 + INTEGER I + + DO I=1,NH + XV(3*NPX+I)=SS1(I,C,D)-SS1(I-1,C,D) + ENDDO + ENDSUBROUTINE + + +C********************************************************************** + SUBROUTINE HU2(XV,C,D) +C Computation of ordinates of GR unit hydrograph HU2 using successives differences on the S curve SS2 +C Inputs: +C C: time constant +C D: exponent +C Outputs: +C XV(3*NPX+NH+1) to XV(3*NPX+3*NH): 2*NH ordinates of discrete hydrograph +C********************************************************************** + Implicit None + INTEGER NPX,NH + PARAMETER (NPX=14,NH=20) + DOUBLEPRECISION XV(3*NPX+5*NH) + DOUBLEPRECISION C,D,SS2 + INTEGER I + + DO I =1,2*NH + XV(3*NPX+NH+I)=SS2(I,C,D)-SS2(I-1,C,D) + ENDDO + ENDSUBROUTINE + + + +C********************************************************************** + SUBROUTINE HU4(XV,ALPHA,BETA) +C Computation of ordinates of MOHYSE unit hydrograph +C Inputs: +C Alpha: parameter +C Beta: parameter +C Outputs: +C XV(3*NPX+NH+1) to XV(3*NPX+3*NH): 2*NH ordinates of discrete hydrograph +C********************************************************************** + Implicit None + INTEGER NPX,NH + PARAMETER (NPX=14,NH=20) + DOUBLEPRECISION XV(3*NPX+5*NH),U(3*NH) + DOUBLEPRECISION ALPHA,BETA,SU + INTEGER K + + SU=0. +c IF(ALPHA.LT.1.)THEN +c WRITE(*,*)' Pb ALPHA' +c STOP +c ENDIF + IF(ALPHA.EQ.1.)THEN + U(1)=1. + SU=1. + DO 1 K=2,3*NH + U(K)=0. + 1 CONTINUE + ELSE + DO 11 K=1,3*NH + U(K)=FLOAT(K)*(ALPHA-1.)*EXP(-FLOAT(K)/BETA) + SU=SU+U(K) + 11 CONTINUE + ENDIF + +c IF(SU.LT.0.0000000001)THEN +c WRITE(*,*)' Pb HU4',ALPHA, BETA +c STOP +c ENDIF + DO 2 K=1,3*NH + XV(3*NPX+K)=U(K)/SU + 2 CONTINUE + ENDSUBROUTINE + + + +C********************************************************************** + SUBROUTINE HU(XV,C) +C Computation of ordinates of GRP unit hydrograph +C Inputs: +C C: time constant +C Alpha: parameter +C Beta: parameter +C Outputs: +C XV(3*NPX+NH+1) to XV(3*NPX+3*NH): 2*NH ordinates of discrete hydrograph +C********************************************************************** + Implicit None + INTEGER NPX,NH + PARAMETER (NPX=14,NH=20) + DOUBLEPRECISION XV(3*NPX+5*NH) + DOUBLEPRECISION C + DOUBLEPRECISION SH + INTEGER I + DO 10 I=1,2*NH + XV(3*NPX+NH+I)=SH(I,C)-SH(I-1,C) + 10 CONTINUE + RETURN + ENDSUBROUTINE + + + +C********************************************************************** + FUNCTION SH(I,C) +C Values of the S curve (cumulative HU curve) of GRP unit hydrograph HU +C Inputs: +C C: time constant +C I: time-step +C Outputs: +C SH: Values of the S curve for I +C********************************************************************** + Implicit None + INTEGER NPX,NH + PARAMETER (NPX=14,NH=20) + DOUBLEPRECISION C + DOUBLEPRECISION SH,FI + INTEGER I + + FI=I + IF(FI.LE.0.)THEN + SH=0. + RETURN + ENDIF + IF(FI.GE.C)THEN + SH=1. + RETURN + ENDIF + SH=FI**2.5/(FI**2.5+(C-FI)**2.5) + RETURN + ENDFUNCTION + + +C********************************************************************** + FUNCTION SS1(I,C,D) +C Values of the S curve (cumulative HU curve) of GR unit hydrograph HU1 +C Inputs: +C C: time constant +C D: exponent +C I: time-step +C Outputs: +C SS1: Values of the S curve for I +C********************************************************************** + Implicit None + DOUBLEPRECISION C,D,SS1 + INTEGER I,FI + + FI=I + IF(FI.LE.0.) THEN + SS1=0. + RETURN + ENDIF + IF(FI.LT.C) THEN + SS1=(FI/C)**D + RETURN + ENDIF + SS1=1. + ENDFUNCTION + + +C********************************************************************** + FUNCTION SS2(I,C,D) +C Values of the S curve (cumulative HU curve) of GR unit hydrograph HU2 +C Inputs: +C C: time constant +C D: exponent +C I: time-step +C Outputs: +C SS2: Values of the S curve for I +C********************************************************************** + Implicit None + DOUBLEPRECISION C,D,SS2 + INTEGER I,FI + + FI=I + IF(FI.LE.0.) THEN + SS2=0. + RETURN + ENDIF + IF(FI.LE.C) THEN + SS2=0.5*(FI/C)**D + RETURN + ENDIF + IF(FI.LT.2.*C) THEN + SS2=1.-0.5*(2.-FI/C)**D + RETURN + ENDIF + SS2=1. + ENDFUNCTION + + + +C********************************************************************** + SUBROUTINE DEL(XV,C) +C Computation of HU ordinates corresponding to a time lag of a given number (possibly non-integer) of time-steps +C (all ordinates are nul except 2 at max) +C Inputs: +C C: time constant +C Outputs: +C XV(3*NPX+NH+1) to XV(3*NPX+3*NH): 2*NH ordinates of discrete hydrograph +C********************************************************************** + Implicit None + INTEGER NPX,NH + PARAMETER (NPX=14,NH=20) + DOUBLEPRECISION XV(3*NPX+5*NH) + DOUBLEPRECISION C,F + INTEGER I,K + I=INT(C) + F=C-INT(C) + DO 1 K=3*NPX+1,3*NPX+3*NH + XV(K)=0. + 1 CONTINUE + XV(3*NPX+I)=1.-F + XV(3*NPX+I+1)=F + ENDSUBROUTINE + + + +C********************************************************************** + SUBROUTINE DEL2(XV,C) +C Computation of HU ordinates corresponding to a time lag of a given number (possibly non-integer) of time-steps +C (all ordinates are nul except 2 at max) +C Inputs: +C C: time constant +C Outputs: +C XV(3*NPX+NH+1) to XV(3*NPX+3*NH): NH ordinates of discrete hydrograph +C********************************************************************** + Implicit None + INTEGER NPX,NH + PARAMETER (NPX=14,NH=20) + DOUBLEPRECISION XV(3*NPX+5*NH) + DOUBLEPRECISION C,F + INTEGER K,I + + IF(C.GT.FLOAT(NH)) C=FLOAT(NH) + I=INT(C) + F=C-INT(C) + DO 1 K=3*NPX+1,3*NPX+NH + XV(K)=0. + 1 CONTINUE + XV(3*NPX+I)=1.-F + XV(3*NPX+I+1)=F + ENDSUBROUTINE + + + +C********************************************************************** + FUNCTION tanHyp(Val) +C Computation of hyperbolic tangent +C********************************************************************** + Implicit None + DOUBLEPRECISION Val,ValExp,tanHyp + + ValExp=EXP(Val) + tanHyp=(ValExp - 1./ValExp)/(ValExp + 1./ValExp) + RETURN + ENDFUNCTION + diff --git a/src/utils_H.f b/src/utils_H.f new file mode 100644 index 0000000000000000000000000000000000000000..56ba8e9924e6d2f3b3e12eb4a4b77d6b659bb014 --- /dev/null +++ b/src/utils_H.f @@ -0,0 +1,272 @@ + + +C********************************************************************** + SUBROUTINE HU1_H(XV,C,D) +C Computation of ordinates of GR unit hydrograph HU1 using successives differences on the S curve SS1 +C Inputs: +C C: time constant +C D: exponent +C Outputs: +C XV(3*NPX+1) to XV(3*NPX+NH): NH ordinates of discrete hydrograph +C********************************************************************** + Implicit None + INTEGER NPX,NH + PARAMETER (NPX=14,NH=480) + DOUBLEPRECISION XV(3*NPX+5*NH) + DOUBLEPRECISION C,D,SS1_H + INTEGER I + + DO I=1,NH + XV(3*NPX+I)=SS1_H(I,C,D)-SS1_H(I-1,C,D) + ENDDO + ENDSUBROUTINE + + +C********************************************************************** + SUBROUTINE HU2_H(XV,C,D) +C Computation of ordinates of GR unit hydrograph HU2 using successives differences on the S curve SS2 +C Inputs: +C C: time constant +C D: exponent +C Outputs: +C XV(3*NPX+NH+1) to XV(3*NPX+3*NH): 2*NH ordinates of discrete hydrograph +C********************************************************************** + Implicit None + INTEGER NPX,NH + PARAMETER (NPX=14,NH=480) + DOUBLEPRECISION XV(3*NPX+5*NH) + DOUBLEPRECISION C,D,SS2_H + INTEGER I + + DO I =1,2*NH + XV(3*NPX+NH+I)=SS2_H(I,C,D)-SS2_H(I-1,C,D) + ENDDO + ENDSUBROUTINE + + + +C********************************************************************** + SUBROUTINE HU4_H(XV,ALPHA,BETA) +C Computation of ordinates of MOHYSE unit hydrograph +C Inputs: +C Alpha: parameter +C Beta: parameter +C Outputs: +C XV(3*NPX+NH+1) to XV(3*NPX+3*NH): 2*NH ordinates of discrete hydrograph +C********************************************************************** + Implicit None + INTEGER NPX,NH + PARAMETER (NPX=14,NH=480) + DOUBLEPRECISION XV(3*NPX+5*NH),U(3*NH) + DOUBLEPRECISION ALPHA,BETA,SU + INTEGER K + + SU=0. +c IF(ALPHA.LT.1.)THEN +c WRITE(*,*)' Pb ALPHA' +c STOP +c ENDIF + IF(ALPHA.EQ.1.)THEN + U(1)=1. + SU=1. + DO 1 K=2,3*NH + U(K)=0. + 1 CONTINUE + ELSE + DO 11 K=1,3*NH + U(K)=FLOAT(K)*(ALPHA-1.)*EXP(-FLOAT(K)/BETA) + SU=SU+U(K) + 11 CONTINUE + ENDIF + +c IF(SU.LT.0.0000000001)THEN +c WRITE(*,*)' Pb HU4',ALPHA, BETA +c STOP +c ENDIF + DO 2 K=1,3*NH + XV(3*NPX+K)=U(K)/SU + 2 CONTINUE + ENDSUBROUTINE + + + +C********************************************************************** + SUBROUTINE HU_H(XV,C) +C Computation of ordinates of GRP unit hydrograph +C Inputs: +C C: time constant +C Alpha: parameter +C Beta: parameter +C Outputs: +C XV(3*NPX+NH+1) to XV(3*NPX+3*NH): 2*NH ordinates of discrete hydrograph +C********************************************************************** + Implicit None + INTEGER NPX,NH + PARAMETER (NPX=14,NH=480) + DOUBLEPRECISION XV(3*NPX+5*NH) + DOUBLEPRECISION C + DOUBLEPRECISION SH_H + INTEGER I + DO 10 I=1,2*NH + XV(3*NPX+NH+I)=SH_H(I,C)-SH_H(I-1,C) + 10 CONTINUE + RETURN + ENDSUBROUTINE + + + +C********************************************************************** + FUNCTION SH_H(I,C) +C Values of the S curve (cumulative HU curve) of GRP unit hydrograph HU +C Inputs: +C C: time constant +C I: time-step +C Outputs: +C SH: Values of the S curve for I +C********************************************************************** + Implicit None + INTEGER NPX,NH + PARAMETER (NPX=14,NH=480) + DOUBLEPRECISION C + DOUBLEPRECISION SH_H,FI + INTEGER I + + FI=I + IF(FI.LE.0.)THEN + SH_H=0. + RETURN + ENDIF + IF(FI.GE.C)THEN + SH_H=1. + RETURN + ENDIF + SH_H=FI**2.5/(FI**2.5+(C-FI)**2.5) + RETURN + ENDFUNCTION + + +C********************************************************************** + FUNCTION SS1_H(I,C,D) +C Values of the S curve (cumulative HU curve) of GR unit hydrograph HU1 +C Inputs: +C C: time constant +C D: exponent +C I: time-step +C Outputs: +C SS1: Values of the S curve for I +C********************************************************************** + Implicit None + DOUBLEPRECISION C,D,SS1_H + INTEGER I,FI + + FI=I + IF(FI.LE.0.) THEN + SS1_H=0. + RETURN + ENDIF + IF(FI.LT.C) THEN + SS1_H=(FI/C)**D + RETURN + ENDIF + SS1_H=1. + ENDFUNCTION + + +C********************************************************************** + FUNCTION SS2_H(I,C,D) +C Values of the S curve (cumulative HU curve) of GR unit hydrograph HU2 +C Inputs: +C C: time constant +C D: exponent +C I: time-step +C Outputs: +C SS2: Values of the S curve for I +C********************************************************************** + Implicit None + DOUBLEPRECISION C,D,SS2_H + INTEGER I,FI + + FI=I + IF(FI.LE.0.) THEN + SS2_H=0. + RETURN + ENDIF + IF(FI.LE.C) THEN + SS2_H=0.5*(FI/C)**D + RETURN + ENDIF + IF(FI.LT.2.*C) THEN + SS2_H=1.-0.5*(2.-FI/C)**D + RETURN + ENDIF + SS2_H=1. + ENDFUNCTION + + + +C********************************************************************** + SUBROUTINE DEL_H(XV,C) +C Computation of HU ordinates corresponding to a time lag of a given number (possibly non-integer) of time-steps +C (all ordinates are nul except 2 at max) +C Inputs: +C C: time constant +C Outputs: +C XV(3*NPX+NH+1) to XV(3*NPX+3*NH): 2*NH ordinates of discrete hydrograph +C********************************************************************** + Implicit None + INTEGER NPX,NH + PARAMETER (NPX=14,NH=480) + DOUBLEPRECISION XV(3*NPX+5*NH) + DOUBLEPRECISION C,F + INTEGER I,K + I=INT(C) + F=C-INT(C) + DO 1 K=3*NPX+1,3*NPX+3*NH + XV(K)=0. + 1 CONTINUE + XV(3*NPX+I)=1.-F + XV(3*NPX+I+1)=F + ENDSUBROUTINE + + + +C********************************************************************** + SUBROUTINE DEL2_H(XV,C) +C Computation of HU ordinates corresponding to a time lag of a given number (possibly non-integer) of time-steps +C (all ordinates are nul except 2 at max) +C Inputs: +C C: time constant +C Outputs: +C XV(3*NPX+NH+1) to XV(3*NPX+3*NH): NH ordinates of discrete hydrograph +C********************************************************************** + Implicit None + INTEGER NPX,NH + PARAMETER (NPX=14,NH=480) + DOUBLEPRECISION XV(3*NPX+5*NH) + DOUBLEPRECISION C,F + INTEGER K,I + + IF(C.GT.FLOAT(NH)) C=FLOAT(NH) + I=INT(C) + F=C-INT(C) + DO 1 K=3*NPX+1,3*NPX+NH + XV(K)=0. + 1 CONTINUE + XV(3*NPX+I)=1.-F + XV(3*NPX+I+1)=F + ENDSUBROUTINE + + + +cC********************************************************************** +c FUNCTION tanHyp_H(Val) +cC Computation of hyperbolic tangent +cC********************************************************************** +c Implicit None +c DOUBLEPRECISION Val,ValExp,tanHyp_H +c +c ValExp=EXP(Val) +c tanHyp_H=(ValExp - 1./ValExp)/(ValExp + 1./ValExp) +c RETURN +c ENDFUNCTION + diff --git a/tests/example_Calibration.R b/tests/example_Calibration.R new file mode 100644 index 0000000000000000000000000000000000000000..8583f78c804283c024227e6a52ba797991731187 --- /dev/null +++ b/tests/example_Calibration.R @@ -0,0 +1,48 @@ +## load of catchment data +require(airGR) +data(L0123001) + +## preparation of InputsModel object +InputsModel <- CreateInputsModel(FUN_MOD=RunModel_GR4J,DatesR=BasinObs$DatesR, + Precip=BasinObs$P,PotEvap=BasinObs$E) + +## calibration period selection +Ind_Run <- seq(which(format(BasinObs$DatesR,format="%d/%m/%Y %H:%M")=="01/01/1990 00:00"), + which(format(BasinObs$DatesR,format="%d/%m/%Y %H:%M")=="31/12/1999 00:00")) + +## preparation of RunOptions object +RunOptions <- CreateRunOptions(FUN_MOD=RunModel_GR4J,InputsModel=InputsModel,IndPeriod_Run=Ind_Run) + +## calibration criterion: preparation of the InputsCrit object +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) + +## preparation of CalibOptions object +CalibOptions <- CreateCalibOptions(FUN_MOD=RunModel_GR4J,FUN_CALIB=Calibration_HBAN) + +## calibration +OutputsCalib <- Calibration(InputsModel=InputsModel,RunOptions=RunOptions,InputsCrit=InputsCrit, + CalibOptions=CalibOptions,FUN_MOD=RunModel_GR4J,FUN_CRIT=ErrorCrit_NSE, + FUN_CALIB=Calibration_HBAN) + +## simulation +Param <- OutputsCalib$ParamFinalR +OutputsModel <- RunModel(InputsModel=InputsModel,RunOptions=RunOptions, + Param=Param,FUN=RunModel_GR4J) + +## results preview +plot_OutputsModel(OutputsModel=OutputsModel,Qobs=BasinObs$Qmm[Ind_Run]) + +## efficiency criterion: Nash-Sutcliffe Efficiency +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) +OutputsCrit <- ErrorCrit_NSE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\n",sep="")) + +## efficiency criterion: Kling-Gupta Efficiency +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_KGE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) +OutputsCrit <- ErrorCrit_KGE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\n",sep="")) + + diff --git a/tests/example_Calibration_HBAN.R b/tests/example_Calibration_HBAN.R new file mode 100644 index 0000000000000000000000000000000000000000..75b7832fd7bf115307ac7852f8eb76053185bacd --- /dev/null +++ b/tests/example_Calibration_HBAN.R @@ -0,0 +1,46 @@ +## load of catchment data +require(airGR) +data(L0123001) + +## preparation of InputsModel object +InputsModel <- CreateInputsModel(FUN_MOD=RunModel_GR4J,DatesR=BasinObs$DatesR, + Precip=BasinObs$P,PotEvap=BasinObs$E) + +## calibration period selection +Ind_Run <- seq(which(format(BasinObs$DatesR,format="%d/%m/%Y %H:%M")=="01/01/1990 00:00"), + which(format(BasinObs$DatesR,format="%d/%m/%Y %H:%M")=="31/12/1999 00:00")) + +## preparation of RunOptions object +RunOptions <- CreateRunOptions(FUN_MOD=RunModel_GR4J,InputsModel=InputsModel,IndPeriod_Run=Ind_Run) + +## calibration criterion: preparation of the InputsCrit object +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) + +## preparation of CalibOptions object +CalibOptions <- CreateCalibOptions(FUN_MOD=RunModel_GR4J,FUN_CALIB=Calibration_HBAN) + +## calibration +OutputsCalib <- Calibration_HBAN(InputsModel=InputsModel,RunOptions=RunOptions, + InputsCrit=InputsCrit,CalibOptions=CalibOptions, + FUN_MOD=RunModel_GR4J,FUN_CRIT=ErrorCrit_NSE) + +## simulation +Param <- OutputsCalib$ParamFinalR +OutputsModel <- RunModel_GR4J(InputsModel=InputsModel,RunOptions=RunOptions,Param=Param) + +## results preview +plot_OutputsModel(OutputsModel=OutputsModel,Qobs=BasinObs$Qmm[Ind_Run]) + +## efficiency criterion: Nash-Sutcliffe Efficiency +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) +OutputsCrit <- ErrorCrit_NSE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\n",sep="")) + +## efficiency criterion: Kling-Gupta Efficiency +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_KGE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) +OutputsCrit <- ErrorCrit_KGE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\n",sep="")) + diff --git a/tests/example_Calibration_optim.R b/tests/example_Calibration_optim.R new file mode 100644 index 0000000000000000000000000000000000000000..f08ec410b22eeb0458226509d157e557d5b0f420 --- /dev/null +++ b/tests/example_Calibration_optim.R @@ -0,0 +1,45 @@ +## load of catchment data +require(airGR) +data(L0123001) + +## preparation of InputsModel object +InputsModel <- CreateInputsModel(FUN_MOD=RunModel_GR4J,DatesR=BasinObs$DatesR, + Precip=BasinObs$P,PotEvap=BasinObs$E) + +## calibration period selection +Ind_Run <- seq(which(format(BasinObs$DatesR,format="%d/%m/%Y %H:%M")=="01/01/1990 00:00"), + which(format(BasinObs$DatesR,format="%d/%m/%Y %H:%M")=="31/12/1999 00:00")) + +## preparation of RunOptions object +RunOptions <- CreateRunOptions(FUN_MOD=RunModel_GR4J,InputsModel=InputsModel,IndPeriod_Run=Ind_Run) + +## calibration criterion: preparation of the InputsCrit object +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) + +## preparation of CalibOptions object +CalibOptions <- CreateCalibOptions(FUN_MOD=RunModel_GR4J,FUN_CALIB=Calibration_optim) + +## calibration +OutputsCalib <- Calibration_optim(InputsModel=InputsModel,RunOptions=RunOptions, + InputsCrit=InputsCrit,CalibOptions=CalibOptions, + FUN_MOD=RunModel_GR4J,FUN_CRIT=ErrorCrit_NSE) + +## simulation +Param <- OutputsCalib$ParamFinalR +OutputsModel <- RunModel_GR4J(InputsModel=InputsModel,RunOptions=RunOptions,Param=Param) + +## results preview +plot_OutputsModel(OutputsModel=OutputsModel,Qobs=BasinObs$Qmm[Ind_Run]) + +## efficiency criterion: Nash-Sutcliffe Efficiency +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) +OutputsCrit <- ErrorCrit_NSE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\n",sep="")) + +## efficiency criterion: Kling-Gupta Efficiency +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_KGE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) +OutputsCrit <- ErrorCrit_KGE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\n",sep="")) diff --git a/tests/example_ErrorCrit.R b/tests/example_ErrorCrit.R new file mode 100644 index 0000000000000000000000000000000000000000..c19c510563a54d66b956c418b592ea60c084ffa6 --- /dev/null +++ b/tests/example_ErrorCrit.R @@ -0,0 +1,61 @@ +## load of catchment data +require(airGR) +data(L0123001) + +## preparation of the InputsModel object +InputsModel <- CreateInputsModel(FUN_MOD=RunModel_GR4J,DatesR=BasinObs$DatesR, + Precip=BasinObs$P,PotEvap=BasinObs$E) + +## run period selection +Ind_Run <- seq(which(format(BasinObs$DatesR,format="%d/%m/%Y %H:%M")=="01/01/1990 00:00"), + which(format(BasinObs$DatesR,format="%d/%m/%Y %H:%M")=="31/12/1999 00:00")) + +## preparation of the RunOptions object +RunOptions <- CreateRunOptions(FUN_MOD=RunModel_GR4J,InputsModel=InputsModel,IndPeriod_Run=Ind_Run) + +## simulation +Param <- c(734.568,-0.840,109.809,1.971) +OutputsModel <- RunModel(InputsModel=InputsModel,RunOptions=RunOptions, + Param=Param,FUN=RunModel_GR4J) + +## efficiency criterion: Nash-Sutcliffe Efficiency +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) +OutputsCrit <- ErrorCrit_NSE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\n",sep="")) + +## efficiency criterion: Nash-Sutcliffe Efficiency on log-transformed flows +transfo <- "log" +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run],transfo=transfo) +OutputsCrit <- ErrorCrit_NSE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\n",sep="")) + +## efficiency criterion: Nash-Sutcliffe Efficiency above a threshold (q75%) +BoolCrit <- rep(TRUE,length(BasinObs$Qmm[Ind_Run])); +BoolCrit[BasinObs$Qmm[Ind_Run]<quantile(BasinObs$Qmm[Ind_Run],0.75,na.rm=TRUE)] <- FALSE; +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run],BoolCrit=BoolCrit) +OutputsCrit <- ErrorCrit_NSE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\n",sep="")) + +## efficiency criterion: Kling-Gupta Efficiency +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_KGE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) +OutputsCrit <- ErrorCrit_KGE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\n",sep="")) +cat(paste("SubCrit ",OutputsCrit$SubCritNames," ",round(OutputsCrit$SubCritValues,4),"\n",sep="")) + +## efficiency criterion: Kling-Gupta Efficiency below a threshold (q10%) on log-trqansformed flows +transfo <- "log" +BoolCrit <- rep(TRUE,length(BasinObs$Qmm[Ind_Run])); +BoolCrit[BasinObs$Qmm[Ind_Run]>quantile(BasinObs$Qmm[Ind_Run],0.10,na.rm=TRUE)] <- FALSE; +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_KGE,InputsModel=InputsModel,RunOptions=RunOptions, + Qobs=BasinObs$Qmm[Ind_Run],BoolCrit=BoolCrit,transfo=transfo) +OutputsCrit <- ErrorCrit_KGE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\n",sep="")) +cat(paste("SubCrit ",OutputsCrit$SubCritNames," ",round(OutputsCrit$SubCritValues,4),"\n",sep="")) + + + + diff --git a/tests/example_RunModel.R b/tests/example_RunModel.R new file mode 100644 index 0000000000000000000000000000000000000000..b240b8cf3c92053f08e856c1b317394dc3427f5a --- /dev/null +++ b/tests/example_RunModel.R @@ -0,0 +1,29 @@ +## load of catchment data +require(airGR) +data(L0123001) + +## preparation of the InputsModel object +InputsModel <- CreateInputsModel(FUN_MOD=RunModel_GR4J,DatesR=BasinObs$DatesR, + Precip=BasinObs$P,PotEvap=BasinObs$E) + +## run period selection +Ind_Run <- seq(which(format(BasinObs$DatesR,format="%d/%m/%Y %H:%M")=="01/01/1990 00:00"), + which(format(BasinObs$DatesR,format="%d/%m/%Y %H:%M")=="31/12/1999 00:00")) + +## preparation of the RunOptions object +RunOptions <- CreateRunOptions(FUN_MOD=RunModel_GR4J,InputsModel=InputsModel,IndPeriod_Run=Ind_Run) + +## simulation +Param <- c(734.568,-0.840,109.809,1.971) +OutputsModel <- RunModel(InputsModel=InputsModel,RunOptions=RunOptions,Param=Param, + FUN_MOD=RunModel_GR4J) + +## results preview +plot_OutputsModel(OutputsModel=OutputsModel,Qobs=BasinObs$Qmm[Ind_Run]) + +## efficiency criterion: Nash-Sutcliffe Efficiency +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) +OutputsCrit <- ErrorCrit_NSE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\n",sep="")) + diff --git a/tests/example_RunModel_CemaNeige.R b/tests/example_RunModel_CemaNeige.R new file mode 100644 index 0000000000000000000000000000000000000000..134bd7d727d780f094194060e17ae74b8bcd0b82 --- /dev/null +++ b/tests/example_RunModel_CemaNeige.R @@ -0,0 +1,25 @@ +## load of catchment data +require(airGR) +data(L0123002) + +## preparation of the InputsModel object +InputsModel <- CreateInputsModel(FUN_MOD=RunModel_CemaNeige,DatesR=BasinObs$DatesR, + Precip=BasinObs$P,TempMean=BasinObs$T, + ZInputs=BasinInfo$HypsoData[51],HypsoData=BasinInfo$HypsoData, + NLayers=5) + +## run period selection +Ind_Run <- seq(which(format(BasinObs$DatesR,format="%d/%m/%Y %H:%M")=="01/01/1990 00:00"), + which(format(BasinObs$DatesR,format="%d/%m/%Y %H:%M")=="31/12/1999 00:00")) + +## preparation of the RunOptions object +RunOptions <- CreateRunOptions(FUN_MOD=RunModel_CemaNeige,InputsModel=InputsModel, + IndPeriod_Run=Ind_Run) + +## simulation +Param <- c(0.962,2.249) +OutputsModel <- RunModel_CemaNeige(InputsModel=InputsModel,RunOptions=RunOptions,Param=Param) + +## results preview +plot_OutputsModel(OutputsModel=OutputsModel) + diff --git a/tests/example_RunModel_CemaNeigeGR4J.R b/tests/example_RunModel_CemaNeigeGR4J.R new file mode 100644 index 0000000000000000000000000000000000000000..6ed335ae3ace2b498373be27105adbc419d743a4 --- /dev/null +++ b/tests/example_RunModel_CemaNeigeGR4J.R @@ -0,0 +1,31 @@ +## load of catchment data +require(airGR) +data(L0123002) + +## preparation of the InputsModel object +InputsModel <- CreateInputsModel(FUN_MOD=RunModel_CemaNeigeGR4J,DatesR=BasinObs$DatesR, + Precip=BasinObs$P,PotEvap=BasinObs$E,TempMean=BasinObs$T, + ZInputs=BasinInfo$HypsoData[51],HypsoData=BasinInfo$HypsoData, + NLayers=5) + +## run period selection +Ind_Run <- seq(which(format(BasinObs$DatesR,format="%d/%m/%Y %H:%M")=="01/01/1990 00:00"), + which(format(BasinObs$DatesR,format="%d/%m/%Y %H:%M")=="31/12/1999 00:00")) + +## preparation of the RunOptions object +RunOptions <- CreateRunOptions(FUN_MOD=RunModel_CemaNeigeGR4J,InputsModel=InputsModel, + IndPeriod_Run=Ind_Run) + +## simulation +Param <- c(408.774,2.646,131.264,1.174,0.962,2.249) +OutputsModel <- RunModel_CemaNeigeGR4J(InputsModel=InputsModel,RunOptions=RunOptions,Param=Param) + +## results preview +plot_OutputsModel(OutputsModel=OutputsModel,Qobs=BasinObs$Qmm[Ind_Run]) + +## efficiency criterion: Nash-Sutcliffe Efficiency +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) +OutputsCrit <- ErrorCrit_NSE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\n",sep="")) + diff --git a/tests/example_RunModel_CemaNeigeGR5J.R b/tests/example_RunModel_CemaNeigeGR5J.R new file mode 100644 index 0000000000000000000000000000000000000000..f543b5d560507e56f69cb769d57df76c18b07bba --- /dev/null +++ b/tests/example_RunModel_CemaNeigeGR5J.R @@ -0,0 +1,31 @@ +## load of catchment data +require(airGR) +data(L0123002) + +## preparation of the InputsModel object +InputsModel <- CreateInputsModel(FUN_MOD=RunModel_CemaNeigeGR5J,DatesR=BasinObs$DatesR, + Precip=BasinObs$P,PotEvap=BasinObs$E,TempMean=BasinObs$T, + ZInputs=BasinInfo$HypsoData[51],HypsoData=BasinInfo$HypsoData, + NLayers=5) + +## run period selection +Ind_Run <- seq(which(format(BasinObs$DatesR,format="%d/%m/%Y %H:%M")=="01/01/1990 00:00"), + which(format(BasinObs$DatesR,format="%d/%m/%Y %H:%M")=="31/12/1999 00:00")) + +## preparation of the RunOptions object +RunOptions <- CreateRunOptions(FUN_MOD=RunModel_CemaNeigeGR5J,InputsModel=InputsModel, + IndPeriod_Run=Ind_Run) + +## simulation +Param <- c(179.139,-0.100,203.815,1.174,2.478,0.977,2.774) +OutputsModel <- RunModel_CemaNeigeGR5J(InputsModel=InputsModel,RunOptions=RunOptions,Param=Param) + +## results preview +plot_OutputsModel(OutputsModel=OutputsModel,Qobs=BasinObs$Qmm[Ind_Run]) + +## efficiency criterion: Nash-Sutcliffe Efficiency +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) +OutputsCrit <- ErrorCrit_NSE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\n",sep="")) + diff --git a/tests/example_RunModel_CemaNeigeGR6J.R b/tests/example_RunModel_CemaNeigeGR6J.R new file mode 100644 index 0000000000000000000000000000000000000000..a24e2098f3e90c84f23e883029f00c145c8efe11 --- /dev/null +++ b/tests/example_RunModel_CemaNeigeGR6J.R @@ -0,0 +1,31 @@ +## load of catchment data +require(airGR) +data(L0123002) + +## preparation of the InputsModel object +InputsModel <- CreateInputsModel(FUN_MOD=RunModel_CemaNeigeGR6J,DatesR=BasinObs$DatesR, + Precip=BasinObs$P,PotEvap=BasinObs$E,TempMean=BasinObs$T, + ZInputs=BasinInfo$HypsoData[51],HypsoData=BasinInfo$HypsoData, + NLayers=5) + +## run period selection +Ind_Run <- seq(which(format(BasinObs$DatesR,format="%d/%m/%Y %H:%M")=="01/01/1990 00:00"), + which(format(BasinObs$DatesR,format="%d/%m/%Y %H:%M")=="31/12/1999 00:00")) + +## preparation of the RunOptions object +RunOptions <- CreateRunOptions(FUN_MOD=RunModel_CemaNeigeGR6J,InputsModel=InputsModel, + IndPeriod_Run=Ind_Run) + +## simulation +Param <- c(116.482,0.500,72.733,1.224,0.278,30.333,0.977,2.776) +OutputsModel <- RunModel_CemaNeigeGR6J(InputsModel=InputsModel,RunOptions=RunOptions,Param=Param) + +## results preview +plot_OutputsModel(OutputsModel=OutputsModel,Qobs=BasinObs$Qmm[Ind_Run]) + +## efficiency criterion: Nash-Sutcliffe Efficiency +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) +OutputsCrit <- ErrorCrit_NSE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\n",sep="")) + diff --git a/tests/example_RunModel_GR1A.R b/tests/example_RunModel_GR1A.R new file mode 100644 index 0000000000000000000000000000000000000000..35779d49c99d0a13f19ef448d100fa695440d24b --- /dev/null +++ b/tests/example_RunModel_GR1A.R @@ -0,0 +1,40 @@ +## load of catchment data +require(airGR) +data(L0123001) + +## conversion of example data from daily to yearly time-step +TabSeries <- data.frame(BasinObs$DatesR,BasinObs$P,BasinObs$E,BasinObs$T,BasinObs$Qmm) +TimeFormat <- "daily" +NewTimeFormat <- "yearly" +ConvertFun <- c("sum","sum","mean","sum") +YearFirstMonth <- 09; +NewTabSeries <- SeriesAggreg(TabSeries=TabSeries,TimeFormat=TimeFormat, + NewTimeFormat=NewTimeFormat,ConvertFun=ConvertFun, + YearFirstMonth=YearFirstMonth) +BasinObs <- NewTabSeries +names(BasinObs) <- c("DatesR","P","E","T","Qmm") + +## preparation of the InputsModel object +InputsModel <- CreateInputsModel(FUN_MOD=RunModel_GR1A,DatesR=BasinObs$DatesR, + Precip=BasinObs$P,PotEvap=BasinObs$E) + +## run period selection +Ind_Run <- seq(which(format(BasinObs$DatesR,format="%Y")=="1990"), + which(format(BasinObs$DatesR,format="%Y")=="1999")) + +## preparation of the RunOptions object +RunOptions <- CreateRunOptions(FUN_MOD=RunModel_GR1A,InputsModel=InputsModel,IndPeriod_Run=Ind_Run) + +## simulation +Param <- c(0.840) +OutputsModel <- RunModel_GR1A(InputsModel=InputsModel,RunOptions=RunOptions,Param=Param) + +## results preview +plot_OutputsModel(OutputsModel=OutputsModel,Qobs=BasinObs$Qmm[Ind_Run]) + +## efficiency criterion: Nash-Sutcliffe Efficiency +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) +OutputsCrit <- ErrorCrit_NSE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\n",sep="")) + diff --git a/tests/example_RunModel_GR2M.R b/tests/example_RunModel_GR2M.R new file mode 100644 index 0000000000000000000000000000000000000000..6ac7e2611e916a9968f4352030b2a0fb2141c61d --- /dev/null +++ b/tests/example_RunModel_GR2M.R @@ -0,0 +1,38 @@ +## load of catchment data +require(airGR) +data(L0123001) + +## conversion of example data from daily to monthly time-step +TabSeries <- data.frame(BasinObs$DatesR,BasinObs$P,BasinObs$E,BasinObs$T,BasinObs$Qmm) +TimeFormat <- "daily" +NewTimeFormat <- "monthly" +ConvertFun <- c("sum","sum","mean","sum") +NewTabSeries <- SeriesAggreg(TabSeries=TabSeries,TimeFormat=TimeFormat, + NewTimeFormat=NewTimeFormat,ConvertFun=ConvertFun) +BasinObs <- NewTabSeries +names(BasinObs) <- c("DatesR","P","E","T","Qmm") + +## preparation of the InputsModel object +InputsModel <- CreateInputsModel(FUN_MOD=RunModel_GR2M,DatesR=BasinObs$DatesR, + Precip=BasinObs$P,PotEvap=BasinObs$E) + +## run period selection +Ind_Run <- seq(which(format(BasinObs$DatesR,format="%m/%Y")=="01/1990"), + which(format(BasinObs$DatesR,format="%m/%Y")=="12/1999")) + +## preparation of the RunOptions object +RunOptions <- CreateRunOptions(FUN_MOD=RunModel_GR2M,InputsModel=InputsModel,IndPeriod_Run=Ind_Run) + +## simulation +Param <- c(265.072,1.040) +OutputsModel <- RunModel_GR2M(InputsModel=InputsModel,RunOptions=RunOptions,Param=Param) + +## results preview +plot_OutputsModel(OutputsModel=OutputsModel,Qobs=BasinObs$Qmm[Ind_Run]) + +## efficiency criterion: Nash-Sutcliffe Efficiency +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) +OutputsCrit <- ErrorCrit_NSE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\n",sep="")) + diff --git a/tests/example_RunModel_GR4H.R b/tests/example_RunModel_GR4H.R new file mode 100644 index 0000000000000000000000000000000000000000..af99a43a54750385c18377c00737d388808407e8 --- /dev/null +++ b/tests/example_RunModel_GR4H.R @@ -0,0 +1,28 @@ +## load of catchment data +require(airGR) +data(L0123003) + +## preparation of the InputsModel object +InputsModel <- CreateInputsModel(FUN_MOD=RunModel_GR4H,DatesR=BasinObs$DatesR, + Precip=BasinObs$P,PotEvap=BasinObs$E) + +## run period selection +Ind_Run <- seq(which(format(BasinObs$DatesR,format="%d/%m/%Y %H:%M")=="01/03/2004 00:00"), + which(format(BasinObs$DatesR,format="%d/%m/%Y %H:%M")=="31/12/2008 00:00")) + +## preparation of the RunOptions object +RunOptions <- CreateRunOptions(FUN_MOD=RunModel_GR4H,InputsModel=InputsModel,IndPeriod_Run=Ind_Run) + +## simulation +Param <- c(521.113,-2.918,218.009,4.124) +OutputsModel <- RunModel_GR4H(InputsModel=InputsModel,RunOptions=RunOptions,Param=Param) + +## results preview +plot_OutputsModel(OutputsModel=OutputsModel,Qobs=BasinObs$Qmm[Ind_Run]) + +## efficiency criterion: Nash-Sutcliffe Efficiency +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) +OutputsCrit <- ErrorCrit_NSE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\n",sep="")) + diff --git a/tests/example_RunModel_GR4J.R b/tests/example_RunModel_GR4J.R new file mode 100644 index 0000000000000000000000000000000000000000..192eee968468dadddc2dee7005b07bfae59d0105 --- /dev/null +++ b/tests/example_RunModel_GR4J.R @@ -0,0 +1,28 @@ +## load of catchment data +require(airGR) +data(L0123001) + +## preparation of the InputsModel object +InputsModel <- CreateInputsModel(FUN_MOD=RunModel_GR4J,DatesR=BasinObs$DatesR, + Precip=BasinObs$P,PotEvap=BasinObs$E) + +## run period selection +Ind_Run <- seq(which(format(BasinObs$DatesR,format="%d/%m/%Y %H:%M")=="01/01/1990 00:00"), + which(format(BasinObs$DatesR,format="%d/%m/%Y %H:%M")=="31/12/1999 00:00")) + +## preparation of the RunOptions object +RunOptions <- CreateRunOptions(FUN_MOD=RunModel_GR4J,InputsModel=InputsModel,IndPeriod_Run=Ind_Run) + +## simulation +Param <- c(257.238,1.012,88.235,2.208) +OutputsModel <- RunModel_GR4J(InputsModel=InputsModel,RunOptions=RunOptions,Param=Param) + +## results preview +plot_OutputsModel(OutputsModel=OutputsModel,Qobs=BasinObs$Qmm[Ind_Run]) + +## efficiency criterion: Nash-Sutcliffe Efficiency +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) +OutputsCrit <- ErrorCrit_NSE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\n",sep="")) + diff --git a/tests/example_RunModel_GR5J.R b/tests/example_RunModel_GR5J.R new file mode 100644 index 0000000000000000000000000000000000000000..4825f5ffc79190a77d25cf5092df5347fc50485f --- /dev/null +++ b/tests/example_RunModel_GR5J.R @@ -0,0 +1,28 @@ +## load of catchment data +require(airGR) +data(L0123001) + +## preparation of the InputsModel object +InputsModel <- CreateInputsModel(FUN_MOD=RunModel_GR5J,DatesR=BasinObs$DatesR, + Precip=BasinObs$P,PotEvap=BasinObs$E) + +## run period selection +Ind_Run <- seq(which(format(BasinObs$DatesR,format="%d/%m/%Y %H:%M")=="01/01/1990 00:00"), + which(format(BasinObs$DatesR,format="%d/%m/%Y %H:%M")=="31/12/1999 00:00")) + +## preparation of the RunOptions object +RunOptions <- CreateRunOptions(FUN_MOD=RunModel_GR5J,InputsModel=InputsModel,IndPeriod_Run=Ind_Run) + +## simulation +Param <- c(245.918,1.027,90.017,2.198,0.434) +OutputsModel <- RunModel_GR5J(InputsModel=InputsModel,RunOptions=RunOptions,Param=Param) + +## results preview +plot_OutputsModel(OutputsModel=OutputsModel,Qobs=BasinObs$Qmm[Ind_Run]) + +## efficiency criterion: Nash-Sutcliffe Efficiency +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) +OutputsCrit <- ErrorCrit_NSE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\n",sep="")) + diff --git a/tests/example_RunModel_GR6J.R b/tests/example_RunModel_GR6J.R new file mode 100644 index 0000000000000000000000000000000000000000..387974853231877da469fbacacc3fb017ec5fd70 --- /dev/null +++ b/tests/example_RunModel_GR6J.R @@ -0,0 +1,28 @@ +## load of catchment data +require(airGR) +data(L0123001) + +## preparation of the InputsModel object +InputsModel <- CreateInputsModel(FUN_MOD=RunModel_GR6J,DatesR=BasinObs$DatesR, + Precip=BasinObs$P,PotEvap=BasinObs$E) + +## run period selection +Ind_Run <- seq(which(format(BasinObs$DatesR,format="%d/%m/%Y %H:%M")=="01/01/1990 00:00"), + which(format(BasinObs$DatesR,format="%d/%m/%Y %H:%M")=="31/12/1999 00:00")) + +## preparation of the RunOptions object +RunOptions <- CreateRunOptions(FUN_MOD=RunModel_GR6J,InputsModel=InputsModel,IndPeriod_Run=Ind_Run) + +## simulation +Param <- c(242.257,0.637,53.517,2.218,0.424,4.759) +OutputsModel <- RunModel_GR6J(InputsModel=InputsModel,RunOptions=RunOptions,Param=Param) + +## results preview +plot_OutputsModel(OutputsModel=OutputsModel,Qobs=BasinObs$Qmm[Ind_Run]) + +## efficiency criterion: Nash-Sutcliffe Efficiency +InputsCrit <- CreateInputsCrit(FUN_CRIT=ErrorCrit_NSE,InputsModel=InputsModel, + RunOptions=RunOptions,Qobs=BasinObs$Qmm[Ind_Run]) +OutputsCrit <- ErrorCrit_NSE(InputsCrit=InputsCrit,OutputsModel=OutputsModel) +cat(paste(" Crit ",OutputsCrit$CritName," ",round(OutputsCrit$CritValue,4),"\n",sep="")) + diff --git a/tests/example_SeriesAggreg.R b/tests/example_SeriesAggreg.R new file mode 100644 index 0000000000000000000000000000000000000000..6018c5d6cb008f2ca81886f283ac4fbccd7e832f --- /dev/null +++ b/tests/example_SeriesAggreg.R @@ -0,0 +1,18 @@ +## load of catchment data +require(airGR) + +## preparation of the initial time series data frame at the daily time-step +data(L0123002) +TabSeries <- data.frame(BasinObs$DatesR,BasinObs$P,BasinObs$E,BasinObs$T,BasinObs$Qmm) +TimeFormat <- "daily" + +## conversion at the monthly time-step +NewTimeFormat <- "monthly" +ConvertFun <- c("sum","sum","mean","sum") +NewTabSeries <- SeriesAggreg(TabSeries=TabSeries,TimeFormat,NewTimeFormat,ConvertFun) + +## conversion at the yearly time-step +NewTimeFormat <- "yearly" +ConvertFun <- c("sum","sum","mean","sum") +NewTabSeries <- SeriesAggreg(TabSeries=TabSeries,TimeFormat,NewTimeFormat,ConvertFun) + diff --git a/tests/example_TransfoParam.R b/tests/example_TransfoParam.R new file mode 100644 index 0000000000000000000000000000000000000000..0c5c5037572e0154543385158f53b72625461eed --- /dev/null +++ b/tests/example_TransfoParam.R @@ -0,0 +1,15 @@ +require(airGR) + +## transformation Real->Transformed for the GR4J model + Xreal <- matrix( c( 221.41, -3.63, 30.00, 1.37, + 347.23, -1.03, 60.34, 1.76, + 854.06, -0.10, 148.41, 2.34), + ncol=4,byrow=TRUE) + Xtran <- TransfoParam(ParamIn=Xreal,Direction="RT",FUN_TRANSFO=TransfoParam_GR4J) + +## transformation Transformed->Real for the GR4J model + Xtran <- matrix( c( +3.60, -2.00, +3.40, -9.10, + +3.90, -0.90, +4.10, -8.70, + +4.50, -0.10, +5.00, -8.10), + ncol=4,byrow=TRUE) + Xreal <- TransfoParam(ParamIn=Xtran,Direction="TR",FUN_TRANSFO=TransfoParam_GR4J) diff --git a/tests/example_TransfoParam_CemaNeige.R b/tests/example_TransfoParam_CemaNeige.R new file mode 100644 index 0000000000000000000000000000000000000000..85efecfca07064f44925666687e7a8243b255728 --- /dev/null +++ b/tests/example_TransfoParam_CemaNeige.R @@ -0,0 +1,15 @@ +require(airGR) + +## transformation Real->Transformed for the CemaNeige module + Xreal <- matrix( c( 0.19, 1.73, + 0.39, 2.51, + 0.74, 4.06), + ncol=2,byrow=TRUE) + Xtran <- TransfoParam_CemaNeige(ParamIn=Xreal,Direction="RT") + +## transformation Transformed->Real for the CemaNeige module + Xtran <- matrix( c( -6.26, +0.55, + -2.13, +0.92, + +4.86, +1.40) + ,ncol=2,byrow=TRUE) + Xreal <- TransfoParam_CemaNeige(ParamIn=Xtran,Direction="TR") diff --git a/tests/example_TransfoParam_GR1A.R b/tests/example_TransfoParam_GR1A.R new file mode 100644 index 0000000000000000000000000000000000000000..993460235f84d0efbe39d890d2c143d50d0170e6 --- /dev/null +++ b/tests/example_TransfoParam_GR1A.R @@ -0,0 +1,15 @@ +require(airGR) + +## transformation Real->Transformed for the GR1A model + Xreal <- matrix( c( 0.625, + 1.250, + 1.875), + ncol=1,byrow=TRUE) + Xtran <- TransfoParam_GR1A(ParamIn=Xreal,Direction="RT") + +## transformation Transformed->Real for the GR1A model + Xtran <- matrix( c( -5.00, + +0.00, + +5.00), + ncol=1,byrow=TRUE) + Xreal <- TransfoParam_GR1A(ParamIn=Xtran,Direction="TR") diff --git a/tests/example_TransfoParam_GR2M.R b/tests/example_TransfoParam_GR2M.R new file mode 100644 index 0000000000000000000000000000000000000000..4c0399a036aafd85c69d6d0cb143639c0d19d9ee --- /dev/null +++ b/tests/example_TransfoParam_GR2M.R @@ -0,0 +1,15 @@ +require(airGR) + +## transformation Real->Transformed for the GR2M model + Xreal <- matrix( c( 221.41, -1.00, + 347.23, +0.00, + 854.01, +1.00), + ncol=2,byrow=TRUE) + Xtran <- TransfoParam_GR2M(ParamIn=Xreal,Direction="RT") + +## transformation Transformed->Real for the GR2M model + Xtran <- matrix( c( +3.60, -5.00, + +3.90, +0.00, + +4.50, +5.00), + ncol=2,byrow=TRUE) + Xreal <- TransfoParam_GR2M(ParamIn=Xtran,Direction="TR") diff --git a/tests/example_TransfoParam_GR4H.R b/tests/example_TransfoParam_GR4H.R new file mode 100644 index 0000000000000000000000000000000000000000..6a2868cfe8dd79e5777b0401d0f7b5b2b75f489e --- /dev/null +++ b/tests/example_TransfoParam_GR4H.R @@ -0,0 +1,15 @@ +require(airGR) + +## transformation Real->Transformed for the GR4H model + Xreal <- matrix( c( 221.41, -3.63, 30.00, 1.37, + 347.23, -1.03, 60.34, 1.76, + 854.06, -0.10, 148.41, 2.34), + ncol=4,byrow=TRUE) + Xtran <- TransfoParam_GR4H(ParamIn=Xreal,Direction="RT") + +## transformation Transformed->Real for the GR4H model + Xtran <- matrix( c( +3.60, -2.00, +3.40, -9.10, + +3.90, -0.90, +4.10, -8.70, + +4.50, -0.10, +5.00, -8.10), + ncol=4,byrow=TRUE) + Xreal <- TransfoParam_GR4H(ParamIn=Xtran,Direction="TR") diff --git a/tests/example_TransfoParam_GR4J.R b/tests/example_TransfoParam_GR4J.R new file mode 100644 index 0000000000000000000000000000000000000000..610190331c200f48ff06bbe21600ec8f78ced195 --- /dev/null +++ b/tests/example_TransfoParam_GR4J.R @@ -0,0 +1,15 @@ +require(airGR) + +## transformation Real->Transformed for the GR4J model + Xreal <- matrix( c( 221.41, -3.63, 30.00, 1.37, + 347.23, -1.03, 60.34, 1.76, + 854.06, -0.10, 148.41, 2.34), + ncol=4,byrow=TRUE) + Xtran <- TransfoParam_GR4J(ParamIn=Xreal,Direction="RT") + +## transformation Transformed->Real for the GR4J model + Xtran <- matrix( c( +3.60, -2.00, +3.40, -9.10, + +3.90, -0.90, +4.10, -8.70, + +4.50, -0.10, +5.00, -8.10), + ncol=4,byrow=TRUE) + Xreal <- TransfoParam_GR4J(ParamIn=Xtran,Direction="TR") diff --git a/tests/example_TransfoParam_GR5J.R b/tests/example_TransfoParam_GR5J.R new file mode 100644 index 0000000000000000000000000000000000000000..b2361f3a94f4a59fe70984b6a1551aa65cf3f560 --- /dev/null +++ b/tests/example_TransfoParam_GR5J.R @@ -0,0 +1,15 @@ +require(airGR) + +## transformation Real->Transformed for the GR5J model + Xreal <- matrix( c( 221.41, -2.65, 27.11, 1.37, -0.76, + 347.23, -0.64, 60.34, 1.76, 0.30, + 854.01, -0.10, 148.41, 2.34, 0.52), + ncol=5,byrow=TRUE) + Xtran <- TransfoParam_GR5J(ParamIn=Xreal,Direction="RT") + +## transformation Transformed->Real for the GR5J model + Xtran <- matrix( c( +3.60, -1.70, +3.30, -9.10, -0.70, + +3.90, -0.60, +4.10, -8.70, +0.30, + +4.50, -0.10, +5.00, -8.10, +0.50), + ncol=5,byrow=TRUE) + Xreal <- TransfoParam_GR5J(ParamIn=Xtran,Direction="TR") diff --git a/tests/example_TransfoParam_GR6J.R b/tests/example_TransfoParam_GR6J.R new file mode 100644 index 0000000000000000000000000000000000000000..1bd48fa469859a4ea54805735a738e2dcae14dbd --- /dev/null +++ b/tests/example_TransfoParam_GR6J.R @@ -0,0 +1,15 @@ +require(airGR) + +## transformation Real->Transformed for the GR6J model + Xreal <- matrix( c( 221.41, -1.18, 27.11, 1.37, -0.18, 20.09, + 347.23, -0.52, 60.34, 1.76, 0.02, 54.60, + 854.06, 0.52, 148.41, 2.34, 0.22, 148.41), + ncol=6,byrow=TRUE) + Xtran <- TransfoParam_GR6J(ParamIn=Xreal,Direction="RT") + +## transformation Transformed->Real for the GR6J model + Xtran <- matrix( c( +3.60, -1.00, +3.30, -9.10, -0.90, +3.00, + +3.90, -0.50, +4.10, -8.70, +0.10, +4.00, + +4.50, +0.50, +5.00, -8.10, +1.10, +5.00), + ncol=6,byrow=TRUE) + Xreal <- TransfoParam_GR6J(ParamIn=Xtran,Direction="TR") diff --git a/tests/example_plot_OutputsModel.R b/tests/example_plot_OutputsModel.R new file mode 100644 index 0000000000000000000000000000000000000000..3cd8e8d2a5bf08990156919fbfb1f5a7239b3b9c --- /dev/null +++ b/tests/example_plot_OutputsModel.R @@ -0,0 +1,54 @@ +#### example 1 without snow module + +## load of catchment data +require(airGR) +data(L0123001) + +## preparation of the InputsModel object +InputsModel <- CreateInputsModel(FUN_MOD=RunModel_GR4J,DatesR=BasinObs$DatesR, + Precip=BasinObs$P,PotEvap=BasinObs$E) + +## run period selection +Ind_Run <- seq(which(format(BasinObs$DatesR,format="%d/%m/%Y %H:%M")=="01/01/1990 00:00"), + which(format(BasinObs$DatesR,format="%d/%m/%Y %H:%M")=="31/12/1999 00:00")) + +## preparation of the RunOptions object +RunOptions <- CreateRunOptions(FUN_MOD=RunModel_GR4J,InputsModel=InputsModel,IndPeriod_Run=Ind_Run) + +## simulation +Param <- c(734.568,-0.840,109.809,1.971) +OutputsModel <- RunModel(InputsModel=InputsModel,RunOptions=RunOptions,Param=Param, + FUN_MOD=RunModel_GR4J) + +## results preview +plot_OutputsModel(OutputsModel=OutputsModel,Qobs=BasinObs$Qmm[Ind_Run]) + + +#### example 2 with snow module + +## load of catchment data +require(airGR) +data(L0123002) + +## preparation of the InputsModel object +InputsModel <- CreateInputsModel(FUN_MOD=RunModel_CemaNeigeGR4J,DatesR=BasinObs$DatesR, + Precip=BasinObs$P,PotEvap=BasinObs$E,TempMean=BasinObs$T, + HypsoData=BasinInfo$HypsoData,NLayers=5) + +## run period selection +Ind_Run <- seq(which(format(BasinObs$DatesR,format="%d/%m/%Y %H:%M")=="01/01/1990 00:00"), + which(format(BasinObs$DatesR,format="%d/%m/%Y %H:%M")=="31/12/1999 00:00")) + +## preparation of the RunOptions object +RunOptions <- CreateRunOptions(FUN_MOD=RunModel_CemaNeigeGR4J,InputsModel=InputsModel, + IndPeriod_Run=Ind_Run) + +## simulation +Param <- c(408.774,2.646,131.264,1.174,0.962,2.249) +OutputsModel <- RunModel(InputsModel=InputsModel,RunOptions=RunOptions,Param=Param, + FUN_MOD=RunModel_CemaNeigeGR4J) + +## results preview +plot_OutputsModel(OutputsModel=OutputsModel,Qobs=BasinObs$Qmm[Ind_Run]) + +