Skip to content
GitLab
Select Git revision
  • 181-simulation-water-losses-on-routed-flows-based-on-gr-groundwater-exchange-function
  • dev default
  • 183-createcaliboptions-crash-when-all-parameters-are-fixed
  • 180-write-a-vignette-with-exemple-of-use-of-runmodel-griwrmoutputsmodel
  • master
  • v0.7.0
  • v0.6.2
  • v0.6.1
  • v0.5.0
  • v0.4.0
  • v0.3.0
Find file BlameHistoryPermalink
utils.RunModel.R 4.30 KiB
1 
#' Check of the parameters of RunModel methods
2 
#'
3 
#' Stop the execution if an error is detected.
4 
#'
5 
#' @param InputsModel \[`GRiwrmInputsModel` object\] see [CreateInputsModel.GRiwrm] for details
6 
#' @param RunOptions \[`GRiwrmRunOptions` object\] see [CreateRunOptions.GRiwrmInputsModel] for details
7 
#' @param Param [list] of containing model parameter values of each node of the network
8 
#' @noRd
9 
checkRunModelParameters <- function(InputsModel, RunOptions, Param) {
10 
  if (!inherits(InputsModel, "GRiwrmInputsModel")) stop("`InputsModel` parameter must of class 'GRiwrmInputsModel' (See ?CreateRunOptions.GRiwrmInputsModel)")
11 
  if (!inherits(RunOptions, "GRiwrmRunOptions")) stop("Argument `RunOptions` parameter must of class 'GRiwrmRunOptions' (See ?CreateRunOptions.GRiwrmInputsModel)")
12 
  if (!is.list(Param) || !all(names(InputsModel) %in% names(Param))) stop("Argument `Param` must be a list with names equal to nodes IDs")
13 
}
14
15
16 
#' Creation of a data.frame with simulated flows at each node of the GRiwrm object
17 
#'
18 
#' @details
19 
#' This function can only be called inside [RunModel.GRiwrmInputsModel] or [RunModel.Supervisor]
20 
#' because it needs a `GRiwrmInputsModel` object internally modified by these functions
21 
#' (`Qupstream` updated with simulated flows).
22 
#'
23 
#' @param InputsModel \[`GRiwrmInputsModel` object\] see [CreateInputsModel.GRiwrm] for details
24 
#' @param OutputsModel \[`GRiwrmOutputsModel` object\] see [RunModel.GRiwrmInputsModel] or [RunModel.Supervisor] for details
25 
#' @param IndPeriod_Run [numeric] index of period to be used for the model run [-]. See [airGR::CreateRunOptions] for details
26 
#'
27 
#' @return a [data.frame] containing the simulated flows (in m3/time step) structured with the following columns:
28 
#' - 'DatesR' vector of dates  of the time series
29 
#' - one column by node with the simulated flows
30 
#' @noRd
31 
OutputsModelQsim <- function(InputsModel, OutputsModel, IndPeriod_Run) {
32 
  griwrm <- attr(InputsModel, "GRiwrm")
33 
  # Get simulated flow for each node
34 
  # Flow for each node is available in OutputsModel except for Direct Injection
35 
  # nodes where it is stored in InputsModel$Qupstream of the downstream node
36 
  QsimRows <- getDiversionRows(griwrm, TRUE)
37 
  lQsim <- lapply(
38 
    QsimRows,
39 
    function(i) {
40 
      x <- griwrm[i, ]
41 
      if (is.na(x$model)) {
42 
        InputsModel[[x$down]]$Qupstream[IndPeriod_Run, x$id]
43 
      } else {
44 
        OutputsModel[[x$id]]$Qsim_m3
45 
      }
46 
    }
47 
  )
48 
  names(lQsim) <- griwrm$id[QsimRows]
49 
  dfQsim <- cbind(data.frame(DatesR = InputsModel[[1]]$DatesR[IndPeriod_Run]),
50 
                  do.call(cbind,lQsim) / attr(InputsModel, "TimeStep"))
51 
  dfQsim <- as.Qm3s(dfQsim)
52 
  return(dfQsim)
53 
}
54
55
56 
#' Convert IniStates list into a vector
57 
#'
58 
#' @param IniStates see [CreateIniStates]
59 
#'
60 
#' @return A vector as in `RunOptions$IniStates`
61 
#' @noRd
62 
#'
63 
serializeIniStates <- function(IniStates) {
64 
  IniStates <- unlist(IniStates)
65 
  return(IniStates)
66 
}
67
68
69 
#' Cap negative `OutputsModel$Qsim_m3` to zero and fill `OutputsModel$Qover_m3`
70 
#' with over-abstracted volumes
7172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112
#' #' @param O Either `OutputsModel` or `OutputsModel$RunOptions` (for warm-up Qsim) #' @param WarmUp `TRUE` if `O` is `OutputsModel$RunOptions` #' #' @return Modified `OutputsModel` or `OutputsModel$RunOptions` #' @noRd #' calcOverAbstraction <- function(O, WarmUp) { f <- list(sim = "Qsim_m3", over = "Qover_m3") if (WarmUp) { f <- lapply(f, function(x) paste0("WarmUp", x)) } if (!is.null(O[[f$sim]])) { O[[f$over]] <- rep(0, length(O[[f$sim]])) if (any(!is.na(O[[f$sim]]) & O[[f$sim]] < 0)) { O[[f$over]][O[[f$sim]] < 0] <- - O[[f$sim]][!is.na(O[[f$sim]]) & O[[f$sim]] < 0] O[[f$sim]][!is.na(O[[f$sim]]) & O[[f$sim]] < 0] <- 0 } } return(O) } #' Get the next time steps date/time of a simulation #' #' @param x Object returned by [RunModel.GRiwrmInputsModel], #' [RunModel.Supervisor], or [RunModel.GRiwrmOutputsModel] #' @param TimeStep [integer] number of time steps to get after the end of the #' simulation #' #' @return A [POSIXct] containing the date/time of the time steps following #' the end of the simulation. #' @export #' getNextTimeSteps <- function(x, TimeStep = 1L) { stopifnot(inherits(x, "GRiwrmOutputsModel"), is.integer(TimeStep)) last_date <- dplyr::last(x[[1]]$DatesR) first_date <- last_date + attr(x, "TimeStep") return(seq(first_date, length.out = TimeStep, by = attr(x, "TimeStep"))) }