#' Create InputsModel object for a **airGRiwrm** network #' #' @param x GRiwrm object describing the diagram of the semi-distributed model, see \code{[GRiwrm]}. #' @param DatesR Vector of POSIXt 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, 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, DatesR,Precip[,id], PotEvap[,id], Qobs, ... ) } return(InputsModel) } #' Create an empty InputsModel object for **airGRiwrm** nodes #' #' @return \emph{GRiwrmInputsModel} empty object CreateEmptyGRiwrmInputsModel <- function() { InputsModel <- list() class(InputsModel) <- append(class(InputsModel), "GRiwrmInputsModel") return(InputsModel) } #' Create one InputsModel for a **airGRiwrm** node #' #' @param id string of the node identifier #' @param griwrm See \code{[GRiwrm]}. #' @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, griwrm, DatesR, Precip, PotEvap, Qobs) { node <- griwrm[griwrm$id == id,] FUN_MOD <- griwrm$model[griwrm$id == id] # Set hydraulic parameters UpstreamNodes <- griwrm$id[griwrm$down == id & !is.na(griwrm$down)] Qupstream <- NULL LengthHydro <- NULL BasinAreas <- NULL if(length(UpstreamNodes) > 0) { # Sub-basin with hydraulic routing Qupstream <- Qobs[ , UpstreamNodes, drop=FALSE] LengthHydro <- griwrm$length[griwrm$id %in% UpstreamNodes] names(LengthHydro) <- UpstreamNodes BasinAreas <- c( griwrm$area[griwrm$id %in% UpstreamNodes], node$area - sum(griwrm$area[griwrm$id %in% UpstreamNodes], na.rm = TRUE) ) names(BasinAreas) <- c(UpstreamNodes, id) } # Set model inputs with the **airGR** function InputsModel <- CreateInputsModel( FUN_MOD, DatesR = DatesR, Precip = Precip, PotEvap = PotEvap, Qupstream = Qupstream, LengthHydro = LengthHydro, BasinAreas = BasinAreas ) # Add Identifiers of connected nodes in order to be able to update them with simulated flows InputsModel$id <- id if(length(UpstreamNodes) > 0) { InputsModel$UpstreamNodes <- UpstreamNodes InputsModel$UpstreamIsRunoff <- !is.na(griwrm$model[match(UpstreamNodes, griwrm$id)]) } # Add the model function InputsModel$FUN_MOD <- FUN_MOD return(InputsModel) }