06-evolution_indicateurs_hydrologiques.Rmd 7.38 KB
Newer Older
1
2
# Evolution des indicateurs hydrologiques

Dorchies David's avatar
Dorchies David committed
3
```{r setup, include=FALSE}
4
5
library(seinebasin2)
cfg <- loadConfig()
Dorchies David's avatar
Dorchies David committed
6
7
8
9
knitr::opts_chunk$set(
  fig.width = 8,
  fig.asp = 1
)
10
11
12
13
14
15
```

L'évolution est représentée sous la forme du rapport entre l'indicateur calculé sur la période future et celui calculé sur la période de référence.

La période de référence correspond à la période 1976-2005 et la période future choisie ici correspond à la période "fin de siècle" 2071-2100.

16
17
18
19
20
21
22
23
24
Les indicateurs sont calculés séparément pour les deux scénarios d'émission RCP 4.5 et RCP 8.5 et une synthèse des différents couples GCM/RCM est réalisée.

```{r}
rcps <- cfg$hydroclim$drias$rcp[-1]
scenarios <- gsub("/", "_", cfg$hydroclim$drias$scenarios)
scenariosX <- rep(scenarios, length(rcps))
rcpsX <- rep(rcps, each = length(scenarios))
```

25
26
## Listes des indicateurs

27
### Indicateurs mensuels
28

29
Pour les données climatiques&nbsp;:
30
31
32
33
34

- Cumul pluviométrie (mm)
- Moyenne températures (°C)
- Cumul ETP (mm)

35
```{r}
36
37
38
39
40
readTsvMatrix <- function(path) {
    df <- read.csv(path, sep = "\t")
    m <- as.matrix(df[,-1])
    rownames(m) <- df[, 1]
    m
41
}
42

43
44
45
46
47
P_month <- calcAll(P_drias, calcMonthlyInterannualSum)
T_month <- calcAll(T_drias, calcMonthlyInterannualMean)
E_month <- calcAll(E_drias, calcMonthlyInterannualSum)
```

48
49
50
Pour les débits&nbsp;:

- Débit moyen
51
- Débit moyen sec de période de retour 5 ans
52

53
54
Ces données ont été calculées et enregistrées lors de la simulation des débits.

55
```{r}
56
57
58
59
60
61
62
63
64
loadIndicators <- function(rcp, scenario, indicator) {
    periods <- names(cfg$hydroclim$drias$periods)
    names(periods) <- periods
    lapply(periods, function(period) {
        file <- paste0(indicator, "_", 
                       substr(cfg$hydroclim$drias$periods[[period]][1], 1, 4),
                       "-",
                       substr(cfg$hydroclim$drias$periods[[period]][2], 1, 4),
                       ".tsv")
Dorchies David's avatar
Dorchies David committed
65
        path <- getDataPath(
66
67
68
69
70
71
72
            cfg$Qnat$path, 
            "Drias2020/Qnat-v1", 
            rcp, 
            scenario, 
            file,
            cfg = cfg
        )
73
        readTsvMatrix(path)
74
    })
75
}
76

77
78
79
80
81
82
83
84
loadAllIndicators <- function(indicator) {
    ind <- mapply(rcp = rcpsX, 
                      scenario = scenariosX, 
                      indicator = indicator, 
                      loadIndicators, 
                      SIMPLIFY = FALSE)
    names(ind) <- paste(rcpsX, scenariosX, sep = " - ")
    return(ind)
85
86
}

87
88
Q_month <- loadAllIndicators("Q_monthly")
Q_month5 <- loadAllIndicators("Q_monthly_5years")
89
90
91
92
93
94
95
96
97
98
99
100
```


### Indicateurs synthétiques

Pour les étiages&nbsp;: VCN10, VCN30 et QMNA pour les périodes de retour 2 ans, 5 ans et 10 ans.

Pour les crues&nbsp;: QJXA pour les périodes de retour 2 ans, 10 ans, 20 ans.

Pour les faibles/forts débits&nbsp;: les quantiles 95% et 10% de débits journaliers

```{r}
101
Q_indicators <- loadAllIndicators("Q_indicators")
102
103
104
105
106
107
108
109
110
111
112
```


## Résultats calculés pour chaque indicateur

Les données utilisées en entrées sont&nbsp;:

- données observées sur la période d'observation
- données simulées sur la période d'observation
- Rapport entre les données simulées sur la période future et la période de référence pour un couple scénario/modèle climatique

113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
```{r}
historiQ <- list(
    obs = list(path = file.path(cfg$calibration$path, "Qobs"),
               period = c(cfg$calibration$date$start, cfg$calibration$date$end)),
    sim = list(path = file.path(cfg$calibration$path, "Qsim"),
               period = c(cfg$calibration$date$start, cfg$calibration$date$end)),
    nat = list(path = file.path(cfg$Qnat$path, "Qnat-v1"),
               period = cfg$hydroclim$drias$periods$ref)
)

loadHistoriQ <- function(l, indicator) {
    file <- paste0(indicator, "_", 
                   substr(l$period[1], 1, 4),
                   "-",
                   substr(l$period[2], 1, 4),
                   ".tsv")
    path <- getDataPath(l$path, file, cfg = cfg)
    readTsvMatrix(path)
}
Qhist_month <- lapply(historiQ, loadHistoriQ, indicator = "Q_monthly")
Qhist_month5 <- lapply(historiQ, loadHistoriQ, indicator = "Q_monthly_5years")
Qhist_indicators <- lapply(historiQ, loadHistoriQ, indicator = "Q_indicators")
```

