From 7209968301ec793c5b46ec04dd973b71ea087c5d Mon Sep 17 00:00:00 2001
From: David <david.dorchies@inrae.fr>
Date: Tue, 31 Dec 2024 16:40:30 +0100
Subject: [PATCH] fix(serializeIniStates): format IniStates as in
CreateRunOptions
Refs #179
---
R/RunModel.GRiwrmOutputsModel.R | 2 +-
R/RunModel.Supervisor.R | 2 +-
R/utils.RunModel.R | 20 +++++++++++++++++++-
3 files changed, 21 insertions(+), 3 deletions(-)
diff --git a/R/RunModel.GRiwrmOutputsModel.R b/R/RunModel.GRiwrmOutputsModel.R
index cf8d00d..878e614 100644
--- a/R/RunModel.GRiwrmOutputsModel.R
+++ b/R/RunModel.GRiwrmOutputsModel.R
@@ -73,7 +73,7 @@ RunModel.GRiwrmOutputsModel <- function(x,
for (id in names(RunOptions)) {
# Run model for the sub-basin and one time step
RunOptions[[id]]$IniResLevels <- NULL
- RunOptions[[id]]$IniStates <- serializeIniStates(x[[id]]$StateEnd)
+ RunOptions[[id]]$IniStates <- serializeIniStates(x[[id]]$StateEnd, InputsModel[[id]])
RunOptions[[id]]$IndPeriod_WarmUp <- 0L
RunOptions[[id]]$IndPeriod_Run <- IndPeriod_Run
}
diff --git a/R/RunModel.Supervisor.R b/R/RunModel.Supervisor.R
index 57a59f2..2959122 100644
--- a/R/RunModel.Supervisor.R
+++ b/R/RunModel.Supervisor.R
@@ -120,7 +120,7 @@ RunModel.Supervisor <- function(x, RunOptions, Param, ...) {
# Loop over sub-basin using SD model
for (id in SD_Ids) {
# Run model for the sub-basin and one time step
- RunOptions[[id]]$IniStates <- serializeIniStates(x$OutputsModel[[id]]$StateEnd)
+ RunOptions[[id]]$IniStates <- serializeIniStates(x$OutputsModel[[id]]$StateEnd, x$InputsModel[[id]])
RunOptions[[id]]$IndPeriod_Run <- iTS
# Route upstream flows for SD nodes
if (x$InputsModel[[id]]$isReservoir) {
diff --git a/R/utils.RunModel.R b/R/utils.RunModel.R
index dbf187b..a881b67 100644
--- a/R/utils.RunModel.R
+++ b/R/utils.RunModel.R
@@ -60,8 +60,26 @@ OutputsModelQsim <- function(InputsModel, OutputsModel, IndPeriod_Run) {
#' @return A vector as in `RunOptions$IniStates`
#' @noRd
#'
-serializeIniStates <- function(IniStates) {
+serializeIniStates <- function(IniStates, InputsModel) {
+ ObjectClass <- class(InputsModel)
+ if (!"CemaNeige" %in% ObjectClass && any(is.na(IniStates$CemaNeigeLayers$G))) {
+ IniStates$CemaNeigeLayers$G <- NULL
+ }
+ if (!"CemaNeige" %in% ObjectClass && any(is.na(IniStates$CemaNeigeLayers$eTG))) {
+ IniStates$CemaNeigeLayers$eTG <- NULL
+ }
+ if (!"CemaNeige" %in% ObjectClass && any(is.na(IniStates$CemaNeigeLayers$Gthr))) {
+ IniStates$CemaNeigeLayers$Gthr <- NULL
+ }
+ if (!"CemaNeige" %in% ObjectClass && any(is.na(IniStates$CemaNeigeLayers$Glocmax))) {
+ IniStates$CemaNeigeLayers$Glocmax <- NULL
+ }
+ IniStates$Store$Rest <- rep(NA, 3)
IniStates <- unlist(IniStates)
+ IniStates[is.na(IniStates) & !grepl("SD", names(IniStates))] <- 0
+ if ("monthly" %in% ObjectClass) {
+ IniStates <- IniStates[seq_len(NState)]
+ }
return(IniStates)
}
--
GitLab