Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
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);
}