137
138
Débits moyens mensuels à Paris sur la période de référence:

139
140
```{r, fig.asp = 0.7}
plot_monthly_mean("rcp4.5", "ref", "H5920010", Q_month, Qhist_month)
141
142
143
144
```

Débits moyens à Paris sur la période 2071-2100 avec le scénario d'émission RCP4.5:

145
146
```{r, fig.asp = 0.7}
plot_monthly_mean("rcp4.5", "end", "H5920010", Q_month, Qhist_month)
147
148
```

149

150
151
152
Les tableaux de synthèse fournissent la valeur minimale, médiane et maximale des évolutions parmi les couples scénario/modèle climatiques.

```{r}
153
calcDelta <- function(ind, rcp, period, delta = "*") {
154
    if (!delta %in% c("*", "+")) stop("`delta`should be equal to \"*\" or \"+\"")
155
156
157
158
159
160
    scenarios <- names(ind)
    names(scenarios) <- scenarios
    ind <- lapply(scenarios, function(x) {
        if (grepl(rcp, x, fixed = TRUE)) {
            
            ind[[x]]
161
        } else {
162
            NULL
163
        }
164
165
166
167
168
169
170
171
172
    })
    ind <- ind[!sapply(ind,is.null)]
    deltas <- lapply(names(ind), function(scenario) {
        dfPer <- ind[[scenario]][[period]]
        dfRef <- ind[[scenario]]$ref
        if (delta == "*") {
            m <- (dfPer - dfRef) / dfRef * 100
        } else {
            m <- dfPer - dfRef
173
174
175
176
177
178
179
        }
    })
    list(
        min = do.call(pmin, deltas),
        med = do.call(pmedian, deltas),
        max = do.call(pmax, deltas)
    )
180
}
181
182
tableDeltaStation <- function(station, delta, ind_hist = NULL) {
    if (!is.null(ind_hist)) delta <- c(ind_hist, delta)
183
184
185
186
187
    l <- lapply(delta, function(m) {
        m[station, ]
    })
    do.call(cbind, l)
}
188
189
```

190
Exemple pour les pluies moyennes mensuelles pour les 6 premières stations:
191
192

```{r}
193
194
deltaPM <- calcDelta(P_month, rcp = "rcp4.5", period = "end")
lapply(deltaPM, function(x) t(head(x)))
195
196
```

197
Exemple pour la température moyenne mensuelle à Paris:
198
199

```{r}
200
deltaTM <- calcDelta(T_month, rcp = "rcp4.5", period = "end", delta = "+")
201
knitr::kable(tableDeltaStation("H5920010", deltaTM), digits = 1)
202
203
204
205
```

**N.B.:** les données climatiques correspondent ici au données moyennes du sous-bassin versant et pas le bassin versant entier. Il faudrait agréger les données des bassins amont pour avoir une moyenne du bassin pour chaque station.

206
Exemple sur le débit mensuel moyen à Paris
207
208

```{r}
209
deltaQM <-  calcDelta(Q_month, rcp = "rcp4.5", period = "end")
210
knitr::kable(tableDeltaStation("H5920010", deltaQM, Qhist_month), digits = 1)
211
212
```

213
Exemple sur tous les indicateurs hydrologiques à Paris:
214
215

```{r}
216
deltaIndicators <- calcDelta(Q_indicators, rcp = "rcp4.5", period = "end")
217
knitr::kable(tableDeltaStation("H5920010", deltaIndicators, Qhist_indicators), digits = 1)
218
```
Dorchies David's avatar
Dorchies David committed
219
## Cartes d'évolutions
220

Dorchies David's avatar
Dorchies David committed
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
```{r}
plot_map_delta <- function(r, title) {
    # Define scale centered around 0
    decVal <- r[r < 0]
    incVal <- r[!(r < 0)]
    decQuant <- quantile(decVal, probs = c(0, 0.1, 0.4, 0.6, 0.9))
    incQuant <- quantile(incVal, probs = c(0.1, 0.4, 0.6, 0.9, 1))
    breaks <- c(decQuant, incQuant)
    breaks[is.na(breaks)] <- 0
    plot_seine_map(r, breaks, title)
}
```

```{r}
plot_map_delta(deltaIndicators$med[, "QA"], "QA - évolution RCP4.5 scénario médian (%)")
```
237
238

```{r}
Dorchies David's avatar
Dorchies David committed
239
plot_map_delta(deltaIndicators$min[, "QMNA5"], "QMNA5 - évolution RCP4.5 scénario minimum (%)")
240
```
241

Dorchies David's avatar
Dorchies David committed
242
243
244
```{r}
plot_map_delta(deltaIndicators$max[, "QJXA10"], "QJXA10 - évolution RCP4.5 scénario maximum (%)")
```