Multi-model agreement
========================

Multi-model agreement performs a comparison of Climate Model Projections anomalies. This vignette aims to illustrate a step-by-step example of how to perform a Multi-model agreement assessment using s2dverification functionalities. The following example illustrates the case of summer projections temperature anomalies for four different models.

*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.*

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


- ŀibssl-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')
install_git('https://earth.bsc.es/gitlab/es/easyNCDF', branch = 'master')
```

Too functions should be load by running the following lines in R, until integrated into current version of s2dverification

```r
source('https://earth.bsc.es/gitlab/es/s2dverification/raw/develop-MagicWP5/R/AnoAgree.R')
source('https://earth.bsc.es/gitlab/es/s2dverification/raw/develop-Magic_WP6/R/WeightedMean.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)
```

### 2- Load files with the `Start ()` function included in the package StartR
The full description of `Start()` and examples of its use can be found here: https://earth.bsc.es/gitlab/es/startR.

This example will use data generated by an ESMValTool namelist. The four models compared are:


- CNRM-CM5 r1i1p1
- IPSL-CM5A-LR r2i1p1
- MIROC5r2i1p1
- MPI-ESM-LR r1i1p1


First is loaded the historical period to compute the mean for the periode 1961-1990.

```r
var0 <- 'tas'
model_names <- c('CNRM-CM5 r1i1p1', 'IPSL-CM5A-LR r2i1p1', 'MIROC5r2i1p1', 'MPI-ESM-LR r1i1p1')
climatology_filenames <- paste0("/home/Earth/ahunter/Magic/Magic_input/",
              c("tas_Amon_CNRM-CM5_historical_r1i1p1_195001-200512_remap.nc", 
                "tas_Amon_IPSL-CM5A-LR_historical_r2i1p1_185001-200512_remap.nc",
                "tas_Amon_MIROC5_historical_r1i1p1_185001-201212_remap.nc",
                "tas_Amon_MPI-ESM-LR_historical_r1i1p1_185001-200512_remap.nc"))
start_climatology <- '1961-01-01'
end_climatology <- '1990-12-31'
reference_data <- Start(model=climatology_filenames, 
                        var = var0, var_var = 'var_names',
                        time = values(list(as.POSIXct(start_climatology), 
                                           as.POSIXct(end_climatology))),
                        lat = 'all', lon = 'all', lon_var = 'lon',
                        return_vars = list(time = 'model', lon = 'model', lat = 'model'),
                        retrieve = TRUE)
                        
model_filenames <- paste0("/home/Earth/ahunter/Magic/Magic_input/",
              c("tas_Amon_CNRM-CM5_rcp85_r1i1p1_200601-205512_remap.nc",
                "tas_Amon_IPSL-CM5A-LR_rcp85_200601-230012_remap.nc",
                "tas_Amon_MIROC5_rcp85_r1i1p1_200601-210012_remap.nc",
                "tas_Amon_MPI-ESM-LR_rcp85_200601-210012_remap.nc"))
start_anomaly <- '2020-01-01'
end_anomaly <- '2050-12-31'
rcp_data <- Start(model = model_filenames,
                  var = var0, var_var = 'var_names',
                  time = values(list(as.POSIXct(start_anomaly), as.POSIXct(end_anomaly))),
                  lat = 'all', lon = 'all', 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, among others, four arrays with the 
requested monthly temperature data for each model. `summary()` function allows to check their content.


```r
> dim(reference_data)
model   var  time   lat   lon 
    4     1   360    96   192
> summary(reference_data)
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
  193.5   268.4   283.0   278.0   295.7   319.5
> dim(rcp_data)
model   var  time   lat   lon 
    4     1   373    96   192 
> summary(rcp_data)
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
  198.2   270.5   284.3   279.7   297.1   322.0   55296 
```

### 3- Multi-model agreement based on seasonal analysis
The multi-model agreement is a comparison based on seasonal anomalies, which are computed and saved by following these steps: 

- `Season()` function from s2dverification package returns the anual time series for the selected season by defining the parameters of initial month of the data (```rmonini = 1```), the first month of the season (```rmoninf = 6```) and the final month of the season (```rmonsup = 8```). The last two parameters, `moninf` and `monsup`, have their origin with respect to the first one `monini`. 

```r
monini <- 1
moninf <- 6
monsup <- 8
time_dim_ref <- which(names(dim(reference_data)) == "time"
reference_seasonal_mean <- Season(reference_data, posdim = time_dim_ref,
                            monini = monini, moninf = moninf, monsup = monsup)
time_dim_proj <- which(names(dim(rcp_data)) == "time"
proj_seasonal_mean <- Season(rcp_data, posdim = time_dim_proj, 
                            monini = monini, moninf = moninf, monsup = monsup)
```

In this exemple, the boreal summer is shown by computing Juny, July and August monthly mean. The function `Season()` returns a multidimensional array containing the sesaonl time series for each model.

```r
> dim(reference_seasonal_mean)
model   var  time   lat   lon 
    4     1    30    96   192 
> dim(proj_seasonal_mean)
model   var  time   lat   lon 
    4     1    31    96   192
```

- Now, the mean climatology value for each grid point and model can be computed by using the `Mean1Dim()` function belonging to the s2dverification package. Also a new dimension will be added by running the function `InsertDim()` in order to obtain the  same dimensions of the projections data. `InsertDim()` repeats the original data the required number of times.

```r
climatology <- Mean1Dim(reference_seasonal_mean, time_dim_ref) 
climatology <- InsertDim(climatology, posdim = time_dim_proj,
                          lendim = dim(proj_seasonal_mean)[time_dim_proj])

> dim(climatology)
model   var   lat   lon 
    4     1    96   192 
> dim(climatology)
model   var  time   lat   lon 
    4     1    31    96   192 
```
- The anomaly for each model is obtain by regular substraction.

```r
anomaly <- proj_seasonal_mean - climatology

> dim(anomaly)
model   var  time   lat   lon 
    4     1    31    96   192 
```

- In order to save this data some characteristics should be defined. A folder will be created in your R working directory. The ncdf file containing the data will be saved on it.


```r
plot_dir <- "./plots_anomaly_agreement_main"
dir.create(plot_dir, recursive = TRUE)
time <- seq(as.numeric(substr(start_anomaly,1,4)), as.numeric(substr(end_anomaly,1,4)), by = 1)
month <- moninf
if (month <= 9) {
  month <- paste0(as.character(0), as.character(month))
}
month <- paste0("-", month, "-")
day <- "01"
time <- as.POSIXct(paste0(time, month, day), tz = "CET")
time <- julian(time, origin = as.POSIXct("1970-01-01"))
attributes(time) <- NULL
dim(time) <- c(time = length(time))
metadata <- list(time = list(standard_name = 'time', long_name = 'time', 
                units = 'days since 1970-01-01 00:00:00', prec = 'double', 
                dim = list(list(name='time', unlim = FALSE))))
attr(time, "variables") <- metadata

units <- attr(reference_data, 'Variables')$common[[var0]]$units
lat <- attr(reference_data, "Variables")$dat1$lat
lon <- attr(reference_data, "Variables")$dat1$lon
months <- paste0(month.abb[moninf],"-", month.abb[monsup])
attributes(lon) <- NULL
attributes(lat) <- NULL
dim(lon) <-  c(lon = length(lon))
dim(lat) <- c(lat = length(lat))
for (mod in 1 : dim(anomaly)[which(names(dim(anomaly)) == "model")]) {
  data <- anomaly[mod,1, , ,]
  data <- aperm(data, c(2,3,1))
  names(dim(data)) <- c("lat", "lon", "time")
  metadata <- list(variable = list(dim = list(list(name='time', unlim = FALSE))))
  attr(data, 'variables') <- metadata
  variable_list <- list(variable = data, lat = lat, lon = lon, time = time)
  names(variable_list)[1] <- var0
  ArrayToNetCDF(variable_list,
              paste0(plot_dir, "/", var0, "_",months, "_multimodel-anomaly_", model_names,"_",
              start_anomaly, "_", end_anomaly,"_", start_climatology, "_", end_climatology,
              ".nc"))
}
```
The next ncdf files will contain the anomaly data for each model:


- tas_Jun-Aug_anomaly_CNRM-CM5 r1i1p1_2020-01-01_2050-12-31_1961-01-01_1990-12-31.nc
- tas_Jun-Aug_anomaly_IPSL-CM5A-LR r2i1p1_2020-01-01_2050-12-31_1961-01-01_1990-12-31.nc
- tas_Jun-Aug_anomaly_MIROC5r2i1p1_2020-01-01_2050-12-31_1961-01-01_1990-12-31.nc
- tas_Jun-Aug_anomaly_MPI-ESM-LR r1i1p1_2020-01-01_2050-12-31_1961-01-01_1990-12-31.nc


### 4- Multi-model agreement visualitzation

Considering the time average anomalies for all models (which will be saved in `average` object), `AnoAgree()` function calculates the percentages of models which agrees with a positive or negative mean in each grid point. 

```r
average <- Mean1Dim(anomaly,  which(names(dim(anomaly)) == "time"))
agreement <- AnoAgree(average, members_dim = which(names(dim(average)) == "model"))

> dim(average)
model   var   lat   lon 
    4     1    96   192
> dim(agreement)
[1]   1  96 192
``` 

So, in a four models comparison case, the `agreement` object can take the next values: 100 (all models agree), 75 (only one model has oposite sign), 50 (only two models agree with the mean signal) and 25 (one model agree with the sign of the mean signal because its magnitude is higher that the other three models) per cent. This values will change with the number of compared models

The next question will be answering by the example plot: Where do 80 % or more models agree in the signal? To obtain this plot the next lines should be running in R. Notice you can modify the threshold by modifying the parameter `agreement_threshold`. The colour map shows the mean temperature anomaly and the dots the model agreement. The plot will be saved in the directory previously created with the name:

- Jun-Augtasanomaly(2050-2020)-(1990-1961).png

```r
agreement_threshold <- 80
colorbar_lim <- ceiling(max(abs(max(average)),abs(min(average))))
brks <- seq(-colorbar_lim, colorbar_lim, length.out = 11)
title <- paste0(months, " ", var0, " anomaly (", substr(end_anomaly, 1, 4), "-",
                substr(start_anomaly, 1, 4), ") - (", substr(end_climatology, 1, 4), "-",
                substr(start_climatology, 1, 4), ")")
             
PlotEquiMap(drop(Mean1Dim(average, which(names(dim(average)) == "model"))), lat = lat, lon = lon,
            units =units, brks=brks, toptitle = title, filled.continents = FALSE,
            dots = drop(agreement) >= agreement_threshold, fileout = paste0(plot_dir, "/",
            paste0(unlist(strsplit(c(title), " ")), collapse=""), ".png"))
```

<img src="Jun-Augtasanomaly(2050-2020)-(1990-1961).png" />


Or selecting a region in the Euro-Atlantic domain [40ºW-45ºE; 20-60ºN]. (EuroAtl_Jun-Augtasanomaly(2050-2020)-(1990-1961).png)

```r
title <- paste0("EuroAtl_", months, " ", var0, " anomaly (", substr(end_anomaly, 1, 4), "-",
                substr(start_anomaly, 1, 4), ") - (", substr(end_climatology, 1, 4), "-",
                substr(start_climatology, 1, 4), ")")
PlotEquiMap(drop(Mean1Dim(average, which(names(dim(average))=="model")))[60:81,c(1:25,172:192)],
            lat = lat[60:81], lon = lon[c(1:25,172:192)], units =units, brks=brks, 
            toptitle = title, filled.continents = FALSE, title_scale=0.7,
            dots = drop(agreement)[60:81,c(1:25,172:192)] >= agreement_threshold, 
            fileout = paste0(plot_dir, "/", paste0(unlist(strsplit(title, " ")), collapse=""),
            ".png"))
```

<img src="EuroAtl_Jun-Augtasanomaly(2050-2020)-(1990-1961).png" />


To visualize the time evolution of models agreement, the spatial average is performed by a grid pixel size weithed mean. `Smoothing()` returns the smoothed time series for a 5 years moving window.

```r
temporal <- drop(WeightedMean(anomaly, lon = lon, lat = lat, mask = NULL))
time_dim <- which(dim(temporal)==length(time))
temporal <- Smoothing(temporal, runmeanlen = 5, numdimt = time_dim)
```

Before visualizing, a data frame with the proper format is created. A new png file will be saved on the folder with the name:

- Shadow_Area-averaged tas_Jun-Aug_multimodel-anomaly_CNRM-CM5r1i1p1_IPSL-CM5A-LRr2i1p1_MIROC5r2i1p1_MPI-ESM-LRr1i1p1_2020-01-01_2050-12-31_1961-01-01_1990-12-31.png


```r
data_frame <- as.data.frame.table(t(temporal))
years <- rep(substr(start_anomaly,1,4) : substr(end_anomaly,1,4),4)
data_frame$Year <- c(years)
names(data_frame)[2] <- "Model"
for (i in 1 : length(levels(data_frame$Model))) {
  levels(data_frame$Model)[i] <- model_names[i]
}

g <- ggplot(data_frame, aes(x = Year, y = Freq)) + theme_bw() + ylab(paste0("Anomaly (", units,
            ")")) +  xlab("Year") + theme(text=element_text(size = 12),
            legend.text=element_text(size = 12), axis.title=element_text(size = 12)) +
            stat_summary(data =  data_frame, fun.y= "mean", mapping = aes(x = data_frame$Year, 
            y = data_frame$Freq, group = interaction(data_frame[2,3]), color = data_frame$Model),
            geom = "line", size = 0.8) + stat_summary(data =  data_frame, geom = "ribbon",
            fun.ymin = "min", fun.ymax = "max", mapping = aes(x = data_frame$Year, 
            y = data_frame$Freq, group = interaction(data_frame[2,3])), alpha = 0.3, 
            color = "red", fill = "red") +
     ggtitle(paste0(months, " ", var0, " anomaly (", start_anomaly, "-", end_anomaly,") - ", "(",
     start_climatology, "-", end_climatology,")"))

ggsave(filename = paste0(plot_dir, "/", "Shadow_Area-averaged_", var0, "_",months,
      "_multimodel-anomaly_", paste0(unlist(lapply(strsplit(model_names, " "), paste0,
      collapse="")), collapse="_"),"_", start_anomaly, "_", end_anomaly,"_", start_climatology,
      "_", end_climatology, ".png"), g, device = NULL, width=8, height=5, units='in',dpi=100) 
```

<img src="Shadow_Area-averaged_tas_Jun-Aug_multimodel-anomaly_CNRM-CM5r1i1p1_IPSL-CM5A-LRr2i1p1_MIROC5r2i1p1_MPI-ESM-LRr1i1p1_2020-01-01_2050-12-31_1961-01-01_1990-12-31.png" />


As this case only contains four different models, it could be interesting a individual visualitzation. And the name of the new png file will be:

- Individual_Area-averaged_tas_Jun-Aug_multimodel-anomaly_CNRM-CM5r1i1p1_IPSL-CM5A-LRr2i1p1_MIROC5r2i1p1_MPI-ESM-LRr1i1p1_2020-01-01_2050-12-31_1961-01-01_1990-12-31.png


```r
g <- ggplot(data_frame, aes(x = Year, y = Freq, color = Model)) + theme_bw() + geom_line() +
            ylab(paste0("Anomaly (", units, ")")) +  xlab("Year")
ggsave(filename = paste0(plot_dir, "/", "Individual_Area-averaged_", var0, "_",months,
      "_multimodel-anomaly_", paste0(unlist(lapply(strsplit(model_names, " "), paste0,
      collapse="")), collapse="_"),"_", start_anomaly, "_", end_anomaly,"_", start_climatology,
      "_", end_climatology, ".png"), g, device = "png", width=8, height=5, units='in', dpi = 100)
``` 


<img src="Individual_Area-averaged_tas_Jun-Aug_multimodel-anomaly_CNRM-CM5r1i1p1_IPSL-CM5A-LRr2i1p1_MIROC5r2i1p1_MPI-ESM-LRr1i1p1_2020-01-01_2050-12-31_1961-01-01_1990-12-31.png" />


