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
3911d1bb
Commit
3911d1bb
authored
Sep 05, 2017
by
unknown
Browse files
v1.0.9.34 CreateIniStates now runs with RunModel_CemaNaige without GR
parent
a1932326
Changes
3
Hide whitespace changes
Inline
Side-by-side
DESCRIPTION
View file @
3911d1bb
Package: airGR
Type: Package
Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling
Version: 1.0.9.3
3
Version: 1.0.9.3
4
Date: 2017-09-05
Authors@R: c(
person("Laurent", "Coron", role = c("aut", "trl")),
...
...
R/CreateIniStates.R
View file @
3911d1bb
...
...
@@ -56,7 +56,7 @@ CreateIniStates <- function(FUN_MOD, InputsModel,
}
if
(
"CemaNeige"
%in%
ObjectClass
&
!
inherits
(
InputsModel
,
"CemaNeige"
))
{
stop
(
"'
RunModel_CemaNeigeGR*
' must be of class 'CemaNeige'"
)
stop
(
"'
InputsModel
' must be of class 'CemaNeige'"
)
return
(
NULL
)
}
...
...
@@ -87,7 +87,6 @@ CreateIniStates <- function(FUN_MOD, InputsModel,
}
UH2
<-
rep
(
Inf
,
UH2n
)
}
}
if
((
identical
(
FUN_MOD
,
RunModel_GR5J
)
|
identical
(
FUN_MOD
,
RunModel_CemaNeigeGR5J
))
&
!
is.null
(
UH1
))
{
...
...
@@ -96,7 +95,39 @@ CreateIniStates <- function(FUN_MOD, InputsModel,
}
UH1
<-
rep
(
Inf
,
UH1n
)
}
if
(
"CemaNeige"
%in%
ObjectClass
&
!
"GR"
%in%
ObjectClass
)
{
if
(
!
is.null
(
ProdStore
))
{
if
(
verbose
)
{
warning
(
sprintf
(
"'%s' does not require 'ProdStore'. Values set to NA"
,
as.character
(
substitute
(
FUN_MOD
))))
}
}
ProdStore
<-
Inf
if
(
!
is.null
(
RoutStore
))
{
if
(
verbose
)
{
warning
(
sprintf
(
"'%s' does not require 'RoutStore'. Values set to NA"
,
as.character
(
substitute
(
FUN_MOD
))))
}
}
RoutStore
<-
Inf
if
(
!
is.null
(
ExpStore
))
{
if
(
verbose
)
{
warning
(
sprintf
(
"'%s' does not require 'ExpStore'. Values set to NA"
,
as.character
(
substitute
(
FUN_MOD
))))
}
}
ExpStore
<-
Inf
if
(
!
is.null
(
UH1
))
{
if
(
verbose
)
{
warning
(
sprintf
(
"'%s' does not require 'UH1'. Values set to NA"
,
as.character
(
substitute
(
FUN_MOD
))))
}
}
UH1
<-
rep
(
Inf
,
UH1n
)
if
(
!
is.null
(
UH2
))
{
if
(
verbose
)
{
warning
(
sprintf
(
"'%s' does not require 'UH2'. Values set to NA"
,
as.character
(
substitute
(
FUN_MOD
))))
}
}
UH2
<-
rep
(
Inf
,
UH2n
)
}
if
(
"CemaNeige"
%in%
ObjectClass
&
(
is.null
(
GCemaNeigeLayers
)
|
is.null
(
eTGCemaNeigeLayers
)))
{
stop
(
"'RunModel_CemaNeigeGR*' need values for 'GCemaNeigeLayers' and 'GCemaNeigeLayers'"
)
...
...
@@ -150,6 +181,7 @@ CreateIniStates <- function(FUN_MOD, InputsModel,
## check length
if
(
!
is.numeric
(
ProdStore
)
||
length
(
ProdStore
)
!=
1L
)
{
print
(
ProdStore
)
stop
(
"'ProdStore' must be numeric of length one"
)
}
if
(
!
is.numeric
(
RoutStore
)
||
length
(
RoutStore
)
!=
1L
)
{
...
...
@@ -177,52 +209,8 @@ CreateIniStates <- function(FUN_MOD, InputsModel,
stop
(
sprintf
(
"'eTGCemaNeigeLayers' must be numeric of length %i"
,
NLayers
))
}
# if ("GR" %in% ObjectClass | "CemaNeige" %in% ObjectClass) {
# if ("hourly" %in% ObjectClass) {
# NState <- 3 * 24 * 20 + 7
# }
# if ("daily" %in% ObjectClass) {
# if (identical(FUN_MOD, RunModel_GR5J)) {
# NState <-
# 2 * 20 + 2 * NLayers + 7
# } else {
# NState <- 3 * 20 + 2 * NLayers + 7
# }
# }
# if ("monthly" %in% ObjectClass) {
# NState <- 2
# }
# if ("yearly" %in% ObjectClass) {
# NState <- 1
# }
# }
# if (!is.null(IniStates)) {
# if (!is.vector(IniStates) | !is.numeric(IniStates)) {
# stop("IniStates must be a vector of numeric values")
# return(NULL)
# }
# if (length(IniStates) != NState) {
# stop(paste0(
# "The length of IniStates must be ",
# NState,
# " for the chosen FUN_MOD"
# ))
# return(NULL)
# }
# } else {
# IniStates <- as.double(rep(0.0, NState))
# IniStates[1:3] <- NA
# }
# if ("yearly" %in% ObjectClass) {
# IniStates <- c(ProdStore)
# }
# else if ("monthly" %in% ObjectClass) {
# IniStates <- c(ProdStore, RoutStore)
# }
## format output
IniStates
<-
list
(
Store
=
list
(
Prod
=
ProdStore
,
Rout
=
RoutStore
,
Exp
=
ExpStore
),
UH
=
list
(
UH1
=
UH1
,
UH2
=
UH2
),
CemaNeigeLayers
=
list
(
G
=
GCemaNeigeLayers
,
eTG
=
eTGCemaNeigeLayers
))
...
...
R/RunModel_CemaNeige.R
View file @
3911d1bb
...
...
@@ -32,7 +32,7 @@ RunModel_CemaNeige <- function(InputsModel,RunOptions,Param){
##Call_DLL_CemaNeige_________________________
for
(
iLayer
in
1
:
NLayers
){
StateStartCemaNeige
<-
RunOptions
$
IniStates
[
(
2
*
(
iLayer
-1
)
+1
)
:
(
2
*
(
iLayer
-1
)
+2
)
];
StateStartCemaNeige
<-
RunOptions
$
IniStates
[
(
7+20+40
)
+
c
(
iLayer
,
iLayer
+
NLayers
)]
RESULTS
<-
.Fortran
(
"frun_CemaNeige"
,
PACKAGE
=
"airGR"
,
##inputs
LInputs
=
as.integer
(
length
(
IndPeriod1
)),
### length of input and output series
...
...
@@ -52,6 +52,7 @@ RunModel_CemaNeige <- function(InputsModel,RunOptions,Param){
)
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
]);
...
...
@@ -60,7 +61,16 @@ RunModel_CemaNeige <- function(InputsModel,RunOptions,Param){
rm
(
RESULTS
);
}
###ENDFOR_iLayer
names
(
CemaNeigeLayers
)
<-
paste
(
"Layer"
,
formatC
(
1
:
NLayers
,
width
=
2
,
flag
=
"0"
),
sep
=
""
);
if
(
ExportStateEnd
)
{
CemaNeigeStateEnd
<-
CreateIniStates
(
FUN_MOD
=
RunModel_CemaNeige
,
InputsModel
=
InputsModel
,
ProdStore
=
NULL
,
RoutStore
=
NULL
,
ExpStore
=
NULL
,
UH1
=
NULL
,
UH2
=
NULL
,
GCemaNeigeLayers
=
CemaNeigeStateEnd
[
seq_len
(
2
*
NLayers
)[
seq_len
(
2
*
NLayers
)
%%
2
==
1
]],
eTGCemaNeigeLayers
=
CemaNeigeStateEnd
[
seq_len
(
2
*
NLayers
)[
seq_len
(
2
*
NLayers
)
%%
2
==
0
]],
verbose
=
FALSE
)
}
##Output_data_preparation
if
(
ExportDatesR
==
FALSE
&
ExportStateEnd
==
FALSE
){
OutputsModel
<-
list
(
CemaNeigeLayers
);
...
...
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