Insurance Risk Indices are an ensemble of indices relevant for insurance industry. These indices are based on Expert Team on Climate Change Detection Indices (ETCCDI). There are currently 5 available indices to compute for extreme: heat (tx90p), cold (tn10p), wind (wx), drought (ccd) and flooding (rx5day). The individual indices can be combined into a single index with or without weighting for each component. This combined index is roughly analogous to the Actuaris Climate Risk Index.
Note: This vignette has been writen to process and plot the output of an ESMValTool namelist configured with a specific set of parameters. If you wish to run and plot the outputs for another set of parameters, you need to re-run the corresponding namelist with the desired parameters, interpolate the output NetCDF files to a common grid, and modify the vignette code accordingly.
The following exemple will compute the 5 different indices in the North Atlantic - European Sector [60ºW-40ºE; 30ºN-70ºN] using the CMIP5 projection for the 8.5 scenario.
This example requires the following system libraries:
You will need to install specific versions of certain R packages as follows:
library(devtools)
install_git('https://earth.bsc.es/gitlab/es/startR', branch = 'develop-hotfixes-0.0.2')
Four functions should be load by running the following lines in R, until integrated into current version of s2dverification
source('https://earth.bsc.es/gitlab/es/s2dverification/raw/develop-Climdex/R/Climdex.R')
source('https://earth.bsc.es/gitlab/es/s2dverification/raw/develop-Climdex/R/Threshold.R')
source('https://earth.bsc.es/gitlab/es/s2dverification/raw/develop-Magic/vignettes/risk_index/DailyAnomaly.R')
source('https://earth.bsc.es/gitlab/es/s2dverification/raw/develop-Magic_WP6/R/WeightedMean.R')
source("https://earth.bsc.es/gitlab/es/s2dverification/raw/develop-Magic_WP6/R/CombineIndices.R")
All the other R packages involved can be installed directly from CRAN and loaded as follows:
library(s2dverification)
library(startR)
library(multiApply)
library(ggplot2)
library(climdex.pcic)
library(parallel)
The Extreme Heat Index (tx90p) is defined as the percentage of days when maximum temperature exceed the 90th percentile.
In order to evaluate the future projections, it is necessary to compute the index climatology during a reference historical period. In this example, the period 1971⨪2000 has been selected. The next steps should be followed:
Start()
. The full description and examples of its use can be found here: https://earth.bsc.es/gitlab/es/startR. The object returned by Start
will have at least one time and two spatial dimensions.var0 <- 'tasmax'
start_climatology <- '1971-01-01'
end_climatology <- '2000-12-31'
lat.min <- 30; lat.max <- 70
lon.min <- -60; lon.max <- 40
climatology_filenames <- paste0("/esarchive/scratch/pbretonn/cmip5-cp4cds/historical/day/tasmax/",
"tasmax_day_IPSL-CM5A-LR_historical_r1i1p1_19500101-20051231.nc")
reference_data <- Start(model = climatology_filenames, var = var0, var_var = 'var_names',
time = values(list(as.POSIXct(start_climatology), as.POSIXct(end_climatology))),
lat = values(list(lat.min, lat.max)), lon = values(list(lon.min, lon.max)),
lon_var = 'lon', lon_reorder = CircularSort(0, 360), return_vars = list(time = 'model',
lon = 'model', lat = 'model'), retrieve = TRUE)
metadata <- attributes(reference_data)
> dim(reference_data)
model var time lat lon
1 1 10957 21 28
dailyAno
function. Finally, the names of the dimensions are restablished.dates <- attributes(reference_data)$Variables$dat1$time
dates <- as.PCICt(dates, cal = attributes(dates)$variables$time$calendar, format = "%Y%m%d")
jdays <- as.numeric(strftime(dates, format = "%j"))
anomaly_data <- Apply(list(reference_data), target_dims = which(names(dim(reference_data)) == "time"),
AtomicFun = "dailyAno", jdays = jdays, ncores = 4)$output1
names(dim(anomaly_data))[1] <- "time"
Trend
function. In order to remove the trend from the reference_data
, the correction is calculated by substracting the detrended_data
to the anomaly_data
. Again, the original dimensional information is restored.detrended_data <- Trend(anomaly_data, posTR = which(names(dim(anomaly_data)) == "time"))
diff <- anomaly_data - detrended_data$detrended
diff <- aperm(diff, c(2,3,1,4,5))
detrended_data <- reference_data - diff
attributes(detrended_data) <- metadata
quantile <- 0.9
base_range <- as.numeric(c(substr(start_climatology, 1, 4), substr(end_climatology, 1, 4)))
thresholds <- Threshold(detrended_data, base_range = as.numeric(base_range),
qtiles = quantile, ncores = detectCores() -1)
thresholds_heat <- thresholds
> dim(thresholds)
jdays model var lat lon
365 1 1 21 28
Climdex()
function will return the extreme heat index during the reference periode.base_index <- Climdex(data = detrended_data, metric = 'tx90p', quantiles = thresholds,
ncores = detectCores() - 1)
The output of ´Climdex´ function will be a ´list()´ object. In the ´base_index$result´ label will be save the index values.
> str(base_index)
List of 2
$ result: num [1:30, 1, 1, 1:21, 1:28] 8.22 12.33 4.38 8.49 9.59 ...
$ years : chr [1:30] "1971" "1972" "1973" "1974" ...
> dim(base_index$result)
year model var lat lon
30 1 1 21 28
base_sd <- Apply(list(base_index$result), target_dims = list(c(1)), AtomicFun = "sd")$output1
base_heat_sd <- base_sd
The Extreme Heat Index is computing for the period 2020⨪2040 by following the next steps:
Start()
function.start_model <- '2020-01-01'
end_model <- '2040-12-31'
model_filenames <- paste0("/esarchive/scratch/pbretonn/cmip5-cp4cds/rcp85/day/tasmax/",
"tasmax_day_IPSL-CM5A-LR_rcp85_r1i1p1_20060101-22051231.nc")
rcp_data <- Start(model = model_filenames, var = var0, var_var = 'var_names',
time = values(list(as.POSIXct(start_model), as.POSIXct(end_model))),
lat = values(list(lat.min, lat.max)), lon = values(list(lon.min, lon.max)),
lon_var = 'lon', lon_reorder = CircularSort(0, 360),
return_vars = list(time = 'model', lon = 'model', lat = 'model'),
retrieve = TRUE)
The object returned by Start()
contains the requested daily maximum temperature data for each gridpoint. summary()
function allows to check their content.
> dim(rcp_data)
model var time lat lon
1 1 7671 21 28
> summary(rcp_data)
Min. 1st Qu. Median Mean 3rd Qu. Max.
221.6 276.7 283.6 283.4 291.2 321.1
projection_index <- Climdex(data = rcp_data, metric = 'tx90p', quantiles = thresholds,
ncores = detectCores() - 1)
base_mean <- 10
base_sd <- InsertDim(base_sd, 1, dim(projection_index$result)[1])
HeatExtremeIndex <- (projection_index$result - base_mean) / base_sd
A Map of the mean index values during the examined period 2020-2040 is obtained and save in PNG format in the working directory with the name: “tx90p_IPSL-CMIP5_85rpc_2020-01-01_2040-12-31.png”
lat <- attr(rcp_data, "Variables")$dat1$lat
lon <- attr(rcp_data, "Variables")$dat1$lon
title <- paste0("Index for tx90p ", substr(start_model, 1, 4), "-",
substr(end_model, 1, 4), " 85rcp CMIP5-IPSL")
breaks <- -8 : 8
PlotEquiMap(Mean1Dim(HeatExtremeIndex, which(names(dim(HeatExtremeIndex)) == "year")), lon = lon,
lat = lat, filled.continents = FALSE, toptitle = title, brks=breaks,
fileout = paste0('tx90p_IPSL-CMIP5_85rpc_', start_model, "_", end_model, ".png"))
The inland average of the Extreme Heat Index can be computed to plot its time evolution using WeigthedMean
function. Smoothing()
returns the smoothed time series for a 3 years moving window which can be modify using runmeanlen
parameter.
masc <- Start(model = '/esarchive/exp/ipsl-cm5a-lr/cmip5-rcp85_i1p1/constant/r0i0p0/fx/sftlf/sftlf.nc',
var = 'sftlf', var_var = 'var_names', lat = values(list(lat.min, lat.max)),
lon = values(list(lon.min, lon.max)), lon_reorder = CircularSort(0,360),
return_vars = list(lon = 'model', lat = 'model'), retrieve = TRUE)
temporal <- WeightedMean(HeatExtremeIndex, lon = lon, lat = lat, mask = drop(masc))
temporal_3ysmooth <- Smoothing(temporal, runmeanlen = 3, numdimt = 1)
The next code should be runned to plot and save the original average and the 3 year smoothed data.
png("Temporal_Inland_ExtremeHeatIndex_IPSL-CMIP5_85rcp_2020-2040.png", width = 8, height = 5, units = 'in',
res = 100, type = "cairo")
plot(substr(start_model, 1, 4):substr(end_model, 1, 4), temporal, type = "l", lty = 5, lwd = 2, bty = 'n',
xlab = "Time (years)", ylab = "Extreme Heat Index", main = "Inland average Extreme Heat Index")
lines(substr(start_model, 1, 4):substr(end_model, 1, 4), temporal_3ysmooth, col = "darkgreen", lwd = 2)
legend('bottomright', c('Anual', '3 years smooth'), col = c(1, 'darkgreen'), lty = c(5, 1), lwd = 2, bty = 'n')
dev.off()
The Extreme Cold Index (tn10p) is defined as the percentage of days when minimum temperature falls behind the 10th percentile. The procedure will be equivalent at the previous Extreme Heat Index example.
var0 <- 'tasmin'
climatology_filenames <- paste0("/esarchive/scratch/pbretonn/cmip5-cp4cds/historical/day/tasmin/",
"tasmin_day_IPSL-CM5A-LR_historical_r1i1p1_19500101-20051231.nc")
reference_data <- Start(model = climatology_filenames, var = var0, var_var = 'var_names',
time = values(list(as.POSIXct(start_climatology), as.POSIXct(end_climatology))),
lat = values(list(lat.min, lat.max)), lon = values(list(lon.min, lon.max)),
lon_var = 'lon', lon_reorder = CircularSort(0, 360),
return_vars = list(time = 'model', lon = 'model', lat = 'model'), retrieve = TRUE)
metadata <- attributes(reference_data)
dates <- attributes(reference_data)$Variables$dat1$time
dates <- as.PCICt(dates, cal = attributes(dates)$variables$time$calendar, format = "%Y%m%d")
jdays <- as.numeric(strftime(dates, format = "%j"))
anomaly_data <- Apply(list(reference_data), target_dims = which(names(dim(reference_data)) == "time"),
AtomicFun = "dailyAno", jdays = jdays, ncores = 4)$output1
names(dim(anomaly_data))[1] <- "time"
detrended_data <- Trend(anomaly_data, posTR = which(names(dim(anomaly_data)) == "time"))
diff <- anomaly_data - detrended_data$detrended
diff <- aperm(diff, c(2,3,1,4,5))
detrended_data <- reference_data - diff
attributes(detrended_data) <- metadata
quantile <- 0.1
base_range <- as.numeric(c(substr(start_climatology, 1, 4), substr(end_climatology, 1, 4)))
thresholds <- Threshold(detrended_data, base_range = as.numeric(base_range), qtiles = quantile,
ncores = detectCores() -1)
base_index <- Climdex(data = detrended_data, metric = 'tx10p', quantiles = thresholds,
ncores = detectCores() - 1)
base_sd <- Apply(list(base_index$result), target_dims = list(c(1)), AtomicFun = "sd")$output1
The Extreme Cold Index is computing for the period 2020⨪2040 by following the next steps:
Start()
function.model_filenames <- paste0("/esarchive/scratch/pbretonn/cmip5-cp4cds/rcp85/day/tasmin/",
"tasmin_day_IPSL-CM5A-LR_rcp85_r1i1p1_20060101-22051231.nc")
rcp_data <- Start(model = model_filenames, var = var0, var_var = 'var_names',
time = values(list(as.POSIXct(start_model), as.POSIXct(end_model))),
lat = values(list(lat.min, lat.max)), lon = values(list(lon.min, lon.max)),
lon_var = 'lon', lon_reorder = CircularSort(0, 360), return_vars = list(time = 'model',
lon = 'model', lat = 'model'), retrieve = TRUE)
projection_index <- Climdex(data = rcp_data, metric = 'tx10p', quantiles = thresholds,
ncores = detectCores() - 1)
base_mean <- 10
base_sd <- InsertDim(base_sd, 1, dim(projection_index$result)[1])
ColdExtremIndex <- (projection_index$result - base_mean) / base_sd
title <- paste0("Index for tn10p ", substr(start_model, 1, 4), "-", substr(end_model, 1, 4),
" 85rcp CMIP5-IPSL")
breaks <- -8 : 8
PlotEquiMap(Mean1Dim(ColdExtremeIndex, which(names(dim(ColdExtremeIndex)) == "year")), lon = lon, lat = lat,
filled.continents = FALSE, toptitle = title, brks=breaks,
fileout = paste0('tn10p_IPSL-CMIP5_85rpc_', start_model, "_", end_model, ".png"))
temporal <- WeightedMean(ColdExtremeIndex, lon = lon, lat = lat, mask = drop(masc))
temporal_3ysmooth <- Smoothing(temporal, runmeanlen = 3, numdimt = 1)
png("Temporal_Inland_ExtremeColdIndex_IPSL-CMIP5_85rcp_2020-2040.png", width = 8, height = 5, units= 'in',
res = 100, type = "cairo")
plot(substr(start_model, 1, 4):substr(end_model, 1, 4), temporal, type = "l", lty = 5, lwd = 2, bty = 'n',
xlab = "Time (years)", ylab = "Extreme Cold Index", main = "Inland average Extreme Cold Index")
lines(substr(start_model, 1, 4):substr(end_model, 1, 4), temporal_3ysmooth, col = "darkgreen",lwd = 2)
legend('bottomleft', c('Anual', '3 years smooth'), col= c(1, 'darkgreen'), lty = c(5, 1), lwd = 2,
bty = 'n')
dev.off()
The Extreme Wind Power Index (Wx) is defined as the percentage of days when wind power exceeds the 90th percentile being wind power proportional to the third power of wind speed. Then, the procedure will be equivalent at the previous examples.
var0 <- 'sfcWind'
climatology_filenames <- paste0("/esarchive/scratch/pbretonn/cmip5-cp4cds/historical/day/sfcWind/",
"sfcWind_day_IPSL-CM5A-LR_historical_r1i1p1_19500101-20051231.nc")
reference_data <- Start(model = climatology_filenames, var = var0, var_var = 'var_names',
time = values(list(as.POSIXct(start_climatology), as.POSIXct(end_climatology))),
lat = values(list(lat.min, lat.max)), lon = values(list(lon.min, lon.max)),
lon_var = 'lon', lon_reorder = CircularSort(0, 360),
return_vars = list(time = 'model', lon = 'model', lat = 'model'), retrieve = TRUE)
metadata <- attributes(reference_data)
reference_data <- 0.5 * 1.23 * (reference_data ** 3)
dates <- attributes(reference_data)$Variables$dat1$time
dates <- as.PCICt(dates, cal = attributes(dates)$variables$time$calendar, format = "%Y%m%d")
jdays <- as.numeric(strftime(dates, format = "%j"))
anomaly_data <- Apply(list(reference_data), target_dims = which(names(dim(reference_data)) == "time"),
AtomicFun = "dailyAno", jdays = jdays, ncores = 4)$output1
names(dim(anomaly_data))[1] <- "time"
detrended_data <- Trend(anomaly_data, posTR = which(names(dim(anomaly_data)) == "time"))
diff <- anomaly_data - detrended_data$detrended
diff <- aperm(diff, c(2,3,1,4,5))
detrended_data <- reference_data - diff
attributes(detrended_data) <- metadata
quantile <- 0.9
base_range <- as.numeric(c(substr(start_climatology, 1, 4), substr(end_climatology, 1, 4)))
thresholds <- Threshold(detrended_data, base_range = as.numeric(base_range), qtiles = quantile,
ncores = detectCores() -1)
base_index <- Climdex(data = detrended_data, metric = 'Wx', quantiles = thresholds,
ncores = detectCores() - 1)
base_sd <- Apply(list(base_index$result), target_dims = list(c(1)), AtomicFun = "sd")$output1
The Extreme Cold Index is computing for the period 2020⨪2040 by following the next steps:
model_filenames <- paste0("/esarchive/scratch/pbretonn/cmip5-cp4cds/rcp85/day/sfcWind/",
"sfcWind_day_IPSL-CM5A-LR_rcp85_r1i1p1_20060101-22051231.nc")
rcp_data <- Start(model = model_filenames, var = var0, var_var = 'var_names',
time = values(list(as.POSIXct(start_model), as.POSIXct(end_model))),
lat = values(list(lat.min, lat.max)), lon = values(list(lon.min, lon.max)),
lon_var = 'lon', lon_reorder = CircularSort(0, 360), return_vars = list(time = 'model',
lon = 'model', lat = 'model'), retrieve = TRUE)
rcp_data <- 0.5 * 1.23 * (rcp_data ** 3)
projection_index <- Climdex(data = rcp_data, metric = 'Wx', quantiles = thresholds,
ncores = detectCores() - 1)
base_mean <- 10
base_sd <- InsertDim(base_sd, 1, dim(projection_index$result)[1])
WindPowerExtremeIndex <- (projection_index$result - base_mean) / base_sd
title <- paste0("Index for Wx ", substr(start_model, 1, 4), "-", substr(end_model, 1, 4),
" 85rcp CMIP5-IPSL")
breaks <- -8 : 8
PlotEquiMap(Mean1Dim(WindPowerExtremeIndex, which(names(dim(WindPowerExtremeIndex)) == "year")), lon = lon,
lat = lat, filled.continents = FALSE, toptitle = title, brks=breaks,
fileout = paste0('wx_IPSL-CMIP5_85rpc_', start_model, "_", end_model, ".png"))
<img src="wx_IPSL-CMIP5_85rpc_2020-01-01_2040-12-31.png"/>
temporal <- WeightedMean(WindPowerExtremeIndex, lon = lon, lat = lat, mask = drop(masc))
temporal_3ysmooth <- Smoothing(temporal, runmeanlen = 3, numdimt = 1)
png("Temporal_Inland_ExtremeWindPowerIndex_IPSL-CMIP5_85rcp_2020-2040.png", width = 8, height = 5,
units= 'in', res = 100, type = "cairo")
plot(substr(start_model, 1, 4):substr(end_model, 1, 4), temporal, type = "l", lty = 5, lwd = 2, bty = 'n',
xlab = "Time (years)", ylab = "Extreme Wind Power Index",
main = "Inland average Extreme Wind Power Index")
lines(substr(start_model, 1, 4):substr(end_model, 1, 4), temporal_3ysmooth, col = "darkgreen",lwd = 2)
legend('bottomleft', c('Anual', '3 years smooth'), col= c(1, 'darkgreen'), lty = c(5, 1), lwd = 2,
bty = 'n')
dev.off()
img src=“Temporal_Inland_ExtremeWindPowerIndex_IPSL-CMIP5_85rcp_2020-2040.png” /
The Extreme Drought Index (cdd), which measures the maximum length of dry spell, is defined as the maximum number of consecutive days with daily precipitation amount lower than 1 mm. Then, the procedure will be equivalent at the previous examples.
var0 <- 'pr'
climatology_filenames <- paste0("/esarchive/scratch/pbretonn/cmip5-cp4cds/historical/day/pr/",
"pr_day_IPSL-CM5A-LR_historical_r1i1p1_19500101-20051231.nc")
reference_data <- Start(model = climatology_filenames, var = var0, var_var = 'var_names',
time = values(list(as.POSIXct(start_climatology), as.POSIXct(end_climatology))),
lat = values(list(lat.min, lat.max)), lon = values(list(lon.min, lon.max)),
lon_var = 'lon', lon_reorder = CircularSort(0, 360),
return_vars = list(time = 'model', lon = 'model', lat = 'model'), retrieve = TRUE)
metadata <- attributes(reference_data)
reference_data <- reference_data * 60 * 60 * 24
dates <- attributes(reference_data)$Variables$dat1$time
dates <- as.PCICt(dates, cal = attributes(dates)$variables$time$calendar, format = "%Y%m%d")
jdays <- as.numeric(strftime(dates, format = "%j"))
anomaly_data <- Apply(list(reference_data), target_dims = which(names(dim(reference_data)) == "time"),
AtomicFun = "dailyAno", jdays = jdays, ncores = 4)$output1
names(dim(anomaly_data))[1] <- "time"
detrended_data <- Trend(anomaly_data, posTR = which(names(dim(anomaly_data)) == "time"))
diff <- anomaly_data - detrended_data$detrended
diff <- aperm(diff, c(2,3,1,4,5))
detrended_data <- reference_data - diff
attributes(detrended_data) <- metadata
Note: This index doesn’t require to compute a threshold as Climdex
function integrates the threshold of precipitation amount lower than 1 mm internally. However, this case requires the calculation of the mean.
base_index <- Climdex(data = detrended_data, metric = 'cdd', ncores = detectCores() - 1)
base_mean <- Apply(list(base_index$result), target_dims = list(c(1)), AtomicFun = "mean")$output1
base_sd <- Apply(list(base_index$result), target_dims = list(c(1)), AtomicFun = "sd")$output1
The Extreme Drought Index is computing for the period 2020⨪2040 by following the next steps.
Start()
function and converting to mm:model_filenames <- paste0("/esarchive/scratch/pbretonn/cmip5-cp4cds/rcp85/day/pr/",
"pr_day_IPSL-CM5A-LR_rcp85_r1i1p1_20060101-22051231.nc")
rcp_data <- Start(model = model_filenames, var = var0, var_var = 'var_names',
time = values(list(as.POSIXct(start_model), as.POSIXct(end_model))),
lat = values(list(lat.min, lat.max)), lon = values(list(lon.min, lon.max)),
lon_var = 'lon', lon_reorder = CircularSort(0, 360),
return_vars = list(time = 'model', lon = 'model', lat = 'model'),
retrieve = TRUE)
rcp_data <- rcp_data * 60 * 60 * 24
projection_index <- Climdex(data = rcp_data, metric = 'cdd', ncores = detectCores() - 1)
base_mean <- InsertDim(base_mean, 1, dim(projection_index$result)[1])
base_sd <- InsertDim(base_sd, 1, dim(projection_index$result)[1])
DroughtExtremeIndex <- (projection_index$result - base_mean) / base_sd
title <- paste0("Index for cdd ", substr(start_model, 1, 4), "-", substr(end_model, 1, 4),
" 85rcp CMIP5-IPSL")
breaks <- -8 : 8
PlotEquiMap(Mean1Dim(DroughtExtremeIndex, which(names(dim(DroughtExtremeIndex)) = "year")), lon = lon,
lat = lat, filled.continents = FALSE, toptitle = title, brks=breaks,
fileout = paste0('cdd_IPSL-CMIP5_85rpc_', start_model, "_", end_model, ".png"))
<img src="cdd_IPSL-CMIP5_85rpc_2020-01-01_2040-12-31.png"/>
temporal <- WeightedMean(DroughtExtremeIndex, lon = lon, lat = lat, mask = drop(masc))
temporal_3ysmooth <- Smoothing(temporal, runmeanlen = 3, numdimt = 1)
png("Temporal_Inland_ExtremeDroughtIndex_IPSL-CMIP5_85rcp_2020-2040.png", width = 8, height = 5, units= 'in', res = 100, type = "cairo")
plot(substr(start_model, 1, 4):substr(end_model, 1, 4), temporal, type = "l", lty = 5, lwd = 2, bty = 'n',
xlab = "Time (years)", ylab = "Extreme Drought Index", main = "Inland average Extreme Drought Index")
lines(substr(start_model, 1, 4):substr(end_model, 1, 4), temporal_3ysmooth, col = "darkgreen",lwd = 2)
legend('bottomleft', c('Anual', '3 years smooth'), col= c(1, 'darkgreen'), lty = c(5, 1), lwd = 2,
bty = 'n')
dev.off()
<img src="Temporal_Inland_ExtremeDroughtIndex_IPSL-CMIP5_85rcp_2020-2040.png" />
The Extreme Flooding Index (rx5day) is defined as the maximum precipitation amount in 5 consecutive days.
var0 <- 'pr'
climatology_filenames <- paste0("/esarchive/scratch/pbretonn/cmip5-cp4cds/historical/day/pr/",
"pr_day_IPSL-CM5A-LR_historical_r1i1p1_19500101-20051231.nc")
reference_data <- Start(model = climatology_filenames, var = var0, var_var = 'var_names',
time = values(list(as.POSIXct(start_climatology), as.POSIXct(end_climatology))),
lat = values(list(lat.min, lat.max)), lon = values(list(lon.min, lon.max)),
lon_var = 'lon', lon_reorder = CircularSort(0, 360),
return_vars = list(time = 'model', lon = 'model',
lat = 'model'), retrieve = TRUE)
metadata <- attributes(reference_data)
reference_data <- reference_data * 60 * 60 * 24
dates <- attributes(reference_data)$Variables$dat1$time
dates <- as.PCICt(dates, cal = attributes(dates)$variables$time$calendar, format = "%Y%m%d")
jdays <- as.numeric(strftime(dates, format = "%j"))
anomaly_data <- Apply(list(reference_data), target_dims = which(names(dim(reference_data)) == "time"),
AtomicFun = "dailyAno", jdays = jdays, ncores = 4)$output1
names(dim(anomaly_data))[1] <- "time"
detrended_data <- Trend(anomaly_data, posTR = which(names(dim(anomaly_data)) == "time"))
diff <- anomaly_data - detrended_data$detrended
diff <- aperm(diff, c(2,3,1,4,5))
detrended_data <- reference_data - diff
attributes(detrended_data) <- metadata
base_index <- Climdex(data = detrended_data, metric = 'rx5day', ncores = detectCores() - 1)
base_mean <- Apply(list(base_index$result), target_dims = list(c(1)), AtomicFun = "mean")$output1
base_sd <- Apply(list(base_index$result), target_dims = list(c(1)), AtomicFun = "sd")$output1
The Extreme Flooding Index is computing for the period 2020-2040 by following the next steps.
Start()
function and converting to mm:model_filenames <- paste0("/esarchive/scratch/pbretonn/cmip5-cp4cds/rcp85/day/pr/",
"pr_day_IPSL-CM5A-LR_rcp85_r1i1p1_20060101-22051231.nc")
rcp_data <- Start(model = model_filenames, var = var0, var_var = 'var_names',
time = values(list(as.POSIXct(start_model), as.POSIXct(end_model))),
lat = values(list(lat.min, lat.max)), lon = values(list(lon.min, lon.max)),
lon_var = 'lon', lon_reorder = CircularSort(0, 360),
return_vars = list(time = 'model', lon = 'model', lat = 'model'), retrieve = TRUE)
rcp_data <- rcp_data * 60 * 60 * 24
projection_index <- Climdex(data = rcp_data, metric = 'rx5day', ncores = detectCores() - 1)
base_mean <- InsertDim(base_mean, 1, dim(projection_index$result)[1])
base_sd <- InsertDim(base_sd, 1, dim(projection_index$result)[1])
FloodingExtremeIndex <- (projection_index$result - base_mean) / base_sd
title <- paste0("Index for rx5day ", substr(start_model, 1, 4), "-", substr(end_model, 1, 4),
" 85rcp CMIP5-IPSL")
breaks <- -8 : 8
PlotEquiMap(Mean1Dim(FloodingExtremeIndex, which(names(dim(FloodingExtremeIndex)) == "year")), lon = lon,
lat = lat, filled.continents = FALSE, toptitle = title, brks=breaks,
fileout = paste0('rx5day_IPSL-CMIP5_85rpc_', start_model, "_", end_model, ".png"))
<img src="rx5day_IPSL-CMIP5_85rpc_2020-01-01_2040-12-31.png"/>
temporal <- WeightedMean(FloodingExtremeIndex, lon = lon, lat = lat, mask = drop(masc))
temporal_3ysmooth <- Smoothing(temporal, runmeanlen = 3, numdimt = 1)
png("Temporal_Inland_ExtremeFloodingIndex_IPSL-CMIP5_85rcp_2020-2040.png", width = 8, height = 5,
units= 'in', res = 100, type = "cairo")
plot(substr(start_model, 1, 4):substr(end_model, 1, 4), temporal, type = "l", lty = 5, lwd = 2, bty = 'n',
xlab = "Time (years)", ylab = "Extreme Flooding Index",
main = "Inland average Extreme Flooding Index")
lines(substr(start_model, 1, 4):substr(end_model, 1, 4), temporal_3ysmooth, col = "darkgreen",lwd = 2)
legend('bottomleft', c('Anual', '3 years smooth'), col= c(1, 'darkgreen'), lty = c(5, 1), lwd = 2,
bty = 'n')
dev.off()
<img src="Temporal_Inland_ExtremeFloodingIndex_IPSL-CMIP5_85rcp_2020-2040.png" />
HeatExtremeIndex = array(1:(234), dim=c(2,3,4)) ColdExtremeIndex = array(100:(100+234), dim=c(2,3,4)) WindPowerExtremeIndex = array(1000:(1000+234), dim=c(2,3,4)) DroughtExtremeIndex = array(10000:(10000+234), dim=c(2,3,4)) FloodingExtremeIndex = array(100000:(100000+234), dim=c(2,3,4))
Extreme Indices should be saved in the same list
object.
indices <- list()
indices[[1]] <- HeatExtremeIndex
indices[[2]] <- ColdExtremeIndex
indices[[3]] <- WindPowerExtremeIndex
indices[[4]] <- DroughtExtremeIndex
indices[[5]] <- FloodingExtremeIndex
names(dim(Indices))[1] <- 'index' ; names(dim(Indices))[-1] <- c('lon','lat','time')
If weights
parameter is defined as NULL
, all indices will be equally weighted if operation
parameter is set as mean
(by default). To define other weights
a vector of length equal to the number of considered indices (5 in this example) and with total sum equal to 1. To consider other settings visit: LINK????
aci <- CombineIndices(indices, weights = c(0.1,0,0.4,0,0.5))
A spatial visulitzation can be performs by executing:
title <- paste0("Combine Indices ", substr(start_model, 1, 4), "-", substr(end_model, 1, 4),
" 85rcp CMIP5-IPSL")
breaks <- -8 : 8
PlotEquiMap(Mean1Dim(FloodingExtremeIndex, which(names(dim(FloodingExtremeIndex)) == "year")), lon = lon,
lat = lat, filled.continents = FALSE, toptitle = title, brks=breaks,
fileout = paste0('rx5day_IPSL-CMIP5_85rpc_', start_model, "_", end_model, ".png"))
<img src="rx5day_IPSL-CMIP5_85rpc_2020-01-01_2040-12-31.png"/>
library(reshape) data_frame <- data.frame(aci = combined_area_average, cdd = area_mean[[1]], rx5day = area_mean[[2]], tx90p = area_mean[[3]], tx10p = area_mean[[4]], wx = area_mean[[5]], years = years)
xymelt <- melt(data_frame, id.vars = “years”)
years = as.numeric(start_model) : as.numeric(end_model) g <- ggplot(xymelt, aes(x = years, y = value, color = variable, linetype = variable, size = variable)) + theme_bw() + geom_line(aes(size = variable)) + ylab(“Component”) + xlab(“Year”) + theme(text=element_text(size = font_size),legend.text=element_text(size = font_size), axis.title=element_text(size = font_size)) + #scale_colour_manual(values=c(“red”, “black”, “black”, “black”, “black”, “black”)) + scale_size_manual(values = c(1, 0.5, 0.5, 0.5, 0.5, 0.5)) + ggtitle(paste0(“ACI components (”, model_name, " " ,rcp_scenario, " “, paste(weight_name, collapse = ‘’), “)”)) ggsave(filename = paste0(“aci”, “area_mean”,model_name,““, rcp_scenario,””, startdate, ““, enddate,””, paste(weight_name, collapse =’’),”.png“), g, device = NULL)
The next exemple compares the Extreme Heat Index for two different projections 8.5 and 2.6 scenarios for summer.
It’s necessary to reload the maximum temperature daily data during for historical simulations to select summer season:
Notice that other seasons can be selected by modifying the parameter seasons
in SeasonSelect()
function to boreal winter ('DJF'
), spring ('MMA'
) and autumn ('SON'
).
var0 <- 'tasmax'
climatology_filenames <- paste0("/esarchive/scratch/pbretonn/cmip5-cp4cds/historical/day/tasmax/",
"tasmax_day_IPSL-CM5A-LR_historical_r1i1p1_19500101-20051231.nc")
reference_data <- Start(model = climatology_filenames, var = var0, var_var = 'var_names',
time = values(list(as.POSIXct(start_climatology), as.POSIXct(end_climatology))),
lat = values(list(lat.min, lat.max)), lon = values(list(lon.min, lon.max)),
lon_var = 'lon', lon_reorder = CircularSort(0, 360),
return_vars = list(time = 'model', lon = 'model', lat = 'model'), retrieve = TRUE)
reference_data <- SeasonSelect(reference_data, seasons='JJA')
metadata <- attributes(reference_data)
To obtain the thresholds values and the standard deviation of the model during the reference period the same code as in paragraph 2.1 should be performed:
dates <- attributes(reference_data)$Variables$dat1$time
dates <- as.PCICt(dates, cal = attributes(dates)$variables$time$calendar, format = "%Y%m%d")
jdays <- as.numeric(strftime(dates, format = "%j"))
anomaly_data <- Apply(list(reference_data), target_dims = which(names(dim(reference_data)) == "time"),
AtomicFun = "dailyAno", jdays = jdays, ncores = 4)$output1
names(dim(anomaly_data))[1] <- "time"
detrended_data <- Trend(anomaly_data, posTR = which(names(dim(anomaly_data)) == "time"))
diff <- anomaly_data - detrended_data$detrended
diff <- aperm(diff, c(2,3,1,4,5))
detrended_data <- reference_data - diff
attributes(detrended_data) <- metadata
quantile <- 0.9
base_range <- as.numeric(c(substr(start_climatology, 1, 4), substr(end_climatology, 1, 4)))
thresholds <- Threshold(detrended_data, base_range = as.numeric(base_range),
qtiles = quantile, ncores = detectCores() -1)
base_index <- Climdex(data = detrended_data, metric = 'tx90p', quantiles = thresholds,
ncores = detectCores() - 1)
base_sd <- Apply(list(base_index$result), target_dims = list(c(1)), AtomicFun = "sd")$output1
base_heat_sd <- base_sd
The two projections are loaded by running:
model_filenames <- paste0("/esarchive/scratch/pbretonn/cmip5-cp4cds/",
c("rcp85/day/tasmax/tasmax_day_IPSL-CM5A-LR_rcp85_r1i1p1_20060101-22051231.nc",
"rcp26/day/tasmax/tasmax_day_IPSL-CM5A-LR_rcp26_r1i1p1_20060101-22051231.nc"))
rcp_data <- Start(model = model_filenames, var = var0, var_var = 'var_names',
time = values(list(as.POSIXct(start_model), as.POSIXct(end_model))),
lat = values(list(lat.min, lat.max)), lon = values(list(lon.min, lon.max)),
lon_var = 'lon', lon_reorder = CircularSort(0, 360),
return_vars = list(time = 'model', lon = 'model', lat = 'model'),
retrieve = TRUE)
The object returned by Start()
contains two models:
> dim(rcp_data)
model var time lat lon
2 1 7671 21 28
projection_index <- Climdex(data = rcp_data, metric = 'tx90p', quantiles = thresholds,
ncores = detectCores() - 1)
base_mean <- 10
base_sd <- InsertDim(base_sd, 1, dim(projection_index$result)[1])
HeatExtremeIndex <- (projection_index$result - base_mean) / base_sd
A Map of the mean index values during the examined period 2020-2040 is obtained and save in PNG format in the working directory with the name: “tx90p_IPSL-CMIP5_85rpc_2020-01-01_2040-12-31.png”
lat <- attr(rcp_data, "Variables")$dat1$lat
lon <- attr(rcp_data, "Variables")$dat1$lon
title <- paste0("Index for tx90p ", substr(start_model, 1, 4), "-",
substr(end_model, 1, 4), " 85rcp CMIP5-IPSL")
breaks <- -8 : 8
PlotEquiMap(Mean1Dim(HeatExtremeIndex, which(names(dim(HeatExtremeIndex)) == "year")), lon = lon,
lat = lat, filled.continents = FALSE, toptitle = title, brks=breaks,
fileout = paste0('tx90p_IPSL-CMIP5_85rpc_', start_model, "_", end_model, ".png"))
The inland average of the Extreme Heat Index can be computed to plot its time evolution using WeigthedMean
function. Smoothing()
returns the smoothed time series for a 3 years moving window which can be modify using runmeanlen
parameter.
masc <- Start(model = '/esarchive/exp/ipsl-cm5a-lr/cmip5-rcp85_i1p1/constant/r0i0p0/fx/sftlf/sftlf.nc',
var = 'sftlf', var_var = 'var_names', lat = values(list(lat.min, lat.max)),
lon = values(list(lon.min, lon.max)), lon_reorder = CircularSort(0,360),
return_vars = list(lon = 'model', lat = 'model'), retrieve = TRUE)
temporal <- WeightedMean(HeatExtremeIndex, lon = lon, lat = lat, mask = drop(masc))
temporal_3ysmooth <- Smoothing(temporal, runmeanlen = 3, numdimt = 1)
The next code should be runned to plot and save the original average and the 3 year smoothed data.
png("Temporal_Inland_ExtremeHeatIndex_IPSL-CMIP5_85rcp_2020-2040.png", width = 8, height = 5, units = 'in',
res = 100, type = "cairo")
plot(substr(start_model, 1, 4):substr(end_model, 1, 4), temporal, type = "l", lty = 5, lwd = 2, bty = 'n',
xlab = "Time (years)", ylab = "Extreme Heat Index", main = "Inland average Extreme Heat Index")
lines(substr(start_model, 1, 4):substr(end_model, 1, 4), temporal_3ysmooth, col = "darkgreen", lwd = 2)
legend('bottomright', c('Anual', '3 years smooth'), col = c(1, 'darkgreen'), lty = c(5, 1), lwd = 2, bty = 'n')
dev.off()