ObsGR.R 1.96 KB
Newer Older
unknown's avatar
unknown committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
ObsGR <- function(ObsBV = NULL, DatesR = NULL, Precip = NULL, PotEvap = NULL, Qobs = NULL, TempMean = NULL, 
                  ZInputs = NULL, HypsoData = NULL, NLayers = 5,
                  TypeModel, CemaNeige = FALSE) {
  
  
  if (is.null(ObsBV) && (is.null(DatesR) | is.null(Precip) | is.null(PotEvap) | is.null(Qobs))) {
    stop("Missing input data")
  }

  if (ncol(ObsBV) >= 5) {
    TempMean <- ObsBV[, 5L]
  }
  if (!is.null(TempMean)) {
    TempMean <- TempMean
  } else {
    TempMean <- NA
  }
  
  if (is.null(ObsBV)) {
    ObsBV <- data.frame(DatesR   = DatesR,
                        Precip   = Precip,
                        PotEvap  = PotEvap,
                        Qobs     = Qobs,
                        TempMean = TempMean)
  }
  
  if (!is.null(ObsBV)) {
    ObsBV <- data.frame(DatesR   = ObsBV[, 1L],
                        Precip   = ObsBV[, 2L],
                        PotEvap  = ObsBV[, 3L],
                        Qobs     = ObsBV[, 4L],
                        TempMean =  TempMean)
  }
  
  SuiteGR <- paste("GR", c("1A", "2M", "4J", "5J", "6J", "4H"), sep = "")
  
  if (! any(TypeModel %in% SuiteGR)) {
    stop("Non convenient model")
  } else {
    if (! CemaNeige) {
      TypeModel <- sprintf("RunModel_%s", TypeModel)
    }
    if (CemaNeige && grepl("J", TypeModel)) {
      TypeModel <- sprintf("RunModel_CemaNeige%s", TypeModel)
    }
    if (CemaNeige && !grepl("J", TypeModel)) {
      warning("CemaNeige can not be used with ", TypeModel)
      TypeModel <- sprintf("RunModel_%s", TypeModel)
    }
    FUN_MOD <- get(TypeModel)
  }


  MOD_obs <- CreateInputsModel(FUN_MOD = FUN_MOD, DatesR = ObsBV$DatesR, 
                      Precip = ObsBV$Precip, PotEvap = ObsBV$PotEvap, TempMean = ObsBV$TempMean, 
                      ZInputs = ZInputs,  HypsoData = HypsoData, NLayers = NLayers, verbose = FALSE)
  
  
  ObsGR <- list(InputsModel = MOD_obs, Qobs = ObsBV$Qobs, TypeModel = TypeModel)
  class(ObsGR) <- c("ObsGR", "GR")
  return(ObsGR)
 
}