04-scenarios_climatiques.Rmd 7.75 KB
Newer Older
1
# Les scénarios climatiques DRIAS 2020 {#drias2020}
2

Dorchies David's avatar
Dorchies David committed
3
```{r setup, include=FALSE}
4
5
6
7
8
9
10
11
library(seinebasin2)
library(sp)
library(dplyr)
cfg <- loadConfig()
```

## Format des données

12
Les chroniques de scénarios climatiques font partie du jeu de données climatiques DRIAS 2020 débiaisées avec la méthode ADAMONT [@verfaillieMethodADAMONTV12017]. Les données, au pas de temps journalier, sont projetées, à l'instar de la base SAFRAN [@vidal50yearHighresolutionAtmospheric2010] sur une grille de 8 km de résolution qui couvrent tout le territoire métropolitain.
13

14
Nous avons effectué une sélection des mailles couvrant le bassin versant de la Seine avec l'exutoire à Vernon.
15
16
17

```{r}
library(seinebasin2)
18
# Mailles SAFRAN des exports DRIAS 2020
19
20
data("gis_safran")
# Shapefile des contours des BVI
21
data("gis_bvi")
22
23

library(sp)
24
plot_safran_bvi <- function(gis_safran, gis_bvi) {
25
    plot(gis_safran)
26
    plot(gis_safran, col = "#AA000020", border = NULL, add = TRUE)
27
    plot(gis_bvi, col = "#33333330", add = TRUE)
28
29
30
    prettymapr::addscalebar()
    prettymapr::addnortharrow(pos = "topleft", scale = 0.5)
}
31
32
33
```

```{r, fig.cap = "Carte de superposition des mailles SAFRAN avec le contour du bassin versant de la Seine à Vernon"}
34
plot_safran_bvi(gis_safran = gis_safran, gis_bvi = gis_bvi)
35
36
37
38
39
title("Superposition des mailles SAFRAN avec le contour du BV")
```

## Calcul de l'intersection entre les couches mailles SAFRAN et BVI 

40
```{r, fig.cap="Fusion de la couche SAFRAN avec celle des bassins versant intermédiaire du bassin versant de la Seine à Vernon"}
41
spMailles <- raster::intersect(gis_safran, gis_bvi)
42
43
plot(gis_bvi, col = "#33333330")
plot(spMailles, add = TRUE)
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
prettymapr::addscalebar()
prettymapr::addnortharrow(pos = "topleft", scale = 0.5)
title("Fusion des couches SAFRAN et BVI")
```

```{r}
dfMailles <- as.data.frame(spMailles)
# Aire de chaque intersect en km2
dfMailles$area <- areaPoly(spMailles) / 1E6

# Calcul de la proportion de chaque intersect pour chaque BVI
calcMaillePropBvi <- function(code) {
    dfBVI <- dfMailles[dfMailles$CODE == code,]
    dfBVI$area_bvi <- sum(dfBVI$area)
    dfBVI$prop <- dfBVI$area / dfBVI$area_bvi
    dfBVI
}

code_hydro <- unique(dfMailles$CODE)
names(code_hydro) <- code_hydro
lProp <- lapply(code_hydro, calcMaillePropBvi)
dfMailles <- do.call(rbind, lProp)
#Exemple de tableau
str(dfMailles[dfMailles$CODE == "H5920010",])
```

## Calcul des données météorologiques moyennées sur les BVI

72
### Liste des scénarios DRIAS 2020 à traiter
73
74

```{r}
75
drias_data_files <- listDataFiles(file.path(cfg$hydroclim$path, "drias"), cfg = cfg)
76
scenarioDriasFiles <- sapply(cfg$hydroclim$drias$scenarios, getDrias2020filenames, drias_data_files)
77
78
```

Dorchies David's avatar
Dorchies David committed
79
La liste des scénarios sélectionnés pour l'étude est la suivante : `r paste(cfg$hydroclim$drias$scenarios, collapse = ", ")`. Pour chaque scenario, les données sont présentes pour une période de référence (1950-2005) et deux projections (2006-2100) pour les scénarios d'émission RCP4.5 et RCP 8.5.
80

81
### Aggrégation des données DRIAS 2020
82

83
```{r, eval=!cfg$data$write_results}
84
driasPath <- getDataPath(cfg$hydroclim$path)
Dorchies David's avatar
Dorchies David committed
85
86
87
88
89

saveBasinsObs <- function(rcp, scenario) {    
    files <- scenarioDriasFiles[, scenario]
    files <- files[grep(paste0("Historical|", rcp), files)]
    BasinsObs <- createBasinsObs(files,
90
91
92
93
                                 dfMailles = dfMailles, cfg = cfg)
    path <- file.path(
        driasPath, 
        paste0(
Dorchies David's avatar
Dorchies David committed
94
            paste("BasinObs", rcp, gsub("/", "_", scenario), sep="_"),
95
96
97
98
            ".RDS"
            )
        )
    saveRDS(BasinsObs, path)
Dorchies David's avatar
Dorchies David committed
99
100
101
102
103
}

mapply(saveBasinsObs, 
       rcp = cfg$hydroclim$drias$rcp[-1], 
       scenario = rep(colnames(scenarioDriasFiles), 2))
104
```
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214

