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
f6d7709b
Commit
f6d7709b
authored
Feb 19, 2019
by
Delaigue Olivier
Browse files
v1.2.3.0 NEW: add an IsHyst argument in RunModel_CemaNeigeGR4J to use hysteresis #5252
parent
87487b78
Changes
3
Hide whitespace changes
Inline
Side-by-side
DESCRIPTION
View file @
f6d7709b
Package: airGR
Type: Package
Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling
Version: 1.2.
2.4
Version: 1.2.
3.0
Date: 2019-02-19
Authors@R: c(
person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")),
...
...
NEWS.rmd
View file @
f6d7709b
...
...
@@ -13,7 +13,7 @@ output:
### 1.2.
2.4
Release Notes (2019-0
1-30
)
### 1.2.
3.0
Release Notes (2019-0
2-19
)
...
...
R/RunModel_CemaNeigeGR4J.R
View file @
f6d7709b
RunModel_CemaNeigeGR4J
<-
function
(
InputsModel
,
RunOptions
,
Param
){
RunModel_CemaNeigeGR4J
<-
function
(
InputsModel
,
RunOptions
,
Param
,
IsHyst
=
FALSE
){
NParam
<-
6
;
FortranOutputsCemaNeige
<-
c
(
"Pliq"
,
"Psol"
,
"SnowPack"
,
"ThermalState"
,
"Gratio"
,
"PotMelt"
,
"Melt"
,
"PliqAndMelt"
,
"Temp"
);
## Arguments_check
if
(
!
is.logical
(
IsHyst
)
|
length
(
IsHyst
)
!=
1L
)
{
stop
(
"'IsHyst' must be a 'logical' of length 1"
)
return
(
NULL
)
}
NParam
<-
ifelse
(
IsHyst
,
8L
,
6L
)
NStates
<-
4L
FortranOutputsCemaNeige
<-
c
(
"Pliq"
,
"Psol"
,
"SnowPack"
,
"ThermalState"
,
"Gratio"
,
"PotMelt"
,
"Melt"
,
"PliqAndMelt"
,
"Temp"
,
"Gthreshold"
,
"Glocalmax"
);
FortranOutputsMod
<-
c
(
"PotEvap"
,
"Precip"
,
"Prod"
,
"Pn"
,
"Ps"
,
"AE"
,
"Perc"
,
"PR"
,
"Q9"
,
"Q1"
,
"Rout"
,
"Exch"
,
"AExch1"
,
"AExch2"
,
"AExch"
,
"QR"
,
"QD"
,
"Qsim"
);
...
...
@@ -37,11 +45,11 @@ RunModel_CemaNeigeGR4J <- function(InputsModel,RunOptions,Param){
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
);
ParamCemaNeige
<-
Param
[(
length
(
Param
)
-1
-2
*
as.integer
(
IsHyst
)
)
:
length
(
Param
)];
NParamMod
<-
as.integer
(
length
(
Param
)
-
(
2+2
*
as.integer
(
IsHyst
)));
################################ to check!!!!!
ParamMod
<-
Param
[
1
:
NParamMod
];
NLayers
<-
length
(
InputsModel
$
LayerPrecip
);
NStatesMod
<-
as.integer
(
length
(
RunOptions
$
IniStates
)
-
2
*
NLayers
);
NStatesMod
<-
as.integer
(
length
(
RunOptions
$
IniStates
)
-
NStates
*
NLayers
);
ExportDatesR
<-
"DatesR"
%in%
RunOptions
$
Outputs_Sim
;
ExportStateEnd
<-
"StateEnd"
%in%
RunOptions
$
Outputs_Sim
;
...
...
@@ -52,6 +60,7 @@ RunModel_CemaNeigeGR4J <- function(InputsModel,RunOptions,Param){
}
else
{
IndOutputsCemaNeige
<-
which
(
FortranOutputsCemaNeige
%in%
RunOptions
$
Outputs_Sim
);
}
CemaNeigeLayers
<-
list
();
CemaNeigeStateEnd
<-
NULL
;
NameCemaNeigeLayers
<-
"CemaNeigeLayers"
;
print
(
ParamCemaNeige
)
##Call_DLL_CemaNeige_________________________
for
(
iLayer
in
1
:
NLayers
){
StateStartCemaNeige
<-
RunOptions
$
IniStates
[(
7+20+40
)
+
c
(
iLayer
,
iLayer
+
NLayers
)]
...
...
@@ -62,15 +71,16 @@ RunModel_CemaNeigeGR4J <- function(InputsModel,RunOptions,Param){
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
NParam
=
as.integer
(
NParam
),
### number of model parameter = 2
Param
=
as.double
(
ParamCemaNeige
)
,
### parameter set
NStates
=
as.integer
(
NStates
),
### number of state variables used for model initialising = 2
StateStart
=
StateStartCemaNeige
,
### state variables used when the model run starts
IsHyst
=
as.integer
(
IsHyst
),
### use of hysteresis
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)
StateEnd
=
rep
(
as.double
(
-999.999
),
as.integer
(
NStates
))
### 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
;
...
...
@@ -85,7 +95,7 @@ RunModel_CemaNeigeGR4J <- function(InputsModel,RunOptions,Param){
if
(
ExportStateEnd
){
CemaNeigeStateEnd
<-
c
(
CemaNeigeStateEnd
,
RESULTS
$
StateEnd
);
}
rm
(
RESULTS
);
}
###ENDFOR_iLayer
names
(
CemaNeigeLayers
)
<-
paste
(
"Layer"
,
formatC
(
1
:
NLayers
,
width
=
2
,
flag
=
"0"
),
sep
=
""
);
names
(
CemaNeigeLayers
)
<-
sprintf
(
"Layer%02i"
,
seq_len
(
NLayers
))
}
###ENDIF_RunSnowModule
if
(
inherits
(
RunOptions
,
"CemaNeige"
)
==
FALSE
){
CemaNeigeLayers
<-
list
();
CemaNeigeStateEnd
<-
NULL
;
NameCemaNeigeLayers
<-
NULL
;
...
...
@@ -121,13 +131,17 @@ RunModel_CemaNeigeGR4J <- function(InputsModel,RunOptions,Param){
)
RESULTS
$
Outputs
[
round
(
RESULTS
$
Outputs
,
3
)
==
(
-999.999
)]
<-
NA
;
RESULTS
$
StateEnd
[
round
(
RESULTS
$
StateEnd
,
3
)
==
(
-999.999
)]
<-
NA
;
if
(
ExportStateEnd
)
{
if
(
ExportStateEnd
)
{
idNStates
<-
seq_len
(
NStates
*
NLayers
)
%%
NStates
RESULTS
$
StateEnd
<-
CreateIniStates
(
FUN_MOD
=
RunModel_CemaNeigeGR4J
,
InputsModel
=
InputsModel
,
ProdStore
=
RESULTS
$
StateEnd
[
1L
],
RoutStore
=
RESULTS
$
StateEnd
[
2L
],
ExpStore
=
NULL
,
UH1
=
RESULTS
$
StateEnd
[(
1
:
20
)
+7
],
UH2
=
RESULTS
$
StateEnd
[(
1
:
40
)
+
(
7+20
)],
GCemaNeigeLayers
=
CemaNeigeStateEnd
[
seq_len
(
2
*
NLayers
)[
seq_len
(
2
*
NLayers
)
%%
2
==
1
]],
eTGCemaNeigeLayers
=
CemaNeigeStateEnd
[
seq_len
(
2
*
NLayers
)[
seq_len
(
2
*
NLayers
)
%%
2
==
0
]],
GCemaNeigeLayers
=
CemaNeigeStateEnd
[
seq_len
(
NStates
*
NLayers
)[
idNStates
==
3
]],
eTGCemaNeigeLayers
=
CemaNeigeStateEnd
[
seq_len
(
NStates
*
NLayers
)[
idNStates
==
2
]],
GthrCemaNeigeLayers
=
CemaNeigeStateEnd
[
seq_len
(
NStates
*
NLayers
)[
idNStates
==
1
]],
GlocmaxCemaNeigeLayers
=
CemaNeigeStateEnd
[
seq_len
(
NStates
*
NLayers
)[
idNStates
==
0
]],
verbose
=
FALSE
)
print
(
CemaNeigeStateEnd
)
}
if
(
inherits
(
RunOptions
,
"CemaNeige"
)
==
TRUE
&
"Precip"
%in%
RunOptions
$
Outputs_Sim
){
RESULTS
$
Outputs
[,
which
(
FortranOutputsMod
[
IndOutputsMod
]
==
"Precip"
)]
<-
InputsModel
$
Precip
[
IndPeriod1
];
}
...
...
@@ -160,7 +174,7 @@ RunModel_CemaNeigeGR4J <- function(InputsModel,RunOptions,Param){
##End
rm
(
RESULTS
);
class
(
OutputsModel
)
<-
c
(
"OutputsModel"
,
"daily"
,
"GR"
,
"CemaNeige"
);
class
(
OutputsModel
)
<-
c
(
"OutputsModel"
,
"daily"
,
"GR"
,
"CemaNeige"
,
if
(
IsHyst
)
"hysteresis"
);
return
(
OutputsModel
);
}
...
...
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