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
0ada9d71
Commit
0ada9d71
authored
Jun 16, 2021
by
Dorchies David
Browse files
feat: use .GetOutputsModel for all RunModel functions
+ bug correction on DatesR item of .GetOutputsModel Refs
#129
parent
329591eb
Pipeline
#24003
failed with stages
in 32 minutes and 21 seconds
Changes
13
Pipelines
1
Show whitespace changes
Inline
Side-by-side
R/RunModel_CemaNeigeGR4H.R
View file @
0ada9d71
...
...
@@ -6,7 +6,6 @@ RunModel_CemaNeigeGR4H <- function(InputsModel, RunOptions, Param) {
NParam
<-
ifelse
(
test
=
IsHyst
,
yes
=
8L
,
no
=
6L
)
NParamCN
<-
NParam
-
4L
NStates
<-
4L
FortranOutputs
<-
.FortranOutputs
(
GR
=
"GR4H"
,
isCN
=
TRUE
)
## Arguments check
...
...
@@ -76,9 +75,9 @@ RunModel_CemaNeigeGR4H <- function(InputsModel, RunOptions, Param) {
## CemaNeige________________________________________________________________________________
if
(
inherits
(
RunOptions
,
"CemaNeige"
))
{
if
(
"all"
%in%
RunOptions
$
Outputs_Sim
)
{
IndOutputsCemaNeige
<-
as.integer
(
1
:
length
(
FortranOutputs
$
CN
))
IndOutputsCemaNeige
<-
as.integer
(
1
:
length
(
RunOptions
$
FortranOutputs
$
CN
))
}
else
{
IndOutputsCemaNeige
<-
which
(
FortranOutputs
$
CN
%in%
RunOptions
$
Outputs_Sim
)
IndOutputsCemaNeige
<-
which
(
RunOptions
$
FortranOutputs
$
CN
%in%
RunOptions
$
Outputs_Sim
)
}
CemaNeigeLayers
<-
list
()
CemaNeigeStateEnd
<-
NULL
...
...
@@ -116,7 +115,7 @@ RunModel_CemaNeigeGR4H <- function(InputsModel, RunOptions, Param) {
## Data storage
CemaNeigeLayers
[[
iLayer
]]
<-
lapply
(
seq_len
(
RESULTS
$
NOutputs
),
function
(
i
)
RESULTS
$
Outputs
[
IndPeriod2
,
i
])
names
(
CemaNeigeLayers
[[
iLayer
]])
<-
FortranOutputs
$
CN
[
IndOutputsCemaNeige
]
names
(
CemaNeigeLayers
[[
iLayer
]])
<-
RunOptions
$
FortranOutputs
$
CN
[
IndOutputsCemaNeige
]
IndPliqAndMelt
<-
which
(
names
(
CemaNeigeLayers
[[
iLayer
]])
==
"PliqAndMelt"
)
if
(
iLayer
==
1
)
{
CatchMeltAndPliq
<-
RESULTS
$
Outputs
[,
IndPliqAndMelt
]
/
NLayers
...
...
@@ -142,9 +141,9 @@ RunModel_CemaNeigeGR4H <- function(InputsModel, RunOptions, Param) {
## GR model
if
(
"all"
%in%
RunOptions
$
Outputs_Sim
)
{
IndOutputsMod
<-
as.integer
(
1
:
length
(
FortranOutputs
$
GR
))
IndOutputsMod
<-
as.integer
(
1
:
length
(
RunOptions
$
FortranOutputs
$
GR
))
}
else
{
IndOutputsMod
<-
which
(
FortranOutputs
$
GR
%in%
RunOptions
$
Outputs_Sim
)
IndOutputsMod
<-
which
(
RunOptions
$
FortranOutputs
$
GR
%in%
RunOptions
$
Outputs_Sim
)
}
## Use of IniResLevels
...
...
@@ -186,45 +185,14 @@ RunModel_CemaNeigeGR4H <- function(InputsModel, RunOptions, Param) {
}
if
(
inherits
(
RunOptions
,
"CemaNeige"
)
&
"Precip"
%in%
RunOptions
$
Outputs_Sim
)
{
RESULTS
$
Outputs
[,
which
(
FortranOutputs
$
GR
[
IndOutputsMod
]
==
"Precip"
)]
<-
InputsModel
$
Precip
[
IndPeriod1
]
RESULTS
$
Outputs
[,
which
(
RunOptions
$
FortranOutputs
$
GR
[
IndOutputsMod
]
==
"Precip"
)]
<-
InputsModel
$
Precip
[
IndPeriod1
]
}
## Output data preparation
## OutputsModel only
if
(
!
ExportDatesR
&
!
ExportStateEnd
)
{
OutputsModel
<-
c
(
lapply
(
seq_len
(
RESULTS
$
NOutputs
),
function
(
i
)
RESULTS
$
Outputs
[
IndPeriod2
,
i
]),
list
(
CemaNeigeLayers
))
names
(
OutputsModel
)
<-
c
(
FortranOutputs
$
GR
[
IndOutputsMod
],
NameCemaNeigeLayers
)
}
## DatesR and OutputsModel only
if
(
ExportDatesR
&
!
ExportStateEnd
)
{
OutputsModel
<-
c
(
list
(
InputsModel
$
DatesR
[
RunOptions
$
IndPeriod_Run
]),
lapply
(
seq_len
(
RESULTS
$
NOutputs
),
function
(
i
)
RESULTS
$
Outputs
[
IndPeriod2
,
i
]),
list
(
CemaNeigeLayers
))
names
(
OutputsModel
)
<-
c
(
"DatesR"
,
FortranOutputs
$
GR
[
IndOutputsMod
],
NameCemaNeigeLayers
)
}
## OutputsModel and StateEnd only
if
(
!
ExportDatesR
&
ExportStateEnd
)
{
OutputsModel
<-
c
(
lapply
(
seq_len
(
RESULTS
$
NOutputs
),
function
(
i
)
RESULTS
$
Outputs
[
IndPeriod2
,
i
]),
list
(
CemaNeigeLayers
),
list
(
RESULTS
$
StateEnd
))
names
(
OutputsModel
)
<-
c
(
FortranOutputs
$
GR
[
IndOutputsMod
],
NameCemaNeigeLayers
,
"StateEnd"
)
}
## DatesR and OutputsModel and StateEnd
if
(
ExportDatesR
&
ExportStateEnd
)
{
OutputsModel
<-
c
(
list
(
InputsModel
$
DatesR
[
RunOptions
$
IndPeriod_Run
]),
lapply
(
seq_len
(
RESULTS
$
NOutputs
),
function
(
i
)
RESULTS
$
Outputs
[
IndPeriod2
,
i
]),
list
(
CemaNeigeLayers
),
list
(
RESULTS
$
StateEnd
))
names
(
OutputsModel
)
<-
c
(
"DatesR"
,
FortranOutputs
$
GR
[
IndOutputsMod
],
NameCemaNeigeLayers
,
"StateEnd"
)
}
## End
rm
(
RESULTS
)
class
(
OutputsModel
)
<-
c
(
"OutputsModel"
,
"hourly"
,
"GR"
,
"CemaNeige"
)
if
(
IsHyst
)
{
class
(
OutputsModel
)
<-
c
(
class
(
OutputsModel
),
"hysteresis"
)
}
return
(
OutputsModel
)
## OutputsModel generation
.GetOutputsModel
(
InputsModel
,
RunOptions
,
RESULTS
,
LInputSeries
,
CemaNeigeLayers
)
}
R/RunModel_CemaNeigeGR4J.R
View file @
0ada9d71
...
...
@@ -6,7 +6,6 @@ RunModel_CemaNeigeGR4J <- function(InputsModel, RunOptions, Param) {
NParam
<-
ifelse
(
test
=
IsHyst
,
yes
=
8L
,
no
=
6L
)
NParamCN
<-
NParam
-
4L
NStates
<-
4L
FortranOutputs
<-
.FortranOutputs
(
GR
=
"GR4J"
,
isCN
=
TRUE
)
## Arguments check
...
...
@@ -76,9 +75,9 @@ RunModel_CemaNeigeGR4J <- function(InputsModel, RunOptions, Param) {
## CemaNeige________________________________________________________________________________
if
(
inherits
(
RunOptions
,
"CemaNeige"
))
{
if
(
"all"
%in%
RunOptions
$
Outputs_Sim
)
{
IndOutputsCemaNeige
<-
as.integer
(
1
:
length
(
FortranOutputs
$
CN
))
IndOutputsCemaNeige
<-
as.integer
(
1
:
length
(
RunOptions
$
FortranOutputs
$
CN
))
}
else
{
IndOutputsCemaNeige
<-
which
(
FortranOutputs
$
CN
%in%
RunOptions
$
Outputs_Sim
)
IndOutputsCemaNeige
<-
which
(
RunOptions
$
FortranOutputs
$
CN
%in%
RunOptions
$
Outputs_Sim
)
}
CemaNeigeLayers
<-
list
()
CemaNeigeStateEnd
<-
NULL
...
...
@@ -115,7 +114,7 @@ RunModel_CemaNeigeGR4J <- function(InputsModel, RunOptions, Param) {
## Data storage
CemaNeigeLayers
[[
iLayer
]]
<-
lapply
(
seq_len
(
RESULTS
$
NOutputs
),
function
(
i
)
RESULTS
$
Outputs
[
IndPeriod2
,
i
])
names
(
CemaNeigeLayers
[[
iLayer
]])
<-
FortranOutputs
$
CN
[
IndOutputsCemaNeige
]
names
(
CemaNeigeLayers
[[
iLayer
]])
<-
RunOptions
$
FortranOutputs
$
CN
[
IndOutputsCemaNeige
]
IndPliqAndMelt
<-
which
(
names
(
CemaNeigeLayers
[[
iLayer
]])
==
"PliqAndMelt"
)
if
(
iLayer
==
1
)
{
CatchMeltAndPliq
<-
RESULTS
$
Outputs
[,
IndPliqAndMelt
]
/
NLayers
...
...
@@ -141,9 +140,9 @@ RunModel_CemaNeigeGR4J <- function(InputsModel, RunOptions, Param) {
## GR model______________________________________________________________________________________
if
(
"all"
%in%
RunOptions
$
Outputs_Sim
)
{
IndOutputsMod
<-
as.integer
(
1
:
length
(
FortranOutputs
$
GR
))
IndOutputsMod
<-
as.integer
(
1
:
length
(
RunOptions
$
FortranOutputs
$
GR
))
}
else
{
IndOutputsMod
<-
which
(
FortranOutputs
$
GR
%in%
RunOptions
$
Outputs_Sim
)
IndOutputsMod
<-
which
(
RunOptions
$
FortranOutputs
$
GR
%in%
RunOptions
$
Outputs_Sim
)
}
## Use of IniResLevels
...
...
@@ -185,45 +184,14 @@ RunModel_CemaNeigeGR4J <- function(InputsModel, RunOptions, Param) {
}
if
(
inherits
(
RunOptions
,
"CemaNeige"
)
&
"Precip"
%in%
RunOptions
$
Outputs_Sim
)
{
RESULTS
$
Outputs
[,
which
(
FortranOutputs
$
GR
[
IndOutputsMod
]
==
"Precip"
)]
<-
InputsModel
$
Precip
[
IndPeriod1
]
RESULTS
$
Outputs
[,
which
(
RunOptions
$
FortranOutputs
$
GR
[
IndOutputsMod
]
==
"Precip"
)]
<-
InputsModel
$
Precip
[
IndPeriod1
]
}
## Output data preparation
## OutputsModel only
if
(
!
ExportDatesR
&
!
ExportStateEnd
)
{
OutputsModel
<-
c
(
lapply
(
seq_len
(
RESULTS
$
NOutputs
),
function
(
i
)
RESULTS
$
Outputs
[
IndPeriod2
,
i
]),
list
(
CemaNeigeLayers
))
names
(
OutputsModel
)
<-
c
(
FortranOutputs
$
GR
[
IndOutputsMod
],
NameCemaNeigeLayers
)
}
## DatesR and OutputsModel only
if
(
ExportDatesR
&
!
ExportStateEnd
)
{
OutputsModel
<-
c
(
list
(
InputsModel
$
DatesR
[
RunOptions
$
IndPeriod_Run
]),
lapply
(
seq_len
(
RESULTS
$
NOutputs
),
function
(
i
)
RESULTS
$
Outputs
[
IndPeriod2
,
i
]),
list
(
CemaNeigeLayers
))
names
(
OutputsModel
)
<-
c
(
"DatesR"
,
FortranOutputs
$
GR
[
IndOutputsMod
],
NameCemaNeigeLayers
)
}
## OutputsModel and StateEnd only
if
(
!
ExportDatesR
&
ExportStateEnd
)
{
OutputsModel
<-
c
(
lapply
(
seq_len
(
RESULTS
$
NOutputs
),
function
(
i
)
RESULTS
$
Outputs
[
IndPeriod2
,
i
]),
list
(
CemaNeigeLayers
),
list
(
RESULTS
$
StateEnd
))
names
(
OutputsModel
)
<-
c
(
FortranOutputs
$
GR
[
IndOutputsMod
],
NameCemaNeigeLayers
,
"StateEnd"
)
}
## DatesR and OutputsModel and StateEnd
if
(
ExportDatesR
&
ExportStateEnd
)
{
OutputsModel
<-
c
(
list
(
InputsModel
$
DatesR
[
RunOptions
$
IndPeriod_Run
]),
lapply
(
seq_len
(
RESULTS
$
NOutputs
),
function
(
i
)
RESULTS
$
Outputs
[
IndPeriod2
,
i
]),
list
(
CemaNeigeLayers
),
list
(
RESULTS
$
StateEnd
))
names
(
OutputsModel
)
<-
c
(
"DatesR"
,
FortranOutputs
$
GR
[
IndOutputsMod
],
NameCemaNeigeLayers
,
"StateEnd"
)
}
## End
rm
(
RESULTS
)
class
(
OutputsModel
)
<-
c
(
"OutputsModel"
,
"daily"
,
"GR"
,
"CemaNeige"
)
if
(
IsHyst
)
{
class
(
OutputsModel
)
<-
c
(
class
(
OutputsModel
),
"hysteresis"
)
}
return
(
OutputsModel
)
## OutputsModel generation
.GetOutputsModel
(
InputsModel
,
RunOptions
,
RESULTS
,
LInputSeries
,
CemaNeigeLayers
)
}
R/RunModel_CemaNeigeGR5H.R
View file @
0ada9d71
...
...
@@ -6,7 +6,6 @@ RunModel_CemaNeigeGR5H <- function(InputsModel, RunOptions, Param) {
NParam
<-
ifelse
(
test
=
IsHyst
,
yes
=
9L
,
no
=
7L
)
NParamCN
<-
NParam
-
5L
NStates
<-
4L
FortranOutputs
<-
.FortranOutputs
(
GR
=
"GR5H"
,
isCN
=
TRUE
)
IsIntStore
<-
inherits
(
RunOptions
,
"interception"
)
if
(
IsIntStore
)
{
Imax
<-
RunOptions
$
Imax
...
...
@@ -82,9 +81,9 @@ RunModel_CemaNeigeGR5H <- function(InputsModel, RunOptions, Param) {
## CemaNeige________________________________________________________________________________
if
(
inherits
(
RunOptions
,
"CemaNeige"
))
{
if
(
"all"
%in%
RunOptions
$
Outputs_Sim
)
{
IndOutputsCemaNeige
<-
as.integer
(
1
:
length
(
FortranOutputs
$
CN
))
IndOutputsCemaNeige
<-
as.integer
(
1
:
length
(
RunOptions
$
FortranOutputs
$
CN
))
}
else
{
IndOutputsCemaNeige
<-
which
(
FortranOutputs
$
CN
%in%
RunOptions
$
Outputs_Sim
)
IndOutputsCemaNeige
<-
which
(
RunOptions
$
FortranOutputs
$
CN
%in%
RunOptions
$
Outputs_Sim
)
}
CemaNeigeLayers
<-
list
()
CemaNeigeStateEnd
<-
NULL
...
...
@@ -122,7 +121,7 @@ RunModel_CemaNeigeGR5H <- function(InputsModel, RunOptions, Param) {
## Data storage
CemaNeigeLayers
[[
iLayer
]]
<-
lapply
(
seq_len
(
RESULTS
$
NOutputs
),
function
(
i
)
RESULTS
$
Outputs
[
IndPeriod2
,
i
])
names
(
CemaNeigeLayers
[[
iLayer
]])
<-
FortranOutputs
$
CN
[
IndOutputsCemaNeige
]
names
(
CemaNeigeLayers
[[
iLayer
]])
<-
RunOptions
$
FortranOutputs
$
CN
[
IndOutputsCemaNeige
]
IndPliqAndMelt
<-
which
(
names
(
CemaNeigeLayers
[[
iLayer
]])
==
"PliqAndMelt"
)
if
(
iLayer
==
1
)
{
CatchMeltAndPliq
<-
RESULTS
$
Outputs
[,
IndPliqAndMelt
]
/
NLayers
...
...
@@ -148,9 +147,9 @@ RunModel_CemaNeigeGR5H <- function(InputsModel, RunOptions, Param) {
## GR model
if
(
"all"
%in%
RunOptions
$
Outputs_Sim
)
{
IndOutputsMod
<-
as.integer
(
1
:
length
(
FortranOutputs
$
GR
))
IndOutputsMod
<-
as.integer
(
1
:
length
(
RunOptions
$
FortranOutputs
$
GR
))
}
else
{
IndOutputsMod
<-
which
(
FortranOutputs
$
GR
%in%
RunOptions
$
Outputs_Sim
)
IndOutputsMod
<-
which
(
RunOptions
$
FortranOutputs
$
GR
%in%
RunOptions
$
Outputs_Sim
)
}
## Use of IniResLevels
...
...
@@ -197,48 +196,14 @@ RunModel_CemaNeigeGR5H <- function(InputsModel, RunOptions, Param) {
}
if
(
inherits
(
RunOptions
,
"CemaNeige"
)
&
"Precip"
%in%
RunOptions
$
Outputs_Sim
)
{
RESULTS
$
Outputs
[,
which
(
FortranOutputs
$
GR
[
IndOutputsMod
]
==
"Precip"
)]
<-
InputsModel
$
Precip
[
IndPeriod1
]
RESULTS
$
Outputs
[,
which
(
RunOptions
$
FortranOutputs
$
GR
[
IndOutputsMod
]
==
"Precip"
)]
<-
InputsModel
$
Precip
[
IndPeriod1
]
}
## Output data preparation
## OutputsModel only
if
(
!
ExportDatesR
&
!
ExportStateEnd
)
{
OutputsModel
<-
c
(
lapply
(
seq_len
(
RESULTS
$
NOutputs
),
function
(
i
)
RESULTS
$
Outputs
[
IndPeriod2
,
i
]),
list
(
CemaNeigeLayers
))
names
(
OutputsModel
)
<-
c
(
FortranOutputs
$
GR
[
IndOutputsMod
],
NameCemaNeigeLayers
)
}
## DatesR and OutputsModel only
if
(
ExportDatesR
&
!
ExportStateEnd
)
{
OutputsModel
<-
c
(
list
(
InputsModel
$
DatesR
[
RunOptions
$
IndPeriod_Run
]),
lapply
(
seq_len
(
RESULTS
$
NOutputs
),
function
(
i
)
RESULTS
$
Outputs
[
IndPeriod2
,
i
]),
list
(
CemaNeigeLayers
))
names
(
OutputsModel
)
<-
c
(
"DatesR"
,
FortranOutputs
$
GR
[
IndOutputsMod
],
NameCemaNeigeLayers
)
}
## OutputsModel and StateEnd only
if
(
!
ExportDatesR
&
ExportStateEnd
)
{
OutputsModel
<-
c
(
lapply
(
seq_len
(
RESULTS
$
NOutputs
),
function
(
i
)
RESULTS
$
Outputs
[
IndPeriod2
,
i
]),
list
(
CemaNeigeLayers
),
list
(
RESULTS
$
StateEnd
))
names
(
OutputsModel
)
<-
c
(
FortranOutputs
$
GR
[
IndOutputsMod
],
NameCemaNeigeLayers
,
"StateEnd"
)
}
## DatesR and OutputsModel and StateEnd
if
(
ExportDatesR
&
ExportStateEnd
)
{
OutputsModel
<-
c
(
list
(
InputsModel
$
DatesR
[
RunOptions
$
IndPeriod_Run
]),
lapply
(
seq_len
(
RESULTS
$
NOutputs
),
function
(
i
)
RESULTS
$
Outputs
[
IndPeriod2
,
i
]),
list
(
CemaNeigeLayers
),
list
(
RESULTS
$
StateEnd
))
names
(
OutputsModel
)
<-
c
(
"DatesR"
,
FortranOutputs
$
GR
[
IndOutputsMod
],
NameCemaNeigeLayers
,
"StateEnd"
)
}
## End
rm
(
RESULTS
)
class
(
OutputsModel
)
<-
c
(
"OutputsModel"
,
"hourly"
,
"GR"
,
"CemaNeige"
)
if
(
IsHyst
)
{
class
(
OutputsModel
)
<-
c
(
class
(
OutputsModel
),
"hysteresis"
)
}
if
(
IsIntStore
)
{
class
(
OutputsModel
)
<-
c
(
class
(
OutputsModel
),
"interception"
)
}
return
(
OutputsModel
)
## OutputsModel generation
.GetOutputsModel
(
InputsModel
,
RunOptions
,
RESULTS
,
LInputSeries
,
CemaNeigeLayers
)
}
R/RunModel_CemaNeigeGR5J.R
View file @
0ada9d71
...
...
@@ -6,7 +6,6 @@ RunModel_CemaNeigeGR5J <- function(InputsModel, RunOptions, Param) {
NParam
<-
ifelse
(
test
=
IsHyst
,
yes
=
9L
,
no
=
7L
)
NParamCN
<-
NParam
-
5L
NStates
<-
4L
FortranOutputs
<-
.FortranOutputs
(
GR
=
"GR5J"
,
isCN
=
TRUE
)
## Arguments check
...
...
@@ -74,9 +73,9 @@ RunModel_CemaNeigeGR5J <- function(InputsModel, RunOptions, Param) {
## CemaNeige________________________________________________________________________________
if
(
inherits
(
RunOptions
,
"CemaNeige"
))
{
if
(
"all"
%in%
RunOptions
$
Outputs_Sim
)
{
IndOutputsCemaNeige
<-
as.integer
(
1
:
length
(
FortranOutputs
$
CN
))
IndOutputsCemaNeige
<-
as.integer
(
1
:
length
(
RunOptions
$
FortranOutputs
$
CN
))
}
else
{
IndOutputsCemaNeige
<-
which
(
FortranOutputs
$
CN
%in%
RunOptions
$
Outputs_Sim
)
IndOutputsCemaNeige
<-
which
(
RunOptions
$
FortranOutputs
$
CN
%in%
RunOptions
$
Outputs_Sim
)
}
CemaNeigeLayers
<-
list
()
CemaNeigeStateEnd
<-
NULL
...
...
@@ -113,7 +112,7 @@ RunModel_CemaNeigeGR5J <- function(InputsModel, RunOptions, Param) {
## Data storage
CemaNeigeLayers
[[
iLayer
]]
<-
lapply
(
seq_len
(
RESULTS
$
NOutputs
),
function
(
i
)
RESULTS
$
Outputs
[
IndPeriod2
,
i
])
names
(
CemaNeigeLayers
[[
iLayer
]])
<-
FortranOutputs
$
CN
[
IndOutputsCemaNeige
]
names
(
CemaNeigeLayers
[[
iLayer
]])
<-
RunOptions
$
FortranOutputs
$
CN
[
IndOutputsCemaNeige
]
IndPliqAndMelt
<-
which
(
names
(
CemaNeigeLayers
[[
iLayer
]])
==
"PliqAndMelt"
)
if
(
iLayer
==
1
)
{
CatchMeltAndPliq
<-
RESULTS
$
Outputs
[,
IndPliqAndMelt
]
/
NLayers
...
...
@@ -139,9 +138,9 @@ RunModel_CemaNeigeGR5J <- function(InputsModel, RunOptions, Param) {
## GR model______________________________________________________________________________________
if
(
"all"
%in%
RunOptions
$
Outputs_Sim
)
{
IndOutputsMod
<-
as.integer
(
1
:
length
(
FortranOutputs
$
GR
))
IndOutputsMod
<-
as.integer
(
1
:
length
(
RunOptions
$
FortranOutputs
$
GR
))
}
else
{
IndOutputsMod
<-
which
(
FortranOutputs
$
GR
%in%
RunOptions
$
Outputs_Sim
)
IndOutputsMod
<-
which
(
RunOptions
$
FortranOutputs
$
GR
%in%
RunOptions
$
Outputs_Sim
)
}
## Use of IniResLevels
...
...
@@ -183,45 +182,14 @@ RunModel_CemaNeigeGR5J <- function(InputsModel, RunOptions, Param) {
}
if
(
inherits
(
RunOptions
,
"CemaNeige"
)
&
"Precip"
%in%
RunOptions
$
Outputs_Sim
)
{
RESULTS
$
Outputs
[,
which
(
FortranOutputs
$
GR
[
IndOutputsMod
]
==
"Precip"
)]
<-
InputsModel
$
Precip
[
IndPeriod1
]
}
## Output data preparation
## OutputsModel only
if
(
!
ExportDatesR
&
!
ExportStateEnd
)
{
OutputsModel
<-
c
(
lapply
(
seq_len
(
RESULTS
$
NOutputs
),
function
(
i
)
RESULTS
$
Outputs
[
IndPeriod2
,
i
]),
list
(
CemaNeigeLayers
))
names
(
OutputsModel
)
<-
c
(
FortranOutputs
$
GR
[
IndOutputsMod
],
NameCemaNeigeLayers
)
}
## DatesR and OutputsModel only
if
(
ExportDatesR
&
!
ExportStateEnd
)
{
OutputsModel
<-
c
(
list
(
InputsModel
$
DatesR
[
RunOptions
$
IndPeriod_Run
]),
lapply
(
seq_len
(
RESULTS
$
NOutputs
),
function
(
i
)
RESULTS
$
Outputs
[
IndPeriod2
,
i
]),
list
(
CemaNeigeLayers
))
names
(
OutputsModel
)
<-
c
(
"DatesR"
,
FortranOutputs
$
GR
[
IndOutputsMod
],
NameCemaNeigeLayers
)
}
## OutputsModel and StateEnd only
if
(
!
ExportDatesR
&
ExportStateEnd
)
{
OutputsModel
<-
c
(
lapply
(
seq_len
(
RESULTS
$
NOutputs
),
function
(
i
)
RESULTS
$
Outputs
[
IndPeriod2
,
i
]),
list
(
CemaNeigeLayers
),
list
(
RESULTS
$
StateEnd
))
names
(
OutputsModel
)
<-
c
(
FortranOutputs
$
GR
[
IndOutputsMod
],
NameCemaNeigeLayers
,
"StateEnd"
)
}
## DatesR and OutputsModel and StateEnd
if
(
ExportDatesR
&
ExportStateEnd
)
{
OutputsModel
<-
c
(
list
(
InputsModel
$
DatesR
[
RunOptions
$
IndPeriod_Run
]),
lapply
(
seq_len
(
RESULTS
$
NOutputs
),
function
(
i
)
RESULTS
$
Outputs
[
IndPeriod2
,
i
]),
list
(
CemaNeigeLayers
),
list
(
RESULTS
$
StateEnd
))
names
(
OutputsModel
)
<-
c
(
"DatesR"
,
FortranOutputs
$
GR
[
IndOutputsMod
],
NameCemaNeigeLayers
,
"StateEnd"
)
}
## End
rm
(
RESULTS
)
class
(
OutputsModel
)
<-
c
(
"OutputsModel"
,
"daily"
,
"GR"
,
"CemaNeige"
)
if
(
IsHyst
)
{
class
(
OutputsModel
)
<-
c
(
class
(
OutputsModel
),
"hysteresis"
)
RESULTS
$
Outputs
[,
which
(
RunOptions
$
FortranOutputs
$
GR
[
IndOutputsMod
]
==
"Precip"
)]
<-
InputsModel
$
Precip
[
IndPeriod1
]
}
return
(
OutputsModel
)
## OutputsModel generation
.GetOutputsModel
(
InputsModel
,
RunOptions
,
RESULTS
,
LInputSeries
,
CemaNeigeLayers
)
}
R/RunModel_CemaNeigeGR6J.R
View file @
0ada9d71
...
...
@@ -6,7 +6,6 @@ RunModel_CemaNeigeGR6J <- function(InputsModel, RunOptions, Param) {
NParam
<-
ifelse
(
test
=
IsHyst
,
yes
=
10L
,
no
=
8L
)
NParamCN
<-
NParam
-
6L
NStates
<-
4L
FortranOutputs
<-
.FortranOutputs
(
GR
=
"GR6J"
,
isCN
=
TRUE
)
## Arguments check
...
...
@@ -78,9 +77,9 @@ RunModel_CemaNeigeGR6J <- function(InputsModel, RunOptions, Param) {
## CemaNeige________________________________________________________________________________
if
(
inherits
(
RunOptions
,
"CemaNeige"
))
{
if
(
"all"
%in%
RunOptions
$
Outputs_Sim
)
{
IndOutputsCemaNeige
<-
as.integer
(
1
:
length
(
FortranOutputs
$
CN
))
IndOutputsCemaNeige
<-
as.integer
(
1
:
length
(
RunOptions
$
FortranOutputs
$
CN
))
}
else
{
IndOutputsCemaNeige
<-
which
(
FortranOutputs
$
CN
%in%
RunOptions
$
Outputs_Sim
)
IndOutputsCemaNeige
<-
which
(
RunOptions
$
FortranOutputs
$
CN
%in%
RunOptions
$
Outputs_Sim
)
}
CemaNeigeLayers
<-
list
()
CemaNeigeStateEnd
<-
NULL
...
...
@@ -117,7 +116,7 @@ RunModel_CemaNeigeGR6J <- function(InputsModel, RunOptions, Param) {
## Data storage
CemaNeigeLayers
[[
iLayer
]]
<-
lapply
(
seq_len
(
RESULTS
$
NOutputs
),
function
(
i
)
RESULTS
$
Outputs
[
IndPeriod2
,
i
])
names
(
CemaNeigeLayers
[[
iLayer
]])
<-
FortranOutputs
$
CN
[
IndOutputsCemaNeige
]
names
(
CemaNeigeLayers
[[
iLayer
]])
<-
RunOptions
$
FortranOutputs
$
CN
[
IndOutputsCemaNeige
]
IndPliqAndMelt
<-
which
(
names
(
CemaNeigeLayers
[[
iLayer
]])
==
"PliqAndMelt"
)
if
(
iLayer
==
1
)
{
CatchMeltAndPliq
<-
RESULTS
$
Outputs
[,
IndPliqAndMelt
]
/
NLayers
...
...
@@ -143,9 +142,9 @@ RunModel_CemaNeigeGR6J <- function(InputsModel, RunOptions, Param) {
## GR model______________________________________________________________________________________
if
(
"all"
%in%
RunOptions
$
Outputs_Sim
)
{
IndOutputsMod
<-
as.integer
(
1
:
length
(
FortranOutputs
$
GR
))
IndOutputsMod
<-
as.integer
(
1
:
length
(
RunOptions
$
FortranOutputs
$
GR
))
}
else
{
IndOutputsMod
<-
which
(
FortranOutputs
$
GR
%in%
RunOptions
$
Outputs_Sim
)
IndOutputsMod
<-
which
(
RunOptions
$
FortranOutputs
$
GR
%in%
RunOptions
$
Outputs_Sim
)
}
## Use of IniResLevels
...
...
@@ -188,46 +187,15 @@ RunModel_CemaNeigeGR6J <- function(InputsModel, RunOptions, Param) {
}
if
(
inherits
(
RunOptions
,
"CemaNeige"
)
&
"Precip"
%in%
RunOptions
$
Outputs_Sim
)
{
RESULTS
$
Outputs
[,
which
(
FortranOutputs
$
GR
[
IndOutputsMod
]
==
"Precip"
)]
<-
InputsModel
$
Precip
[
IndPeriod1
]
}
## Output data preparation
## OutputsModel only
if
(
!
ExportDatesR
&
!
ExportStateEnd
)
{
OutputsModel
<-
c
(
lapply
(
seq_len
(
RESULTS
$
NOutputs
),
function
(
i
)
RESULTS
$
Outputs
[
IndPeriod2
,
i
]),
list
(
CemaNeigeLayers
))
names
(
OutputsModel
)
<-
c
(
FortranOutputs
$
GR
[
IndOutputsMod
],
NameCemaNeigeLayers
)
}
## DatesR and OutputsModel only
if
(
ExportDatesR
&
!
ExportStateEnd
)
{
OutputsModel
<-
c
(
list
(
InputsModel
$
DatesR
[
RunOptions
$
IndPeriod_Run
]),
lapply
(
seq_len
(
RESULTS
$
NOutputs
),
function
(
i
)
RESULTS
$
Outputs
[
IndPeriod2
,
i
]),
list
(
CemaNeigeLayers
))
names
(
OutputsModel
)
<-
c
(
"DatesR"
,
FortranOutputs
$
GR
[
IndOutputsMod
],
NameCemaNeigeLayers
)
}
## OutputsModel and StateEnd only
if
(
!
ExportDatesR
&
ExportStateEnd
)
{
OutputsModel
<-
c
(
lapply
(
seq_len
(
RESULTS
$
NOutputs
),
function
(
i
)
RESULTS
$
Outputs
[
IndPeriod2
,
i
]),
list
(
CemaNeigeLayers
),
list
(
RESULTS
$
StateEnd
))
names
(
OutputsModel
)
<-
c
(
FortranOutputs
$
GR
[
IndOutputsMod
],
NameCemaNeigeLayers
,
"StateEnd"
)
}
## DatesR and OutputsModel and StateEnd
if
(
ExportDatesR
&
ExportStateEnd
)
{
OutputsModel
<-
c
(
list
(
InputsModel
$
DatesR
[
RunOptions
$
IndPeriod_Run
]),
lapply
(
seq_len
(
RESULTS
$
NOutputs
),
function
(
i
)
RESULTS
$
Outputs
[
IndPeriod2
,
i
]),
list
(
CemaNeigeLayers
),
list
(
RESULTS
$
StateEnd
))
names
(
OutputsModel
)
<-
c
(
"DatesR"
,
FortranOutputs
$
GR
[
IndOutputsMod
],
NameCemaNeigeLayers
,
"StateEnd"
)
}
## End
rm
(
RESULTS
)
class
(
OutputsModel
)
<-
c
(
"OutputsModel"
,
"daily"
,
"GR"
,
"CemaNeige"
)
if
(
IsHyst
)
{
class
(
OutputsModel
)
<-
c
(
class
(
OutputsModel
),
"hysteresis"
)
RESULTS
$
Outputs
[,
which
(
RunOptions
$
FortranOutputs
$
GR
[
IndOutputsMod
]
==
"Precip"
)]
<-
InputsModel
$
Precip
[
IndPeriod1
]
}
return
(
OutputsModel
)
## OutputsModel generation
.GetOutputsModel
(
InputsModel
,
RunOptions
,
RESULTS
,
LInputSeries
,
CemaNeigeLayers
)
}
R/RunModel_GR1A.R
View file @
0ada9d71
...
...
@@ -3,7 +3,6 @@ RunModel_GR1A <- function(InputsModel, RunOptions, Param) {
## Initialization of variables
NParam
<-
1
FortranOutputs
<-
.FortranOutputs
(
GR
=
"GR1A"
)
$
GR
## Arguments check
...
...
@@ -38,9 +37,9 @@ RunModel_GR1A <- function(InputsModel, RunOptions, Param) {
IndPeriod1
<-
c
(
RunOptions
$
IndPeriod_WarmUp
,
RunOptions
$
IndPeriod_Run
)
LInputSeries
<-
as.integer
(
length
(
IndPeriod1
))
if
(
"all"
%in%
RunOptions
$
Outputs_Sim
)
{
IndOutputs
<-
as.integer
(
1
:
length
(
FortranOutputs
))
IndOutputs
<-
as.integer
(
1
:
length
(
RunOptions
$
FortranOutputs
$
GR
))
}
else
{
IndOutputs
<-
which
(
FortranOutputs
%in%
RunOptions
$
Outputs_Sim
)
IndOutputs
<-
which
(
RunOptions
$
FortranOutputs
$
GR
%in%
RunOptions
$
Outputs_Sim
)
}
...
...
@@ -69,34 +68,9 @@ RunModel_GR1A <- function(InputsModel, RunOptions, Param) {
RESULTS
$
Outputs
[
RESULTS
$
Outputs
<=
-99e8
]
<-
NA
RESULTS
$
StateEnd
[
RESULTS
$
StateEnd
<=
-99e8
]
<-
NA
## Output data preparation
## OutputsModel only
if
(
!
ExportDatesR
&
!
ExportStateEnd
)
{
OutputsModel
<-
lapply
(
seq_len
(
RESULTS
$
NOutputs
),
function
(
i
)
RESULTS
$
Outputs
[
IndPeriod2
,
i
])
names
(
OutputsModel
)
<-
FortranOutputs
[
IndOutputs
]
}
## DatesR and OutputsModel only
if
(
ExportDatesR
&
!
ExportStateEnd
)
{
OutputsModel
<-
c
(
list
(
InputsModel
$
DatesR
[
RunOptions
$
IndPeriod_Run
]),
lapply
(
seq_len
(
RESULTS
$
NOutputs
),
function
(
i
)
RESULTS
$
Outputs
[
IndPeriod2
,
i
]))
names
(
OutputsModel
)
<-
c
(
"DatesR"
,
FortranOutputs
[
IndOutputs
])
}
## OutputsModel and StateEnd only
if
(
!
ExportDatesR
&
ExportStateEnd
)
{
OutputsModel
<-
c
(
lapply
(
seq_len
(
RESULTS
$
NOutputs
),
function
(
i
)
RESULTS
$
Outputs
[
IndPeriod2
,
i
]),
list
(
RESULTS
$
StateEnd
))
names
(
OutputsModel
)
<-
c
(
FortranOutputs
[
IndOutputs
],
"StateEnd"
)
}
## DatesR and OutputsModel and StateEnd
if
((
ExportDatesR
&
ExportStateEnd
)
|
"all"
%in%
RunOptions
$
Outputs_Sim
)
{
OutputsModel
<-
c
(
list
(
InputsModel
$
DatesR
[
RunOptions
$
IndPeriod_Run
]),
lapply
(
seq_len
(
RESULTS
$
NOutputs
),
function
(
i
)
RESULTS
$
Outputs
[
IndPeriod2
,
i
]),
list
(
RESULTS
$
StateEnd
))
names
(
OutputsModel
)
<-
c
(
"DatesR"
,
FortranOutputs
[
IndOutputs
],
"StateEnd"
)
}
## End
class
(
OutputsModel
)
<-
c
(
"OutputsModel"
,
"yearly"
,
"GR"
)
return
(
OutputsModel
)
## OutputsModel generation
.GetOutputsModel
(
InputsModel
,
RunOptions
,
RESULTS
,
LInputSeries
)
}
R/RunModel_GR2M.R
View file @
0ada9d71
...
...
@@ -3,7 +3,6 @@ RunModel_GR2M <- function(InputsModel, RunOptions, Param) {
## Initialization of variables
NParam
<-
2
FortranOutputs
<-
.FortranOutputs
(
GR
=
"GR2M"
)
$
GR
## Arguments check
...
...
@@ -47,9 +46,9 @@ RunModel_GR2M <- function(InputsModel, RunOptions, Param) {
IndPeriod1
<-
c
(
RunOptions
$
IndPeriod_WarmUp
,
RunOptions
$
IndPeriod_Run
)
LInputSeries
<-
as.integer
(
length
(
IndPeriod1
))
if
(
"all"
%in%
RunOptions
$
Outputs_Sim
)
{
IndOutputs
<-
as.integer
(
1
:
length
(
FortranOutputs
))
IndOutputs
<-
as.integer
(
1
:
length
(
RunOptions
$
FortranOutputs
$
GR
))
}
else
{
IndOutputs
<-
which
(
FortranOutputs
%in%
RunOptions
$
Outputs_Sim
)
IndOutputs
<-
which
(
RunOptions
$
FortranOutputs
$
GR
%in%
RunOptions
$
Outputs_Sim
)
}
## Output data preparation
...
...
@@ -91,34 +90,9 @@ RunModel_GR2M <- function(InputsModel, RunOptions, Param) {
}
## Output data preparation
## OutputsModel only
if
(
!
ExportDatesR
&
!
ExportStateEnd
)
{
OutputsModel
<-
lapply
(
seq_len
(
RESULTS
$
NOutputs
),
function
(
i
)
RESULTS
$
Outputs
[
IndPeriod2
,
i
])
names
(
OutputsModel
)
<-
FortranOutputs
[
IndOutputs
]
}
## DatesR and OutputsModel only
if
(
ExportDatesR
&
!
ExportStateEnd
)
{
OutputsModel
<-
c
(
list
(
InputsModel
$
DatesR
[
RunOptions
$
IndPeriod_Run
]),
lapply
(
seq_len
(
RESULTS
$
NOutputs
),
function
(
i
)
RESULTS
$
Outputs
[
IndPeriod2
,
i
]))
names
(
OutputsModel
)
<-
c
(
"DatesR"
,
FortranOutputs
[
IndOutputs
])
}
## OutputsModel and StateEnd only
if
(
!
ExportDatesR
&
ExportStateEnd
)
{
OutputsModel
<-
c
(
lapply
(
seq_len
(
RESULTS
$
NOutputs
),
function
(
i
)
RESULTS
$
Outputs
[
IndPeriod2
,
i
]),
list
(
RESULTS
$
StateEnd
))
names
(
OutputsModel
)
<-
c
(
FortranOutputs
[
IndOutputs
],
"StateEnd"
)