## Analyse des données climatiques des GCM/RCM

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

## Lecture des données climatiques

```{r}
# Load all climatic data scenarios
loadAllBasinsObs <- function(rcp, scenario) {
    message("Processing ", rcp, " scenario ", scenario, "...")
    file <- paste0(paste("BasinObs", rcp, scenario, sep = "_"), ".RDS")
    loadBasinsObs(file, cfg = cfg)
}
AllBasinsObs <- mapply(loadAllBasinsObs, 
                       rcp = rcpsX,
                       scenario = scenariosX, 
                       SIMPLIFY = FALSE)
names(AllBasinsObs) <- paste(rcpsX, scenariosX, sep = " - ")
```

```{r}
# arrange data by climat variable
formatObs <- function(BasinsObs, item) {
    cbind(DatesR = BasinsObs$DatesR, as.data.frame(BasinsObs[[item]]))
}

P_drias_BVI <- lapply(AllBasinsObs, formatObs, item = "P")
E_drias_BVI <- lapply(AllBasinsObs, formatObs, item = "E")
T_drias_BVI <- lapply(AllBasinsObs, formatObs, item = "Temp")
rm(AllBasinsObs)

```

```{r}
# Convert BVI to BV
data("griwrm")

P_drias <- lapply(P_drias_BVI, convertMeteoBVI2BV, griwrm = griwrm)
E_drias <- lapply(E_drias_BVI, convertMeteoBVI2BV, griwrm = griwrm)
T_drias <- lapply(T_drias_BVI, convertMeteoBVI2BV, griwrm = griwrm)

# Calcul pour tous les scénarios et périodes
calcPeriod <- function(period, df, calcFUN) {
    ind <- calcFUN(selectDriasPeriod(df, period))
    t(ind)
}
calcAll <- function(data, calcFUN, periods = names(cfg$hydroclim$drias$periods)) {
    names(periods) <- periods
    lapply(data, function(df) {
        lapply(as.list(periods), calcPeriod, df = df, calcFUN = calcFUN)
    })
}
P_drias_month <- calcAll(P_drias, calcMonthlyInterannualSum)
T_drias_month <- calcAll(T_drias, calcMonthlyInterannualMean)
E_drias_month <- calcAll(E_drias, calcMonthlyInterannualSum)
```

```{r}
# Calculs pour les données observées sur la période de référence
BasinsObs <- loadBasinsObs("BasinsObs_observations_day_1958-2019.RDS", cfg = cfg)
P_obs <- formatObs(BasinsObs, item = "P")
T_obs <- formatObs(BasinsObs, item = "Temp")
E_obs <- formatObs(BasinsObs, item = "E")
P_obs_month <- t(calcMonthlyInterannualSum(P_obs))
T_obs_month <- t(calcMonthlyInterannualMean(T_obs))
E_obs_month <- t(calcMonthlyInterannualSum(E_obs))
```

```{r, fig.cap="Précipitation moyenne mensuelle du bassin versant à Paris Austerlitz (H5920010) entre 1976 et 2005 pour le climat observé et 5 couples GCM/RCM (DRIAS 2020)"}
plot_monthly_mean("rcp4.5", "ref", "H5920010", P_drias_month, list(obs = P_obs_month), "Precipitation (mm)")
```

```{r, fig.cap="Température moyenne mensuelle du bassin versant à Paris Austerlitz (H5920010) entre 1976 et 2005 pour le climat observé et 5 couples GCM/RCM (DRIAS 2020)"}
plot_monthly_mean("rcp4.5", "ref", "H5920010", T_drias_month, list(obs = T_obs_month), "Temperature (°C)")
```

```{r, fig.cap="ETP moyenne mensuelle du bassin versant à Paris Austerlitz (H5920010) entre 1976 et 2005 pour le climat observé et 5 couples GCM/RCM (DRIAS 2020)"}
plot_monthly_mean("rcp4.5", "ref", "H5920010", E_drias_month, list(obs = E_obs_month), "PE (mm)")
```

```{r, eval=cfg$data$write_results}
# Sauvegarde des données mensuelles dans le cloud
saveClimaticData <- function(obs, drias, path, name) {
    drias$obs <- list(ref = obs)
    lapply(names(drias), function(scenario) {
        lapply(names(drias[[scenario]]), function(period) {
            file <- paste0(name, "_monthly_",
                         gsub(" ", "", scenario),"_",
                         paste(lubridate::year(cfg$hydroclim$drias$periods[[period]]), collapse = "-"),
                         ".tsv")
            m <- drias[[scenario]][[period]]
            df <- cbind(Id = rownames(m), m)
                readr::write_tsv(as.data.frame(df),
                                 file.path(path, file))
        })
    })
}

path <- getDataPath(cfg$hydroclim$path, "Analyses")
saveClimaticData(P_obs_month, P_drias_month, path, "P")
saveClimaticData(T_obs_month, T_drias_month, path, "T")
saveClimaticData(E_obs_month, E_drias_month, path, "E")
```