Heatwave and coldwave duration
==============================

Heatwave and coldwave duration is the total duration of "extreme spells"; the total number of days in a season where the temperature exceeds a threshold over a minimum number of consecutive days. Other tools for computing such events are also available, but the novelty of this tool is that the users can select their own thresholds (based on quantiles) and minimum duration for an event. The duration of heatwaves and coldwaves helps to understand potential changes in energy demand.

*Note: This vignette has been written 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 example will compute the heatwvaves and coldwaves duration in the North Atlantic - European Sector [20ºW-50ºE; 30ºN-80ºN] using the CMIP5 projection for the 8.5 scenario.

### 1- Load dependencies
This example requires the following system libraries:


- libssl-dev
- libnecdf-dev
- cdo


You will need to install specific versions of certain R packages as follows:
```r
library(devtools)
install_git('https://earth.bsc.es/gitlab/es/startR', branch = 'develop-hotfixes-0.0.2')
```

Six functions should be loaded by running the following lines in R, until integrated into the new magic.bsc package.

```r
source('https://earth.bsc.es/gitlab/nperez/magic.bsc/raw/develop-bugfixes-0.0.0/R/Climdex.R')
source('https://earth.bsc.es/gitlab/nperez/magic.bsc/raw/develop-bugfixes-0.0.0/R/Threshold.R')
source('https://earth.bsc.es/gitlab/nperez/magic.bsc/raw/develop-bugfixes-0.0.0/R/DailyAno.R')
source('https://earth.bsc.es/gitlab/nperez/magic.bsc/raw/develop-bugfixes-0.0.0/R/WeightedMean.R')
source('https://earth.bsc.es/gitlab/nperez/magic.bsc/raw/develop-bugfixes-0.0.0/R/CombineIndices.R')
source('https://earth.bsc.es/gitlab/nperez/magic.bsc/raw/develop-bugfixes-0.0.0/R/SeasonSelect.R')
```


All the other R packages involved can be installed directly from CRAN and loaded as follows:
```r
library(s2dverification)
library(startR)
library(multiApply)
library(ggplot2)
library(climdex.pcic)
library(parallel)
```

### 2- Heatwaves duration 

The Heatwaves duration is the number of consecutive days for which the maximum temperature is exceeding a threshold during summer. 


#### 2.1- Defining heatwaves threshold

In this example, the threshold is defined as the 90th percentile of maximum temprature during the period 1971-2000. 

The historical simulations for the CMIP5 model should be loaded by the function `Start` from `s2dverification` package:


```r
var0 <- 'tasmax'
start_climatology <- '1971-01-01'
end_climatology <- '2000-12-31'
lat.min <- 30;  lat.max <- 80
lon.min <- -20; lon.max <- 50
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)
```

The summer data can be picked by `SeasonSelect` function from the `magic.bsc` package.

```r
reference_data <- SeasonSelect(reference_data, seasons = 'JJA')
```

The 

```r
quantile <- 0.9
base_range <- as.numeric(c(substr(start_climatology, 1, 4), substr(end_climatology, 1, 4)))
thresholds <- Threshold(reference_data, base_range = as.numeric(base_range), 
                        qtiles = quantile, ncores = detectCores() -1)[152:243,,]
names(dim(thresholds)) <- c('jdays', 'lat', 'lon')                    
```

```r
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)

rcp_data <- SeasonSelect(rcp_data, seasons = 'JJA')
```


```r
jdays <- sort(rep(substr(start_model, 1, 4):substr(end_model, 1, 4), 92))
```

```r
.WaveLength <- function(x, threshold, min.conseq){
                    a <- which(x > threshold)
                    if (max(lengths(split(a, cumsum(c(TRUE, diff(a)!=1))))) < min.conseq) {a <- c()}
                    return(length(a))
}
WaveLength <- function(x, threshold, min.conseq = 5, indices){
                tapply(x, INDEX = indices, FUN = .WaveLength, threshold = threshold, min.conseq = min.conseq)
}

res <- Apply(list(rcp_data, thresholds), target_dims = list(c('time'), c('jdays')), AtomicFun = WaveLength, 
             min.conse = 5, indices = as.numeric(format(dates, "%Y")), output_dims = 'time')
```

```r
lat <- attr(rcp_data, "Variables")$dat1$lat
lon <- attr(rcp_data, "Variables")$dat1$lon
breaks <- seq(0,92,4)
png("Spatial_Heatwave_rcp85_2020-2040_90thpercentile_1971-2000.png", width = 8, height = 12, units = 'in', 
    res = 100, type = "cairo")
par(mfrow=c(4,1))
PlotEquiMap(apply(res$output1, c(2,3), max), lon = lon, lat = lat, brks = breaks, drawleg = FALSE, 
            filled.continents = FALSE, toptitle = c("Heatwave duration rcp 8.5 2020-2040","Maximum"), title_scale = 0.8,
            cols = heat.colors(length(breaks)-1)[(length(breaks)-1):1])
PlotEquiMap(apply(res$output1, c(2,3), mean), lon = lon, lat = lat, filled.continents = FALSE, brks = breaks, 
            drawleg = FALSE, toptitle = "Mean", title_scale = 0.8, 
            cols = heat.colors(length(breaks)-1)[(length(breaks)-1):1])
PlotEquiMap(apply(res$output1, c(2,3), min), lon = lon, lat = lat, filled.continents = FALSE, brks = breaks, 
            drawleg = FALSE, toptitle = "Minimum", title_scale = 0.8, 
            cols = heat.colors(length(breaks)-1)[(length(breaks)-1):1])
ColorBar(brks = breaks, vertical = FALSE, extra_margin = c(8,1.5,0.5,0.5), 
            cols = heat.colors(length(breaks)-1)[(length(breaks)-1):1])
dev.off()
```

<img src="Spatial_Heatwave_rcp85_2020-2040_90thpercentile_1971-2000.png" />




Apply(res$output1, target_dims = 'time', AtomicFun = ')
t <- Trend(res$output1, posTR = 1)
max(t$trend[2,,])
t$trend[2,,]

pos <- which(t$trend[2,,] == max(t$trend[2,,]), arr.ind = TRUE)

res$output1[,pos[1], pos[2]]
lat[pos[1]]
lon[pos[2]]

plot(2020:2040, res$output1[, pos[1], pos[2]], type="l", bty= 'n', xlim=c(2020,2040), lwd = 2, lty = 5, xlab = "Time (years)", ylab = "Number of days", main = paste("Time evolution of "))
lines(2020:2040, Smoothing(res$output1[, pos[1], pos[2]], runmeanlen = 3, numdimt = 1), col = 'darkgreen', lwd = 2)

y <- res$output1[,1,1]
x <- 1:21
lm(y ~ x)

t$trend[,1,1]


