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
ad63d07c
Commit
ad63d07c
authored
Oct 14, 2020
by
Delaigue Olivier
Browse files
1.6.3.4 style(RunModel_LAG): minor typo and code revisions
Refs
#34
parent
3e2a0f07
Pipeline
#16629
passed with stages
in 11 minutes and 13 seconds
Changes
3
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
DESCRIPTION
View file @
ad63d07c
Package: airGR
Type: Package
Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling
Version: 1.6.3.
3
Date: 2020-10-
06
Version: 1.6.3.
4
Date: 2020-10-
14
Authors@R: c(
person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")),
person("Olivier", "Delaigue", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-7668-8468"), email = "airGR@inrae.fr"),
...
...
NEWS.md
View file @
ad63d07c
## Release History of the airGR Package
### 1.6.3.
3
Release Notes (2020-10-
06
)
### 1.6.3.
4
Release Notes (2020-10-
14
)
#### New features
...
...
R/RunModel_LAG.R
View file @
ad63d07c
RunModel_LAG
<-
function
(
InputsModel
,
RunOptions
,
Param
)
{
RunModel_LAG
<-
function
(
InputsModel
,
RunOptions
,
Param
)
{
NParam
<-
1
##Arguments_check
if
(
inherits
(
InputsModel
,
"InputsModel"
)
==
FALSE
){
stop
(
"'InputsModel' must be of class 'InputsModel'"
)
}
if
(
inherits
(
InputsModel
,
"SD"
)
==
FALSE
){
stop
(
"'InputsModel' must be of class 'SD'"
)
}
if
(
inherits
(
RunOptions
,
"RunOptions"
)
==
FALSE
){
stop
(
"'RunOptions' must be of class 'RunOptions'"
)
}
if
(
!
is.vector
(
Param
)
|
!
is.numeric
(
Param
)){
stop
(
"'Param' must be a numeric vector"
)
}
if
(
sum
(
!
is.na
(
Param
))
!=
NParam
){
stop
(
paste
(
"'Param' must be a vector of length"
,
NParam
,
"and contain no NA"
))
}
if
(
is.null
(
InputsModel
$
OutputsModel
))
{
if
(
!
inherits
(
InputsModel
,
"InputsModel"
))
{
stop
(
"'InputsModel' must be of class 'InputsModel'"
)
}
if
(
!
inherits
(
InputsModel
,
"SD"
))
{
stop
(
"'InputsModel' must be of class 'SD'"
)
}
if
(
!
inherits
(
RunOptions
,
"RunOptions"
))
{
stop
(
"'RunOptions' must be of class 'RunOptions'"
)
}
if
(
!
is.vector
(
Param
)
|
!
is.numeric
(
Param
))
{
stop
(
"'Param' must be a numeric vector"
)
}
if
(
sum
(
!
is.na
(
Param
))
!=
NParam
)
{
stop
(
paste
(
"'Param' must be a vector of length"
,
NParam
,
"and contain no NA"
))
}
if
(
is.null
(
InputsModel
$
OutputsModel
))
{
stop
(
"'InputsModel' should contain an 'OutputsModel' key containing the output of the runoff of the downstream subcatchment"
)
}
if
(
is.null
(
InputsModel
$
OutputsModel
$
Qsim
))
{
if
(
is.null
(
InputsModel
$
OutputsModel
$
Qsim
))
{
stop
(
"'InputsModel$OutputsModel' should contain a key 'Qsim' containing the output of the runoff of the downstream subcatchment"
)
}
if
(
sum
(
!
is.na
(
InputsModel
$
OutputsModel
$
Qsim
))
!=
length
(
RunOptions
$
IndPeriod_Run
))
{
if
(
sum
(
!
is.na
(
InputsModel
$
OutputsModel
$
Qsim
))
!=
length
(
RunOptions
$
IndPeriod_Run
))
{
stop
(
"'InputsModel$OutputsModel$Qim' should have the same lenght as 'RunOptions$IndPeriod_Run' and contain no NA"
)
}
OutputsModel
<-
InputsModel
$
OutputsModel
OutputsModel
$
QsimDown
<-
OutputsModel
$
Qsim
if
(
inherits
(
InputsModel
,
"daily"
))
{
TimeStep
<-
60
*
60
*
24
}
...
...
@@ -30,7 +39,7 @@ RunModel_LAG <- function(InputsModel,RunOptions,Param) {
}
# propagation time from upstream meshes to outlet
PT
<-
InputsModel
$
LengthHydro
/
Param
[
1
]
/
TimeStep
PT
<-
InputsModel
$
LengthHydro
/
Param
[
1
L
]
/
TimeStep
HUTRANS
<-
rbind
(
1
-
(
PT
-
floor
(
PT
)),
PT
-
floor
(
PT
))
NbUpBasins
<-
length
(
InputsModel
$
LengthHydro
)
...
...
@@ -39,7 +48,7 @@ RunModel_LAG <- function(InputsModel,RunOptions,Param) {
for
(
upstream_basin
in
seq_len
(
NbUpBasins
))
{
Qupstream
<-
InputsModel
$
Qupstream
[
RunOptions
$
IndPeriod_Run
,
upstream_basin
]
if
(
!
is.na
(
InputsModel
$
BasinAreas
[
upstream_basin
]))
{
if
(
!
is.na
(
InputsModel
$
BasinAreas
[
upstream_basin
]))
{
# Upstream flow with area needs to be converted to m3 by time step
Qupstream
<-
Qupstream
*
InputsModel
$
BasinAreas
[
upstream_basin
]
*
1E3
}
...
...
@@ -52,7 +61,7 @@ RunModel_LAG <- function(InputsModel,RunOptions,Param) {
HUTRANS
[
2
,
upstream_basin
]
}
# Warning for negative flows
if
(
any
(
OutputsModel
$
Qsim
<
0
))
{
if
(
any
(
OutputsModel
$
Qsim
<
0
))
{
warning
(
length
(
which
(
OutputsModel
$
Qsim
<
0
)),
" time steps with negative flow, set to zero."
)
OutputsModel
$
Qsim
[
OutputsModel
$
Qsim
<
0
]
<-
0
}
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment