Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
HYCAR-Hydro
airGR
Commits
f53b6a57
Commit
f53b6a57
authored
Mar 01, 2019
by
Delaigue Olivier
Browse files
v1.2.7.2 CLEAN: remove \n at the ends of error and warning messages
parent
dd45d335
Changes
25
Hide whitespace changes
Inline
Side-by-side
DESCRIPTION
View file @
f53b6a57
Package: airGR
Type: Package
Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling
Version: 1.2.7.
1
Date: 2019-0
2-28
Version: 1.2.7.
2
Date: 2019-0
3-01
Authors@R: c(
person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")),
person("Charles", "Perrin", role = c("aut", "ths"), comment = c(ORCID = "0000-0001-8552-1881")),
...
...
NEWS.rmd
View file @
f53b6a57
...
...
@@ -13,7 +13,7 @@ output:
### 1.2.7.
1
Release Notes (2019-0
2-28
)
### 1.2.7.
2
Release Notes (2019-0
3-01
)
...
...
R/Calibration_Michel.R
View file @
f53b6a57
...
...
@@ -4,27 +4,27 @@ Calibration_Michel <- function(InputsModel, RunOptions, InputsCrit, CalibOptions
##_____Arguments_check_____________________________________________________________________
if
(
!
inherits
(
InputsModel
,
"InputsModel"
))
{
stop
(
"InputsModel must be of class 'InputsModel'
\n
"
)
stop
(
"InputsModel must be of class 'InputsModel'"
)
return
(
NULL
)
}
if
(
!
inherits
(
RunOptions
,
"RunOptions"
))
{
stop
(
"RunOptions must be of class 'RunOptions'
\n
"
)
stop
(
"RunOptions must be of class 'RunOptions'"
)
return
(
NULL
)
}
if
(
!
inherits
(
InputsCrit
,
"InputsCrit"
))
{
stop
(
"InputsCrit must be of class 'InputsCrit'
\n
"
)
stop
(
"InputsCrit must be of class 'InputsCrit'"
)
return
(
NULL
)
}
if
(
inherits
(
InputsCrit
,
"Multi"
))
{
stop
(
"InputsCrit must be of class 'Single' or 'Compo'
\n
"
)
stop
(
"InputsCrit must be of class 'Single' or 'Compo'"
)
return
(
NULL
)
}
if
(
!
inherits
(
CalibOptions
,
"CalibOptions"
))
{
stop
(
"CalibOptions must be of class 'CalibOptions'
\n
"
)
stop
(
"CalibOptions must be of class 'CalibOptions'"
)
return
(
NULL
)
}
if
(
!
inherits
(
CalibOptions
,
"HBAN"
))
{
stop
(
"CalibOptions must be of class 'HBAN' if Calibration_Michel is used
\n
"
)
stop
(
"CalibOptions must be of class 'HBAN' if Calibration_Michel is used"
)
return
(
NULL
)
}
if
(
!
missing
(
FUN_CRIT
))
{
...
...
@@ -91,7 +91,7 @@ Calibration_Michel <- function(InputsModel, RunOptions, InputsCrit, CalibOptions
}
}
if
(
is.null
(
FUN_TRANSFO
))
{
stop
(
"FUN_TRANSFO was not found (in Calibration function)
\n
"
)
stop
(
"FUN_TRANSFO was not found (in Calibration function)"
)
return
(
NULL
)
}
}
...
...
@@ -114,7 +114,7 @@ Calibration_Michel <- function(InputsModel, RunOptions, InputsCrit, CalibOptions
NParam
<-
ncol
(
CalibOptions
$
StartParamDistrib
)
}
if
(
NParam
>
20
)
{
stop
(
"Calibration_Michel can handle a maximum of 20 parameters
\n
"
)
stop
(
"Calibration_Michel can handle a maximum of 20 parameters"
)
return
(
NULL
)
}
HistParamR
<-
matrix
(
NA
,
nrow
=
500
*
NParam
,
ncol
=
NParam
)
...
...
@@ -237,11 +237,11 @@ Calibration_Michel <- function(InputsModel, RunOptions, InputsCrit, CalibOptions
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
"
)
stop
(
"each input set must be a matrix of one single line"
)
return
(
NULL
)
}
if
(
ncol
(
NewParamOptimT
)
!=
ncol
(
OldParamOptimT
)
|
ncol
(
NewParamOptimT
)
!=
length
(
OptimParam
))
{
stop
(
"each input set must have the same number of values
\n
"
)
stop
(
"each input set must have the same number of values"
)
return
(
NULL
)
}
##Proposal_of_new_parameter_sets ###(local search providing 2 * NParam-1 new sets)
...
...
R/CreateCalibOptions.R
View file @
f53b6a57
...
...
@@ -54,7 +54,7 @@ CreateCalibOptions <-
BOOL
<-
TRUE
}
if
(
!
BOOL
)
{
stop
(
"incorrect FUN_MOD for use in CreateCalibOptions
\n
"
)
stop
(
"incorrect FUN_MOD for use in CreateCalibOptions"
)
return
(
NULL
)
}
...
...
@@ -66,7 +66,7 @@ CreateCalibOptions <-
BOOL
<-
TRUE
}
if
(
!
BOOL
)
{
stop
(
"incorrect FUN_CALIB for use in CreateCalibOptions
\n
"
)
stop
(
"incorrect FUN_CALIB for use in CreateCalibOptions"
)
return
(
NULL
)
}
...
...
@@ -99,7 +99,7 @@ CreateCalibOptions <-
FUN1
<-
TransfoParam_CemaNeige
}
if
(
is.null
(
FUN1
))
{
stop
(
"FUN1 was not found
\n
"
)
stop
(
"FUN1 was not found"
)
return
(
NULL
)
}
##_set_FUN2
...
...
@@ -130,7 +130,7 @@ CreateCalibOptions <-
}
}
if
(
is.null
(
FUN_TRANSFO
))
{
stop
(
"FUN_TRANSFO was not found
\n
"
)
stop
(
"FUN_TRANSFO was not found"
)
return
(
NULL
)
}
...
...
@@ -171,19 +171,19 @@ CreateCalibOptions <-
FixedParam
<-
rep
(
NA
,
NParam
)
}
else
{
if
(
!
is.vector
(
FixedParam
))
{
stop
(
"FixedParam must be a vector
\n
"
)
stop
(
"FixedParam must be a vector"
)
return
(
NULL
)
}
if
(
length
(
FixedParam
)
!=
NParam
)
{
stop
(
"Incompatibility between FixedParam length and FUN_MOD
\n
"
)
stop
(
"Incompatibility between FixedParam length and FUN_MOD"
)
return
(
NULL
)
}
if
(
all
(
!
is.na
(
FixedParam
)))
{
stop
(
"At least one parameter must be not set (NA)
\n
"
)
stop
(
"At least one parameter must be not set (NA)"
)
return
(
NULL
)
}
if
(
all
(
is.na
(
FixedParam
)))
{
warning
(
"You have not set any parameter in \"FixedParam\"
\n
"
)
warning
(
"You have not set any parameter in \"FixedParam\""
)
}
}
...
...
@@ -196,23 +196,23 @@ CreateCalibOptions <-
}
else
{
if
(
!
is.matrix
(
SearchRanges
))
{
stop
(
"SearchRanges must be a matrix
\n
"
)
stop
(
"SearchRanges must be a matrix"
)
return
(
NULL
)
}
if
(
!
is.numeric
(
SearchRanges
))
{
stop
(
"SearchRanges must be a matrix of numeric values
\n
"
)
stop
(
"SearchRanges must be a matrix of numeric values"
)
return
(
NULL
)
}
if
(
sum
(
is.na
(
SearchRanges
))
!=
0
)
{
stop
(
"SearchRanges must not include NA values
\n
"
)
stop
(
"SearchRanges must not include NA values"
)
return
(
NULL
)
}
if
(
nrow
(
SearchRanges
)
!=
2
)
{
stop
(
"SearchRanges must have 2 rows
\n
"
)
stop
(
"SearchRanges must have 2 rows"
)
return
(
NULL
)
}
if
(
ncol
(
SearchRanges
)
!=
NParam
)
{
stop
(
"Incompatibility between SearchRanges ncol and FUN_MOD
\n
"
)
stop
(
"Incompatibility between SearchRanges ncol and FUN_MOD"
)
return
(
NULL
)
}
}
...
...
@@ -279,37 +279,37 @@ CreateCalibOptions <-
##check_StartParamList_and_StartParamDistrib__format
if
(
"HBAN"
%in%
ObjectClass
&
!
is.null
(
StartParamList
))
{
if
(
!
is.matrix
(
StartParamList
))
{
stop
(
"StartParamList must be a matrix
\n
"
)
stop
(
"StartParamList must be a matrix"
)
return
(
NULL
)
}
if
(
!
is.numeric
(
StartParamList
))
{
stop
(
"StartParamList must be a matrix of numeric values
\n
"
)
stop
(
"StartParamList must be a matrix of numeric values"
)
return
(
NULL
)
}
if
(
sum
(
is.na
(
StartParamList
))
!=
0
)
{
stop
(
"StartParamList must not include NA values
\n
"
)
stop
(
"StartParamList must not include NA values"
)
return
(
NULL
)
}
if
(
ncol
(
StartParamList
)
!=
NParam
)
{
stop
(
"Incompatibility between StartParamList ncol and FUN_MOD
\n
"
)
stop
(
"Incompatibility between StartParamList ncol and FUN_MOD"
)
return
(
NULL
)
}
}
if
(
"HBAN"
%in%
ObjectClass
&
!
is.null
(
StartParamDistrib
))
{
if
(
!
is.matrix
(
StartParamDistrib
))
{
stop
(
"StartParamDistrib must be a matrix
\n
"
)
stop
(
"StartParamDistrib must be a matrix"
)
return
(
NULL
)
}
if
(
!
is.numeric
(
StartParamDistrib
[
1
,
]))
{
stop
(
"StartParamDistrib must be a matrix of numeric values
\n
"
)
stop
(
"StartParamDistrib must be a matrix of numeric values"
)
return
(
NULL
)
}
if
(
sum
(
is.na
(
StartParamDistrib
[
1
,
]))
!=
0
)
{
stop
(
"StartParamDistrib must not include NA values on the first line
\n
"
)
stop
(
"StartParamDistrib must not include NA values on the first line"
)
return
(
NULL
)
}
if
(
ncol
(
StartParamDistrib
)
!=
NParam
)
{
stop
(
"Incompatibility between StartParamDistrib ncol and FUN_MOD
\n
"
)
stop
(
"Incompatibility between StartParamDistrib ncol and FUN_MOD"
)
return
(
NULL
)
}
}
...
...
R/CreateInputsCrit.R
View file @
f53b6a57
...
...
@@ -39,7 +39,7 @@ CreateInputsCrit <- function(FUN_CRIT,
## check 'InputsModel'
if
(
!
inherits
(
InputsModel
,
"InputsModel"
))
{
stop
(
"'InputsModel' must be of class 'InputsModel'
\n
"
)
stop
(
"'InputsModel' must be of class 'InputsModel'"
)
return
(
NULL
)
}
...
...
@@ -51,7 +51,7 @@ CreateInputsCrit <- function(FUN_CRIT,
## check 'obs'
vecObs
<-
unlist
(
obs
)
if
(
length
(
vecObs
)
%%
LLL
!=
0
|
!
is.numeric
(
vecObs
))
{
stop
(
sprintf
(
"'obs' must be a (list of) vector(s) of numeric values of length %i
\n
"
,
LLL
),
call.
=
FALSE
)
stop
(
sprintf
(
"'obs' must be a (list of) vector(s) of numeric values of length %i"
,
LLL
),
call.
=
FALSE
)
}
if
(
!
is.list
(
obs
))
{
obs
<-
list
(
obs
)
...
...
@@ -108,14 +108,14 @@ CreateInputsCrit <- function(FUN_CRIT,
## check 'RunOptions'
if
(
!
inherits
(
RunOptions
,
"RunOptions"
))
{
stop
(
"'RunOptions' must be of class 'RunOptions'
\n
"
)
stop
(
"'RunOptions' must be of class 'RunOptions'"
)
return
(
NULL
)
}
## check 'weights'
if
(
length
(
listArgs
$
weights
)
>
1
&
sum
(
unlist
(
listArgs
$
weights
))
==
0
&
!
any
(
sapply
(
listArgs
$
weights
,
is.null
)))
{
stop
(
"sum of 'weights' cannot be equal to zero
\n
"
)
stop
(
"sum of 'weights' cannot be equal to zero"
)
}
...
...
@@ -125,10 +125,10 @@ CreateInputsCrit <- function(FUN_CRIT,
## preparation of warning messages
inVarObs
<-
c
(
"Q"
,
"SCA"
,
"SWE"
,
"SD"
)
msgVarObs
<-
"'varObs' must be a (list of) character vector(s) and one of %s
\n
"
msgVarObs
<-
"'varObs' must be a (list of) character vector(s) and one of %s"
msgVarObs
<-
sprintf
(
msgVarObs
,
paste
(
sapply
(
inVarObs
,
shQuote
),
collapse
=
", "
))
inTransfo
<-
c
(
""
,
"sqrt"
,
"log"
,
"inv"
,
"sort"
)
msgTransfo
<-
"'transfo' must be a (list of) character vector(s) and one of %s
\n
"
msgTransfo
<-
"'transfo' must be a (list of) character vector(s) and one of %s"
msgTransfo
<-
sprintf
(
msgTransfo
,
paste
(
sapply
(
inTransfo
,
shQuote
),
collapse
=
", "
))
...
...
@@ -139,17 +139,17 @@ CreateInputsCrit <- function(FUN_CRIT,
## check 'FUN_CRIT'
if
(
!
(
identical
(
iListArgs2
$
FUN_CRIT
,
ErrorCrit_NSE
)
|
identical
(
iListArgs2
$
FUN_CRIT
,
ErrorCrit_KGE
)
|
identical
(
iListArgs2
$
FUN_CRIT
,
ErrorCrit_KGE2
)
|
identical
(
iListArgs2
$
FUN_CRIT
,
ErrorCrit_RMSE
)))
{
stop
(
"incorrect 'FUN_CRIT' for use in 'CreateInputsCrit'
\n
"
,
call.
=
FALSE
)
stop
(
"incorrect 'FUN_CRIT' for use in 'CreateInputsCrit'"
,
call.
=
FALSE
)
return
(
NULL
)
}
if
(
identical
(
iListArgs2
$
FUN_CRIT
,
ErrorCrit_RMSE
)
&
length
(
listArgs
$
weights
)
>
1
&
all
(
!
is.null
(
unlist
(
listArgs
$
weights
))))
{
stop
(
"calculating a composite criterion with the RMSE is not allowed since RMSE is not an adimensional measure
\n
"
,
call.
=
FALSE
)
stop
(
"calculating a composite criterion with the RMSE is not allowed since RMSE is not an adimensional measure"
,
call.
=
FALSE
)
return
(
NULL
)
}
## check 'obs'
if
(
!
is.vector
(
iListArgs2
$
obs
)
|
length
(
iListArgs2
$
obs
)
!=
LLL
|
!
is.numeric
(
iListArgs2
$
obs
))
{
stop
(
sprintf
(
"'obs' must be a (list of) vector(s) of numeric values of length %i
\n
"
,
LLL
),
call.
=
FALSE
)
stop
(
sprintf
(
"'obs' must be a (list of) vector(s) of numeric values of length %i"
,
LLL
),
call.
=
FALSE
)
return
(
NULL
)
}
...
...
@@ -158,11 +158,11 @@ CreateInputsCrit <- function(FUN_CRIT,
iListArgs2
$
BoolCrit
<-
rep
(
TRUE
,
length
(
iListArgs2
$
obs
))
}
if
(
!
is.logical
(
iListArgs2
$
BoolCrit
))
{
stop
(
"'BoolCrit' must be a (list of) vector(s) of boolean
\n
"
,
call.
=
FALSE
)
stop
(
"'BoolCrit' must be a (list of) vector(s) of boolean"
,
call.
=
FALSE
)
return
(
NULL
)
}
if
(
length
(
iListArgs2
$
BoolCrit
)
!=
LLL
)
{
stop
(
"'BoolCrit' and 'InputsModel' series must have the same length
\n
"
,
call.
=
FALSE
)
stop
(
"'BoolCrit' and 'InputsModel' series must have the same length"
,
call.
=
FALSE
)
return
(
NULL
)
}
...
...
@@ -199,7 +199,7 @@ CreateInputsCrit <- function(FUN_CRIT,
## check 'weights'
if
(
!
is.null
(
iListArgs2
$
weights
))
{
if
(
!
is.vector
(
iListArgs2
$
weights
)
|
length
(
iListArgs2
$
weights
)
!=
1
|
!
is.numeric
(
iListArgs2
$
weights
)
|
any
(
iListArgs2
$
weights
<
0
))
{
stop
(
"'weights' must be a single (list of) positive or equal to zero value(s)
\n
"
,
call.
=
FALSE
)
stop
(
"'weights' must be a single (list of) positive or equal to zero value(s)"
,
call.
=
FALSE
)
return
(
NULL
)
}
}
...
...
@@ -207,7 +207,7 @@ CreateInputsCrit <- function(FUN_CRIT,
## check 'epsilon'
if
(
!
is.null
(
iListArgs2
$
epsilon
))
{
if
(
!
is.vector
(
iListArgs2
$
epsilon
)
|
length
(
iListArgs2
$
epsilon
)
!=
1
|
!
is.numeric
(
iListArgs2
$
epsilon
)
|
any
(
iListArgs2
$
epsilon
<=
0
))
{
stop
(
"'epsilon' must be a single (list of) positive value(s)
\n
"
,
call.
=
FALSE
)
stop
(
"'epsilon' must be a single (list of) positive value(s)"
,
call.
=
FALSE
)
return
(
NULL
)
}
}
else
if
(
iListArgs2
$
transfo
%in%
c
(
"log"
,
"inv"
)
&
any
(
iListArgs2
$
obs
%in%
0
)
&
warnings
)
{
...
...
R/CreateInputsModel.R
View file @
f53b6a57
...
...
@@ -58,18 +58,18 @@ CreateInputsModel <- function(FUN_MOD,
BOOL
<-
TRUE
}
if
(
!
BOOL
)
{
stop
(
"Incorrect FUN_MOD for use in CreateInputsModel
\n
"
)
stop
(
"Incorrect FUN_MOD for use in CreateInputsModel"
)
return
(
NULL
)
}
##check_arguments
if
(
"GR"
%in%
ObjectClass
|
"CemaNeige"
%in%
ObjectClass
)
{
if
(
is.null
(
DatesR
))
{
stop
(
"DatesR is missing
\n
"
)
stop
(
"DatesR is missing"
)
return
(
NULL
)
}
if
(
"POSIXlt"
%in%
class
(
DatesR
)
==
FALSE
&
"POSIXct"
%in%
class
(
DatesR
)
==
FALSE
)
{
stop
(
"DatesR must be defined as POSIXlt or POSIXct
\n
"
)
stop
(
"DatesR must be defined as POSIXlt or POSIXct"
)
return
(
NULL
)
}
if
(
"POSIXlt"
%in%
class
(
DatesR
)
==
FALSE
)
{
...
...
@@ -81,103 +81,103 @@ CreateInputsModel <- function(FUN_MOD,
return
(
NULL
)
}
if
(
any
(
duplicated
(
DatesR
)))
{
stop
(
"DatesR must not include duplicated values
\n
"
)
stop
(
"DatesR must not include duplicated values"
)
return
(
NULL
)
}
LLL
<-
length
(
DatesR
)
}
if
(
"GR"
%in%
ObjectClass
)
{
if
(
is.null
(
Precip
))
{
stop
(
"Precip is missing
\n
"
)
stop
(
"Precip is missing"
)
return
(
NULL
)
}
if
(
is.null
(
PotEvap
))
{
stop
(
"PotEvap is missing
\n
"
)
stop
(
"PotEvap is missing"
)
return
(
NULL
)
}
if
(
!
is.vector
(
Precip
)
|
!
is.vector
(
PotEvap
))
{
stop
(
"Precip and PotEvap must be vectors of numeric values
\n
"
)
stop
(
"Precip and PotEvap must be vectors of numeric values"
)
return
(
NULL
)
}
if
(
!
is.numeric
(
Precip
)
|
!
is.numeric
(
PotEvap
))
{
stop
(
"Precip and PotEvap must be vectors of numeric values
\n
"
)
stop
(
"Precip and PotEvap must be vectors of numeric values"
)
return
(
NULL
)
}
if
(
length
(
Precip
)
!=
LLL
|
length
(
PotEvap
)
!=
LLL
)
{
stop
(
"Precip, PotEvap and DatesR must have the same length
\n
"
)
stop
(
"Precip, PotEvap and DatesR must have the same length"
)
return
(
NULL
)
}
}
if
(
"CemaNeige"
%in%
ObjectClass
)
{
if
(
is.null
(
Precip
))
{
stop
(
"Precip is missing
\n
"
)
stop
(
"Precip is missing"
)
return
(
NULL
)
}
if
(
is.null
(
TempMean
))
{
stop
(
"TempMean is missing
\n
"
)
stop
(
"TempMean is missing"
)
return
(
NULL
)
}
if
(
!
is.vector
(
Precip
)
|
!
is.vector
(
TempMean
))
{
stop
(
"Precip and TempMean must be vectors of numeric values
\n
"
)
stop
(
"Precip and TempMean must be vectors of numeric values"
)
return
(
NULL
)
}
if
(
!
is.numeric
(
Precip
)
|
!
is.numeric
(
TempMean
))
{
stop
(
"Precip and TempMean must be vectors of numeric values
\n
"
)
stop
(
"Precip and TempMean must be vectors of numeric values"
)
return
(
NULL
)
}
if
(
length
(
Precip
)
!=
LLL
|
length
(
TempMean
)
!=
LLL
)
{
stop
(
"Precip, TempMean and DatesR must have the same length
\n
"
)
stop
(
"Precip, TempMean and DatesR must have the same length"
)
return
(
NULL
)
}
if
(
is.null
(
TempMin
)
!=
is.null
(
TempMax
))
{
stop
(
"TempMin and TempMax must be both defined if not null
\n
"
)
stop
(
"TempMin and TempMax must be both defined if not null"
)
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
"
)
stop
(
"TempMin and TempMax must be vectors of numeric values"
)
return
(
NULL
)
}
if
(
!
is.numeric
(
TempMin
)
|
!
is.numeric
(
TempMax
))
{
stop
(
"TempMin and TempMax must be vectors of numeric values
\n
"
)
stop
(
"TempMin and TempMax must be vectors of numeric values"
)
return
(
NULL
)
}
if
(
length
(
TempMin
)
!=
LLL
|
length
(
TempMax
)
!=
LLL
)
{
stop
(
"TempMin, TempMax and DatesR must have the same length
\n
"
)
stop
(
"TempMin, TempMax and DatesR must have the same length"
)
return
(
NULL
)
}
}
if
(
!
is.null
(
HypsoData
))
{
if
(
!
is.vector
(
HypsoData
))
{
stop
(
"HypsoData must be a vector of numeric values if not null
\n
"
)
stop
(
"HypsoData must be a vector of numeric values if not null"
)
return
(
NULL
)
}
if
(
!
is.numeric
(
HypsoData
))
{
stop
(
"HypsoData must be a vector of numeric values if not null
\n
"
)
stop
(
"HypsoData must be a vector of numeric values if not null"
)
return
(
NULL
)
}
if
(
length
(
HypsoData
)
!=
101
)
{
stop
(
"HypsoData must be of length 101 if not null
\n
"
)
stop
(
"HypsoData must be of length 101 if not null"
)
return
(
NULL
)
}
if
(
sum
(
is.na
(
HypsoData
))
!=
0
&
sum
(
is.na
(
HypsoData
))
!=
101
)
{
stop
(
"HypsoData must not contain any NA if not null
\n
"
)
stop
(
"HypsoData must not contain any NA if not null"
)
return
(
NULL
)
}
}
if
(
!
is.null
(
ZInputs
))
{
if
(
length
(
ZInputs
)
!=
1
)
{
stop
(
"\t ZInputs must be a single numeric value if not null
\n
"
)
stop
(
"\t ZInputs must be a single numeric value if not null"
)
return
(
NULL
)
}
if
(
is.na
(
ZInputs
)
|
!
is.numeric
(
ZInputs
))
{
stop
(
"\t ZInputs must be a single numeric value if not null
\n
"
)
stop
(
"\t ZInputs must be a single numeric value if not null"
)
return
(
NULL
)
}
}
if
(
is.null
(
HypsoData
))
{
if
(
verbose
)
{
warning
(
"\t HypsoData is missing => a single layer is used and no extrapolation is made
\n
"
)
warning
(
"\t HypsoData is missing => a single layer is used and no extrapolation is made"
)
}
HypsoData
<-
as.numeric
(
rep
(
NA
,
101
))
ZInputs
<-
as.numeric
(
NA
)
...
...
@@ -186,12 +186,12 @@ CreateInputsModel <- function(FUN_MOD,
}
if
(
is.null
(
ZInputs
))
{
if
(
verbose
&
!
identical
(
HypsoData
,
as.numeric
(
rep
(
NA
,
101
))))
{
warning
(
"\t ZInputs is missing => HypsoData[51] is used
\n
"
)
warning
(
"\t ZInputs is missing => HypsoData[51] is used"
)
}
ZInputs
<-
HypsoData
[
51L
]
}
if
(
NLayers
<=
0
)
{
stop
(
"NLayers must be a positive integer value
\n
"
)
stop
(
"NLayers must be a positive integer value"
)
return
(
NULL
)
}
if
(
NLayers
!=
as.integer
(
NLayers
))
{
...
...
@@ -209,14 +209,14 @@ CreateInputsModel <- function(FUN_MOD,
if
(
sum
(
BOOL_NA_TMP
)
!=
0
)
{
BOOL_NA
<-
BOOL_NA
|
BOOL_NA_TMP
if
(
verbose
)
{
warning
(
"\t Values < 0 or NA values detected in Precip series
\n
"
)
warning
(
"\t Values < 0 or NA values detected in Precip series"
)
}
}
BOOL_NA_TMP
<-
(
PotEvap
<
0
)
|
is.na
(
PotEvap
)
if
(
sum
(
BOOL_NA_TMP
)
!=
0
)
{
BOOL_NA
<-
BOOL_NA
|
BOOL_NA_TMP
if
(
verbose
)
{
warning
(
"\t Values < 0 or NA values detected in PotEvap series
\n
"
)
warning
(
"\t Values < 0 or NA values detected in PotEvap series"
)
}
}
}
...
...
@@ -225,14 +225,14 @@ CreateInputsModel <- function(FUN_MOD,
if
(
sum
(
BOOL_NA_TMP
)
!=
0
)
{
BOOL_NA
<-
BOOL_NA
|
BOOL_NA_TMP
if
(
verbose
)
{
warning
(
"\t Values < 0 or NA values detected in Precip series
\n
"
)
warning
(
"\t Values < 0 or NA values detected in Precip series"
)
}
}
BOOL_NA_TMP
<-
(
TempMean
<
(
-150
))
|
is.na
(
TempMean
)
if
(
sum
(
BOOL_NA_TMP
)
!=
0
)
{
BOOL_NA
<-
BOOL_NA
|
BOOL_NA_TMP
if
(
verbose
)
{
warning
(
"\t Values < -150) or NA values detected in TempMean series
\n
"
)
warning
(
"\t Values < -150) or NA values detected in TempMean series"
)
}
}
if
(
!
is.null
(
TempMin
)
&
!
is.null
(
TempMax
))
{
...
...
@@ -240,21 +240,21 @@ CreateInputsModel <- function(FUN_MOD,
if
(
sum
(
BOOL_NA_TMP
)
!=
0
)
{
BOOL_NA
<-
BOOL_NA
|
BOOL_NA_TMP
if
(
verbose
)
{
warning
(
"\t Values < -150) or NA values detected in TempMin series
\n
"
)
warning
(
"\t Values < -150) or NA values detected in TempMin series"
)
}
}
BOOL_NA_TMP
<-
(
TempMax
<
(
-150
))
|
is.na
(
TempMax
)
if
(
sum
(
BOOL_NA_TMP
)
!=
0
)
{
BOOL_NA
<-
BOOL_NA
|
BOOL_NA_TMP
if
(
verbose
)
{
warning
(
"\t Values < -150) or NA values detected in TempMax series
\n
"
)
warning
(
"\t Values < -150) or NA values detected in TempMax series"
)
}
}
}
}
if
(
sum
(
BOOL_NA
)
!=
0
)
{
WTxt
<-
NULL
WTxt
<-
paste
(
WTxt
,
"\t Missing values are not allowed in InputsModel
\n
"
,
sep
=
""
)
WTxt
<-
paste
(
WTxt
,
"\t Missing values are not allowed in InputsModel"
,
sep
=
""
)
Select
<-
(
max
(
which
(
BOOL_NA
))
+
1
)
:
length
(
BOOL_NA
)
...
...
@@ -277,8 +277,8 @@ CreateInputsModel <- function(FUN_MOD,
DatesR
<-
DatesR
[
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
=
""
)
WTxt
<-
paste
(
WTxt
,
"\t -> Data were trunced to keep the most recent available time-steps"
,
sep
=
""
)
WTxt
<-
paste
(
WTxt
,
"\t -> "
,
length
(
Select
),
" time-steps were kept"
,
sep
=
""
)
if
(
!
is.null
(
WTxt
)
&
verbose
)
{
warning
(
WTxt
)
...
...
R/CreateRunOptions.R
View file @
f53b6a57
...
...
@@ -37,60 +37,60 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
BOOL
<-
TRUE
}
if
(
!
BOOL
)
{
stop
(
"incorrect 'FUN_MOD' for use in 'CreateRunOptions'
\n
"
)
stop
(
"incorrect 'FUN_MOD' for use in 'CreateRunOptions'"
)
return
(
NULL
)
}
##check_InputsModel
if
(
!
inherits
(
InputsModel
,
"InputsModel"
))
{
stop
(
"'InputsModel' must be of class 'InputsModel'
\n
"
)
stop
(
"'InputsModel' must be of class 'InputsModel'"
)
return
(
NULL
)
}
if
(
"GR"
%in%
ObjectClass
&
!
inherits
(
InputsModel
,
"GR"
))
{
stop
(
"'InputsModel' must be of class 'GR'
\n
"
)
stop
(
"'InputsModel' must be of class 'GR'"
)
return
(
NULL
)
}
if
(
"CemaNeige"
%in%
ObjectClass
&
!
inherits
(
InputsModel
,
"CemaNeige"
))
{
stop
(
"'InputsModel' must be of class 'CemaNeige'
\n
"
)
stop
(
"'InputsModel' must be of class 'CemaNeige'"
)
return
(
NULL
)
}
if
(
"hourly"
%in%
ObjectClass
&
!
inherits
(
InputsModel
,
"hourly"
))
{
stop
(
"'InputsModel' must be of class 'hourly'
\n
"
)
stop
(
"'InputsModel' must be of class 'hourly'"
)
return
(
NULL
)
}
if
(
"daily"
%in%
ObjectClass
&
!
inherits
(
InputsModel
,
"daily"
))
{
stop
(
"'InputsModel' must be of class 'daily'
\n
"
)
stop
(
"'InputsModel' must be of class 'daily'"
)
return
(
NULL
)
}
if
(
"monthly"
%in%
ObjectClass
&
!
inherits
(
InputsModel
,
"monthly"
))
{
stop
(
"'InputsModel' must be of class 'monthly'
\n
"
)
stop
(
"'InputsModel' must be of class 'monthly'"
)
return
(
NULL
)
}
if
(
"yearly"
%in%
ObjectClass
&
!
inherits
(
InputsModel
,
"yearly"
))
{
stop
(
"'InputsModel' must be of class 'yearly'
\n
"
)
stop
(
"'InputsModel' must be of class 'yearly'"
)
return
(
NULL
)
}