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
4390ce3e
Commit
4390ce3e
authored
Jan 26, 2021
by
Delaigue Olivier
Browse files
Style v1.6.9.31: review whitespaces, semicolons and indents in many functions
parent
3880f5bd
Pipeline
#19645
passed with stages
in 12 minutes and 37 seconds
Changes
17
Pipelines
1
Expand all
Hide whitespace changes
Inline
Side-by-side
DESCRIPTION
View file @
4390ce3e
Package: airGR
Type: Package
Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling
Version: 1.6.9.3
0
Version: 1.6.9.3
1
Date: 2021-01-25
Authors@R: c(
person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")),
...
...
R/CreateCalibOptions.R
View file @
4390ce3e
...
...
@@ -319,8 +319,8 @@ CreateCalibOptions <- function(FUN_MOD,
##check_SearchRanges
if
(
is.null
(
SearchRanges
))
{
ParamT
<-
matrix
(
c
(
rep
(
-9.99
,
NParam
),
rep
(
+9.99
,
NParam
)),
ncol
=
NParam
,
byrow
=
TRUE
)
ParamT
<-
matrix
(
c
(
rep
(
-9.99
,
NParam
),
rep
(
+9.99
,
NParam
)),
ncol
=
NParam
,
byrow
=
TRUE
)
SearchRanges
<-
TransfoParam
(
ParamIn
=
ParamT
,
Direction
=
"TR"
,
FUN_TRANSFO
=
FUN_TRANSFO
)
}
else
{
...
...
@@ -351,12 +351,12 @@ CreateCalibOptions <- function(FUN_MOD,
if
((
"GR5H"
%in%
ObjectClass
)
&
(
"interception"
%in%
ObjectClass
))
{
ParamT
<-
matrix
(
c
(
+3.46
,
-1.25
,
+4.04
,
-9.53
,
-9.34
,
+3.74
,
-0.41
,
+4.78
,
-8.94
,
-3.33
,
+4.29
,
+0.16
,
+5.39
,
-7.39
,
+3.33
),
ncol
=
5
,
byrow
=
TRUE
)
;
+4.29
,
+0.16
,
+5.39
,
-7.39
,
+3.33
),
ncol
=
5
,
byrow
=
TRUE
)
}
if
((
"GR5H"
%in%
ObjectClass
)
&
!
(
"interception"
%in%
ObjectClass
))
{
ParamT
<-
matrix
(
c
(
+3.28
,
-0.39
,
+4.14
,
-9.54
,
-7.49
,
+3.62
,
-0.19
,
+4.80
,
-9.00
,
-6.31
,
+4.01
,
-0.04
,
+5.43
,
-7.53
,
-5.33
),
ncol
=
5
,
byrow
=
TRUE
)
;
+4.01
,
-0.04
,
+5.43
,
-7.53
,
-5.33
),
ncol
=
5
,
byrow
=
TRUE
)
}
if
(
"GR4J"
%in%
ObjectClass
)
{
ParamT
<-
matrix
(
c
(
+5.13
,
-1.60
,
+3.03
,
-9.05
,
...
...
@@ -399,12 +399,12 @@ CreateCalibOptions <- function(FUN_MOD,
if
((
"CemaNeigeGR5H"
%in%
ObjectClass
)
&
(
"interception"
%in%
ObjectClass
))
{
ParamT
<-
matrix
(
c
(
+3.46
,
-1.25
,
+4.04
,
-9.53
,
-9.34
,
-9.96
,
+6.63
,
+3.74
,
-0.41
,
+4.78
,
-8.94
,
-3.33
,
-9.14
,
+6.90
,
+4.29
,
+0.16
,
+5.39
,
-7.39
,
+3.33
,
+4.10
,
+7.21
),
ncol
=
7
,
byrow
=
TRUE
)
;
+4.29
,
+0.16
,
+5.39
,
-7.39
,
+3.33
,
+4.10
,
+7.21
),
ncol
=
7
,
byrow
=
TRUE
)
}
if
((
"CemaNeigeGR5H"
%in%
ObjectClass
)
&
!
(
"interception"
%in%
ObjectClass
))
{
ParamT
<-
matrix
(
c
(
+3.28
,
-0.39
,
+4.14
,
-9.54
,
-7.49
,
-9.96
,
+6.63
,
+3.62
,
-0.19
,
+4.80
,
-9.00
,
-6.31
,
-9.14
,
+6.90
,
+4.01
,
-0.04
,
+5.43
,
-7.53
,
-5.33
,
+4.10
,
+7.21
),
ncol
=
7
,
byrow
=
TRUE
)
;
+4.01
,
-0.04
,
+5.43
,
-7.53
,
-5.33
,
+4.10
,
+7.21
),
ncol
=
7
,
byrow
=
TRUE
)
}
if
(
"CemaNeigeGR4J"
%in%
ObjectClass
)
{
ParamT
<-
matrix
(
c
(
+5.13
,
-1.60
,
+3.03
,
-9.05
,
-9.96
,
+6.63
,
...
...
R/CreateInputsModel.R
View file @
4390ce3e
This diff is collapsed.
Click to expand it.
R/DataAltiExtrapolation_Valery.R
View file @
4390ce3e
...
...
@@ -3,15 +3,15 @@ DataAltiExtrapolation_Valery <- function(DatesR,
TempMean
,
TempMin
=
NULL
,
TempMax
=
NULL
,
ZInputs
,
HypsoData
,
NLayers
,
verbose
=
TRUE
)
{
##Altitudinal_gradient_functions_______________________________________________________________
##unique_gradient_for_precipitation
GradP_Valery2010
<-
function
()
{
return
(
0.00041
)
### value from Valery PhD thesis page 126
}
##daily_gradients_for_mean_min_and_max_air_temperature
GradT_Valery2010
<-
function
()
{
RESULT
<-
matrix
(
c
(
##Altitudinal_gradient_functions_______________________________________________________________
##unique_gradient_for_precipitation
GradP_Valery2010
<-
function
()
{
return
(
0.00041
)
### value from Valery PhD thesis page 126
}
##daily_gradients_for_mean_min_and_max_air_temperature
GradT_Valery2010
<-
function
()
{
RESULT
<-
matrix
(
c
(
01
,
01
,
0.434
,
0.366
,
0.498
,
02
,
01
,
0.434
,
0.366
,
0.500
,
03
,
01
,
0.435
,
0.367
,
0.501
,
...
...
@@ -378,174 +378,174 @@ DataAltiExtrapolation_Valery <- function(DatesR,
29
,
12
,
0.431
,
0.366
,
0.495
,
30
,
12
,
0.432
,
0.366
,
0.496
,
31
,
12
,
0.433
,
0.366
,
0.497
),
ncol
=
5
,
byrow
=
TRUE
)
dimnames
(
RESULT
)
<-
list
(
1
:
366
,
c
(
"day"
,
"month"
,
"grad_Tmean"
,
"grad_Tmin"
,
"grad_Tmax"
))
return
(
RESULT
)
}
dimnames
(
RESULT
)
<-
list
(
1
:
366
,
c
(
"day"
,
"month"
,
"grad_Tmean"
,
"grad_Tmin"
,
"grad_Tmax"
))
return
(
RESULT
)
}
##Format_______________________________________________________________________________________
HypsoData
<-
as.double
(
HypsoData
)
ZInputs
<-
as.double
(
ZInputs
)
HypsoData
<-
as.double
(
HypsoData
)
ZInputs
<-
as.double
(
ZInputs
)
##ElevationLayers_Creation_____________________________________________________________________
ZLayers
<-
as.double
(
rep
(
NA
,
NLayers
))
if
(
!
identical
(
HypsoData
,
as.double
(
rep
(
NA
,
101
))))
{
nmoy
<-
100
%/%
NLayers
nreste
<-
100
%%
NLayers
ncont
<-
0
for
(
iLayer
in
1
:
NLayers
)
{
if
(
nreste
>
0
)
{
nn
<-
nmoy
+
1
nreste
<-
nreste
-
1
}
else
{
nn
<-
nmoy
}
if
(
nn
==
1
)
{
ZLayers
[
iLayer
]
<-
HypsoData
[
ncont
+
1
]
}
if
(
nn
==
2
)
{
ZLayers
[
iLayer
]
<-
0.5
*
(
HypsoData
[
ncont
+
1
]
+
HypsoData
[
ncont
+
2
])
}
if
(
nn
>
2
)
{
ZLayers
[
iLayer
]
<-
HypsoData
[
ncont
+
nn
/
2
]
}
ncont
<-
ncont
+
nn
ZLayers
<-
as.double
(
rep
(
NA
,
NLayers
))
if
(
!
identical
(
HypsoData
,
as.double
(
rep
(
NA
,
101
))))
{
nmoy
<-
100
%/%
NLayers
nreste
<-
100
%%
NLayers
ncont
<-
0
for
(
iLayer
in
1
:
NLayers
)
{
if
(
nreste
>
0
)
{
nn
<-
nmoy
+
1
nreste
<-
nreste
-
1
}
else
{
nn
<-
nmoy
}
if
(
nn
==
1
)
{
ZLayers
[
iLayer
]
<-
HypsoData
[
ncont
+
1
]
}
if
(
nn
==
2
)
{
ZLayers
[
iLayer
]
<-
0.5
*
(
HypsoData
[
ncont
+
1
]
+
HypsoData
[
ncont
+
2
])
}
if
(
nn
>
2
)
{
ZLayers
[
iLayer
]
<-
HypsoData
[
ncont
+
nn
/
2
]
}
ncont
<-
ncont
+
nn
}
}
##Precipitation_extrapolation__________________________________________________________________
##Initialisation
if
(
identical
(
ZInputs
,
HypsoData
[
51
])
&
NLayers
==
1
)
{
LayerPrecip
<-
list
(
as.double
(
Precip
))
}
else
{
##Elevation_gradients_for_daily_mean_precipitation
GradP
<-
GradP_Valery2010
()
### single value
TabGradP
<-
rep
(
GradP
,
length
(
Precip
))
##Extrapolation
##Thresold_of_inputs_median_elevation
Zthreshold
<-
4000
LayerPrecip_mat
<-
sapply
(
1
:
NLayers
,
function
(
iLayer
)
{
##If_layer_elevation_smaller_than_Zthreshold
if
(
ZLayers
[
iLayer
]
<=
Zthreshold
)
{
prcp
<-
as.double
(
Precip
*
exp
(
TabGradP
*
(
ZLayers
[
iLayer
]
-
ZInputs
)))
##If_layer_elevation_greater_than_Zthreshold
if
(
identical
(
ZInputs
,
HypsoData
[
51
])
&
NLayers
==
1
)
{
LayerPrecip
<-
list
(
as.double
(
Precip
))
}
else
{
##Elevation_gradients_for_daily_mean_precipitation
GradP
<-
GradP_Valery2010
()
### single value
TabGradP
<-
rep
(
GradP
,
length
(
Precip
))
##Extrapolation
##Thresold_of_inputs_median_elevation
Zthreshold
<-
4000
LayerPrecip_mat
<-
sapply
(
1
:
NLayers
,
function
(
iLayer
)
{
##If_layer_elevation_smaller_than_Zthreshold
if
(
ZLayers
[
iLayer
]
<=
Zthreshold
)
{
prcp
<-
as.double
(
Precip
*
exp
(
TabGradP
*
(
ZLayers
[
iLayer
]
-
ZInputs
)))
##If_layer_elevation_greater_than_Zthreshold
}
else
{
##If_inputs_median_elevation_smaller_than_Zthreshold
if
(
ZInputs
<=
Zthreshold
)
{
prcp
<-
as.double
(
Precip
*
exp
(
TabGradP
*
(
Zthreshold
-
ZInputs
)))
##If_inputs_median_elevation_greater_then_Zthreshold
}
else
{
##If_inputs_median_elevation_smaller_than_Zthreshold
if
(
ZInputs
<=
Zthreshold
)
{
prcp
<-
as.double
(
Precip
*
exp
(
TabGradP
*
(
Zthreshold
-
ZInputs
)))
##If_inputs_median_elevation_greater_then_Zthreshold
}
else
{
prcp
<-
as.double
(
Precip
)
}
prcp
<-
as.double
(
Precip
)
}
return
(
prcp
)
})
if
(
PrecipScale
)
{
LayerPrecip_mat
<-
LayerPrecip_mat
/
rowMeans
(
LayerPrecip_mat
)
*
Precip
LayerPrecip_mat
[
is.nan
(
LayerPrecip_mat
)]
<-
0
}
LayerPrecip
<-
as.list
(
as.data.frame
(
LayerPrecip_mat
))
return
(
prcp
)
})
if
(
PrecipScale
)
{
LayerPrecip_mat
<-
LayerPrecip_mat
/
rowMeans
(
LayerPrecip_mat
)
*
Precip
LayerPrecip_mat
[
is.nan
(
LayerPrecip_mat
)]
<-
0
}
LayerPrecip
<-
as.list
(
as.data.frame
(
LayerPrecip_mat
))
}
##Temperature_extrapolation____________________________________________________________________
##Initialisation
LayerTempMean
<-
list
()
LayerTempMin
<-
list
()
LayerTempMax
<-
list
()
if
(
identical
(
ZInputs
,
HypsoData
[
51
])
&
NLayers
==
1
)
{
LayerTempMean
[[
1
]]
<-
as.double
(
TempMean
)
LayerTempMean
<-
list
()
LayerTempMin
<-
list
()
LayerTempMax
<-
list
()
if
(
identical
(
ZInputs
,
HypsoData
[
51
])
&
NLayers
==
1
)
{
LayerTempMean
[[
1
]]
<-
as.double
(
TempMean
)
if
(
!
is.null
(
TempMin
)
&
!
is.null
(
TempMax
))
{
LayerTempMin
[[
1
]]
<-
as.double
(
TempMin
)
LayerTempMax
[[
1
]]
<-
as.double
(
TempMax
)
}
}
else
{
##Elevation_gradients_for_daily_mean_min_and_max_temperature
GradT
<-
as.data.frame
(
GradT_Valery2010
())
iday
<-
match
(
format
(
DatesR
,
format
=
"%d%m"
),
sprintf
(
"%02i%02i"
,
GradT
[,
"day"
],
GradT
[,
"month"
]))
TabGradT
<-
GradT
[
iday
,
c
(
"grad_Tmean"
,
"grad_Tmin"
,
"grad_Tmax"
)]
##Extrapolation
##On_each_elevation_layer...
for
(
iLayer
in
1
:
NLayers
)
{
LayerTempMean
[[
iLayer
]]
<-
as.double
(
TempMean
+
(
ZInputs
-
ZLayers
[
iLayer
])
*
abs
(
TabGradT
[,
"grad_Tmean"
])
/
100
)
if
(
!
is.null
(
TempMin
)
&
!
is.null
(
TempMax
))
{
LayerTempMin
[[
1
]]
<-
as.double
(
TempMin
)
LayerTempMax
[[
1
]]
<-
as.double
(
TempMax
)
}
}
else
{
##Elevation_gradients_for_daily_mean_min_and_max_temperature
GradT
<-
as.data.frame
(
GradT_Valery2010
())
iday
<-
match
(
format
(
DatesR
,
format
=
"%d%m"
),
sprintf
(
"%02i%02i"
,
GradT
[,
"day"
],
GradT
[,
"month"
]))
TabGradT
<-
GradT
[
iday
,
c
(
"grad_Tmean"
,
"grad_Tmin"
,
"grad_Tmax"
)]
##Extrapolation
##On_each_elevation_layer...
for
(
iLayer
in
1
:
NLayers
)
{
LayerTempMean
[[
iLayer
]]
<-
as.double
(
TempMean
+
(
ZInputs
-
ZLayers
[
iLayer
])
*
abs
(
TabGradT
[,
"grad_Tmean"
])
/
100
)
if
(
!
is.null
(
TempMin
)
&
!
is.null
(
TempMax
))
{
LayerTempMin
[[
iLayer
]]
<-
as.double
(
TempMin
+
(
ZInputs
-
ZLayers
[
iLayer
])
*
abs
(
TabGradT
[,
"grad_Tmin"
])
/
100
)
LayerTempMax
[[
iLayer
]]
<-
as.double
(
TempMax
+
(
ZInputs
-
ZLayers
[
iLayer
])
*
abs
(
TabGradT
[,
"grad_Tmax"
])
/
100
)
}
LayerTempMin
[[
iLayer
]]
<-
as.double
(
TempMin
+
(
ZInputs
-
ZLayers
[
iLayer
])
*
abs
(
TabGradT
[,
"grad_Tmin"
])
/
100
)
LayerTempMax
[[
iLayer
]]
<-
as.double
(
TempMax
+
(
ZInputs
-
ZLayers
[
iLayer
])
*
abs
(
TabGradT
[,
"grad_Tmax"
])
/
100
)
}
}
}
##Solid_Fraction_for_each_elevation_layer______________________________________________________
LayerFracSolidPrecip
<-
list
()
##Thresold_of_inputs_median_elevation
Zthreshold
<-
1500
##Option
Option
<-
"USACE"
if
(
!
is.na
(
ZInputs
))
{
if
(
ZInputs
<
Zthreshold
&
!
is.null
(
TempMin
)
&
!
is.null
(
TempMax
))
{
Option
<-
"Hydrotel"
}
LayerFracSolidPrecip
<-
list
()
##Thresold_of_inputs_median_elevation
Zthreshold
<-
1500
##Option
Option
<-
"USACE"
if
(
!
is.na
(
ZInputs
))
{
if
(
ZInputs
<
Zthreshold
&
!
is.null
(
TempMin
)
&
!
is.null
(
TempMax
))
{
Option
<-
"Hydrotel"
}
##On_each_elevation_layer...
for
(
iLayer
in
1
:
NLayers
)
{
}
##Turcotte_formula_from_Hydrotel
if
(
Option
==
"Hydrotel"
)
{
TempMin
<-
LayerTempMin
[[
iLayer
]]
TempMax
<-
LayerTempMax
[[
iLayer
]]
SolidFraction
<-
1
-
TempMax
/
(
TempMax
-
TempMin
)
SolidFraction
[
TempMin
>=
0
]
<-
0
SolidFraction
[
TempMax
<=
0
]
<-
1
}
##USACE_formula
if
(
Option
==
"USACE"
)
{
USACE_Tmin
<-
-1.0
USACE_Tmax
<-
3.0
TempMean
<-
LayerTempMean
[[
iLayer
]]
SolidFraction
<-
1
-
(
TempMean
-
USACE_Tmin
)
/
(
USACE_Tmax
-
USACE_Tmin
)
SolidFraction
[
TempMean
>
USACE_Tmax
]
<-
0
SolidFraction
[
TempMean
<
USACE_Tmin
]
<-
1
}
LayerFracSolidPrecip
[[
iLayer
]]
<-
as.double
(
SolidFraction
)
##On_each_elevation_layer...
for
(
iLayer
in
1
:
NLayers
)
{
##Turcotte_formula_from_Hydrotel
if
(
Option
==
"Hydrotel"
)
{
TempMin
<-
LayerTempMin
[[
iLayer
]]
TempMax
<-
LayerTempMax
[[
iLayer
]]
SolidFraction
<-
1
-
TempMax
/
(
TempMax
-
TempMin
)
SolidFraction
[
TempMin
>=
0
]
<-
0
SolidFraction
[
TempMax
<=
0
]
<-
1
}
namesLayer
<-
sprintf
(
"L%i"
,
seq_along
(
LayerPrecip
))
names
(
LayerPrecip
)
<-
namesLayer
names
(
LayerTempMean
)
<-
namesLayer
if
(
!
is.null
(
TempMin
)
&
!
is.null
(
TempMax
))
{
names
(
LayerTempMin
)
<-
namesLayer
names
(
LayerTempMax
)
<-
namesLayer
}
names
(
LayerFracSolidPrecip
)
<-
namesLayer
##USACE_formula
if
(
Option
==
"USACE"
)
{
USACE_Tmin
<-
-1.0
USACE_Tmax
<-
3.0
TempMean
<-
LayerTempMean
[[
iLayer
]]
SolidFraction
<-
1
-
(
TempMean
-
USACE_Tmin
)
/
(
USACE_Tmax
-
USACE_Tmin
)
SolidFraction
[
TempMean
>
USACE_Tmax
]
<-
0
SolidFraction
[
TempMean
<
USACE_Tmin
]
<-
1
}
LayerFracSolidPrecip
[[
iLayer
]]
<-
as.double
(
SolidFraction
)
}
namesLayer
<-
sprintf
(
"L%i"
,
seq_along
(
LayerPrecip
))
names
(
LayerPrecip
)
<-
namesLayer
names
(
LayerTempMean
)
<-
namesLayer
if
(
!
is.null
(
TempMin
)
&
!
is.null
(
TempMax
))
{
names
(
LayerTempMin
)
<-
namesLayer
names
(
LayerTempMax
)
<-
namesLayer
}
names
(
LayerFracSolidPrecip
)
<-
namesLayer
##END__________________________________________________________________________________________
return
(
list
(
LayerPrecip
=
LayerPrecip
,
LayerTempMean
=
LayerTempMean
,
LayerTempMin
=
LayerTempMin
,
LayerTempMax
=
LayerTempMax
,
LayerFracSolidPrecip
=
LayerFracSolidPrecip
,
ZLayers
=
ZLayers
))
return
(
list
(
LayerPrecip
=
LayerPrecip
,
LayerTempMean
=
LayerTempMean
,
LayerTempMin
=
LayerTempMin
,
LayerTempMax
=
LayerTempMax
,
LayerFracSolidPrecip
=
LayerFracSolidPrecip
,
ZLayers
=
ZLayers
))
}
R/PE_Oudin.R
View file @
4390ce3e
...
...
@@ -65,7 +65,7 @@ PE_Oudin <- function(JD, Temp,
LInputs
=
as.integer
(
length
(
Temp
))
if
(
length
(
FI
)
==
1
)
{
FI
<-
rep
(
FI
,
LInputs
)
FI
<-
rep
(
FI
,
LInputs
)
}
RESULTS
<-
.Fortran
(
"frun_pe_oudin"
,
PACKAGE
=
"airGR"
,
...
...
@@ -96,7 +96,7 @@ PE_Oudin <- function(JD, Temp,
COSOM
<-
-1
}
if
(
COSOM
>
1
)
{
COSOM
<-
1
COSOM
<-
1
}
COSOM2
<-
COSOM
*
COSOM
...
...
R/PEdaily_Oudin.R
View file @
4390ce3e
...
...
@@ -70,7 +70,7 @@ PEdaily_Oudin <- function(JD,
COSOM
<-
-1
}
if
(
COSOM
>
1
)
{
COSOM
<-
1
COSOM
<-
1
}
COSOM2
<-
COSOM
*
COSOM
...
...
@@ -94,11 +94,11 @@ PEdaily_Oudin <- function(JD,
if
(
is.na
(
Temp
[
k
]))
{
PE_Oudin_D
[
k
]
<-
NA
}
else
{
if
(
Temp
[
k
]
>=
-5.0
)
{
PE_Oudin_D
[
k
]
<-
GE
*
(
Temp
[
k
]
+
5
)
/
100
/
28.5
}
else
{
PE_Oudin_D
[
k
]
<-
0
}
if
(
Temp
[
k
]
>=
-5.0
)
{
PE_Oudin_D
[
k
]
<-
GE
*
(
Temp
[
k
]
+
5
)
/
100
/
28.5
}
else
{
PE_Oudin_D
[
k
]
<-
0
}
}
}
...
...
R/RunModel_GR2M.R
View file @
4390ce3e
...
...
@@ -59,8 +59,8 @@ RunModel_GR2M <- function(InputsModel, RunOptions, Param) {
## Use of IniResLevels
if
(
!
is.null
(
RunOptions
$
IniResLevels
))
{
RunOptions
$
IniStates
[
1
]
<-
RunOptions
$
IniResLevels
[
1
]
*
Param
[
1
]
### production store level (mm)
RunOptions
$
IniStates
[
2
]
<-
RunOptions
$
IniResLevels
[
2
]
*
Param
[
2
]
### routing store level (mm)
RunOptions
$
IniStates
[
1
]
<-
RunOptions
$
IniResLevels
[
1
]
*
Param
[
1
]
### production store level (mm)
RunOptions
$
IniStates
[
2
]
<-
RunOptions
$
IniResLevels
[
2
]
*
Param
[
2
]
### routing store level (mm)
}
## Call GR model Fortan
...
...
R/RunModel_GR4H.R
View file @
4390ce3e
...
...
@@ -64,8 +64,8 @@ RunModel_GR4H <- function(InputsModel, RunOptions, Param) {
## Use of IniResLevels
if
(
!
is.null
(
RunOptions
$
IniResLevels
))
{
RunOptions
$
IniStates
[
1
]
<-
RunOptions
$
IniResLevels
[
1
]
*
Param
[
1
]
### production store level (mm)
RunOptions
$
IniStates
[
2
]
<-
RunOptions
$
IniResLevels
[
2
]
*
Param
[
3
]
### routing store level (mm)
RunOptions
$
IniStates
[
1
]
<-
RunOptions
$
IniResLevels
[
1
]
*
Param
[
1
]
### production store level (mm)
RunOptions
$
IniStates
[
2
]
<-
RunOptions
$
IniResLevels
[
2
]
*
Param
[
3
]
### routing store level (mm)
}
## Call GR model Fortan
...
...
R/RunModel_GR4J.R
View file @
4390ce3e
...
...
@@ -63,8 +63,8 @@ RunModel_GR4J <- function(InputsModel, RunOptions, Param) {
## Use of IniResLevels
if
(
!
is.null
(
RunOptions
$
IniResLevels
))
{
RunOptions
$
IniStates
[
1
]
<-
RunOptions
$
IniResLevels
[
1
]
*
Param
[
1
]
### production store level (mm)
RunOptions
$
IniStates
[
2
]
<-
RunOptions
$
IniResLevels
[
2
]
*
Param
[
3
]
### routing store level (mm)
RunOptions
$
IniStates
[
1
]
<-
RunOptions
$
IniResLevels
[
1
]
*
Param
[
1
]
### production store level (mm)
RunOptions
$
IniStates
[
2
]
<-
RunOptions
$
IniResLevels
[
2
]
*
Param
[
3
]
### routing store level (mm)
}
## Call GR model Fortan
...
...
R/RunModel_GR5H.R
View file @
4390ce3e
...
...
@@ -70,8 +70,8 @@ RunModel_GR5H <- function(InputsModel, RunOptions, Param) {
## Use of IniResLevels
if
(
!
is.null
(
RunOptions
$
IniResLevels
))
{
RunOptions
$
IniStates
[
1
]
<-
RunOptions
$
IniResLevels
[
1
]
*
Param
[
1
]
### production store level (mm)
RunOptions
$
IniStates
[
2
]
<-
RunOptions
$
IniResLevels
[
2
]
*
Param
[
3
]
### routing store level (mm)
RunOptions
$
IniStates
[
1
]
<-
RunOptions
$
IniResLevels
[
1
]
*
Param
[
1
]
### production store level (mm)
RunOptions
$
IniStates
[
2
]
<-
RunOptions
$
IniResLevels
[
2
]
*
Param
[
3
]
### routing store level (mm)
if
(
IsIntStore
)
{
RunOptions
$
IniStates
[
4
]
<-
RunOptions
$
IniResLevels
[
4
]
*
Imax
### interception store level (mm)
}
...
...
R/RunModel_GR5J.R
View file @
4390ce3e
...
...
@@ -64,8 +64,8 @@ RunModel_GR5J <- function(InputsModel, RunOptions, Param) {
## Use of IniResLevels
if
(
!
is.null
(
RunOptions
$
IniResLevels
))
{
RunOptions
$
IniStates
[
1
]
<-
RunOptions
$
IniResLevels
[
1
]
*
Param
[
1
]
### production store level (mm)
RunOptions
$
IniStates
[
2
]
<-
RunOptions
$
IniResLevels
[
2
]
*
Param
[
3
]
### routing store level (mm)
RunOptions
$
IniStates
[
1
]
<-
RunOptions
$
IniResLevels
[
1
]
*
Param
[
1
]
### production store level (mm)
RunOptions
$
IniStates
[
2
]
<-
RunOptions
$
IniResLevels
[
2
]
*
Param
[
3
]
### routing store level (mm)
}
## Call GR model Fortan
...
...
R/RunModel_GR6J.R
View file @
4390ce3e
...
...
@@ -68,8 +68,8 @@ RunModel_GR6J <- function(InputsModel, RunOptions, Param) {
## Use of IniResLevels
if
(
!
is.null
(
RunOptions
$
IniResLevels
))
{
RunOptions
$
IniStates
[
1
]
<-
RunOptions
$
IniResLevels
[
1
]
*
Param
[
1
]
### production store level (mm)
RunOptions
$
IniStates
[
2
]
<-
RunOptions
$
IniResLevels
[
2
]
*
Param
[
3
]
### routing store level (mm)
RunOptions
$
IniStates
[
1
]
<-
RunOptions
$
IniResLevels
[
1
]
*
Param
[
1
]
### production store level (mm)
RunOptions
$
IniStates
[
2
]
<-
RunOptions
$
IniResLevels
[
2
]
*
Param
[
3
]
### routing store level (mm)
RunOptions
$
IniStates
[
3
]
<-
RunOptions
$
IniResLevels
[
3
]
### exponential store level (mm)
}
...
...
R/TransfoParam_CemaNeige.R
View file @
4390ce3e
...
...
@@ -28,7 +28,7 @@ TransfoParam_CemaNeige <- function(ParamIn, Direction) {
}
if
(
Direction
==
"RT"
)
{
ParamOut
<-
ParamIn
ParamOut
[,
1
]
<-
ParamIn
[,
1
]
*
19.98
-
9.99
### CemaNeige X1 (weighting coefficient for snow pack thermal state)
ParamOut
[,
1
]
<-
ParamIn
[,
1
]
*
19.98
-
9.99
### CemaNeige X1 (weighting coefficient for snow pack thermal state)
ParamOut
[,
2
]
<-
log
(
ParamIn
[,
2
]
*
200
)
### CemaNeige X2 (degree-day melt coefficient)
}
...
...
R/TransfoParam_CemaNeigeHyst.R
View file @
4390ce3e
...
...
@@ -22,15 +22,15 @@ TransfoParam_CemaNeigeHyst <- function(ParamIn, Direction) {
## transformation
if
(
Direction
==
"TR"
)
{
ParamOut
<-
ParamIn
ParamOut
<-
ParamIn
ParamOut
[,
1
]
<-
(
ParamIn
[,
1
]
+
9.99
)
/
19.98
### CemaNeige X1 (weighting coefficient for snow pack thermal state)
ParamOut
[,
2
]
<-
exp
(
ParamIn
[,
2
])
/
200
### CemaNeige X2 (degree-day melt coefficient)
ParamOut
[,
3
]
<-
(
ParamIn
[,
3
]
*
5
)
+
50
### Hyst Gaccum
ParamOut
[,
4
]
<-
(
ParamIn
[,
4
]
/
19.98
)
+
0.5
### Hyst CV
}
if
(
Direction
==
"RT"
)
{
ParamOut
<-
ParamIn
ParamOut
[,
1
]
<-
ParamIn
[,
1
]
*
19.98
-
9.99
### CemaNeige X1 (weighting coefficient for snow pack thermal state)
ParamOut
<-
ParamIn
ParamOut
[,
1
]
<-
ParamIn
[,
1
]
*
19.98
-
9.99
### CemaNeige X1 (weighting coefficient for snow pack thermal state)
ParamOut
[,
2
]
<-
log
(
ParamIn
[,
2
]
*
200
)
### CemaNeige X2 (degree-day melt coefficient)
ParamOut
[,
3
]
<-
(
ParamIn
[,
3
]
-
50
)
/
5
### Hyst Gaccum
ParamOut
[,
4
]
<-
(
ParamIn
[,
4
]
-
0.5
)
*
19.98
### Hyst CV
...
...
R/TransfoParam_GR1A.R
View file @
4390ce3e
...
...
@@ -25,7 +25,7 @@ TransfoParam_GR1A <- function(ParamIn, Direction) {
ParamOut
<-
(
ParamIn
+
10.0
)
/
8
}
if
(
Direction
==
"RT"
)
{
ParamOut
<-
ParamIn
*
8
-
10.0
ParamOut
<-
ParamIn
*
8
-
10.0
}
...
...
R/TransfoParam_Lag.R
View file @
4390ce3e
...
...
@@ -25,7 +25,7 @@ TransfoParam_Lag <- function(ParamIn, Direction) {
ParamOut
<-
20
*
(
ParamIn
+
10
)
/
20.0
}
if
(
Direction
==
"RT"
)
{
ParamOut
<-
ParamIn
*
20.0
/
20
-
10
ParamOut
<-
ParamIn
*
20.0
/
20
-
10
}