Skip to content
GitLab
Select Git revision
  • master default
Find file BlameHistoryPermalink
RunModel_Lag.R 2.78 KiB
1 
RunModel_Lag <- function(InputsModel, RunOptions, Param) {
2
3 
  NParam <- 1
4
5 
  ##Arguments_check
6 
  if (!inherits(InputsModel, "InputsModel")) {
7 
    stop("'InputsModel' must be of class 'InputsModel'")
8 
  }
9 
  if (!inherits(InputsModel, "SD")) {
10 
    stop("'InputsModel' must be of class 'SD'")
11 
  }
12 
  if (!inherits(RunOptions, "RunOptions")) {
13 
    stop("'RunOptions' must be of class 'RunOptions'")
14 
  }
15 
  if (!is.vector(Param) | !is.numeric(Param)) {
16 
    stop("'Param' must be a numeric vector")
17 
  }
18 
  if (sum(!is.na(Param)) != NParam) {
19 
    stop(paste("'Param' must be a vector of length", NParam, "and contain no NA"))
20 
  }
21 
  if (is.null(InputsModel$OutputsModel)) {
22 
    stop("'InputsModel' should contain an 'OutputsModel' key containing the output of the runoff of the downstream subcatchment")
23 
  }
24 
  if (is.null(InputsModel$OutputsModel$Qsim)) {
25 
    stop("'InputsModel$OutputsModel' should contain a key 'Qsim' containing the output of the runoff of the downstream subcatchment")
26 
  }
27 
  if (sum(!is.na(InputsModel$OutputsModel$Qsim)) != length(RunOptions$IndPeriod_Run)) {
28 
    stop("'InputsModel$OutputsModel$Qim' should have the same lenght as 'RunOptions$IndPeriod_Run' and contain no NA")
29 
  }
30
31 
  OutputsModel <- InputsModel$OutputsModel
32 
  OutputsModel$QsimDown <- OutputsModel$Qsim
33
34 
  if (inherits(InputsModel, "daily")) {
35 
    TimeStep <- 60 * 60 * 24
36 
  }
37 
  if (inherits(InputsModel, "hourly")) {
38 
    TimeStep <- 60 * 60
39 
  }
40
41 
  # propagation time from upstream meshes to outlet
42 
  PT <- InputsModel$LengthHydro / Param[1L] / TimeStep
43 
  HUTRANS <- rbind(1 - (PT - floor(PT)), PT - floor(PT))
44
45 
  NbUpBasins <- length(InputsModel$LengthHydro)
46 
  LengthTs <- length(OutputsModel$QsimDown)
47 
  OutputsModel$Qsim <- OutputsModel$QsimDown * InputsModel$BasinAreas[length(InputsModel$BasinAreas)] * 1e3
48
49 
  for (upstream_basin in seq_len(NbUpBasins)) {
50 
    Qupstream <- InputsModel$Qupstream[RunOptions$IndPeriod_Run, upstream_basin]
51 
    if (!is.na(InputsModel$BasinAreas[upstream_basin])) {
52 
      # Upstream flow with area needs to be converted to m3 by time step
53 
      Qupstream <- Qupstream * InputsModel$BasinAreas[upstream_basin] * 1e3
54 
    }
55 
    OutputsModel$Qsim <- OutputsModel$Qsim +
56 
      c(rep(0, floor(PT[upstream_basin])),
57 
        Qupstream[1:(LengthTs - floor(PT[upstream_basin]))]) *
58 
      HUTRANS[1, upstream_basin] +
59 
      c(rep(0, floor(PT[upstream_basin] + 1)),
60 
        Qupstream[1:(LengthTs - floor(PT[upstream_basin]) - 1)]) *
61 
      HUTRANS[2, upstream_basin]
62 
  }
63 
  # Warning for negative flows
64 
  if (any(OutputsModel$Qsim < 0)) {
65 
    warning(length(which(OutputsModel$Qsim < 0)), " time steps with negative flow, set to zero.")
66 
    OutputsModel$Qsim[OutputsModel$Qsim < 0] <- 0
67 
  }
68 
  # Convert back Qsim to mm
69 
  OutputsModel$Qsim <- OutputsModel$Qsim / sum(InputsModel$BasinAreas, na.rm = TRUE) / 1e3
70 
  return(OutputsModel)
71
}