CreateInputsModel.Griwrm.R

#' Create InputsModel object for a GRIWRM network
#'
#' @param x Ginet object describing the diagram of the semi-distributed model, see \code{[Ginet]}.
#' @param girop Girop object giving the run-off model parameters, see \code{[Girop]}.
#' @param DateR Vector of POSIXlt observation time steps.
#' @param Precip Matrix or data frame of numeric containing precipitation in mm. Column names correspond to node IDs.
#' @param PotEvap Matrix or data frame of numeric containing potential evaporation in mm. Column names correspond to node IDs.
#' @param Qobs Matrix or data frame of numeric containing potential observed flow in mm. Column names correspond to node IDs.
#' @param verbose (optional) boolean indicating if the function is run in verbose mode or not, default = \code{TRUE}
#' @param ... further arguments passed to \code{\link[airGR]{CreateInputsModel}}.
#'
#' @return GriwrmInputsModel object equivalent to airGR InputsModel object for a semi-distributed model (See \code{\link[airGR]{CreateInputsModel}})
#' @export
CreateInputsModel.Griwrm <- function(x, girop, DatesR, Precip, PotEvap, Qobs, verbose = TRUE, ...) {

  InputsModel <- CreateEmptyGriwrmInputsModel()
  Qobs[is.na(Qobs)] <- -99 # airGRCreateInputsModel doesn't accept NA values

  for(id in getNodeRanking(x)) {
    if(verbose) cat("CreateInputsModel.griwrm: Treating sub-basin", id, "...\n")
    InputsModel[[id]] <- CreateOneGriwrmInputsModel(
      id, x, girop, DatesR,Precip[,id], PotEvap[,id], Qobs, ...
    )
  }
  return(InputsModel)
}


#' Create an empty InputsModel object for GRIWRM nodes
#'
#' @return \emph{GriwrmInputsModel} empty object
CreateEmptyGriwrmInputsModel <- function() {
  InputsModel <- list()
  class(InputsModel) <- append(class(InputsModel), "GriwrmInputsModel")
  return(InputsModel)
}


#' Create one InputsModel for a GRIWRM node
#'
#' @param id string of the node identifier
#' @param ginet See \code{[Ginet]}.
#' @param girop See \code{[Girop]}.
#' @param DatesR vector of dates required to create the GR model and CemaNeige module inputs.
#' @param Precip time series of potential evapotranspiration (catchment average) (mm/time step).
#' @param PotEvap time series of potential evapotranspiration (catchment average) (mm/time step).
#' @param Qobs Matrix or data frame of numeric containing observed flow (mm/time step). Column names correspond to node IDs.
##'
#' @return \emph{InputsModel} object for one.
CreateOneGriwrmInputsModel <- function(id, ginet, girop, DatesR, Precip, PotEvap, Qobs) {
  node <- ginet[ginet$id == id,]
  FUN_MOD <- girop$model[girop$id == id]

  # Set hydraulic parameters
  UpstreamNodes <- ginet$id[ginet$down == id & !is.na(ginet$down)]
  Qupstream <- NULL
  LengthHydro <- NULL
  BasinAreas <- NULL

  if(length(UpstreamNodes) > 0) {
    # Sub-basin with hydraulic routing
    for(idUpstrNode in UpstreamNodes) {
      Qupstream1 <- matrix(Qobs[,idUpstrNode], ncol = 1)
      if(is.null(Qupstream)) {
        Qupstream <- Qupstream1
      } else {
        Qupstream <- cbind(Qupstream, Qupstream1)
      }
    }
    LengthHydro <- ginet$length[girop$id %in% UpstreamNodes]