import xarray as xr
import numpy as np
from pathlib import Path
import threading
import os
import json
import yaml

from scipy.stats import t

from pylab import cm
from matplotlib.colors import ListedColormap

import rpy2.robjects as ro
from rpy2.robjects.packages import importr
from rpy2.robjects import numpy2ri

importr('SpecsVerification')
importr('multiApply')
numpy2ri.activate()

#libraries for the Score Cards:
#importr('ncdf4') ## to load netCDF files
#importr('formattable') ## to plot horizontal color bars
#importr('kableExtra') ## to print data in formatted tables
##importr('magick') ## for saving as .png
#importr('stringr') ## for manipulating mayuscules in the figure title
#importr('s2dverification') ## for function ColorBar()
#importr('abind') ## for function abind()

class tools:
    
    def thread(self,
               target
              ):
        
        # This function allows threading. Used in the downloader requests
        
        TR = threading.Thread(target = target)
        TR.start()
        
        
    def check_files_dates(self,
                          folder_path,
                          months = [1, 12],
                          years = [1979, 2019],
                          filename_start = '2m_temperature-',
                          filename_end = '.nc',
                          filename_include = '',
                          verbose = False
                         ):
        
        #This function check that the files in folder_path include all the dates specified by months and years
        folder_path = Path(folder_path)
        
        files_missed = []
        files_ok = []
        ok = True
        for yy in range(years[0], years[1]+1):
            for mm in range(months[0], months[1]+1):
                filename_start_i = filename_start + '{}{:02d}01'.format(yy, mm)
                
                if filename_include:
                    filename_i = filename_start_i + '...' + filename_include + '...' + filename_end
                else:
                    filename_i = filename_start_i + filename_end
                    
                file = [f for f in os.listdir(folder_path) if f.endswith(filename_end) \
                                                           and f.startswith(filename_start_i) \
                                                           and (filename_include in f)]
                
                if len(file) > 1:
                    print('ERROR: More than 1 file found starting with {} and ending with {}.'.format(filename_start_i,
                                                                                                      filename_end))
                    break
                    
                elif not file:
                    files_missed.append(filename_i)
                    ok = False
                else:
                    file = file[0]
                    files_ok.append(folder_path.joinpath(file))
        
        if verbose:
            if ok:
                print('\nAll files located: {} / between years {} / between months {}.\n'.format(filename_start, years, months))
            else:
                print('\nSome files are missing:{}'.format(files_missed))
         
        
        return ok, files_ok, files_missed


    
 
    def corresponding_month(self,
                            start_month,
                            ileadtime,
                            start_year = None
                           ):
        
        # This function computes the corresponding month and year after adding any leadtime months to given start_month and
        # start_year
        
        month_leadtime = start_month + ileadtime
        if start_year is None:
            year_leadtime = None
            
        else:
            year_leadtime = start_year
            
        if month_leadtime > 12:
            month_leadtime = month_leadtime - 12
            if start_year is not None:
                year_leadtime = start_year + 1
                
        return month_leadtime, year_leadtime
        
    
    
    # Weighted average for online computation 
    def average_online(self,
                       xmean_i,
                       x_j,
                       n_ij
                      ):
        xmean_ij = xmean_i + (x_j - xmean_i) / n_ij
        
        return xmean_ij
    
    def cov(self, 
            data1,
            data2,
            dim = None
           ):
        """Compute covariance between two DataArray objects along a shared dimension.

        Parameters
        ----------
        other: DataArray
            The other array with which the covariance will be computed
        dim: The dimension along which the covariance will be computed

        Returns
        -------
        covariance: DataArray
        """
        #In case of no nan's, skip this part since it is slower
        if data1.isnull().sum() > 0 or data2.isnull().sum() > 0:
            
            # 1. Broadcast the two arrays. 
            data1, data2     = xr.broadcast(data1, data2)

            # 2. Ignore the nans. 
            # WARNING!!! NOT SURE IF THIS PROCEDURE IS COMPLETELY SUCCESFULL.
            valid_values    = data1.notnull() & data2.notnull()
            data1            = data1.where(valid_values, drop=True)
            data2           = data2.where(valid_values, drop=True)
            valid_count     = valid_values.sum(dim)
            
        else:
            valid_count = len(data1.coords[dim])            

        #3. Compute mean and standard deviation along the given dim
        demeaned_data1   = data1 - data1.mean(dim = dim)
        demeaned_data2  = data2 - data2.mean(dim = dim)
                
        #4. Compute  covariance along the given dim
        if dim:
            axis = data1.get_axis_num(dim = dim)
        else:
            axis = None
            
        covariance = np.sum(demeaned_data1*demeaned_data2, axis = axis)/(valid_count)

        return covariance

    def corr(self,
             data1,
             data2,
             dim = None
            ):
        """Compute correlation between two DataArray objects along a shared dimension.

        Parameters
        ----------
        other: DataArray
            The other array with which the correlation will be computed
        dim: The dimension along which the correlation will be computed

        Returns
        -------
        correlation: DataArray
        """
        n = len(data1.coords[dim])
        
        #In case of no nan's, skip this part since it is slower
        if data1.isnull().sum() > 0 or data2.isnull().sum() > 0:
            # 1. Broadcast the two arrays.

            data1, data2     = xr.broadcast(data1, data2)

            # 2. Ignore the nans
            # WARNING!!! NOT SURE IF THIS PROCEDURE IS COMPLETELY SUCCESFULL.
            valid_values    = data1.notnull() & data2.notnull()
            data1            = data1.where(valid_values, drop=True)
            data2           = data2.where(valid_values, drop=True)

        # 3. Compute correlation based on standard deviations and cov()
        data1_std        = data1.std(dim=dim)
        data2_std       = data2.std(dim=dim)
        
        #Pearson correlation coeficient
        correlation = self.cov(data1, data2, dim = dim)/(data1_std*data2_std)
        
        #t-score for the null hypothesis being no linear regression between data1 and data1 along dim
        tscore = correlation*np.sqrt(n - 2) / np.sqrt(1 - correlation**2)
        #p-value for the given t-score, i.e. the probability of the null hypothesis being true
        pval = xr.DataArray(t.sf(tscore, n - 2)*2, coords = tscore.coords)

        return correlation, pval
    
    
    
    def add_periods(self,
                    data,
                    periods = [[2,3,4], [4,5,6]],
                    leadtime_dimname = 'step'
                   ):
        #This function add leadtime periods as an average of specified leadtime months defined in periods
        
        Lpp = len(periods)
        leadtime_coords = data.coords[leadtime_dimname].values
        Lll = len(leadtime_coords)
        
        leadtime_periods_coords = [i for i in range(Lll + 1, Lll + Lpp + 1)]

        #Computing average field for each period
        d_pp = []
        for pp, ll in zip(periods, leadtime_periods_coords):
            d_i = data.sel({leadtime_dimname: pp}) \
                      .mean(leadtime_dimname) \
                      .assign_coords({leadtime_dimname: ll})
            
            d_pp.append(d_i)
        
        data_pp = xr.concat(d_pp, dim = leadtime_dimname)
        data = xr.concat([data, data_pp], dim = leadtime_dimname)
                    
        return data
    
    
    def frps(self,
             ens_terciles,
             obs_terciles,
             ncores
            ):
        
        R_frps = ro.r('''
            
            fun <- function(ens, obs, ncores) {
            
                   res <- Apply(list(ens, obs),
                                target_dims = list(c(1,2), c(1)),
                                EnsRps,
                                R.new = Inf,
                                ncores = ncores
                               )$output1
                               
                   return(res)
                }   
            ''')
        
        return np.array(R_frps(ens_terciles, obs_terciles, ncores))

    def rps(self,
             ens_terciles,
             obs_terciles,
             ncores
            ):
        
        R_rps = ro.r('''
            
            fun <- function(ens, obs, ncores) {
            
                   res <- Apply(list(ens, obs),
                                target_dims = list(c(1,2), c(1)),
                                EnsRps,
                                R.new = NA,
                                ncores = ncores
                               )$output1
                               
                   return(res)
                }   
            ''')
        
        return np.array(R_rps(ens_terciles, obs_terciles, ncores))
    
    def fcrps(self,
              ens,
              obs,
              ncores
             ):
    

        R_fcrps = ro.r('''

            fun <- function(ens, obs, ncores) {

                    res <- Apply(list( ens, obs),
                                 target_dims = list(c(1,2), c(1)),
                                 EnsCrps, 
                                 R.new=Inf, 
                                 ncores = ncores
                                )$output1

                    return(res)
                }   
            ''')
        
        return np.array(R_fcrps(ens, obs, ncores))

    def crps(self,
              ens,
              obs,
              ncores
             ):
    

        R_crps = ro.r('''

            fun <- function(ens, obs, ncores) {

                    res <- Apply(list( ens, obs),
                                 target_dims = list(c(1,2), c(1)),
                                 EnsCrps, 
                                 R.new=NA, 
                                 ncores = ncores
                                )$output1

                    return(res)
                }   
            ''')
        
        return np.array(R_crps(ens, obs, ncores))
                               
    def obs2ens_clim(self,
                     obs,
                     ncores
                    ):
                
        R_obs2ens_clim = ro.r('''

            fun <- function(obs, ncores) {

                   res = Apply(obs, 
                               target_dims=c(1),
                               ClimEns,
                               ncores = ncores
                              )$output1

                    return(res)
                }
            ''')
        
        return np.array(R_obs2ens_clim(obs, ncores))
    
    
    def skillscore(self,
                   score,
                   score_ref,
                   ncores = 10,
                   R = False
                  ):
    
        if R:
            R_skillscore = ro.r('''

                fun <- function(score, score_ref, ncores) {

                       res = Apply(list(score, score_ref),
                                target_dims=list(NULL, NULL),
                                SkillScore, 
                                ncores = ncores
                               )$output1

                       return(res)
                    }   
                ''')
            
            return np.array(R_skillscore(score, score_ref, ncores))
        
        else:
            return 1 - score/score_ref, None
        
    def scorecardfunction(self,
                            year0,
                            year1,
                            sc_centersystem, 
                            sc_centersystemname,
                            sc_units, 
                            sc_varname,
                            sc_varname_long,
                            sc_plevel,
                            sc_inputpath,
                            sc_outputpath,
                            sc_paramID,
                            sc_type):
        
        somefunctions = ro.r('''
            ## modified version of formattable::color_bar() to draw inside a table a colored column bar, also with negative values:
            color_bar_neg <- function(color1 = "lightgreen", color2 = "pink", ratio = 1, ...){
                formatter("span",
                    style = function(x) style(
                        display = "inline-block",
                        float = ifelse(x >= 0, "left", "right"),
                        "text-align" = ifelse(as.numeric(x) >= 0, "left", "right"),
                        "margin-left" = ifelse(as.numeric(x) >= 0, "50%", "0%"),
                        "margin-right" = ifelse(as.numeric(x) >= 0,"0%", "50%"),
                        "border-radius" = "4px",
                        "background-color" = ifelse(as.numeric(x) < 0, color1, color2),
                        width = ratio * percent(abs(as.numeric(x)), ...)))
            }

            ## as previous function, but for variables that only have positive values: 
            color_bar_pos <- function (color = "lightgray", fun = "proportion_score", score = NULL, ratio = 1, ...){
                fun <- match.fun(fun)
                formatter("span", style = function(x) style(display = "inline-block", float = "left", 
                direction = "rtl", "border-radius" = "4px", "padding-right" = "2px", "margin-left" = "25%", 
                "background-color" = csscolor(color), width = ratio * percent(fun(as.numeric(x), score))))
            }

            color_bar_RMSSS <- function (color1 = "violet", color2 = "lawngreen", ratio = 0.7, score = NULL, ...){
                formatter("span", style = function(x) style(display = "inline-block", float = "left", 
                direction = "rtl", "border-radius" = "4px", `padding-right` = "2px", "margin-left" = "25%", 
                "background-color" = ifelse(x < 1, color1, color2), width = ratio * percent(proportion_score(as.numeric(x), score))))
            }

            ## function to normalize width of the colored column bars in the figure:
            proportion_score <- function(x, score = NULL, na.rm = FALSE){
                x / max(abs(score), na.rm = na.rm)
            }

            ## modified version of formattable::color_bar() to draw in a table colored column bars, also with negative values
            ## it also normalize the values considering the max value of data in the "score" variable (usually shown in the other columns)
            color_bar_score <- function(color1 = "lightgreen", color2 = "pink", score = NULL, ratio = 1, ...){
                formatter("span",
                    style = function(x) style(
                        display = "inline-block",
                        float = ifelse(as.numeric(x) >= 0, "left", "right"),
                        "text-align" = ifelse(as.numeric(x) >= 0, "left", "right"),
                        "margin-left" = ifelse(as.numeric(x) >= 0, "50%", "0%"),
                        "margin-right" = ifelse(as.numeric(x) >= 0,"0%", "50%"),
                        "border-radius" = "4px",
                        "background-color" = ifelse(as.numeric(x) < 0, color1, color2),
                        width = ratio * percent(proportion_score(abs(as.numeric(x)), score), ...)))
            }
            ''')

            
        teleconnection_functions = ro.r('''
            REOF <- function(ano, lon, lat, ntrunc) {
                nlat <- length(lat)
                nlon <- length(lon)
                ntimes <- dim(ano)[1]

                if (is.null(ntrunc) || ntrunc %% 1!=0 || ntrunc <= 0) stop("Parameter 'ntrunc' must be an integer positive number greater than zero")
                if (ntrunc > min(ntimes, nlat * nlon)) stop(paste0("Parameter 'ntrunc' must be equal or smaller than ", min(ntimes,nlat*nlon)))

                ## Get the first ntrunc EOFs:
                eofs <- EOF(ano = ano, lon = lon, lat = lat, neofs = ntrunc)

                ## Recover loadings (with norm 1), weighting the EOFs by the weigths, then put them as a two-dimensional array
                Loadings <- eofs$EOFs * InsertDim(eofs$wght, 1, ntrunc)
                dim(Loadings) <- c(ntrunc, nlat * nlon)

                ## Rotate the loadings:
                varim <- varimax(t(Loadings))

                ## Weight back the rotated loadings (REOFs):
                REOFs <- varim$loadings
                dim(REOFs) <- c(nlat, nlon, ntrunc)
                REOFs <- REOFs / InsertDim(eofs$wght, 3, ntrunc)

                ## Reorder dimensions to match EOF conventions: (ntrunc,nlat,nlon)
                REOFs <- aperm(REOFs,c(3,1,2))

                ## Compute the rotated PCs (RPCs): just multiply the weigthed anomalies by the loading patterns.
                ano.wght <- ano * InsertDim(eofs$wght, 1, ntimes)
                dim(ano.wght) <- c(ntimes, nlat * nlon)
                RPCs <- ano.wght %*% varim$loadings

                ## Alternative methods suggested here:
                ## https://stats.stackexchange.com/questions/59213/how-to-compute-varimax-rotated-principal-components-in-r/137003#137003
                ## gives same results as pinv is just transpose in this case, as loadings are ortonormal!
                # invLoadings <- t(pracma::pinv(varim$loadings)) ## invert and traspose the rotated loadings. pinv uses a SVD again (!)
                # RPCs <- ano.wght %*% invLoadings

                ## Compute explained variance fraction:
                var <- apply(RPCs,2, function(x) { sum (x*x) } ) * 100 / eofs$tot_var
                dim(var) <- c(reofs = length(var))
                dim(RPCs) <- dim(eofs$PCs)
                names(dim(RPCs))[2] <- 'rpc'
                dim(REOFs) <- dim(eofs$EOFs)
                names(dim(REOFs))[1] <- 'reof'
                return(list(REOFs = REOFs, RPCs = RPCs, wght = eofs$wght, var = var))
            }

            CorrPatterns <- function(ano, lon, lat, PCs, nPCs = 4, nrow = NULL, ncol = NULL, show = FALSE, var = NULL){
                nlat <- length(lat)
                nlon <- length(lon)

                proj.cor <- array(NA, c(nPCs, nlat, nlon))

                ## Project the PCS:
                for(t in 1:nPCs) {
                    proj.cor[t, , ] <- apply(ano, c(2,3),
                    function(x) {
                        cor(x, PCs[,t], use = "na.or.complete")
                    }
                    )
                }

                if (show) {
                    brks.corr <- seq(-1, 1, 0.1)

                    ## plot title:
                    if(is.null(var)) plot.titles <- paste0("pattern #", 1:nPCs) else plot.titles <- paste0("pattern #", 1:nPCs, "  (", round(var[1:nPCs],1), "% tot.var)")

                    PlotLayout(PlotEquiMap, c(2,3), var=proj.cor, lat=lat, lon=lon,
                            filled.continents=FALSE, bar_scale=.5, brks=brks.corr,
                            nrow=nrow, ncol=ncol, titles=plot.titles)
                    invisible(proj.cor)
                } else {
                    proj.cor
                }
            }

            ProjectField2 <- function(ano, eof, mode = NULL) {
                # Checking ano
                if (!is.numeric(ano) || !is.array(ano)) {
                    stop("Parameter 'ano' must be a numeric array.")
                }

                # Checking eof
                print_error <- FALSE
                if (!is.list(eof)) {
                    print_error <- TRUE
                } else {
                    if ('EOFs' %in% names(eof)) {
                    EOFs <- "EOFs"
                    } else if ('REOFs' %in% names(eof)) {
                    EOFs <- "REOFs"
                    } else if ('patterns' %in% names(eof)) {
                    EOFs <- "patterns"
                    } else {
                    print_error <- TRUE
                    }
                    if (!'wght' %in% names(eof)) {
                    print_error <- TRUE
                    }
                }
                if (print_error) {
                    str(eof)
                    stop("Parameter 'eof' must be a list with the components 'EOFs' or 'REOFs' and 'wght' as output from EOF() or REOF().")
                }

                if (!is.numeric(eof[[EOFs]]) || !is.array(eof[[EOFs]])) {
                    stop("The component 'EOFs' of parameter 'eof' must be a numeric array.")
                }
                if (length(dim(eof[[EOFs]])) != 3) {
                    stop("The component 'EOFs' of parameter 'eof' must have dimensions c(neof, nlat, nlon).")
                }
                if (!is.numeric(eof$wght) || !is.array(eof$wght)) {
                    stop("The component 'wght' of parameter 'eof' must be a numeric array.")
                }
                if (length(dim(eof$wght)) != 2) {
                    stop("The component 'wght' of parameter 'eof' must have dimensions c(n. latitudes, n. longitudes).")
                }

                # Truncate eof to keep only selected modes
                # This is for compatibility with NAO function
                if (!is.null(mode)) {
                    eof[[EOFs]] <- Subset(eof[[EOFs]], 1, mode)
                }

                # Get ano and eof dimensions
                # moredims can be different lead times, ensemble members, models, whatever.
                nlon <- dim(ano)[length(dim(ano))]
                nlat <- dim(ano)[length(dim(ano))-1]
                neofs <- dim(eof[[EOFs]])[1]
                moredims <- dim(ano)[1:(length(dim(ano))-2)]
                nanom <- prod(moredims)

                # Security checks.
                if (dim(eof[[EOFs]])[2] != nlat || dim(eof$wght)[1] != nlat) {
                    stop("Inconsistent number of latitudes between parameter 'eof' and input field")
                }
                if (dim(eof[[EOFs]])[3] != nlon || dim(eof$wght)[2] != nlon) {
                    stop("Inconsistent number of longitudes between parameter 'eof' and input field")
                }

                # Multiply anomalies and EOFs by weights
                # Change dimensions of ano to (nanom,nlat,nlon), then multiply by weights
                dim(ano) <- c(nanom,nlat,nlon)
                ano.wght <- ano*InsertDim(eof$wght,1,nanom)
                dim(ano.wght) <- c(nanom,nlat*nlon)
                loadings <- eof[[EOFs]]*InsertDim(eof$wght,1,neofs)
                dim(loadings) <- c(neofs,nlat*nlon)

                # Matrix multiplication anomalies (anom,nlat*nlon) by loadings (nlat*nlon,neofs)
                # Result is then (anom,neofs)
                projection <- ano.wght %*% t(loadings)

                # Change back dimensions to feet original input
                dim(projection) <- c(moredims, pc = unname(neofs))
                return(projection)
            }

            # interpolates the values in grid2 on grid1 (of lower resolution than grid2) with the bilinear method
            bilinear <- function(lat1.list, lon1.list, lat2.list, lon2.list, grid2, world=TRUE){
                R <- 6371 # earth mean radius (km)
                Rx2 <- 2 * R

                n.lat1 <- length(lat1.list)
                n.lon1 <- length(lon1.list)
                n.lat2 <- length(lat2.list)
                n.lon2 <- length(lon2.list)
                n.points1 <- as.double(n.lat1 * n.lon1) # number of points of grid1
                n.points2 <- as.double(n.lat2 * n.lon2)
                n.points.tot <- n.points1 * n.points2
                n.layers <- dim(grid2)[1]

                nearest.lat <- array(NA, c(n.lat1,2))  # latitude of the two closer grid points
                nearest.lat.pos <- array(NA, c(n.lat1,2)) # position inside grid2 of the two closer points in the latitudinal sense

                for(l in 1:n.lat1){
                    pos.first <- which.min(abs(lat2.list - lat1.list[l]))
                    lat2.list.temp <- lat2.list
                    lat2.list.temp[pos.first] <- 10000000000
                    pos.second <- which.min(abs(lat2.list.temp-lat1.list[l]))
                    nearest.lat[l,1] <- lat2.list[pos.first]
                    nearest.lat[l,2] <- lat2.list[pos.second]
                    nearest.lat.pos[l,1] <- pos.first
                    nearest.lat.pos[l,2] <- pos.second
                }

                # correct longitude values if one of the two grids has positive longitude values only and the other also negative ones:
                if(length(which(lon1.list<0))>0 && length(which(lon2.list<0))==0) lon2.list[which(lon2.list>180)] <- lon2.list[which(lon2.list>180)] - 360
                if(length(which(lon1.list<0))==0 && length(which(lon2.list<0))<0) lon2.list[which(lon2.list<0)] <- lon2.list[which(lon2.list<0)] + 360

                nearest.lon <- array(NA, c(n.lon1, 2))  # longitude of the two closer grid points
                nearest.lon.pos <- array(NA, c(n.lon1,2)) # position inside grid2 of the two closer points in the longitudinal sense

                for(l in 1:n.lon1){
                    pos.first <- which.min(abs(lon2.list - lon1.list[l]))
                    lon2.list.temp <- lon2.list
                    lon2.list.temp[pos.first] <- 10000000000
                    pos.second <- which.min(abs(lon2.list.temp - lon1.list[l]))

                    if(world){
                        ## points of grid1 to the left of all points of grid2 are also associated to the rightmost points of grid2 because earth is flat:
                        if(lon1.list[l] < lon2.list[pos.first] && lon1.list[l] < lon2.list[pos.second]) pos.second <- n.lon2
                        ## points of grid1 to the right of all points of grid2 are also associated to the leftmost points of grid2 because earth is flat:
                        if(lon1.list[l] > lon2.list[pos.first] && lon1.list[l] > lon2.list[pos.second]) pos.second <- 1
                    }

                    nearest.lon[l,1] <- lon2.list[pos.first]
                    nearest.lon[l,2] <- lon2.list[pos.second]
                    nearest.lon.pos[l,1] <- pos.first
                    nearest.lon.pos[l,2] <- pos.second
                }


                lat1.list.rad <- lat1.list*(pi/180) ##deg2rad(lat1.list)
                lon1.list.rad <- lon1.list*(pi/180) ##deg2rad(lon1.list)
                nearest.lat.rad <- nearest.lat*(pi/180) ##deg2rad(nearest.lat)
                nearest.lon.rad <- nearest.lon*(pi/180) ##deg2rad(nearest.lon)

                pred <- array(NA, c(n.layers, n.lat1, n.lon1))
                for(y in 1:n.lat1){
                    for(x in 1:n.lon1){

                    # conversion to rad:
                    lat <- lat1.list.rad[y]  # lat y lon of the grid1 point selected
                    lon <- lon1.list.rad[x]
                    lat1 <- nearest.lat.rad[y,1] # lat y lon of its 4 nearest points
                    lon1 <- nearest.lon.rad[x,1]
                    lat2 <- nearest.lat.rad[y,1]
                    lon2 <- nearest.lon.rad[x,2]
                    lat3 <- nearest.lat.rad[y,2]
                    lon3 <- nearest.lon.rad[x,1]
                    lat4 <- nearest.lat.rad[y,2]
                    lon4 <- nearest.lon.rad[x,2]
                    latN <- c(lat1,lat2,lat3,lat4)
                    lonN <- c(lon1,lon2,lon3,lon4)

                    distN <- sqrt((sin((lat-latN)/2))^2 + cos(lat)*cos(latN)*(sin((lon-lonN)/2))^2)
                    distN <- Rx2 * asin(pmin(distN,1))  # distance in km of the 4 nearest points

                    ss <- which(distN == 0)
                    weights <- distN^2
                    weights[ss] <- 0.000000000001  # not to have +inf in the denominator of the weight matrix
                    weights <- 1/weights
                    sum.weights <- sum(weights)

                    for(l in 1:n.layers){
                        value1 <- grid2[l, nearest.lat.pos[y,1], nearest.lon.pos[x,1]] # grid2 value of its 4 nearest points
                        value2 <- grid2[l, nearest.lat.pos[y,1], nearest.lon.pos[x,2]] # for layer l
                        value3 <- grid2[l, nearest.lat.pos[y,2], nearest.lon.pos[x,1]]
                        value4 <- grid2[l, nearest.lat.pos[y,2], nearest.lon.pos[x,2]]
                        valueN <- c(value1,value2,value3,value4)

                        values.weighted <- valueN * weights
                        sum.values.weighted <- sum(values.weighted)
                        pred[l,y,x] <- sum.values.weighted / sum.weights
                        if(sum.weights==0) pred[l,y,x] <- NA  # si los 4 puntos estan tan lejanos que no tienen peso; pero creo que con ese metodo no se verifica nunca
                    }
                    }
                }

                #interp<-list()
                #for(l in 1:n.layers) interp[[l]]<-pred[l,,]
                #return(interp)
                return(pred)
            } 

            Scorecard_by_teleconnection <- function(tel.names, tel.units, scores, system.name, lead.months, dirout1, dirout2, hindcasts.filename, ref.caption, system.filename) {

                ## Check inputs:
                if(is.null(tel.names))
                    stop(paste0("Teleconnection names are missing"))

                if(is.null(system.name))
                    stop(paste0("System name is missing"))

                if(is.null(scores))
                    stop("You need to provide the scores of the teleconnections")

                ## number of teleconnections to plot:
                n.teleconnections <- length(tel.names)

                ## Load metrics from the 12 netCDF files of the chosen forecast system, one for each start month:
                start.months <- c("01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12")
                n.start.months <- length(start.months)
                n.lead.times <- length(lead.months)

                ## empty arrays with the score values to plot:
                bias <- corr <- RMSSS <- SpreadRatio <- array(NA, c(n.start.months, n.teleconnections, n.lead.times))

                ## scores <- scores.system[[1]] ## for the debug

                for(tel in 1:n.teleconnections){
                    for(mm in 1:n.start.months){
                        for(ff in 1:n.lead.times){
                            bias[mm, tel, ff] <- scores[[tel]]$Mean.bias[mm, ff]
                            corr[mm, tel, ff] <- scores[[tel]]$Corr[mm, ff]
                            RMSSS[mm, tel, ff] <- scores[[tel]]$RMSSS[mm, ff]
                            SpreadRatio[mm, tel, ff] <- scores[[tel]]$SpreadRatio[mm, ff]
                        }
                    }
                }

                ## ## example with random numbers:
                ## bias <- corr <- array(runif(n.start.months*n.teleconnections*n.lead.times, min = -1, max = 1), c(n.start.months, n.teleconnections, n.lead.times))
                ## RMSSS <- SpreadRatio <- array(runif(n.start.months*n.teleconnections*n.lead.times, min = 0.1, max = 2), c(n.start.months, n.teleconnections, n.lead.times))
                ## system.name <- "ECMWF System 5" ## for the debug

                ## round the scores:
                n.dec <- 2
                bias <- round(bias, n.dec)
                corr <- round(corr, 2)
                RMSSS <- round(RMSSS, 2)
                SpreadRatio <- round(SpreadRatio, 2)

                month.names <- c("January", "February", "March", "April", "May",  "June", "July", "August", "September", "October", "November", "December")

                ## list of start months for the legend (spaces are needed to draw empty rows in the figure):
                month.legend <- rep("", n.start.months * n.teleconnections)
                for(mm in 1:n.start.months){
                    month.legend[ceiling(n.teleconnections/2) + (mm - 1) * n.teleconnections] <- month.names[mm]
                }

                ## round bias values:
                bias <- round(bias, 2)
                ## data inside the table to plot:
                table <- data.frame(Start_date = month.legend, Teleconnections = rep(tel.names, n.start.months),
                                    BiasLead1 = as.vector(t(bias[,,1])), BiasLead2 = as.vector(t(bias[,,2])),
                                    BiasLead3 = as.vector(t(bias[,,3])), BiasLead4 = as.vector(t(bias[,,4])),
                                    BiasLead5 = as.vector(t(bias[,,5])), BiasLead6 = as.vector(t(bias[,,6])),
                                    CorrLead1 = as.vector(t(corr[,,1])), CorrLead2 = as.vector(t(corr[,,2])),
                                    CorrLead3 = as.vector(t(corr[,,3])), CorrLead4 = as.vector(t(corr[,,4])),
                                    CorrLead5 = as.vector(t(corr[,,5])), CorrLead6 = as.vector(t(corr[,,6])),
                                    RMSSSLead1 = as.vector(t(RMSSS[,,1])), RMSSSLead2 = as.vector(t(RMSSS[,,2])),
                                    RMSSSLead3 = as.vector(t(RMSSS[,,3])), RMSSSLead4 = as.vector(t(RMSSS[,,4])),
                                    RMSSSLead5 = as.vector(t(RMSSS[,,5])), RMSSSLead6 = as.vector(t(RMSSS[,,6])),
                                    SpreadRatioLead1 = as.vector(t(SpreadRatio[,,1])), SpreadRatioLead2 = as.vector(t(SpreadRatio[,,2])),
                                    SpreadRatioLead3 = as.vector(t(SpreadRatio[,,3])), SpreadRatioLead4 = as.vector(t(SpreadRatio[,,4])),
                                    SpreadRatioLead5 = as.vector(t(SpreadRatio[,,5])), SpreadRatioLead6 = as.vector(t(SpreadRatio[,,6])))

                ## table header:
                my.col.names <- c("Start date", "Teleconnection", rep(1:n.lead.times, 4))

                options(stringsAsFactors = FALSE)


                ## vector with the background color (white for cells with data, gray for cells with no data or with data issues):
                table.col <- rep("white", 12 * 2)
                ## remove corrupted start dates of March and July of CMCC S3:
                if(system.name == "CMCC-S3"){
                    my.rows <- c(5:6, 13:14)
                    for(i in my.rows) { 
                        for(j in 3:n.columns) table[i,j] <- NaN
                    }
                    table.col[my.rows] <- "gray"
                }

                ## add colored column bars over the data:
                table2 <- table
                ## select the number of decimals to show, their font size and color:
                for(col in 3:(2 + n.lead.times * 4)) {
                    table2[,col] <- format(table[,col], nsmall = 2)
                    table2[,col] <- cell_spec(table2[,col], font_size = 0.8, color="gray70") ## smaller font size
                }
                n.columns <- 2 + n.lead.times * 4
                ##add colored column bars over the data ((without data normalization):
                cols <- rev(rep(c("#ef8a62","#67a9cf"), 4))
                for(i in 3 : (2 + n.lead.times)) table2[,i] <- color_bar_score(cols[1], cols[2], bias, ratio = 0.5)(table[,i])
                for(i in (3 + n.lead.times):(2 + n.lead.times*2)) table2[,i] <- color_bar_neg(cols[3], cols[4], ratio = 0.5)(table[,i])
                for(i in (3 + n.lead.times*2):(2 + n.lead.times*3)) table2[,i] <- color_bar_neg(cols[5], cols[6], ratio = 0.5)(table[,i])
                for(i in (3 + n.lead.times*3):(2 + n.lead.times*4)) table2[,i] <- color_bar_pos(cols[8], score = SpreadRatio, ratio = 0.7)(table[,i])
                ## replace cells with NaN with "":
                for(i in 3:n.columns) table2[,i] <- str_replace(table2[,i], "NaN", "")


                table2$Start_date <- cell_spec(table$Start_date, font_size = 20)
                table2$Teleconnections <- cell_spec(table$Teleconnections, font_size = 20)

                ## draw the figure in html:
                my.bias.title <- paste0("Mean bias") ## (", tel.unit, ")")
                n.columns <- 2 + n.lead.times * 4
                my.header.names <- data.frame(c1=c(system.name, my.bias.title,
                                                            "Correlation", "RMSSS", "Ensemble spread/RMSE"), c2=c(2, rep(n.lead.times, 4)))
                tel.units.title <- paste0("(Unit ", tel.names[1],": ", tel.units[1],"; ", tel.names[2],": ", tel.units[2],")")
                my.header2.names <- data.frame(
                    c1 = c(ref.caption, tel.units.title, "", tel.units.title, ""),
                    c2 = c(2, n.lead.times, n.lead.times, n.lead.times, n.lead.times))

                table.html <- kbl(table2, escape = F, col.names = my.col.names, align = rep("c", n.columns)) %>%
                kable_paper("hover", full_width = F) %>%
                add_header_above(c(" " = 2, "Forecast month" = n.lead.times, "Forecast month" = n.lead.times,
                                "Forecast month" = n.lead.times, "Forecast month" = n.lead.times), font_size = 22) %>%
                ## add_header_above(c("(Obs: ERA5 1993-2016)" = 2, "(Niño3.4: K; NAO: hPa)" = n.lead.times, " " = n.columns - 2 - n.lead.times), align = "center", font_size = 22) %>%
                add_header_above(header = my.header2.names, align = "center", font_size = 22) %>%
                add_header_above(header = my.header.names, font_size = 30) %>%
                column_spec(1, bold = TRUE, width_min = "3.5cm") %>%
                column_spec(2, bold = TRUE, width_min = "7cm") %>%
                column_spec(3 : n.columns, width_min = "3cm") %>%
                column_spec(c(1, 2, 2 + n.lead.times, 2 + n.lead.times * 2, 2 + n.lead.times * 3), border_right = "2px solid gray") %>%
                column_spec(1, border_left = "2px solid gray") %>%
                column_spec(n.columns, border_right = "2px solid gray") %>%
                row_spec(0, font_size = 25) %>%
                row_spec(seq(from = 0, to = n.start.months * n.teleconnections, by = n.teleconnections), extra_css = "border-bottom: 1px solid") 
               # add_footnote() %>%
               # footnote(
               #     general = c("",
               #         "<i>Note:</i> eventual cells in grey represent start dates with data issues (e.g. corrupted values, missing start dates)."
               #     ),
               #     general_title = "<sub>.</sub>",
               #     footnote_as_chunk = F ,
               #     escape = F
               # )
                
                ## convert html to .png:
                my.file <- "./scorecard_by_telec.png"
                save_kable(table.html, file = my.file)

                ## move output to desired folder:
                # old convention filename:
                #scorecardname <- paste0(system.filename, "-scorecard_by_teleconnection-era5-global-s-l-p-", substr(hindcasts.filename,1,4), "_", substr(hindcasts.filename,7,10), ".png")
                # new convention filename:
                scorecardname <- paste0(system.filename, "-scorecard_by_teleconnection-global-p-", substr(hindcasts.filename,1,4), "_", substr(hindcasts.filename,7,10), "-era5.png")
                scorecardname34 <- paste0(system.filename, "-34-scorecard_by_teleconnection-global-p-", substr(hindcasts.filename,1,4), "_", substr(hindcasts.filename,7,10), "-era5.png")
                scorecardname151 <- paste0(system.filename, "-151-scorecard_by_teleconnection-global-p-", substr(hindcasts.filename,1,4), "_", substr(hindcasts.filename,7,10), "-era5.png")
                
                ##moving the scorecard to the right folder:
                if (file.exists(paste0(dirout1, scorecardname34)) == TRUE){system(paste0("rm -f ", dirout1, scorecardname34))}
                system(paste0("cp ", my.file, " ", dirout1, scorecardname34))
                print(paste0(dirout1, scorecardname34))
                if (file.exists(paste0(dirout2, scorecardname151)) == TRUE){system(paste0("rm -f ", dirout2, scorecardname151))}
                system(paste0("mv ", my.file, " ", dirout2, scorecardname151))
                print(paste0(dirout2, scorecardname151))

                ##copy in anomaly folder:
                if (file.exists(paste0(gsub("seasonal_monthly", "seasonal_postprocessed", dirout1), scorecardname34)) == TRUE){system(paste0("rm -f ", gsub("seasonal_monthly", "seasonal_postprocessed", dirout1), scorecardname34))}
                system(paste0("cp ", my.file, " ", gsub("seasonal_monthly", "seasonal_postprocessed", dirout1), scorecardname34))
                print(paste0(gsub("seasonal_monthly", "seasonal_postprocessed", dirout1), scorecardname34))
                if (file.exists(paste0(gsub("seasonal_monthly", "seasonal_postprocessed", dirout2), scorecardname151)) == TRUE){system(paste0("rm -f ", gsub("seasonal_monthly", "seasonal_postprocessed", dirout2), scorecardname151))}
                system(paste0("mv ", my.file, " ", gsub("seasonal_monthly", "seasonal_postprocessed", dirout2), scorecardname151))
                print(paste0(gsub("seasonal_monthly", "seasonal_postprocessed", dirout2), scorecardname151))

                #temporary solution:
                #system(paste0("mv ", my.file, " ", "/data/alba/scorecards-teleconnections/scorecards_temp/", scorecardname))

                return(print(paste0("Scorecard figure of teleconnection saved")))


            }

            ## function to measure observed or forecast monthly time series of el Niño 3.4:
            ## (the "ñ" was replaced with an "n" because not all keyboards have it)
            Nino3.4 <- function(system.name, year.start = 1961, year.end = 1990, lead.months = NULL, input.path = NULL) {
                ## ## for the debug:
                ## system.name = "ECMWF System 5" ## "ERA5"
                ## year.start = 1993
                ## year.end = 2016
                ## lead.months = 1:6
                ## input.path <- input.path.sys ## input.path.rean

                ## number of forecast months:
                n.lead.times <- length(lead.months)
                my.years <- year.start : year.end
                n.years <- length(my.years)
                my.months <- c("01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12")
                n.months <- length(my.months)

                ## Check inputs:
                if(!is.character(system.name))
                    stop(paste0("Input system name ", system.name, "is missing or it is not a character"))

                ## convert system names shown in the figure title in names used in the netCDF files:
                if(system.name == "ERA5") system.filename <- ""
                if(system.name == "ECMWF System 5") { system.filename <- "ecmwfs5"; output.filename <- "ecmwf-5" }
                if(system.name == "DWD System 2") { system.filename <- "dwds2"; output.filename <- "dwd-2" }
                if(system.name == "Météo-France System 7") { system.filename <- "meteo_frances7"; output.filename <- "meteo_france-7" }
                if(system.name == "Météo-France System 6") { system.filename <- "meteo_frances6"; output.filename <- "meteo_france-6" }
                if(system.name == "CMCC System 3") { system.filename <- "cmccs3"; output.filename <- "cmcc-3" }
                if(system.name == "UK Met Office System 14") { system.filename <- "ukmos14"; output.filename <- "ukmo-14" }
                if(system.name == "NCEP System 2") { system.filename <- "nceps2"; output.filename <- "ncep-2" }

                if(system.name == "ERA5") mod.system <- "" else mod.system <- "-"
                if(system.name == "ERA5") mod2.system <- "hres-" else mod2.system <- ""

                ## load lat and lon values:
                if(system.name == "ERA5"){
                    nc <- nc_open(paste0(input.path,
                                    system.filename, mod.system, "/sea_surface_temperature-", mod2.system,
                                    my.years[1], my.months[2], "01.nc"))
                } else {
                    nc <- nc_open(paste0(input.path,"/sea_surface_temperature/",
                                    system.filename, mod.system, "sea_surface_temperature-", mod2.system,
                                    my.years[1], my.months[2], "01.nc"))

                }

                lat.netCDF <- ncvar_get(nc, "latitude")
                lon.netCDF <- ncvar_get(nc, "longitude")
                nc_close(nc)

                n.lat.netCDF <- length(lat.netCDF)
                n.lon.netCDF <- length(lon.netCDF)
                rm(nc)

                ## set region borders of el Niño3.4 region:
                lat.min <- -5
                lat.max <- 5
                lon.min <- 190 ## correspond to 170 W
                lon.max <- 240 ## correspond to 120 W

                ## position of lat and lon min and max values inside the netCDF:
                if(is.null(lat.min)) pos.lat.min <- length(lat.netCDF) else pos.lat.min <- which(lat.netCDF >= lat.min)[length(which(lat.netCDF >= lat.min))]
                if(is.null(lat.max)) pos.lat.max <- 1 else pos.lat.max <- which(lat.netCDF <= lat.max)[1]
                if(is.null(lon.min)) pos.lon.min <- 1 else pos.lon.min <- which(lon.netCDF >= lon.min)[1]
                if(is.null(lon.max)) pos.lon.max <- length(lon.netCDF) else pos.lon.max <- which(lon.netCDF >= lon.max)[1]

                pos.lat.region <- pos.lat.max : pos.lat.min
                pos.lon.region <- pos.lon.min : pos.lon.max
                lat.region <- lat.netCDF[pos.lat.region]
                lon.region <- lon.netCDF[pos.lon.region]
                n.lat.region <- length(pos.lat.region)
                n.lon.region <- length(pos.lon.region)

                ## load one netCDF to read the number of members:
                if(system.name != "ERA5"){
                    nc <- nc_open(paste0(input.path, "/sea_surface_temperature/", system.filename, mod.system,
                                    "sea_surface_temperature-", mod2.system, my.years[1], my.months[2], "01.nc"))

                    n.members <- length(ncvar_get(nc, "number"))
                    nc_close(nc)
                }

                ## define array where to load data:
                if(system.name == "ERA5"){
                    ##SST <- array(NA, c(n.years, n.months, n.lat.netCDF, n.lon.netCDF))
                    SST.region <- array(NA, c(n.years, n.months, n.lat.region, n.lon.region))
                } else {
                    ##SST <- array(NA, c(n.years, n.months, n.members, n.lead.times, n.lat.netCDF, n.lon.netCDF))
                    SST.region <- array(NA, c(n.years, n.months, n.members, n.lead.times, n.lat.region, n.lon.region))
                }

                ## load all monthly data of 1 variable and system/reanalysis:
                for(yy in 1:n.years){
                    for(mm in 1:n.months){
                        if(system.filename == "ukmos14" && yy == 1 && mm == 1){
                            print("No data for UKMO-14 January 1993")
                        }else{
                            print(paste0("Loading ", input.path, "/", system.filename, mod.system,
                                            "sea_surface_temperature-", mod2.system, my.years[yy], my.months[mm], "01.nc"))

                            ## open netCDF file:
                            if(system.name == "ERA5"){
                                nc <- nc_open(paste0(input.path, system.filename, mod.system,
                                            "/sea_surface_temperature-", mod2.system, my.years[yy], my.months[mm], "01.nc"))
                            } else {
                                nc <- nc_open(paste0(input.path, "/sea_surface_temperature/", system.filename, mod.system,
                                            "sea_surface_temperature-", mod2.system, my.years[yy], my.months[mm], "01.nc"))
                            }

                            if(system.name == "ERA5") {
                                a <- ncvar_get(nc, "sst")
                                b <- aperm(a, c(2,1)) ## swap lat and lon between them, so lat is the first dimension
                                rm(a)
                                gc()
                                SST.region[yy, mm,,] <- b[pos.lat.region, pos.lon.region]
                                rm(b)
                                gc()
                            } else {
                                ## beware that ncvar_get loads the data in INVERSE ORDER of the dimensions in the netCDF file!!!
                                a <- ncvar_get(nc, "sst") ## [lon, lat, lead, members]
                                ## PlotEquiMap(a[,,1,1], lon=lon.netCDF, lat=lat.netCDF) ## for the debug

                                b <- aperm(a, c(4,3,2,1)) ## [members, leads, lat, lon]
                                rm(a)
                                gc()
                                ##PlotEquiMap(b[1,1,,], lon=lon.netCDF, lat=lat.netCDF, filled.continents = FALSE) ## for the debug

                                SST.region[yy, mm,,,,] <- b[,, pos.lat.region, pos.lon.region]
                                rm(b)
                                gc()
                                ##PlotEquiMap(SST[yy, mm,1,1,,], lon=lon.netCDF, lat=lat.netCDF, filled.continents = FALSE) ## for the debug

                            }

                            nc_close(nc)  ## close netCDF
                            gc()
                        }
                    }
                    gc()
                }
                gc()

                ## PlotEquiMap(array(1, c(length(lon.netCDF[401:1001]), length(lat.netCDF[281:441]))), lon=lon.netCDF[401:1001], lat=lat.netCDF[281:441], cols="white", filled.continents = FALSE) ## for the debug

                ## PlotEquiMap(SST.region[1,1,,], lon=lon.region, lat=lat.region, filled.continents = FALSE) ## for the debug
                ##PlotEquiMap(SST.region[1,1,1,1,,], lon=lon.region, lat=lat.region, filled.continents = FALSE) ## for the debug

                ## convert SST to anomalies with respect to 1993-2016, for each start date and forecast month indipendently:
                print(paste0("Converting SST to anomalies. Please wait..."))

                if(system.name == "ERA5"){
                    ## SST.clim <- array(0, c(n.months, n.lat.netCDF, n.lon.netCDF))
                    SST.region.clim <- array(0, c(n.months, n.lat.region, n.lon.region))
                    for(i in 1:n.years) SST.region.clim <- SST.region.clim + SST.region[i,,,] ## in this case, it is 100 times faster than using apply()!!!
                    ## normalize for the number of years to measure the average (aka the climatology) instead of the sum:
                    SST.region.clim <- SST.region.clim / n.years
                } else {
                    ## SST.clim <- array(0, c(n.months, n.members, n.lead.times, n.lat.netCDF, n.lon.netCDF))
                    SST.region.clim <- array(NA, c(n.months, n.members, n.lead.times, n.lat.region, n.lon.region))
                    ## for(i in 1:n.years) SST.region.clim <- SST.region.clim + SST.region[i,,,,,] ## in this case, it is 100 times faster than using apply()!!!
                    ## average over years and members:
                    SST.region.clim <- apply(SST.region, c(2,4,5,6), mean, na.rm = TRUE) ## [st.dates, leads, lat, lon]
                }
                
                ## PlotEquiMap(SST.region.clim[8,,], lon=lon.region, lat=lat.region, brks=c(295, 297.5, 298, 298.5, 299, 299.5, 300, 300.5, 301, 301.5, 302, 305), filled.continents=FALSE) ## for the debug
                ## PlotEquiMap(SST.region.clim[3,6,,], lon=lon.region, lat=lat.region, brks=c(295, 297, 297.5, 298, 298.5, 299, 299.5, 300, 300.5, 301, 301.5, 302, 305), filled.continents=FALSE) ## for the debug
                
                ## same as SST.clim, but with a dimension more to represent the years too:
                if(system.name == "ERA5") {
                    ## SST.clim.full <- array(NA, c(n.years, n.months, n.lat.netCDF, n.lon.netCDF))
                    SST.region.clim.full <- array(NA, c(n.years, n.months, n.lat.region, n.lon.region))
                    for(i in 1:n.years) SST.region.clim.full[i,,,] <- SST.region.clim
                } else {
                    ## SST.clim.full <- array(NA, c(n.years, n.months, n.members, n.lead.times, n.lat.netCDF, n.lon.netCDF))
                    SST.region.clim.full <- array(NA, c(n.years, n.months, n.members, n.lead.times, n.lat.region, n.lon.region))
                    for(yy in 1:n.years){
                        for(mm in 1:n.members) SST.region.clim.full[yy,,mm,,,] <- SST.region.clim
                    }
                }
                
                ## measure SST monthly anomalies:
                SST.region.anom <- SST.region - SST.region.clim.full
                
                rm(SST.region, SST.region.clim.full)
                #if(system.name == "ERA5"){gc()}
                
                paste0("Measuring Nino3.4. Please wait...")

                ## measure average SST anomalies over the target region:
                if(system.name == "ERA5"){
                    ## average of SST anomalies over lon and lat keeping year and month fixed:
                    Nino <- apply(SST.region.anom, c(1,2), mean, na.rm = TRUE)

                    ## average of SST clim over lon an lat of Nino3.4 region keeping only month fixed:
                    Nino.clim <- apply(SST.region.clim, 1, mean, na.rm = TRUE)
                } else {
                    ## average of SST anomalies over lon, lat and members and fixing, obtaining the ensemble mean of ENSO index:
                    Nino <- apply(SST.region.anom, c(1,2,4), mean, na.rm = TRUE) ## [years, st.dates, leads]

                    ## average of SST anomalies over lon and lat keeping year, month and member fixed: (ENSO index for each member)
                    Nino.by.memb <- apply(SST.region.anom, c(1,2,3,4), mean, na.rm = TRUE) ## [years, st.dates, members, leads]

                    ## difference between the ENSO index of each member and its ensemble mean:
                    Nino.full <- InsertDim(Nino, 3, n.members) ## [years, st.dates, members, leads]
                    Nino.ens.diff <- Nino.by.memb - Nino.full

                    ## ensemble spread of the Niño3.4:
                    Nino.spread <- apply(Nino.ens.diff, c(2,4), sd, na.rm = TRUE) ## dim: [st.months, leads]

                    ## average of SST clim over lon and lat of Nino3.4 region keeping month and lead fixed:
                    Nino.clim <- apply(SST.region.clim, c(1,2), mean, na.rm = TRUE) ## [st.date, lead]
                }

                if(system.name == "ERA5"){
                    return(list(Nino = Nino, Nino.clim = Nino.clim))
                } else {
                    return(list(Nino = Nino, Nino.clim = Nino.clim, Nino.spread = Nino.spread, Nino.by.memb = Nino.by.memb))
                }

            }

            ## function to measure the scores of el Niño3.4:
            ## input.path is the path of the input netCDF monthly SST files:
            Nino3.4.scores <- function(system.name, year.start, year.end, lead.months = 1:6, input.path.rean = NULL, input.path.sys = NULL)
            {
                ## measure obs. and pred. Nino time series:
                print("Measuring observed Niño. Please wait...")
                Nino.obs.list <- Nino3.4(system.name = "ERA5", year.start, year.end, input.path = input.path.rean) ## format: [year, month]

                print("Measuring forecasted Niño. Please wait...") ### issue:
                Nino.for.list <- Nino3.4(system.name = system.name, year.start, year.end, lead.months = lead.months, input.path = input.path.sys) ## format: [year, month, lead]

                n.lead.months <- length(lead.months)

                n.years <- as.integer(year.end) - as.integer(year.start) + 1
                n.start.dates <- 12

                Nino.obs <- Nino.obs.list$Nino ## [year, st.dates] ## load observed Nino
                Nino.obs.mean <- Nino.obs.list$Nino.clim ## [st.dates] load observed SST Nino3.4 region climatology

                ## Copy the observed data to the various leads to be able to compare it with forecasts:
                Nino.obs.shifted <- Nino.obs
                Nino.obs.shifted[1:(n.years-1),] <- Nino.obs[-1,]
                Nino.obs.shifted[n.years,] <- NA

                Nino.obs.double <- abind(Nino.obs, Nino.obs.shifted, along = 2) ## attach a copy of it after December, shifted by 1 year
                Nino.obs.full <- array(NA, c(n.years, n.start.dates, n.lead.months)) ## [year, st.dates, leads]
                for(lead in 1:n.lead.months) Nino.obs.full[,, lead] <- Nino.obs.double[, lead : (lead + 11)]

                Nino.obs.mean.double <- c(Nino.obs.mean, Nino.obs.mean) ## concatenate a copy of the vector after December
                Nino.obs.mean.full <- array(NA, c(n.start.dates, n.lead.months))
                for(lead in 1:n.lead.months) Nino.obs.mean.full[, lead] <- Nino.obs.mean.double[lead : (lead + 11)]
                ## Nino.obs.mean.full <- InsertDim(Nino.obs.mean, 2, n.lead.months)

                Nino.for <- Nino.for.list$Nino ## [years, st.dates, leads] ## load forecasted Nino
                Nino.for.mean <- Nino.for.list$Nino.clim ## [st.dates, leads] load forecasted SST Nino3.4 region climatology
                Nino.for.spread <- Nino.for.list$Nino.spread
                ##Nino.for.mean <- Nino.for.list$Nino.clim

                Nino.bias <- Nino.for.mean - Nino.obs.mean.full

                ## compute other error scores of the Niño::
                Corr <- RMSE <- RMSEClim <- RMSSS <- SpreadRatio <- array(NA, c(n.start.dates, n.lead.months))
                for(mm in 1:n.start.dates){
                    for(ll in 1:n.lead.months){
                        n.years.not.na <- length(which(!is.na(Nino.obs.full[mm, ll,]))) ## count only years without NA
                        Corr[mm, ll] <- cor(Nino.for[, mm, ll], Nino.obs.full[, mm, ll], use="na.or.complete")
                        RMSE[mm, ll] <- ((sum((Nino.for[, mm, ll] - Nino.obs.full[, mm, ll])^2, na.rm = TRUE))/n.years.not.na)^0.5
                        SpreadRatio[mm, ll] <- Nino.for.spread[mm, ll] / RMSE[mm, ll]
                        RMSEClim[mm, ll] <- ((sum((Nino.obs.full[, mm, ll])^2, na.rm = TRUE))/n.years.not.na)^0.5
                        RMSSS[mm, ll] <- 1 - (RMSE[mm, ll] / RMSEClim[mm, ll])
                    }
                }

                ## plot(Nino.for[,12,2], type = "l", col="red") ## for the debug
                ## lines(Nino.obs.full[,12,2], col="blue")

                return(list(Mean.bias = Nino.bias, Corr = Corr, RMSSS = RMSSS, RMSE = RMSE, RMSEClim = RMSEClim, EnsSpread = Nino.for.spread, SpreadRatio = SpreadRatio))

                ## test <- list(Mean.bias = Nino.bias, Corr = Corr, RMSSS = RMSSS, RMSE = RMSE, RMSEClim = RMSEClim, EnsSpread = Nino.for.spread, SpreadRatio = SpreadRatio)
            }

            ## function to measure observed or forecast monthly time series of NAO using mean sea level pressure:
            ## note that period should be 1961-1990 but hindcasts are only defined for 1993-2016, so we had to use this last period
            ## note that if system.name is "ERA5", than you have to specify argument "grid2interp" providing the name of a seasonal dataset
            NAO.slp <- function(system.name, year.start = 1961, year.end = 1990, lead.months = NULL, input.path.rean = NULL, input.path.sys = NULL, grid2interp = NULL) {

                ## set region borders of NAO region:
                lat.min <- 20
                lat.max <- 80
                lon.min <- 280 ## in degrees East (correspond to 80 W)
                lon.max <- 40

                ## for the debug:
                ## system.name <- "ECMWF System 5" ##"ERA5"
                ## input.path <- input.path.sys ## input.path.rean ## input.path.sys

                n.lead.times <- length(lead.months) ## number of forecast months
                my.years <- year.start : year.end
                n.years <- length(my.years)
                my.months <- c("01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12")
                n.months <- length(my.months)

                ## Check inputs:
                if(!is.character(system.name))
                    stop(paste0("Input system name ", system.name, "is missing or it is not a character"))

                ## convert system names shown in the figure title in names used in the netCDF files:
                if(system.name == "ERA5") system.filename <- ""
                if(system.name == "ECMWF System 5") { system.filename <- "ecmwfs5"; output.filename <- "ecmwf-5" }
                if(system.name == "DWD System 2") { system.filename <- "dwds2"; output.filename <- "dwd-2" }
                if(system.name == "Météo-France System 7") { system.filename <- "meteo_frances7"; output.filename <- "meteo_france-7" }
                if(system.name == "Météo-France System 6") { system.filename <- "meteo_frances6"; output.filename <- "meteo_france-6" }
                if(system.name == "CMCC System 3") { system.filename <- "cmccs3"; output.filename <- "cmcc-3" }
                if(system.name == "UK Met Office System 14") { system.filename <- "ukmos14"; output.filename <- "ukmo-14" }
                if(system.name == "NCEP System 2") { system.filename <- "nceps2"; output.filename <- "ncep-2" }

                if(system.name == "ERA5") mod.system <- "" else mod.system <- "-"
                if(system.name == "ERA5") mod2.system <- "hres-" else mod2.system <- ""

                ## load lat and lon values:
                if(system.name == "ERA5"){
                    nc <- nc_open(paste0(input.path.rean,
                                    "/mean_sea_level_pressure-hres-", my.years[1], my.months[2], "01.nc"))
                } else {
                    nc <- nc_open(paste0(input.path.sys, "/mean_sea_level_pressure/",
                                        system.filename, mod.system, "mean_sea_level_pressure-", mod2.system,
                                        my.years[1], my.months[2], "01.nc"))
                }

                lat.netCDF <- ncvar_get(nc, "latitude")
                lon.netCDF <- ncvar_get(nc, "longitude")
                nc_close(nc)

                n.lat.netCDF <- length(lat.netCDF)
                n.lon.netCDF <- length(lon.netCDF)
                rm(nc)
                gc()

                ## position of lat and lon min and max values of the region inside the netCDF:
                if(is.null(lat.min)) pos.lat.min <- n.lat.netCDF else pos.lat.min <- which(lat.netCDF >= lat.min)[length(which(lat.netCDF >= lat.min))]
                if(is.null(lat.max)) pos.lat.max <- 1 else pos.lat.max <- which(lat.netCDF <= lat.max)[1]
                if(is.null(lon.min)) pos.lon.min <- 1 else pos.lon.min <- which(lon.netCDF >= lon.min)[1]
                if(is.null(lon.max)) pos.lon.max <- n.lon.netCDF else pos.lon.max <- which(lon.netCDF >= lon.max)[1]
                
                if(lon.min < lon.max) {
                    pos.lon.region <- pos.lon.min : pos.lon.max
                    lon.region <- lon.netCDF[pos.lon.region]
                } else { ## case when area passes for Greenwitch as for NAO region:
                    pos.lon.region <- c(1: pos.lon.max, pos.lon.min : length(lon.netCDF))
                    lon.region <- lon.netCDF[pos.lon.region] ## for PlotEquiMap to work, longitudes must be from 0 to 360!!!
                }

                pos.lat.region <- pos.lat.max : pos.lat.min
                lat.region <- lat.netCDF[pos.lat.region]
                lat.region.rev <- rev(lat.region) ## to order lat from negative to positive for NAO function

                n.lon.region <- length(lon.region)
                n.lat.region <- length(lat.region)

                ## ## attribute for NAO function()
                ## attr(lon.region, "first_lon") <- head(lon.region, 1)
                ## attr(lon.region, "last_lon") <- tail(lon.region, 1)
                ## attr(lon.region, "data_across_gw") <- TRUE
                ## attr(lon.region, "array_across_gw") <- TRUE
                ## attr(lat.region.rev, "first_lat") <- head(lat.region.rev, 1)
                ## attr(lat.region.rev, "last_lat") <- tail(lat.region.rev, 1)

                ## load one netCDF to read the number of members:
                if(system.name != "ERA5"){
                    nc <- nc_open(paste0(input.path.sys, "/mean_sea_level_pressure/", system.filename, mod.system,
                                    "mean_sea_level_pressure-", mod2.system, my.years[1], my.months[2], "01.nc"))

                    n.members <- length(ncvar_get(nc, "number"))
                    nc_close(nc)
                    rm(nc)
                    gc()
                }

                ## define array where to load data:
                ## load only data in the NAO region because all data won't fit in memory!!!
                if(system.name == "ERA5"){
                    SLP.region <- array(NA, c(n.years, n.months, n.lat.region, n.lon.region))
                } else {
                    SLP.region <- array(NA, c(n.years, n.months, n.members, n.lead.times, n.lat.region, n.lon.region))
                }

                ## load all monthly data of 1 variable and system/reanalysis:
                for(yy in 1:n.years){
                    for(mm in 1:n.months){
                        if(system.filename == "ukmos14" && yy == 1 && mm == 1){
                            print("No data for UKMO-14 January 1993")
                        }else{
                            if(system.name != "ERA5"){
                                print(paste0("Loading ", input.path.sys, "/mean_sea_level_pressure/", system.filename, mod.system,
                                            "mean_sea_level_pressure-", mod2.system, my.years[yy], my.months[mm], "01.nc"))

                                ## open netCDF file:
                                nc <- nc_open(paste0(input.path.sys, "/mean_sea_level_pressure/",
                                                    system.filename, mod.system, "mean_sea_level_pressure-", mod2.system,
                                                    my.years[yy], my.months[mm], "01.nc"))

                                ## beware that ncvar_get loads the data in INVERSE ORDER of the dimensions in the netCDF file!!!
                                a <- ncvar_get(nc, "msl")
                                b <- aperm(a, c(4,3,2,1))
                                SLP.region[yy, mm,,,,] <- b[,, pos.lat.region, pos.lon.region]
                                ##PlotEquiMap(SLP[yy, mm,1,1,,], lon=lon.netCDF, lat=lat.netCDF, filled.continents = FALSE) ## for the debug

                            } else { ## load reanalysis instead:
                                print(paste0("Loading ", input.path.rean,
                                            system.filename, mod.system, "/mean_sea_level_pressure-", mod2.system,
                                            my.years[yy], my.months[mm], "01.nc"))

                                nc <- nc_open(paste0(input.path.rean,
                                                    system.filename, mod.system, "/mean_sea_level_pressure-", mod2.system,
                                                    my.years[yy], my.months[mm], "01.nc"))

                                a <- ncvar_get(nc, "msl")
                                b <- aperm(a, c(2,1)) ## swap lat and lon so lat is the first dimension
                                SLP.region[yy, mm,,] <- b[pos.lat.region, pos.lon.region]
                            }
                            nc_close(nc) ## close netCDF
                            rm(a, b)
                            gc()
                        }
                    }
                    gc()
                }
                gc()

                ##PlotEquiMap(SLP.region[1,1,,], lon=lon.region, lat=lat.region, filled.continents = FALSE) ## for the debug
                ##PlotEquiMap(SLP.region[1,1,1,1,,], lon=lon.region, lat=lat.region, filled.continents = FALSE) ## for the debug

                ## interpolate observed data to same grid of seasonal dataset:
                if(system.name == "ERA5"){
                    if(grid2interp == "ECMWF System 5") system.filename2 <- "ecmwfs5"
                    if(grid2interp == "DWD System 2") system.filename2 <- "dwds2"
                    if(grid2interp == "Météo-France System 7") system.filename2 <- "meteo_frances7"
                    if(grid2interp == "Météo-France System 6") system.filename2 <- "meteo_frances6"
                    if(grid2interp == "CMCC System 3") system.filename2 <- "cmccs3"
                    if(grid2interp == "UK Met Office System 14") system.filename2 <- "ukmos14"
                    if(grid2interp == "NCEP System 2") system.filename2 <- "nceps2"

                    ## load 1 file with the lat and lon values of the grid of the seasonal system:
                    nc <- nc_open(paste0(input.path.sys, "/mean_sea_level_pressure/",
                                        system.filename2, "-mean_sea_level_pressure-",
                                        my.years[1], my.months[2], "01.nc"))

                    lat.netCDF.sys <- ncvar_get(nc, "latitude")
                    lon.netCDF.sys <- ncvar_get(nc, "longitude")
                    nc_close(nc)

                    n.lat.netCDF.sys <- length(lat.netCDF.sys)
                    n.lon.netCDF.sys <- length(lon.netCDF.sys)
                    rm(nc)
                    gc()

                    ## position of lat and lon min and max values of the region inside the netCDF of seasonal forecasts:
                    if(is.null(lat.min)) pos.lat.min.sys <- n.lat.netCDF.sys else pos.lat.min.sys <- which(lat.netCDF.sys >= lat.min)[length(which(lat.netCDF.sys >= lat.min))]
                    if(is.null(lat.max)) pos.lat.max.sys <- 1 else pos.lat.max.sys <- which(lat.netCDF.sys <= lat.max)[1]
                    if(is.null(lon.min)) pos.lon.min.sys <- 1 else pos.lon.min.sys <- which(lon.netCDF.sys >= lon.min)[1]
                    if(is.null(lon.max)) pos.lon.max.sys <- n.lon.netCDF.sys else pos.lon.max.sys <- which(lon.netCDF.sys >= lon.max)[1]

                    if(lon.min < lon.max) {
                        pos.lon.region.sys <- pos.lon.min.sys : pos.lon.max.sys
                        lon.region.sys <- lon.netCDF.sys[pos.lon.region.sys]
                    } else { ## case when area passes for Greenwitch as for NAO region:
                        pos.lon.region.sys <- c(1 : pos.lon.max.sys, pos.lon.min.sys : n.lon.netCDF.sys)
                        lon.region.sys <- lon.netCDF.sys[pos.lon.region.sys] ## for PlotEquiMap to work, longitudes must be from 0 to 360!!!
                    }

                    pos.lat.region.sys <- pos.lat.max.sys : pos.lat.min.sys
                    lat.region.sys <- lat.netCDF.sys[pos.lat.region.sys]

                    n.lon.region.sys <- length(lon.region.sys)
                    n.lat.region.sys <- length(lat.region.sys)

                    ## SLP observed values interpolated to seasonal grid:
                    SLP.region.sys <- array(NA, c(n.years, n.months, n.lat.region.sys, n.lon.region.sys))
                    for(yy in 1:n.years){
                            grid2 <- SLP.region[yy,,,]
                            SLP.region.sys[yy,,,] <- bilinear(lat1.list = lat.region.sys, lon1.list = lon.region.sys, lat2.list = lat.region, lon2.list = lon.region, grid2 = grid2, world = FALSE)
                    }

                    rm(grid2)
                    ##PlotEquiMap(SLP.region.sys[1,1,,], lon=lon.region.sys, lat=lat.region.sys, filled.continents = FALSE) ## for the debug

                    ## starting from now we always work with the grid of the seasonal forecasts because even the reanalysis was interpolated to that grid:
                    lat.region <- lat.region.sys
                    lon.region <- lon.region.sys
                    n.lat.region <- n.lat.region.sys
                    n.lon.region <- n.lon.region.sys
                    SLP.region <- SLP.region.sys
                    rm(SLP.region.sys)
                    gc()
                } ## close if on system.name

                ## convert SLP to anomalies with respect to 1993-2016, for each start date and forecast month indipendently:
                paste0("Converting SLP to anomalies. Please wait...")
                if(system.name == "ERA5"){
                    SLP.region.clim <- array(0, c(n.months, n.lat.region, n.lon.region))
                    for(i in 1:n.years) SLP.region.clim <- SLP.region.clim + SLP.region[i,,,] ## in this case, it is 100 times faster than using apply()!!!
                } else {
                    SLP.region.clim <- array(0, c(n.months, n.members, n.lead.times, n.lat.region, n.lon.region))
                    for(i in 1:n.years) SLP.region.clim <- SLP.region.clim + SLP.region[i,,,,,] ## in this case, it is 100 times faster than using apply()!!!
                }

                ## normalize for the number of years to measure the average (aka the climatology) instead of the sum:
                SLP.region.clim <- SLP.region.clim / n.years

                ## same as SLP.clim, but with a dimension more to represent the years too:
                if(system.name == "ERA5") {
                    SLP.region.clim.full <- array(NA, c(n.years, n.months, n.lat.region, n.lon.region))
                    for(i in 1:n.years) SLP.region.clim.full[i,,,] <- SLP.region.clim
                } else {
                    SLP.region.clim.full <- array(NA, c(n.years, n.months, n.members, n.lead.times, n.lat.region, n.lon.region))
                    for(i in 1:n.years) SLP.region.clim.full[i,,,,,] <- SLP.region.clim
                }

                ## measure SLP monthly anomalies:
                SLP.region.anom <- SLP.region - SLP.region.clim.full

                rm(SLP.region.clim.full, SLP.region)
                gc()

                ## ## normalize by standard deviation to get numbers from -3 to 3:
                ## if(system.name == "ERA5"){
                ##     SLP.sd <- InsertDim(InsertDim(apply(SLP.anom.region, c(3,4), sd), 1, n.months), 1, n.years)
                ## } else {
                ##     SLP.sd <- InsertDim(InsertDim(InsertDim(apply(SLP.anom.region, c(4,5,6), sd), 1, n.members), 1, n.months), 1, n.years)
                ## }
                ##
                ## eventual normalization:
                ## SLP.anom.region.norm <- SLP.anom.region / SLP.sd
                ## rm(SLP.sd)
                ## gc()

                ## ## reverse lat values from negatives to positives in order to load the object in NAO() function:
                ## SLP.region.anom.rev <- SLP.region.anom
                ## if(system.name == "ERA5"){
                ##     for(lat in 1:n.lat.region) SLP.region.anom.rev[,,lat,] <- SLP.region.anom[,, n.lat.region + 1 - lat,]
                ## } else {
                ##     for(lat in 1:n.lat.region) SLP.region.anom.rev[,,,,lat,] <- SLP.region.anom[,,,, n.lat.region + 1 - lat,]
                ## }
                ## ##rm(SLP.anom.region)
                ## gc()

                if(system.name == "ERA5"){
                    ## tt.ext <- abind(SLP.anom.region, SLP.anom.region, along = 2) ## double it so that january follows december
                    ## SLP.anom.region2 <- array(NA, c(1,1, n.years, n.lead.times, n.lat.region, n.lon.region))
                    nPCs <- 20
                    nao.obs <- array(NA, c(n.months, n.lead.times, n.years)) ## NAO index for each start date and lead time
                    nao.obs.reofs <- nao.obs.wght <- array(NA, c(n.months, n.lead.times, n.lat.region, n.lon.region))

                    chosen.st.date <- 12 ##1:n.months ## it should loop over all months but December is the chosen one as NAO is its best
                    for(ss in chosen.st.date){ ## fix a start month
                        ## measure NAO index for lead time 1 (same month of the start date):
                        print(paste0("Measuring NAO index of start date ", ss, " and lead month 1"))

                        ##tt2 <- SLP.anom.region[, ss,,] ## select only data of chosen start month
                        ##tt3 <- InsertDim(tt2, 2, n.lead.times) ## insert 6 lead times; the first one is ok, the others have to be added
                        ##for(ll in 2:n.lead.times) tt3[,ll,,] <- tt.ext[,ss + ll - 1,,] ## add the other lead times
                        ##SLP.anom.region2 <- InsertDim(InsertDim(tt3, 1, 1),1, 1)

                        ## data format for NAO() function:
                        ## ano_obs = [1,1, years*, leads**, lat, lon] *all years of a fixed start month
                        ## nao.obs[ss, 1,] <- NAO(ano_obs = SLP.anom.region2, lon = lon.region, lat = lat.region.rev, ftime_average = 1)$NAO_obs[1,]
                        ##plot(1:n.years, nao.obs$NAO_obs[1,], type="b") ## plot NAO index

                        ## ## reorder lon so that it goes from 0 to 360:
                        ## if(system.name == "ERA5") {
                        ##     pos.lon.reord <- c(321:481, 1:320)
                        ## } else {
                        ##     pos.lon.reord <- pos.lon.region
                        ## }
                        ##
                        ## lon.region.reord <- lon.region[pos.lon.reord]

                        SLP.region.anom.sdate <- SLP.region.anom[,ss,,] ## pos.lon.reord] ## [year, lat ,lon]

                        # Compute rotated EOFs, return the TC (typically the first four are NAO, EA, EA/WR & SCAN)
                        ## reofs <- REOF(anom.s, lon.s, lat.s, ntrunc)

                        reofs <- REOF(SLP.region.anom.sdate, lon = lon.region, lat = lat.region, nPCs)
                        PCs <- Subset(reofs$RPCs, along = 2, 1:nPCs, drop = FALSE)

                        ## Visualize all the Euro-Atlantic teleconnection patterns:
                        ## CorrPatterns(ano = SLP.region.anom.sdate, lon = lon.region, lat = lat.region, PCs = PCs, nPCs = nPCs, show = TRUE, var = NULL)

                        ## The pattern that mostly resemble NAO+ is manually selected and inserted in vector below. The first element correspond to the first start date, and so on up to the 12th start date:

                        ## pos.nao <- c(4, 8, 3, 1, 4, 2, 5, 3, 2, 5, 3, 9)
                        pos.nao <- 1 ## in December, NAO is the first PC

                        nao.obs[ss, 1,] <- PCs[, pos.nao]
                        nao.obs.reofs[ss, 1,,] <- reofs$REOFs[pos.nao,,]
                        nao.obs.wght[ss, 1,,] <- reofs$wght
                    }

                    rm(SLP.region.anom, SLP.region.anom.sdate)
                    gc()

                    ## copy observed NAO index for chosen start date on the other start dates:
                    for(std in 1:n.months){
                        if(std != chosen.st.date){
                            nao.obs[std, 1,] <- nao.obs[chosen.st.date, 1, ]
                            nao.obs.reofs[std, 1,,] <- nao.obs.reofs[chosen.st.date, 1,,]
                            nao.obs.wght[std, 1,,] <- nao.obs.wght[chosen.st.date, 1,,]
                        }
                    }

                    ## copy observed NAO index for lead time 1 on the other lead times shifting by 1 year after December:
                    nao.obs.shifted <- nao.obs[,1,] ## take only the first lead of nao.obs [st.d, lead, years]
                    nao.obs.shifted[,1:(n.years-1)] <- nao.obs.shifted[,-1]
                    nao.obs.shifted[, n.years] <- NA
                    nao.obs.double <- abind(nao.obs[,1,], nao.obs.shifted, along = 1)

                    nao.obs.full <- nao.obs ## [st.d, lead, years]
                    for(lead in 1:n.lead.times){
                        nao.obs.full[,lead,] <- nao.obs.double[lead : (lead+11),]
                        ##nao.obs[, ll,] <- nao.obs[,1,]
                        nao.obs.reofs[,lead,,] <- nao.obs.reofs[,1,,]
                        nao.obs.wght[,lead,,] <- nao.obs.wght[,1,,]
                    }

                    ## ## create a triple version of nao.obs to be able to quickly assign NAO indices to the rest of the lead times:
                    ## nao.obs3 <- abind(nao.obs, nao.obs, nao.obs, along = 1)
                    ## for(ll in 2:n.lead.times){
                    ##     nao.obs3[(n.months + 1):(n.months * 2), ll,] <- nao.obs3[(n.months + ll):(n.months * 2 - 1 + ll),1,]
                    ## }

                    ## nao.obs <- nao.obs3[(n.months + 1):(n.months * 2),,]

                    save(nao.obs, nao.obs.reofs, nao.obs.wght, file="./nao_obs.RData") ## for the debug
                    save(nao.obs.full, file="./nao_obs_full.RData") ## for the debug (not debug: needed!)
                } else {
                    load("./nao_obs_full.RData") ## load pre-calculated nao.obs, nao.obs.reofs and nao.obs.wght
                    load("./nao_obs.RData") ## load pre-calculated nao.obs, nao.obs.reofs and nao.obs.wght
                    nao.for <- array(NA, c(n.months, n.lead.times, n.members, n.years)) ## NAO index for each st. date and lead and member
                    for(ss in 1:n.months){ ## fix a start month
                        ## tt2 <- SLP.anom.region[, ss,,,,] ## select only data of chosen start month
                        ## SLP.anom.region2 <- InsertDim(tt2, 1, 1)
                        ## rm(tt2)
                        ## gc()

                        ## data format for NAO() function:
                        ## ano_obs = [1,1, years*, leads**, lat, lon] *all years of a fixed start month
                        ## ano_exp = [1, members, years*, leads**, lat, lon] ** all lead months of a fixed start month
                        for(ll in 1:n.lead.times){
                            for(mm in 1:n.members){
                                print(paste0("Measuring NAO index for start date ", ss, ", lead time ", ll, " and member ", mm))

                                SLP.region.anom.sdate.lead.memb <- SLP.region.anom[,ss,mm,ll,,] ## pos.lon.reord] ## [year, lat ,lon]

                                eof <- list()
                                eof$EOFs <- InsertDim(nao.obs.reofs[ss, ll,,], 1, 1)
                                eof$wght <- nao.obs.wght[ss, ll,,]

                                nao.for[ss, ll, mm,] <- ProjectField2(ano = SLP.region.anom.sdate.lead.memb, eof = eof)
                                ## test <- NAO(ano_exp = SLP.anom.region2, lon = lon.region, lat = lat.region.rev, ftime_average = 1, obsproj = FALSE)
                                ##plot(1:n.years, nao.obs$NAO_obs[1,], type="b") ## plot NAO index
                            } ## close if on mm
                        }  ## close if on ll
                    } ## close if on ss

                    rm(SLP.region.anom)
                    gc()

                    save(nao.for, file="./nao_for.RData") ## for the debug

                }

                if(system.name == "ERA5"){
                    return(nao = nao.obs)
                } else {
                    return(nao = nao.for)
                }

            }

            ## function to measure the scores of NAO index:
            ## input.path is the path of the input netCDF monthly SLP files:
            NAO.scores <- function(system.name, year.start, year.end, lead.months = 1:6, input.path.rean = NULL, input.path.sys = NULL){

                ## bypass it at present because it takes too much time (2h), load saved values instead:
                ##
                ## ## measure obs. and pred. NAO time series
                NAO.obs <- NAO.slp(system.name = "ERA5", year.start = year.start, year.end = year.end, lead.months = 1:6, input.path.rean = input.path.rean, input.path.sys = input.path.sys, grid2interp = system.name) ## format: [start month, lead month, year, grid2interp = system.name]
                NAO.for <- NAO.slp(system.name = system.name, year.start = year.start, year.end = year.end, lead.months = lead.months, input.path.rean = input.path.rean, input.path.sys = input.path.sys, grid2interp = NULL) ## format: [start month, lead month, member, year]

                ## ## for the debug:
                load("./nao_obs_full.RData") ## load observed NAO index ('nao.obs.full') [st.dates, leads, years]
                load("./nao_for.RData") ## load predicted NAO index for each member ('nao.for') [st.dates, leads, members, years]

                my.years <- year.start : year.end
                my.months <- c("01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12")
                n.years <- as.integer(year.end) - as.integer(year.start) + 1
                n.lead.months <- length(lead.months)
                n.start.dates <- 12 ## automatize it in future
                ###n.members <- 25 ## automatize it in future
                if(system.name == "ECMWF System 5") system.filename <- "ecmwfs5"
                if(system.name == "DWD System 2") system.filename <- "dwds2"
                if(system.name == "Météo-France System 7") system.filename <- "meteo_frances7"
                if(system.name == "Météo-France System 6") system.filename <- "meteo_frances6"
                if(system.name == "CMCC System 3") system.filename <- "cmccs3"
                if(system.name == "UK Met Office System 14") system.filename <- "ukmos14"
                if(system.name == "NCEP System 2") system.filename <- "nceps2"
                nc <- nc_open(paste0(input.path.sys, "/mean_sea_level_pressure/", system.filename,
                          "-mean_sea_level_pressure-", my.years[1], my.months[2], "01.nc"))
                n.members <- length(ncvar_get(nc, "number"))
                nc_close(nc)

                ## normalize observed NAO index to get a number from -3 to 3:
                nao.obs.sd <- apply(nao.obs.full, c(1,2), sd, na.rm = TRUE) ## fix st.date and lead and measure the st.dev. over years
                nao.obs.sd.full <- InsertDim(nao.obs.sd, 3, n.years) ## [st.dates, leads, years]
                nao.obs.norm <- nao.obs.full / nao.obs.sd.full ## [st.dates, leads, years]

                ## normalize predicted NAO index to get a number from -3 to 3:
                nao.for.sd <- apply(nao.for, c(1,2), sd, na.rm = TRUE) ## fix st.date and lead and measure sd over members and years
                nao.for.sd.full <- InsertDim(InsertDim(nao.for.sd, 3, n.members), 4, n.years)

                nao.for.norm <- nao.for / nao.for.sd.full ## [st.dates, leads, members, years]

                ## average of observed NAO index over all years: (should be close to 0 but not exactly 0)
                nao.obs.clim <- apply(nao.obs.norm, c(1,2), mean, na.rm = TRUE) ## [st.dates, leads]
                nao.obs.clim.full <- InsertDim(nao.obs.clim, 3, n.years) ## [st.dates, leads, years]

                ## ensemble mean of forecasted NAO index:
                nao.for.ens <- apply(nao.for.norm, c(1,2,4), mean, na.rm = TRUE) ## [start date, lead month, year]
                nao.for.ens.clim <- apply(nao.for.ens, c(1,2), mean, na.rm = TRUE) ## yearly average of the ensemble mean [st.date, lead]

                ## spread of the NAO ensemble mean: (= NAO ensemble spread):
                nao.for.ens.full <- InsertDim(nao.for.ens, 3, n.members)
                nao.for.ens.diff <- nao.for.norm - nao.for.ens.full
                nao.for.ens.spread <- apply(nao.for.ens.diff, c(1,2), sd)

                ## ## definition of spread below is always equal to 1 because nao.for.norm was normalized to 1
                ## ## nao.for.spread <- apply(nao.for.norm, c(1,2), sd, na.rm = TRUE) ## dim: [start months, lead months]

                ## NAO bias: (should be close to 0!)
                nao.bias <- nao.for.ens.clim - nao.obs.clim

                ## compute other error scores of the Niño::
                Corr <- RMSE <- RMSEClim <- RMSSS <- SpreadRatio <- array(NA, c(12, n.lead.months))
                for(mm in 1:12){ ## start month
                    for(ll in 1:n.lead.months){ ## lead month
                        n.years.not.na <- length(which(!is.na(nao.obs.norm[mm, ll,]))) ## count only years without NA
                        Corr[mm, ll] <- cor(nao.for.ens[mm, ll,], nao.obs.norm[mm, ll,], use="na.or.complete")
                        RMSE[mm, ll] <- ((sum((nao.for.ens[mm, ll,] - nao.obs.norm[mm, ll,])^2, na.rm = TRUE)) / n.years.not.na)^0.5
                        SpreadRatio[mm, ll] <- (nao.for.ens.spread[mm, ll] / RMSE[mm, ll])
                        RMSEClim[mm, ll] <- ((sum((nao.obs.norm[mm, ll,] - nao.obs.clim.full[mm, ll,])^2, na.rm = TRUE)) / n.years.not.na)^0.5
                        RMSSS[mm, ll] <- 1 - (RMSE[mm, ll] / RMSEClim[mm, ll])
                    }
                }

                return(list(Mean.bias = nao.bias, Corr = Corr, RMSSS = RMSSS, RMSE = RMSE, RMSEClim = RMSEClim, EnsSpread = nao.for.ens.spread, SpreadRatio = SpreadRatio))
                ##test <- list(Mean.bias = nao.bias, Corr = Corr, RMSSS = RMSSS, RMSE = RMSE, RMSEClim = RMSEClim, EnsSpread = nao.for.ens.spread, SpreadRatio = SpreadRatio)

            } 

            ## ABOVE THIS LINE FUNCTIONS TO COMPUTE THE SCORES
            ## BELOW THIS LINE FUNCTIONS TO PLOT THE SCORECARD

            scorecard_by_index <- function(scores, system.name, system_internal_name, lead.months, dirout, var.unit, var.name, index, regiontitle, scoretypefilename) {
                ## Check inputs:
                if(is.null(scores))
                    stop("You need to provide the scores of el Nino3.4")

                ## number of regions to plot:
                n.teleconnections <- 1
                n.regions <- n.teleconnections
                n.dec <- 2
                #print('+++++++++++++++++++++++++++++++++++1')
                
                ## Load metrics from the 12 netCDF files of the chosen forecast system, one for each start month:
                start.months <- c("01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12")
                n.start.months <- length(start.months)
                n.lead.times <- length(lead.months)
                n.for.months <- length(lead.months)
                #print('+++++++++++++++++++++++++++++++++++2')
                
                ## empty arrays with the score values to plot:
                bias <- corr <- RMSSS <- SpreadRatio <- array(NA, c(n.start.months, n.teleconnections, n.lead.times))

                ## scores <- list(scores.nino[[1]], scores.nao[[1]]) ## scores.system[[1]] ## for the debug
                #print('+++++++++++++++++++++++++++++++++++3')
                

                if(system_internal_name == "ukmo_s14" && index == "nao"){ #removing erroneous data of start month January because of January 1993
                    for(tel in 1:n.teleconnections){
                        for(ff in 1:n.lead.times){
                            scores$Mean.bias[1,ff] <- NA
                            scores$Corr[1,ff] <- NA
                            scores$RMSSS[1,ff] <- NA
                            scores$SpreadRatio[1,ff] <- NA
                        }
                    }     
                }
                for(tel in 1:n.teleconnections){
                    for(mm in 1:n.start.months){
                    for(ff in 1:n.lead.times){
                        bias[mm, tel, ff] <- scores$Mean.bias[mm, ff]
                        corr[mm, tel, ff] <- scores$Corr[mm, ff]
                        RMSSS[mm, tel, ff] <- scores$RMSSS[mm, ff]
                        SpreadRatio[mm, tel, ff] <- scores$SpreadRatio[mm, ff]
                    }
                    }
                }

                #print('+++++++++++++++++++++++++++++++++++4')
                
                ## ## example with random numbers:
                ## bias <- corr <- array(runif(n.start.months*n.teleconnections*n.lead.times, min = -1, max = 1), c(n.start.months, n.teleconnections, n.lead.times))
                ## RMSSS <- SpreadRatio <- array(runif(n.start.months*n.teleconnections*n.lead.times, min = 0.1, max = 2), c(n.start.months, n.teleconnections, n.lead.times))
                ## system.name <- "ECMWF System 5" ## for the debug

                ## round the scores:
                bias <- round(bias, n.dec)
                corr <- round(corr, n.dec)
                RMSSS <- round(RMSSS, n.dec)
                SpreadRatio <- round(SpreadRatio, n.dec)
                #print('+++++++++++++++++++++++++++++++++++5')

                if(scoretypefilename == "target_month_"){
                	## in case of the scorecard by target month, translate values by 1 to shift from start date to target month:   
                	bias2 <- abind(bias, bias, bias, along = 1)
                	for(ff in 2:n.for.months){
                   	    bias2[(n.start.months + 1):(n.start.months * 2),,ff] <- bias2[(n.start.months + 2 - ff):(n.start.months * 2 + 1 - ff),,ff]
                	}
                	bias2 <- bias2[(n.start.months + 1):(n.start.months * 2),,] ## take only central part of the array
                    bias <- InsertDim(bias2, 2, 1)
                    corr2 <- abind(corr, corr, corr, along = 1)
                    for(ff in 2:n.for.months){
                        corr2[(n.start.months + 1):(n.start.months * 2),,ff] <- corr2[(n.start.months + 2 - ff):(n.start.months * 2 + 1 - ff),,ff]
                    }
                    corr2 <- corr2[(n.start.months + 1):(n.start.months * 2),,] ## take only central part of the array
                    corr <- InsertDim(corr2, 2, 1)
                    RMSSS2 <- abind(RMSSS, RMSSS, RMSSS, along = 1)
                    for(ff in 2:n.for.months){
                        RMSSS2[(n.start.months + 1):(n.start.months * 2),,ff] <- RMSSS2[(n.start.months + 2 - ff):(n.start.months * 2 + 1 - ff),,ff]
                    }
                    RMSSS2 <- RMSSS2[(n.start.months + 1):(n.start.months * 2),,] ## take only central part of the array
                    RMSSS <- InsertDim(RMSSS2, 2, 1)
                    SpreadRatio2 <- abind(SpreadRatio, SpreadRatio, SpreadRatio, along = 1)
                    for(ff in 2:n.for.months){
                        SpreadRatio2[(n.start.months + 1):(n.start.months * 2),,ff] <- SpreadRatio2[(n.start.months + 2 - ff):(n.start.months * 2 + 1 - ff),,ff]
                    }
                    SpreadRatio2 <- SpreadRatio2[(n.start.months + 1):(n.start.months * 2),,] ## take only central part of the array
                    SpreadRatio <- InsertDim(SpreadRatio2, 2, 1)
                    rm(bias2, corr2, RMSSS2, SpreadRatio2)	
                }

                ## row titles:
                region.names.figure2 <- rep("", n.for.months)
                region.names.figure2[3] <- regiontitle[3]
                region.names.figure2[4] <- regiontitle[1] 
                region.names.figure2[5] <- regiontitle[2] 
                forecast.month.figure <- 1:n.for.months
                #print('+++++++++++++++++++++++++++++++++++6')
                
                table <- data.frame(Region = region.names.figure2, Forecast_month = forecast.month.figure,
                                    BiasColumn1 = as.vector(t(bias[1,,])), BiasColumn2 = as.vector(t(bias[2,,])),
                                    BiasColumn3 = as.vector(t(bias[3,,])), BiasColumn4 = as.vector(t(bias[4,,])),
                                    BiasColumn5 = as.vector(t(bias[5,,])), BiasColumn6 = as.vector(t(bias[6,,])),
                                    BiasColumn7 = as.vector(t(bias[7,,])), BiasColumn8 = as.vector(t(bias[8,,])),
                                    BiasColumn9 = as.vector(t(bias[9,,])), BiasColumn10 = as.vector(t(bias[10,,])),
                                    BiasColumn11 = as.vector(t(bias[11,,])), BiasColumn12 = as.vector(t(bias[12,,])),
                                    CorrColumn1 = as.vector(t(corr[1,,])), CorrColumn2 = as.vector(t(corr[2,,])),
                                    CorrColumn3 = as.vector(t(corr[3,,])), CorrColumn4 = as.vector(t(corr[4,,])),
                                    CorrColumn5 = as.vector(t(corr[5,,])), CorrColumn6 = as.vector(t(corr[6,,])),
                                    CorrColumn7 = as.vector(t(corr[7,,])), CorrColumn8 = as.vector(t(corr[8,,])),
                                    CorrColumn9 = as.vector(t(corr[9,,])), CorrColumn10 = as.vector(t(corr[10,,])),
                                    CorrColumn11 = as.vector(t(corr[11,,])), CorrColumn12 = as.vector(t(corr[12,,])),
                                    RMSSSColumn1 = as.vector(t(RMSSS[1,,])), RMSSSColumn2 = as.vector(t(RMSSS[2,,])),
                                    RMSSSColumn3 = as.vector(t(RMSSS[3,,])), RMSSSColumn4 = as.vector(t(RMSSS[4,,])),
                                    RMSSSColumn5 = as.vector(t(RMSSS[5,,])), RMSSSColumn6 = as.vector(t(RMSSS[6,,])),
                                    RMSSSColumn7 = as.vector(t(RMSSS[7,,])), RMSSSColumn8 = as.vector(t(RMSSS[8,,])),
                                    RMSSSColumn9 = as.vector(t(RMSSS[9,,])), RMSSSColumn10 = as.vector(t(RMSSS[10,,])),
                                    RMSSSColumn11 = as.vector(t(RMSSS[11,,])), RMSSSColumn12 = as.vector(t(RMSSS[12,,])),
                                    SORColumn1 = as.vector(t(SpreadRatio[1,,])), SORColumn2 = as.vector(t(SpreadRatio[2,,])),
                                    SORColumn3 = as.vector(t(SpreadRatio[3,,])), SORColumn4 = as.vector(t(SpreadRatio[4,,])),
                                    SORColumn5 = as.vector(t(SpreadRatio[5,,])), SORColumn6 = as.vector(t(SpreadRatio[6,,])),
                                    SORColumn7 = as.vector(t(SpreadRatio[7,,])), SORColumn8 = as.vector(t(SpreadRatio[8,,])),
                                    SORColumn9 = as.vector(t(SpreadRatio[9,,])), SORColumn10 = as.vector(t(SpreadRatio[10,,])),
                                    SORColumn11 = as.vector(t(SpreadRatio[11,,])), SORColumn12 = as.vector(t(SpreadRatio[12,,])))
                #print('+++++++++++++++++++++++++++++++++++7')
                ## cell colors of Bias metric:
                ## bias.max <- max(abs(bias), na.rm = TRUE)
                bias.minmax_max <- quantile(bias, 0.98, na.rm = TRUE)
                bias.minmax_min <- quantile(bias, 0.02, na.rm = TRUE)
                bias.max <- max(abs(bias.minmax_min), abs(bias.minmax_max))
                bias.int <- bias.max * c(-1, -0.8, -0.6, -0.4, -0.2, 0, 0.2, 0.4, 0.6, 0.8, 1) ## one point more than the colors below (the intervals)
                bias.int <- round(bias.int, n.dec)
                #print('+++++++++++++++++++++++++++++++++++8')
                
                ##bias.palette <- c('#045a8d','#2b8cbe','#74a9cf','#bdc9e1','#f1eef6','#fef0d9','#fdcc8a','#fc8d59','#e34a33','#b30000') ## (b300000 is red)
                bias.palette <- c('#2D004B', '#542789', '#8073AC', '#B2ABD2', '#D8DAEB', '#FEE0B6', '#FDB863', '#E08214', '#B35806', '#7F3B08')
                colorunder_bias <- "#04040E"
                colorsup_bias <- "#730C04"
                colorunder <- "#04040E"
                colorsup <- "#730C04"
                #print('+++++++++++++++++++++++++++++++++++9')
                
                bias.col <- array("gray", c(n.for.months * n.regions, n.start.months)) ## gray is to detect outliers
                bias.text.col <- array("#2A2A2A", c(n.for.months * n.regions, n.start.months)) ## black is the default text color
                bias.text.bold <- array(TRUE, c(n.for.months * n.regions, n.start.months)) ## TRUE is the default bold value
                #print('+++++++++++++++++++++++++++++++++++10')
                
                for(mm in 1:n.start.months){
                    for(ff in 1:n.for.months){
                        for(rr in 1:n.regions){
                            for(pp in 1:(length(bias.int)-1)){
                                if(is.nan(bias[mm, rr, ff]) | toString(bias[mm,rr,ff]) == "NA"){
                                    bias.col[ff + (rr-1) * n.for.months, mm] <- "gray"
                                    bias.text.col[ff + (rr-1) * n.for.months, mm] <- "gray"
                                } else {
                                    if(bias[mm, rr, ff] >= bias.int[pp] && bias[mm, rr, ff] <= bias.int[pp+1])
                                        bias.col[ff + (rr-1) * n.for.months, mm] <- bias.palette[pp]

                                        if(bias[mm, rr, ff] < bias.int[1]){bias.col[ff + (rr-1) * n.for.months, mm] <- colorunder_bias}
                                        if(bias[mm, rr, ff] > bias.int[length(bias.int)]){bias.col[ff + (rr-1) * n.for.months, mm] <- colorsup_bias}

                                
                                    ## color text in white and bold if background is gray or dark blue or dark red:
                                    if(is.nan(bias[mm, rr, ff]) ||
                                    (!is.nan(bias[mm, rr, ff]) && pp == 1 && bias[mm, rr, ff] < bias.int[2]) ||
                                    (!is.nan(bias[mm, rr, ff]) && pp == 2 && bias[mm, rr, ff] < bias.int[3]) ||
                                    (!is.nan(bias[mm, rr, ff]) && pp == (length(bias.int)-1) && bias[mm, rr, ff] >= bias.int[length(bias.int)-1])){
                                        bias.text.col[ff + (rr-1) * n.for.months, mm] <- "white"
                                        #bias.text.bold[ff + (rr-1) * n.for.months, mm] <- TRUE # T or F to modify the default bold
                                    }
                                }
                            }
                            
                        }
                    }
                } 


               #print('+++++++++++++++++++++++++++++++++++11')
                
                ## cell colors of Correlation metric:
                ## Corr.int <- c(0, 0.2, 0.4, 0.6, 0.8, 1) ## one point more than the colors below (the intervals)
                ## Corr.palette <- c('#fef0d9','#fdcc8a','#fc8d59','#e34a33','#b30000')
                Corr.int <- c(-1, -0.8, -0.6, -0.4, -0.2, 0, 0.2, 0.4, 0.6, 0.8, 1) ## one point more than the colors below (the intervals)
                Corr.palette <- c('#2D004B', '#542789', '#8073AC', '#B2ABD2', '#D8DAEB', '#FEE0B6', '#FDB863', '#E08214', '#B35806', '#7F3B08')
                Corr.col <- array(colorunder, c(n.for.months * n.regions, n.start.months)) ## gray is to detect outliers
                Corr.text.col <- array("#2A2A2A", c(n.for.months * n.regions, n.start.months)) ## black is the default text color
                Corr.text.bold <- array(TRUE, c(n.for.months * n.regions, n.start.months)) ## TRUE is the default bold value
                #print('+++++++++++++++++++++++++++++++++++12')
                

                for(mm in 1:n.start.months){
                    for(ff in 1:n.for.months){
                        for(rr in 1:n.regions){
                            for(pp in 1:(length(Corr.int)-1)){
                                if(is.nan(corr[mm, rr, ff]) | toString(corr[mm, rr, ff]) == "NA"){
                                    Corr.col[ff + (rr-1) * n.for.months, mm] <- "gray"
                                    Corr.text.col[ff + (rr-1) * n.for.months, mm] <- "gray"
                                } else {
                                    if(corr[mm, rr, ff] >= Corr.int[pp] && corr[mm, rr, ff] <= Corr.int[pp+1])
                                        Corr.col[ff + (rr-1) * n.for.months, mm] <- Corr.palette[pp]
                                

                                    ## color text in white and bold if background is gray or dark blue or dark red:
                                    if(is.nan(corr[mm, rr, ff]) ||
                                    (!is.nan(corr[mm, rr, ff]) && pp == 1 && corr[mm, rr, ff] < Corr.int[2]) ||
                                    (!is.nan(corr[mm, rr, ff]) && pp == 2 && corr[mm, rr, ff] < Corr.int[3]) ||
                                    (!is.nan(corr[mm, rr, ff]) && pp == (length(Corr.int)-1) && corr[mm, rr, ff] >= Corr.int[length(Corr.int)-1])){
                                        Corr.text.col[ff + (rr-1) * n.for.months, mm] <- "white"
                                        Corr.text.bold[ff + (rr-1) * n.for.months, mm] <- TRUE
                                    }
                                }
                            }
                        }
                    }
                } 

                #print('+++++++++++++++++++++++++++++++++++13')
                
                ## cell colors of RMSSS metric:
                RMSSS.int <- c(-1, -0.8, -0.6, -0.4, -0.2, 0, 0.2, 0.4, 0.6, 0.8, 1) ## one point more than the colors below (the intervals)
                RMSSS.palette <- c('#2D004B', '#542789', '#8073AC', '#B2ABD2', '#D8DAEB', '#FEE0B6', '#FDB863', '#E08214', '#B35806', '#7F3B08')
                RMSSS.col <- array(colorunder, c(n.for.months * n.regions, n.start.months)) ## deep blue is to detect outliers
                RMSSS.text.col <- array("#2A2A2A", c(n.for.months * n.regions, n.start.months)) ## black is the default text color
                RMSSS.text.bold <- array(TRUE, c(n.for.months * n.regions, n.start.months)) ## TRUE is the defaul bold value

                for(mm in 1:n.start.months){
                    for(ff in 1:n.for.months){
                        for(rr in 1:n.regions){
                            for(pp in 1:(length(RMSSS.int)-1)){
                                if(is.nan(RMSSS[mm, rr, ff]) | toString(RMSSS[mm,rr,ff]) == "NA"){
                                    RMSSS.col[ff + (rr-1) * n.for.months, mm] <- "gray"
                                    RMSSS.text.col[ff + (rr-1) * n.for.months, mm] <- "gray"
                                } else {
                                    if(RMSSS[mm, rr, ff] >= RMSSS.int[pp] && RMSSS[mm, rr, ff] <= RMSSS.int[pp+1])
                                        RMSSS.col[ff + (rr-1) * n.for.months, mm] <- RMSSS.palette[pp]
                                
                                    if(RMSSS[mm, rr, ff] > RMSSS.int[length(RMSSS.int)]){RMSSS.col[ff + (rr-1) * n.for.months, mm] <- colorsup}    
                                
                                    

                                    ## color text in white and bold if background is gray or dark blue or dark red:
                                    if(is.nan(RMSSS[mm, rr, ff]) ||
                                    (!is.nan(RMSSS[mm, rr, ff]) && pp == 1 && RMSSS[mm, rr, ff] < RMSSS.int[2]) ||
                                    (!is.nan(RMSSS[mm, rr, ff]) && pp == 2 && RMSSS[mm, rr, ff] < RMSSS.int[3]) ||
                                    (!is.nan(RMSSS[mm, rr, ff]) && pp == (length(RMSSS.int)-1) && RMSSS[mm, rr, ff] >= RMSSS.int[length(RMSSS.int)-1])){
                                        RMSSS.text.col[ff + (rr-1) * n.for.months, mm] <- "white"
                                        RMSSS.text.bold[ff + (rr-1) * n.for.months, mm] <- TRUE
                                    }
                                }
                            }
                            
                        }
                    }
                } 
                
                #print('+++++++++++++++++++++++++++++++++++14')
                
                ## cell colors of Spread Ratio (SOR) metric:
                #SOR.int <- c(0, 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 1) ## one point more than the colors below (the intervals)
                #SOR.int <- c(0, 0.2, 0.4, 0.6, 0.8, 0.9, 1, 1.1, 1.2, 1.3, 1.5) ## one point more than the colors below (the intervals)
                #SOR.palette <- c('#2D004B', '#542789', '#8073AC', '#B2ABD2', '#D8DAEB', '#FEE0B6', '#FDB863', '#E08214', '#B35806', '#7F3B08') #palette for divergent colorscales
                #SOR.palette <- c('#FEEACC', '#FEEACC', '#FDD8A7', '#FDC38D', '#FCA16C', '#F67B51', '#E7533A', '#AD0000', '#AD0000', '#7F0000') #palette for sequential colorscales (if this one, then cells with first range should be text color black)
                
                SOR.int <- c(0, 0.2, 0.4, 0.6, 0.8, 0.9, 1.1, 1.2, 1.4, 1.6, 1.8) ## one point more than the colors below (the intervals)
                SOR.palette <- c('#2D004B', '#542789', '#8073AC', '#B2ABD2', '#D8DAEB', 'white', '#FDB863', '#E08214', '#B35806', '#7F3B08') #new palette according to https://earth.bsc.es/gitlab/external/c3s512-seasonal-forecast-eqc/-/issues/32#note_143763
                SOR.col <- array(colorunder, c(n.for.months * n.regions, n.start.months)) ## deep blue is to detect outliers
                SOR.text.col <- array("#2A2A2A", c(n.for.months * n.regions, n.start.months)) ## black is the default text color
                SOR.text.bold <- array(TRUE, c(n.for.months * n.regions, n.start.months)) ## TRUE is the default bold value

                for(mm in 1:n.start.months){
                    for(ff in 1:n.for.months){
                        for(rr in 1:n.regions){
                            for(pp in 1:(length(SOR.int)-1)){
                                if(is.nan(SpreadRatio[mm, rr, ff]) | toString(SpreadRatio[mm, rr, ff]) == "NA"){
                                    SOR.col[ff + (rr-1) * n.for.months, mm] <- "gray"
                                    SOR.text.col[ff + (rr-1) * n.for.months, mm] <- "gray"
                                } else {
                                    if(SpreadRatio[mm, rr, ff] >= SOR.int[pp] && SpreadRatio[mm, rr, ff] <= SOR.int[pp+1])
                                        SOR.col[ff + (rr-1) * n.for.months, mm] <- SOR.palette[pp]
                                
                                    if(SpreadRatio[mm, rr, ff] > SOR.int[length(SOR.int)]){SOR.col[ff + (rr-1) * n.for.months, mm] <- colorsup}    
                                
                                

                                    ## color text in white and bold if background is gray or dark blue or dark red:
                                    if (SOR.palette[1] == '#FEEACC'){
                                        if(is.nan(SpreadRatio[mm, rr, ff]) ||
                                        (!is.nan(SpreadRatio[mm, rr, ff]) && pp == (length(SOR.int)-1) && SpreadRatio[mm, rr, ff] >= SOR.int[length(SOR.int)-1])){
                                            SOR.text.col[ff + (rr-1) * n.for.months, mm] <- "white"
                                            SOR.text.bold[ff + (rr-1) * n.for.months, mm] <- TRUE
                                        }
                                    }else{
                                        if(is.nan(SpreadRatio[mm, rr, ff]) ||
                                        (!is.nan(SpreadRatio[mm, rr, ff]) && pp == 1 && SpreadRatio[mm, rr, ff] < SOR.int[2]) ||
                                        (!is.nan(SpreadRatio[mm, rr, ff]) && pp == 2 && SpreadRatio[mm, rr, ff] < SOR.int[3]) ||
                                        (!is.nan(SpreadRatio[mm, rr, ff]) && pp == (length(SOR.int)-1) && SpreadRatio[mm, rr, ff] >= SOR.int[length(SOR.int)-1])){
                                            SOR.text.col[ff + (rr-1) * n.for.months, mm] <- "white"
                                            SOR.text.bold[ff + (rr-1) * n.for.months, mm] <- TRUE
                                        }
                                    }
                                }
                            }
                            
                        }
                    }
                } 
                
                #print('+++++++++++++++++++++++++++++++++++15')
                
                ## table header:
                my.col.names <- c("Climate index", "Forecast month", rep(c("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"), 4))

                options(stringsAsFactors = FALSE)
                my.header.names <- as.data.frame(data.frame(c1=c("", paste0("Mean Bias (", var.unit,")"),
                                                                "Correlation", "RMSSS", "Spread-to-error ratio"), c2=c(2, rep(n.start.months, 4))))
                my.header.names2 <- data.frame(c1 = paste0(var.name, " of ", system.name), c2=50)

                n.columns <- 2 + n.start.months * 4
                #print('+++++++++++++++++++++++++++++++++++16')
                
                ## remove corrupted start dates of CMCC S3:
                if(system.name == "CMCC System 3"){
                    if(scoretypefilename == "start_date_"){
                        ## case of single-level variables by start date:
                        for(j in c(5, 9, 17, 21, 29, 33, 41, 45)) table[,j] <- NaN
                        bias.col[, c(3,7)] <- Corr.col[, c(3,7)] <- RMSSS.col[, c(3,7)] <- SOR.col[, c(3,7)] <- "gray"
                        bias.text.col[, c(3, 7)] <- Corr.text.col[, c(3,7)] <- RMSSS.text.col[, c(3,7)] <- SOR.text.col[, c(3,7)] <- "white"
                    }
                    if(scoretypefilename == "target_month_"){
                        for(i in 1:n.for.months) {
                            for(r in 1:n.regions){
                                for(j in c(5, 9, 17, 21, 29, 33, 41, 45)) table[i + (r-1)*n.for.months, j + (i-1)] <- NaN
                                bias.col[i + (r-1)*n.for.months, c(3,7) + (i-1)] <- Corr.col[i + (r-1)*n.for.months, c(3,7) + (i-1)] <- RMSSS.col[i + (r-1)*n.for.months, c(3,7) + (i-1)] <- SOR.col[i + (r-1)*n.for.months, c(3,7) + (i-1)] <- "gray"
                                bias.text.col[i + (r-1)*n.for.months, c(3, 7) + (i-1)] <- Corr.text.col[i + (r-1)*n.for.months, c(3,7) + (i-1)] <- RMSSS.text.col[i + (r-1)*n.for.months, c(3,7) + (i-1)] <- SOR.text.col[i + (r-1)*n.for.months, c(3,7) + (i-1)] <- "white"
                            }
                        }
                    }
                }

                #print('+++++++++++++++++++++++++++++++++++17')
                
                ## as above, but without normalization:
                table2 <- table

                ## select font size, color of numbers in the table and add decimals with zero in some cases (e.g: 0.1 becomes 0.10, etc):
                for(col in 3:(2 + n.start.months * 4)) {
                    if (col > (2 + n.start.months)) table2[,col] <- format(table[,col], nsmall = 2) else table2[,col] <- format(table[,col], nsmall = n.dec)
                    table2[,col] <- cell_spec(table2[,col], font_size = 8, color="gray70") ## smaller font size
                }
                #print('+++++++++++++++++++++++++++++++++++18')
                
                ## add colored column bars over the data
                ## without data normalization:

                ## ## this would show the color bards inside the figure, but we want the 2D diagrams instead:
                ## for(ss in 1:n.start.months){
                ##     table2[, 2 + ss] <- color_bar_score("red", "#0571b0", mean.bias, ratio = 0.5)(table[, 2 + ss])
                ##     table2[, 2 + n.start.months + ss] <- color_bar_neg("#998ec3","#f1a340", ratio = 0.7)(table[, 2 + n.start.months + ss])
                ##     table2[, 2 + n.start.months * 2 + ss] <- color_bar_neg("violet","lawngreen", ratio = 1.4)(table[, 2 + n.start.months * 2 + ss])
                ##     table2[, 2 + n.start.months * 3 + ss] <- color_bar_neg("violet","lawngreen", ratio = 1.4)(table[, 2 + n.start.months * 3 + ss])
                ## }

                ## replace with "" cells with NaN:
                for(i in 3:n.columns) table2[,i] <- str_replace(table2[,i], "NaN", "")
                #print('+++++++++++++++++++++++++++++++++++19')
                
                ## draw the figure in html:
                if (scoretypefilename == "start_date_"){
                    table.html <- kbl(table2, escape = F, col.names=my.col.names, align = rep("c", n.columns)) %>%
                    kable_paper("hover", full_width = F) %>%
                    add_header_above(c(" " = 2, "Start date" = n.start.months, "Start date" = n.start.months, "Start date" = n.start.months, "Start date" = n.start.months)) %>%
                    add_header_above(c(" " = 2, " " = n.start.months * 4), align = "left", font_size = 14) %>%
                    add_header_above(header = my.header.names, font_size = 20) %>%
                    ##add_header_above(header = my.header.names2, font_size = 20, align = "left") %>%

                    column_spec(2 + n.start.months*0 + 1, background = bias.col[,1], color = bias.text.col[,1], bold = bias.text.bold[,1]) %>%
                    column_spec(2 + n.start.months*0 + 2, background = bias.col[,2], color = bias.text.col[,2], bold = bias.text.bold[,2]) %>%
                    column_spec(2 + n.start.months*0 + 3, background = bias.col[,3], color = bias.text.col[,3], bold = bias.text.bold[,3]) %>%
                    column_spec(2 + n.start.months*0 + 4, background = bias.col[,4], color = bias.text.col[,4], bold = bias.text.bold[,4]) %>%
                    column_spec(2 + n.start.months*0 + 5, background = bias.col[,5], color = bias.text.col[,5], bold = bias.text.bold[,5]) %>%
                    column_spec(2 + n.start.months*0 + 6, background = bias.col[,6], color = bias.text.col[,6], bold = bias.text.bold[,6]) %>%
                    column_spec(2 + n.start.months*0 + 7, background = bias.col[,7], color = bias.text.col[,7], bold = bias.text.bold[,7]) %>%
                    column_spec(2 + n.start.months*0 + 8, background = bias.col[,8], color = bias.text.col[,8], bold = bias.text.bold[,8]) %>%
                    column_spec(2 + n.start.months*0 + 9, background = bias.col[,9], color = bias.text.col[,9], bold = bias.text.bold[,9]) %>%
                    column_spec(2 + n.start.months*0 + 10, background = bias.col[,10], color = bias.text.col[,10], bold = bias.text.bold[,10]) %>%
                    column_spec(2 + n.start.months*0 + 11, background = bias.col[,11], color = bias.text.col[,11], bold = bias.text.bold[,11]) %>%
                    column_spec(2 + n.start.months*0 + 12, background = bias.col[,12], color = bias.text.col[,12], bold = bias.text.bold[,12]) %>%

                    column_spec(2 + n.start.months*1 + 1, background = Corr.col[,1], color = Corr.text.col[,1], bold = Corr.text.bold[,1]) %>%
                    column_spec(2 + n.start.months*1 + 2, background = Corr.col[,2], color = Corr.text.col[,2], bold = Corr.text.bold[,2]) %>%
                    column_spec(2 + n.start.months*1 + 3, background = Corr.col[,3], color = Corr.text.col[,3], bold = Corr.text.bold[,3]) %>%
                    column_spec(2 + n.start.months*1 + 4, background = Corr.col[,4], color = Corr.text.col[,4], bold = Corr.text.bold[,4]) %>%
                    column_spec(2 + n.start.months*1 + 5, background = Corr.col[,5], color = Corr.text.col[,5], bold = Corr.text.bold[,5]) %>%
                    column_spec(2 + n.start.months*1 + 6, background = Corr.col[,6], color = Corr.text.col[,6], bold = Corr.text.bold[,6]) %>%
                    column_spec(2 + n.start.months*1 + 7, background = Corr.col[,7], color = Corr.text.col[,7], bold = Corr.text.bold[,7]) %>%
                    column_spec(2 + n.start.months*1 + 8, background = Corr.col[,8], color = Corr.text.col[,8], bold = Corr.text.bold[,8]) %>%
                    column_spec(2 + n.start.months*1 + 9, background = Corr.col[,9], color = Corr.text.col[,9], bold = Corr.text.bold[,9]) %>%
                    column_spec(2 + n.start.months*1 + 10, background = Corr.col[,10], color = Corr.text.col[,10], bold = Corr.text.bold[,10]) %>%
                    column_spec(2 + n.start.months*1 + 11, background = Corr.col[,11], color = Corr.text.col[,11], bold = Corr.text.bold[,11]) %>%
                    column_spec(2 + n.start.months*1 + 12, background = Corr.col[,12], color = Corr.text.col[,12], bold = Corr.text.bold[,12]) %>%

                    column_spec(2 + n.start.months*2 + 1, background = RMSSS.col[,1], color = RMSSS.text.col[,1], bold = RMSSS.text.bold[,1]) %>%
                    column_spec(2 + n.start.months*2 + 2, background = RMSSS.col[,2], color = RMSSS.text.col[,2], bold = RMSSS.text.bold[,2]) %>%
                    column_spec(2 + n.start.months*2 + 3, background = RMSSS.col[,3], color = RMSSS.text.col[,3], bold = RMSSS.text.bold[,3]) %>%
                    column_spec(2 + n.start.months*2 + 4, background = RMSSS.col[,4], color = RMSSS.text.col[,4], bold = RMSSS.text.bold[,4]) %>%
                    column_spec(2 + n.start.months*2 + 5, background = RMSSS.col[,5], color = RMSSS.text.col[,5], bold = RMSSS.text.bold[,5]) %>%
                    column_spec(2 + n.start.months*2 + 6, background = RMSSS.col[,6], color = RMSSS.text.col[,6], bold = RMSSS.text.bold[,6]) %>%
                    column_spec(2 + n.start.months*2 + 7, background = RMSSS.col[,7], color = RMSSS.text.col[,7], bold = RMSSS.text.bold[,7]) %>%
                    column_spec(2 + n.start.months*2 + 8, background = RMSSS.col[,8], color = RMSSS.text.col[,8], bold = RMSSS.text.bold[,8]) %>%
                    column_spec(2 + n.start.months*2 + 9, background = RMSSS.col[,9], color = RMSSS.text.col[,9], bold = RMSSS.text.bold[,9]) %>%
                    column_spec(2 + n.start.months*2 + 10, background = RMSSS.col[,10], color = RMSSS.text.col[,10], bold = RMSSS.text.bold[,10]) %>%
                    column_spec(2 + n.start.months*2 + 11, background = RMSSS.col[,11], color = RMSSS.text.col[,11], bold = RMSSS.text.bold[,11]) %>%
                    column_spec(2 + n.start.months*2 + 12, background = RMSSS.col[,12], color = RMSSS.text.col[,12], bold = RMSSS.text.bold[,12]) %>%

                    column_spec(2 + n.start.months*3 + 1, background = SOR.col[,1], color = SOR.text.col[,1], bold = SOR.text.bold[,1]) %>%
                    column_spec(2 + n.start.months*3 + 2, background = SOR.col[,2], color = SOR.text.col[,2], bold = SOR.text.bold[,2]) %>%
                    column_spec(2 + n.start.months*3 + 3, background = SOR.col[,3], color = SOR.text.col[,3], bold = SOR.text.bold[,3]) %>%
                    column_spec(2 + n.start.months*3 + 4, background = SOR.col[,4], color = SOR.text.col[,4], bold = SOR.text.bold[,4]) %>%
                    column_spec(2 + n.start.months*3 + 5, background = SOR.col[,5], color = SOR.text.col[,5], bold = SOR.text.bold[,5]) %>%
                    column_spec(2 + n.start.months*3 + 6, background = SOR.col[,6], color = SOR.text.col[,6], bold = SOR.text.bold[,6]) %>%
                    column_spec(2 + n.start.months*3 + 7, background = SOR.col[,7], color = SOR.text.col[,7], bold = SOR.text.bold[,7]) %>%
                    column_spec(2 + n.start.months*3 + 8, background = SOR.col[,8], color = SOR.text.col[,8], bold = SOR.text.bold[,8]) %>%
                    column_spec(2 + n.start.months*3 + 9, background = SOR.col[,9], color = SOR.text.col[,9], bold = SOR.text.bold[,9]) %>%
                    column_spec(2 + n.start.months*3 + 10, background = SOR.col[,10], color = SOR.text.col[,10], bold = SOR.text.bold[,10]) %>%
                    column_spec(2 + n.start.months*3 + 11, background = SOR.col[,11], color = SOR.text.col[,11], bold = SOR.text.bold[,11]) %>%
                    column_spec(2 + n.start.months*3 + 12, background = SOR.col[,12], color = SOR.text.col[,12], bold = SOR.text.bold[,12]) %>% 

                    column_spec(1, bold = TRUE, width_min = "4cm", width_max = "4cm") %>%
                    column_spec(2, bold = TRUE, width_max = "1cm") %>%
                    column_spec(3:n.columns, width_max = "0.9cm", width_min = "0.9cm") %>%
                    #column_spec(c(1, 2, 2+n.start.months, 2+n.start.months*2, 2+n.start.months*3), border_right = TRUE) %>%
                    column_spec(c(1, 2, 2+n.start.months, 2+n.start.months*2, 2+n.start.months*3), border_right = "1px solid black") %>%
                    column_spec(1, border_left = "4px solid gray") %>%
                    column_spec(n.columns, border_right = "4px solid gray") %>%

                    column_spec(c(1,2,14,26,38), border_right = "1px solid black") %>%
                    row_spec(seq(from = 0, to = n.for.months * n.regions, by = n.for.months), extra_css = "border-bottom: 2px solid black", hline_after = TRUE) #1px solid")
                }else{
                    table.html <- kbl(table2, escape = F, col.names=my.col.names, align = rep("c", 2 + n.start.months * 4)) %>%
                    kable_paper("hover", full_width = F) %>%
                    add_header_above(c(" " = 2, "Target month" = n.start.months, "Target month" = n.start.months, "Target month" = n.start.months, "Target month" = n.start.months)) %>%
                    add_header_above(c(" " = 2, " " = n.start.months * 4), align = "left", font_size = 14) %>%
                    add_header_above(header = my.header.names, font_size = 20) %>%
                    ##add_header_above(header = my.header.names2, font_size = 20, align = "left") %>%

                    column_spec(2 + n.start.months*0 + 1, background = bias.col[,1], color = bias.text.col[,1], bold = bias.text.bold[,1]) %>%
                    column_spec(2 + n.start.months*0 + 2, background = bias.col[,2], color = bias.text.col[,2], bold = bias.text.bold[,2]) %>%
                    column_spec(2 + n.start.months*0 + 3, background = bias.col[,3], color = bias.text.col[,3], bold = bias.text.bold[,3]) %>%
                    column_spec(2 + n.start.months*0 + 4, background = bias.col[,4], color = bias.text.col[,4], bold = bias.text.bold[,4]) %>%
                    column_spec(2 + n.start.months*0 + 5, background = bias.col[,5], color = bias.text.col[,5], bold = bias.text.bold[,5]) %>%
                    column_spec(2 + n.start.months*0 + 6, background = bias.col[,6], color = bias.text.col[,6], bold = bias.text.bold[,6]) %>%
                    column_spec(2 + n.start.months*0 + 7, background = bias.col[,7], color = bias.text.col[,7], bold = bias.text.bold[,7]) %>%
                    column_spec(2 + n.start.months*0 + 8, background = bias.col[,8], color = bias.text.col[,8], bold = bias.text.bold[,8]) %>%
                    column_spec(2 + n.start.months*0 + 9, background = bias.col[,9], color = bias.text.col[,9], bold = bias.text.bold[,9]) %>%
                    column_spec(2 + n.start.months*0 + 10, background = bias.col[,10], color = bias.text.col[,10], bold = bias.text.bold[,10]) %>%
                    column_spec(2 + n.start.months*0 + 11, background = bias.col[,11], color = bias.text.col[,11], bold = bias.text.bold[,11]) %>%
                    column_spec(2 + n.start.months*0 + 12, background = bias.col[,12], color = bias.text.col[,12], bold = bias.text.bold[,12]) %>%

                    column_spec(2 + n.start.months*1 + 1, background = Corr.col[,1], color = Corr.text.col[,1], bold = Corr.text.bold[,1]) %>%
                    column_spec(2 + n.start.months*1 + 2, background = Corr.col[,2], color = Corr.text.col[,2], bold = Corr.text.bold[,2]) %>%
                    column_spec(2 + n.start.months*1 + 3, background = Corr.col[,3], color = Corr.text.col[,3], bold = Corr.text.bold[,3]) %>%
                    column_spec(2 + n.start.months*1 + 4, background = Corr.col[,4], color = Corr.text.col[,4], bold = Corr.text.bold[,4]) %>%
                    column_spec(2 + n.start.months*1 + 5, background = Corr.col[,5], color = Corr.text.col[,5], bold = Corr.text.bold[,5]) %>%
                    column_spec(2 + n.start.months*1 + 6, background = Corr.col[,6], color = Corr.text.col[,6], bold = Corr.text.bold[,6]) %>%
                    column_spec(2 + n.start.months*1 + 7, background = Corr.col[,7], color = Corr.text.col[,7], bold = Corr.text.bold[,7]) %>%
                    column_spec(2 + n.start.months*1 + 8, background = Corr.col[,8], color = Corr.text.col[,8], bold = Corr.text.bold[,8]) %>%
                    column_spec(2 + n.start.months*1 + 9, background = Corr.col[,9], color = Corr.text.col[,9], bold = Corr.text.bold[,9]) %>%
                    column_spec(2 + n.start.months*1 + 10, background = Corr.col[,10], color = Corr.text.col[,10], bold = Corr.text.bold[,10]) %>%
                    column_spec(2 + n.start.months*1 + 11, background = Corr.col[,11], color = Corr.text.col[,11], bold = Corr.text.bold[,11]) %>%
                    column_spec(2 + n.start.months*1 + 12, background = Corr.col[,12], color = Corr.text.col[,12], bold = Corr.text.bold[,12]) %>%

                    column_spec(2 + n.start.months*2 + 1, background = RMSSS.col[,1], color = RMSSS.text.col[,1], bold = RMSSS.text.bold[,1]) %>%
                    column_spec(2 + n.start.months*2 + 2, background = RMSSS.col[,2], color = RMSSS.text.col[,2], bold = RMSSS.text.bold[,2]) %>%
                    column_spec(2 + n.start.months*2 + 3, background = RMSSS.col[,3], color = RMSSS.text.col[,3], bold = RMSSS.text.bold[,3]) %>%
                    column_spec(2 + n.start.months*2 + 4, background = RMSSS.col[,4], color = RMSSS.text.col[,4], bold = RMSSS.text.bold[,4]) %>%
                    column_spec(2 + n.start.months*2 + 5, background = RMSSS.col[,5], color = RMSSS.text.col[,5], bold = RMSSS.text.bold[,5]) %>%
                    column_spec(2 + n.start.months*2 + 6, background = RMSSS.col[,6], color = RMSSS.text.col[,6], bold = RMSSS.text.bold[,6]) %>%
                    column_spec(2 + n.start.months*2 + 7, background = RMSSS.col[,7], color = RMSSS.text.col[,7], bold = RMSSS.text.bold[,7]) %>%
                    column_spec(2 + n.start.months*2 + 8, background = RMSSS.col[,8], color = RMSSS.text.col[,8], bold = RMSSS.text.bold[,8]) %>%
                    column_spec(2 + n.start.months*2 + 9, background = RMSSS.col[,9], color = RMSSS.text.col[,9], bold = RMSSS.text.bold[,9]) %>%
                    column_spec(2 + n.start.months*2 + 10, background = RMSSS.col[,10], color = RMSSS.text.col[,10], bold = RMSSS.text.bold[,10]) %>%
                    column_spec(2 + n.start.months*2 + 11, background = RMSSS.col[,11], color = RMSSS.text.col[,11], bold = RMSSS.text.bold[,11]) %>%
                    column_spec(2 + n.start.months*2 + 12, background = RMSSS.col[,12], color = RMSSS.text.col[,12], bold = RMSSS.text.bold[,12]) %>%

                    column_spec(2 + n.start.months*3 + 1, background = SOR.col[,1], color = SOR.text.col[,1], bold = SOR.text.bold[,1]) %>%
                    column_spec(2 + n.start.months*3 + 2, background = SOR.col[,2], color = SOR.text.col[,2], bold = SOR.text.bold[,2]) %>%
                    column_spec(2 + n.start.months*3 + 3, background = SOR.col[,3], color = SOR.text.col[,3], bold = SOR.text.bold[,3]) %>%
                    column_spec(2 + n.start.months*3 + 4, background = SOR.col[,4], color = SOR.text.col[,4], bold = SOR.text.bold[,4]) %>%
                    column_spec(2 + n.start.months*3 + 5, background = SOR.col[,5], color = SOR.text.col[,5], bold = SOR.text.bold[,5]) %>%
                    column_spec(2 + n.start.months*3 + 6, background = SOR.col[,6], color = SOR.text.col[,6], bold = SOR.text.bold[,6]) %>%
                    column_spec(2 + n.start.months*3 + 7, background = SOR.col[,7], color = SOR.text.col[,7], bold = SOR.text.bold[,7]) %>%
                    column_spec(2 + n.start.months*3 + 8, background = SOR.col[,8], color = SOR.text.col[,8], bold = SOR.text.bold[,8]) %>%
                    column_spec(2 + n.start.months*3 + 9, background = SOR.col[,9], color = SOR.text.col[,9], bold = SOR.text.bold[,9]) %>%
                    column_spec(2 + n.start.months*3 + 10, background = SOR.col[,10], color = SOR.text.col[,10], bold = SOR.text.bold[,10]) %>%
                    column_spec(2 + n.start.months*3 + 11, background = SOR.col[,11], color = SOR.text.col[,11], bold = SOR.text.bold[,11]) %>%
                    column_spec(2 + n.start.months*3 + 12, background = SOR.col[,12], color = SOR.text.col[,12], bold = SOR.text.bold[,12]) %>%

                    column_spec(1, bold = TRUE, width_min = "4cm", width_max = "4cm") %>%
                    column_spec(1, border_left = "4px solid black") %>%
                    column_spec(2, bold = TRUE, width_max = "1cm") %>%
                    column_spec(3:n.columns, width_max = "0.9cm", width_min = "0.9cm") %>%
                    #column_spec(c(1, 2, 2+n.start.months, 2+n.start.months*2, 2+n.start.months*3), border_right = TRUE) %>%
                    column_spec(c(1, 2, 2+n.start.months, 2+n.start.months*2, 2+n.start.months*3), border_right = "1px solid black") %>%
                    column_spec(n.columns, border_right = "4px solid black") %>%

                    column_spec(c(1,2,14,26,38), border_right = "2px solid black") %>%
                    row_spec(seq(from = 0, to = n.for.months * n.regions, by = n.for.months), extra_css = "border-bottom: 2px solid black", hline_after = TRUE) #1px solid")
                    
                }
                
                
                #print('+++++++++++++++++++++++++++++++++++20')
                
                ## convert html to .png:
                my.file <- paste0("./scorecard_by_", index, ".png")
                save_kable(table.html, file = my.file)

                ## remove white space below the scorecard (only for VM)
                system(paste0("convert ", my.file, " -gravity South -chop 0x450 ", my.file))

                print("Saving scorecard. Please wait...")
                #print('+++++++++++++++++++++++++++++++++++21')
                
                ## add the color legend:
                png(filename= "./scorecard_legend_RMSSS.png", width=455, height=40)
                ColorBar(brks = RMSSS.int, cols = RMSSS.palette, vertical = FALSE, var_limits=c(-10000000, 1), col_inf = colorunder)
                dev.off()
            
                png(filename= "./scorecard_legend_SOR.png", width=455, height=40)
                ColorBar(brks = SOR.int, cols = SOR.palette, vertical = FALSE, var_limits=c(0, 1), col_sup = colorsup)
                dev.off()

                png(filename= "./scorecard_legend_bias.png", width=455, height=40)
                ColorBar(brks = round(bias.int, n.dec), cols = bias.palette, vertical = FALSE, triangle_ends_scale = 1, col_inf = colorunder_bias, col_sup = colorsup_bias) 
                dev.off()
                
                png(filename= "./scorecard_legend_corr.png", width=455, height=40)
                ColorBar(brks = Corr.int, cols = Corr.palette, vertical = FALSE, triangle_ends_scale = 0, col_inf = colorunder) 
                dev.off()
            
                ## add white space to the left:
                system(paste0("convert ./scorecard_legend_bias.png -background white -splice 225x0 ./scorecard_legend_bias_full.png"))
                
                ## put all legends together:
                system(paste0("montage ./scorecard_legend_bias_full.png ./scorecard_legend_corr.png ./scorecard_legend_RMSSS.png ./scorecard_legend_SOR.png -tile 4x1 -geometry -4+10 ./scorecard_legend_full.png"))
  
                
                ## put legends below the scorecard:
                system(paste0("montage ", my.file, " ./scorecard_legend_full.png -tile 1x2 -geometry +0+0 ", my.file))
                #print('+++++++++++++++++++++++++++++++++++23')
                
                fileout <- paste0(dirout, "scorecard_", index, "_", scoretypefilename, system_internal_name, ".png")
                #print('+++++++++++++++++++++++++++++++++++24')
                print(fileout)
                system(paste0("mv ", my.file, paste0(" ", fileout)))

                ## delete temporary files:
                system("rm ./scorecard_legend_bias.png ./scorecard_legend_bias_full.png ./scorecard_legend_corr.png ./scorecard_legend_RMSSS.png ./scorecard_legend_SOR.png ./scorecard_legend_full.png")
                #print('+++++++++++++++++++++++++++++++++++25')
                
                return(print(paste0("Scorecard figure of el Nino3.4 of variable ", var.name, " and ", system.name," saved in ", fileout)))

                }



            ''')

        initialfunctions = ro.r('''
            initialfunction_conversionfactor <- function(var.name, system.filename) {
                                # transformation of units for data that need transformation for correct visualization
                unitconversionfactor = 1
                if(var.name == "Total precipitation" || var.name == "Snowfall" || var.name == "Runoff" || var.name == "Evaporation"){
                    unitconversionfactor = 10^8
                    }
                if(var.name == "Snow depth" || var.name == "East-west surface stress rate of accumulation" || var.name == "North-south surface stress rate of accumulation"){
                    unitconversionfactor = 10^2
                    }
                if(var.name == "Specific humidity"){
                    unitconversionfactor = 10^6
                    }
                if(var.name == "Snow depth" && system.filename == "meteo_frances7"){
                    unitconversionfactor = 10^-2
                }
               
                return (unitconversionfactor)
            }

            initialfunction_colorscale <- function(var.name) {
                # inverse color scale: 
                #   usually: inverse.scale = FALSE -> blue (min values) to red (max values) 
                #   special vairables: inverse.scale = TRUE -> red (min values) to blue (max values)
                inverse.scale = FALSE
                if(var.name == ""){ #Total precipitation #finally not used: all variables same palette
                    inverse.scale = TRUE
                    }

                return (inverse.scale)
            }

            initialfunction_roundbias <- function(var.name, plevel){
                ## round the scores:
                n.dec <- 2
                if(var.name == "Geopotential" && plevel == 50) n.dec = 0
                if(var.name == "Geopotential" && plevel == 200) n.dec = 0
                if(var.name == "Geopotential" && plevel == 500) n.dec = 0
                if(var.name == "Geopotential" && plevel == 850) n.dec = 0
                
                if(var.name == "Specific humidity" && plevel == 500) n.dec = 0
                if(var.name == "Specific humidity" && plevel == 850) n.dec = 0
                
                if(var.name == "Snow depth") n.dec = 1
                if(var.name == "Mean sea level pressure") n.dec = 0
                if(var.name == "Surface sensible heat flux") n.dec = 1
                if(var.name == "Surface solar radiation downwards") n.dec = 1
                if(var.name == "Snow density") n.dec = 1 
                
                return (n.dec) #, n.dec.leg)
            }

            initialfunction_regionnames_and_borders <- function() {
                #define region names
                region.names <- c("Tropics", "Extra-tropical NH", "Extra-tropical SH") 
                
                ## create full region names to show in the figures:
                region.names.figure_by_region <- c("Tropics (30°S-30°N)", "Extra-tropical NH (30°N-90°N)", "Extra-tropical SH (30°S-90°S)")
                region.names.figure <- c("(30°S-30°N)", "(30°N-90°N)", "(30°S-90°S)")
            
            
                ## set region borders:
                lat.min <- c(-30, 30, -90)
                lat.max <- c(30, 90, -30)
                lon.min <- c("", "", "")
                lon.max <- c("", "", "")

                names <- cbind(region.names, region.names.figure, lat.min, lat.max, lon.min, lon.max, region.names.figure_by_region)

                return (names)
            }

            initialfunction_hindcastsperiod <- function(start.year, end.year, caption){
                ## suffix with hindcast period written in the filename:
                if(caption=="hind"){
                    hindcasts.filename <- paste0(start.year, "to", end.year) #"1993to2016"
                }
                if(caption=="ref"){
                    hindcasts.filename <- paste0("(Ref: ERA5 ", start.year, "-", end.year, ")")
                }
                
                return(hindcasts.filename)
                
            }

            initialfunction_read_data <- function(start.months, input.path, system.filename, var.filename, hindcasts.filename, m, mod.pressure, unitconversionfactor, metric){
                
                bias <- corr <- frpss <- fcrpss <- list()
                rps <- crps <- rps.clim <- crps.clim <- list() ## newline
                for(m in start.months){
                    ## open netCDF file:
                    if(m=="01" & system.filename == "ukmos14"){hindcasts.filename<-"1994to2016"}else{hindcasts.filename<-"1993to2016"}
                    
                    print(paste0("Loading netCDF file: ", paste0(input.path, "/EQCmetrics-", system.filename,
                             "-", var.filename, "-", hindcasts.filename, "-s", m, mod.pressure, ".nc")))

                    nc <- nc_open(paste0(input.path, "/EQCmetrics-", system.filename,
                             "-", var.filename, "-", hindcasts.filename, "-s", m, mod.pressure,".nc"))

                    ## load data from variables:
                    mm <- as.numeric(m)
                    bias[[mm]] <- ncvar_get(nc, "bias")
                    corr[[mm]] <- ncvar_get(nc, "correlation")
                    frpss[[mm]] <- ncvar_get(nc, "frpss")
                    fcrpss[[mm]] <- ncvar_get(nc, "fcrpss")
                    ## newlines
                    rps[[mm]] <- ncvar_get(nc, "rps") ## [lead, lon, lat]
                    crps[[mm]] <- ncvar_get(nc, "crps") ## [lead, lon, lat]
                    rps.clim[[mm]] <- ncvar_get(nc, "rps_clim") ## [lead, lon, lat]
                    crps.clim[[mm]] <- ncvar_get(nc, "crps_clim") ## [lead, lon, lat]
                    
                    
                    ## set to NA values of bias that are exactly 0 because they correspond to mask values 
                    # (as a difference between tho numbers with many decimales can be zero only very rarely). 
                    # Set to NA correlation values or correlation that are infinite. 
                    # Set to NA values of rps.clim and crps.clim that are exactly 0 because they correspond to mask values. 
                    # In this case values are not a difference as for bias, so 0 values may be right values of rps.clim instead of mask values. 
                    # However, an RPS.clim of exactly 0 means perfect climatological forecasts, and this we know it is not possible, 
                    # only explanation is that input data has some issues, for example it is constant data, as in case of Greenland and Antarctica. 
                    # Thus, these grid points can be added to points of the mask.

                    bias[[mm]][which(bias[[mm]] == 0)] <- NA 
                    corr[[mm]][which(is.infinite(corr[[mm]]))] <- NA 
                    rps.clim[[mm]][which(rps.clim[[mm]] == 0)] <- NA 
                    crps.clim[[mm]][which(crps.clim[[mm]] == 0)] <- NA

                    # Data transformation for visualization (special cases):
                    if(unitconversionfactor != 1) bias[[mm]] <- bias[[mm]] * unitconversionfactor
                    if(var.filename == "snow_depth"){
                        bias[[mm]][which(bias[[mm]] < -100)] <- NA ## remove points close to Greenland and Anctartica where sometimes the values of the bias are close to -10 m
                        bias[[mm]][which(bias[[mm]] > 100)] <- NA ## remove points close to Greenland and Anctartica where sometimes the values of the bias are close too high
                    }
                    ## close netCDF:
                    nc_close(nc)
                }              

                if(metric == "bias") data <- bias
                if(metric == "corr") data <- corr
                if(metric == "frpss") data <- frpss
                if(metric == "fcrpss") data <- fcrpss
                if(metric == "rps") data <- rps
                if(metric == "crps") data <- crps
                if(metric == "rps.clim") data <- rps.clim
                if(metric == "crps.clim") data <- crps.clim

                return(data)
            }

            initialfunction_latlon_values <- function(input.path, system.filename, var.filename, hindcasts.filename, mod.pressure, latlon){
                ## open netCDF file:
                m <- "02"
                nc <- nc_open(paste0(input.path, "/EQCmetrics-", system.filename,
                             "-", var.filename, "-", hindcasts.filename, "-s", m, mod.pressure,".nc"))
                coords <- ncvar_get(nc, latlon)
                
                return(coords)
                
            }

            ''')

        R_scorecardfunction1 = ro.r('''
            library(ncdf4) ## to load netCDF files
            library(formattable) ## to plot horizontal color bars
            library(kableExtra) ## to print data in formatted tables
            #library(magick) ## for saving as .png #not necessary
            library(stringr) ## for manipulating mayuscules in the figure title #is it necessary?
            library(s2dverification) ## for function ColorBar()
            library(abind) ## for function abind()

            
            ## function to plot the seasonal scores as a function of the region or of the forecast system.
            ## if you only pass 1 forecast system in "system.names" and more than one region in "region.names",
            ## then it plots the scores as a function of the regions.
            ## if you pass more than 1 forecast system in "system.names" and only one region in "region.names",
            ## then it plot the scores as a function of the system (this last feature is not yet implemented).
            Scorecard_by_region <- function(start.year=year0, end.year=year1, system.filename=sc_centersystem, system.name=sc_centersystemname, var.unit=sc_units, var.filename=sc_varname, var.name=sc_varname_long, plevel=scplevel, input.path = sc_inputpath, fileout = sc_outputpath, varParamId = sc_paramID, lead.months = 1:6) {

                if(plevel==""){
                    mod.pressure <- ""
                    mod.pressure.title <- ""
                }else{
                    plevel <- as.integer(plevel)
                    mod.pressure <- paste0("-p", plevel)
                    mod.pressure.title <- paste0(" at ", plevel, " hPa")
                }

                unitconversionfactor <- initialfunction_conversionfactor(var.name,system.filename)
                inverse.scale <- initialfunction_colorscale(var.name)
                if (unitconversionfactor != 1){var.unit <- paste0(gsub("e-0", "e-", gsub("+0", "", toString(formatC(1/unitconversionfactor, format="e", digits=0)))), " ", var.unit)}
                n.dec <- initialfunction_roundbias(var.name, plevel)
                
                region.names <- initialfunction_regionnames_and_borders()[,1]
                region.names.figure <- initialfunction_regionnames_and_borders()[,7]
                lat.min <- initialfunction_regionnames_and_borders()[,3]
                lat.max <- initialfunction_regionnames_and_borders()[,4]
                lon.min <- c() #initialfunction_regionnames_and_borders()[,5]
                lon.max <- c() #initialfunction_regionnames_and_borders()[,6]
                n.regions <- length(region.names)

                ## suffix with hindcast period written in the filename:
                hindcasts.filename <- initialfunction_hindcastsperiod(start.year, end.year, "hind")
                ref.caption <- initialfunction_hindcastsperiod(start.year, end.year, "ref")
                
                ## Load metrics from the 12 netCDF files of the chosen forecast system, one for each start month:
                #start.months <- c("01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12")
                start.months <- c("01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12")
                n.start.months <- length(start.months)
                
                bias <- initialfunction_read_data(start.months, input.path, system.filename, var.filename, hindcasts.filename, m, mod.pressure, unitconversionfactor, "bias")
                corr <- initialfunction_read_data(start.months, input.path, system.filename, var.filename, hindcasts.filename, m, mod.pressure, unitconversionfactor, "corr")
                frpss <- initialfunction_read_data(start.months, input.path, system.filename, var.filename, hindcasts.filename, m, mod.pressure, unitconversionfactor, "frpss")
                fcrpss <- initialfunction_read_data(start.months, input.path, system.filename, var.filename, hindcasts.filename, m, mod.pressure, unitconversionfactor, "fcrpss")
                rps <- initialfunction_read_data(start.months, input.path, system.filename, var.filename, hindcasts.filename, m, mod.pressure, unitconversionfactor, "rps")
                crps <- initialfunction_read_data(start.months, input.path, system.filename, var.filename, hindcasts.filename, m, mod.pressure, unitconversionfactor, "crps")
                rps.clim <- initialfunction_read_data(start.months, input.path, system.filename, var.filename, hindcasts.filename, m, mod.pressure, unitconversionfactor, "rps.clim")
                crps.clim <- initialfunction_read_data(start.months, input.path, system.filename, var.filename, hindcasts.filename, m, mod.pressure, unitconversionfactor, "crps.clim")

                ## load lat and lon values:
                lat.netCDF <- initialfunction_latlon_values(input.path, system.filename, var.filename, hindcasts.filename, mod.pressure, "latitude")
                lon.netCDF <- initialfunction_latlon_values(input.path, system.filename, var.filename, hindcasts.filename, mod.pressure, "longitude")
                
                ## position of lat and lon min and max values inside the netCDF:
                pos.lat.min <- pos.lat.max <- pos.lon.min <- pos.lon.max <- c()
                for(i in 1:n.regions){
                    if(is.null(lat.min)) pos.lat.min[i] <- length(lat.netCDF) else pos.lat.min[i] <- which(lat.netCDF >= as.integer(lat.min[i]))[length(which(lat.netCDF >= as.integer(lat.min[i])))]
                    if(is.null(lat.max)) pos.lat.max[i] <- 1 else pos.lat.max[i] <- which(lat.netCDF <= as.integer(lat.max[i]))[1]
                    if(is.null(lon.min)) pos.lon.min[i] <- 1 else pos.lon.min[i] <- which(lon.netCDF == as.integer(lon.min[i]))
                    if(is.null(lon.max)) pos.lon.max[i] <- length(lon.netCDF) else pos.lon.max[i] <- which(lon.netCDF == as.integer(lon.max[i]))
                }
    
                ## forecast month to extract:
                my.for.months <- 1:6 ## select only the first 6 forecast months even if there are 8 in total; last two are probably f.months 2-4 and 3-5
                n.for.months <- length(my.for.months)
    

                ### START DIFFERENT SCRIPT ###
                ## empty arrays with the score values to plot:
                mean.bias <- mean.corr <- mean.fcrpss <- mean.frpss <- array(NA, c(n.start.months, n.regions, n.for.months))
                mean.crpss <- mean.rpss <- mean.crps <- mean.rps <- mean.crps.clim <- mean.rps.clim <- array(NA, c(n.start.months, n.regions, n.for.months)) ## newline

                for(i in 1:n.regions){
                    for(m in start.months){
                        mm <- as.numeric(m)

                        ## select only scores inside the target region: [lon, lat, n.for.months]
                        bias.region <- bias[[mm]][pos.lon.min[i]:pos.lon.max[i], pos.lat.max[i]:pos.lat.min[i], my.for.months]
                        corr.region <- corr[[mm]][pos.lon.min[i]:pos.lon.max[i], pos.lat.max[i]:pos.lat.min[i], my.for.months]
                        fcrpss.region <- fcrpss[[mm]][my.for.months, pos.lon.min[i]:pos.lon.max[i], pos.lat.max[i]:pos.lat.min[i]]
                        frpss.region <- frpss[[mm]][my.for.months, pos.lon.min[i]:pos.lon.max[i], pos.lat.max[i]:pos.lat.min[i]]

                        ## newlines:
                        rps.region <- rps[[mm]][my.for.months, pos.lon.min[i]:pos.lon.max[i], pos.lat.max[i]:pos.lat.min[i]]
                        crps.region <- crps[[mm]][my.for.months, pos.lon.min[i]:pos.lon.max[i], pos.lat.max[i]:pos.lat.min[i]]
                        rps.clim.region <- rps.clim[[mm]][my.for.months, pos.lon.min[i]:pos.lon.max[i], pos.lat.max[i]:pos.lat.min[i]]
                        crps.clim.region <- crps.clim[[mm]][my.for.months, pos.lon.min[i]:pos.lon.max[i], pos.lat.max[i]:pos.lat.min[i]]
                        rps.region[which(is.infinite(rps.region))] <- -1 ## replace -Inf with -100 or the average will be -Inf too
                        crps.region[which(is.infinite(crps.region))] <- -1 ## replace -Inf with -100 or the average will be -Inf too
                        rps.clim.region[which(is.infinite(rps.region))] <- -1 ## replace -Inf with -100 or the average will be -Inf too
                        crps.clim.region[which(is.infinite(crps.region))] <- -1 ## replace -Inf with -100 or the average will be -Inf too
                        mean.rps[mm, i,] <- apply(rps.region, 1, mean, na.rm = TRUE)
                        mean.crps[mm, i,] <- apply(crps.region, 1, mean, na.rm = TRUE)
                        mean.rps.clim[mm, i,] <- apply(rps.clim.region, 1, mean, na.rm = TRUE)
                        mean.crps.clim[mm, i,] <- apply(crps.clim.region, 1, mean, na.rm = TRUE)
                        mean.rpss[mm, i,] <- 1 - mean.rps[mm, i,] / mean.rps.clim[mm, i,]
                        mean.crpss[mm, i,] <- 1 - mean.crps[mm, i,] / mean.crps.clim[mm, i,]

                        ## average score values inside the target region:
                        mean.bias[mm, i,] <- apply(bias.region, 3, mean, na.rm = TRUE) ## [n.start.months, n.regions, n.for.months]
                        mean.corr[mm, i,] <- apply(corr.region, 3, mean, na.rm = TRUE)
                        mean.fcrpss[mm, i,] <- apply(fcrpss.region, 1, mean, na.rm = TRUE)
                        mean.frpss[mm, i,] <- apply(frpss.region, 1, mean, na.rm = TRUE)

                        ## for the debug:
                        ## PlotEquiMap(bias.region[,, 2], lon=lon.netCDF[pos.lon.min[i] : pos.lon.max[i]], lat=lat.netCDF[pos.lat.max[i] : pos.lat.min[i]], filled.continents = FALSE, brks=c(-100, -5, -4, -3, -2, -1, 0, 1, 2, 3, 4, 5, 100))
                        ## PlotEquiMap(corr.region[,,2], lon=lon.netCDF[pos.lon.min[i] : pos.lon.max[i]], lat=lat.netCDF[pos.lat.max[i] : pos.lat.min[i]], filled.continents = FALSE, brks=c(-10, -9, -8, -7, -6, -5, -4, -3, -2, -1, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10)/10)

                    }
                } 

                ## set values more negative of -1 to -1:
                mean.fcrpss[which(mean.fcrpss < -1)] <- -1
                mean.frpss[which(mean.frpss < -1)] <- -1

                ## round the scores:
                mean.bias <- round(mean.bias, n.dec)
                mean.corr <- round(mean.corr, 2)
                mean.fcrpss <- round(mean.fcrpss, 2)
                mean.frpss <- round(mean.frpss, 2)
                ## newlines:
                mean.crpss <- round(mean.crpss, 2)
                mean.rpss <- round(mean.rpss, 2)

                ## list of start months (spaces are needed to draw empty rows in the figure):
                month.names <- c("","January", "", "", "February", "", "", "March", "", "", "April", "", "", "May", "", "", "June", "", "", "July", "", "", "August", "", "", "September", "", "", "October", "", "", "November", "", "", "December", "")

                ## for snow variables, remove the Tropics region:
                if(var.name == "Snowfall" || var.name == "Snow density" || var.name == "Snow depth" || var.name == "Sea-ice cover"){
                    mean.bias <- mean.bias[,-1,]
                    mean.corr <- mean.corr[,-1,]
                    mean.crpss <- mean.crpss[,-1,]
                    mean.rpss <- mean.rpss[,-1,]
                    region.names.figure <- region.names.figure[-1]
                    n.regions <- 2
                    month.names <- c("January", "", "February", "", "March", "" , "April", "", "May", "", "June", "", "July", "", "August", "", "September", "", "October", "", "November", "", "December", "")
                }

                ## data inside the table to plot:
                table <- data.frame(Start_date = month.names, Region = region.names.figure,
                        BiasLead1 = as.vector(t(mean.bias[,,1])), BiasLead2 = as.vector(t(mean.bias[,,2])),
                        BiasLead3 = as.vector(t(mean.bias[,,3])), BiasLead4 = as.vector(t(mean.bias[,,4])),
                        BiasLead5 = as.vector(t(mean.bias[,,5])), BiasLead6 = as.vector(t(mean.bias[,,6])),
                        CorrLead1 = as.vector(t(mean.corr[,,1])), CorrLead2 = as.vector(t(mean.corr[,,2])),
                        CorrLead3 = as.vector(t(mean.corr[,,3])), CorrLead4 = as.vector(t(mean.corr[,,4])),
                        CorrLead5 = as.vector(t(mean.corr[,,5])), CorrLead6 = as.vector(t(mean.corr[,,6])),
                        CrpssLead1 = as.vector(t(mean.crpss[,,1])), CrpssLead2 = as.vector(t(mean.crpss[,,2])),
                        CrpssLead3 = as.vector(t(mean.crpss[,,3])), CrpssLead4 = as.vector(t(mean.crpss[,,4])),
                        CrpssLead5 = as.vector(t(mean.crpss[,,5])), CrpssLead6 = as.vector(t(mean.crpss[,,6])),
                        RpssLead1 = as.vector(t(mean.rpss[,,1])), RpssLead2 = as.vector(t(mean.rpss[,,2])),
                        RpssLead3 = as.vector(t(mean.rpss[,,3])), RpssLead4 = as.vector(t(mean.rpss[,,4])),
                        RpssLead5 = as.vector(t(mean.rpss[,,5])), RpssLead6 = as.vector(t(mean.rpss[,,6])))

                ## table header:
                my.col.names <- c("Start date", "Region", 1:6, 1:6, 1:6, 1:6)

                ## add mayuscule to first letter add remove the eventual mayuscule in the second part of the variable name:
                ##var.name.min <- paste0(toupper(substring(var.name, 1, 1)), substring(str_to_lower(var.name), 2, nchar(var.name)))
                var.name.min <- var.name #("varname_long" from attrs)

                options(stringsAsFactors = FALSE)
                my.header.names <- as.data.frame(data.frame(c1=c("", "", paste0("Mean Bias (", var.unit,")"),
                                                     "Correlation", "CRPSS", "RPSS"), c2=c(1, 1, 6, 6, 6, 6)))
                
                my.header.names2 <- data.frame(c1=paste0(var.name.min, mod.pressure.title, " of ", system.name), c2=26)
                                
                n.columns <- 2 + n.for.months * 4
                
                table.col <- rep("white", 12 * n.regions)

                #remove "known issue" data from cmcc-3:
                ## remove corrupted start dates of CMCC S3:
                if(system.name == "CMCC-S3"){
                    if(plevel==""){
                        ## case of single-level variables:
                        if(n.regions == 3) my.rows <- c(7:9, 19:21) else my.rows <- c(5:6, 13:14)
                        for(i in my.rows) { 
                            for(j in 3:n.columns) table[i,j] <- NaN
                        }
                    } else { ## case of pressure-levels variables:
                        if(n.regions == 3) my.rows <- 7:27 else my.rows <- 5:18
                        for(i in my.rows) {
                            for(j in 3:n.columns) table[i,j] <- NaN
                        }
                    }
                    table.col[my.rows] <- "gray"
                }
                
                ## add colored column bars over the data
                ## without data normalization:
                table2 <- table

                ## select the number of decimals to show, their font size and color:
                for(col in 3:(2 + n.for.months * 4)) {
                    if (col > (2 + n.for.months)) table2[,col] <- format(table[,col], nsmall = 2) else table2[,col] <- format(table[,col], nsmall = n.dec)
                    table2[,col] <- cell_spec(table2[,col], font_size = 8, color="gray70") ## smaller font size
                }
                
                #old color scale:
                #if(inverse.scale==TRUE){
                #    for(i in 3:(2+n.for.months)) table2[,i] <- color_bar_score("red", "#0571B0", mean.bias, ratio = 0.5)(table[,i])
                #}else{    
                #    for(i in 3:(2+n.for.months)) table2[,i] <- color_bar_score("#0571B0", "red", mean.bias, ratio = 0.5)(table[,i])
                #}
                #for(i in (3+n.for.months):(2+n.for.months*2)) table2[,i] <- color_bar_neg("#998EC3","#F1A340", ratio = 0.7)(table[,i])
                #for(i in (3+n.for.months*2):(2+n.for.months*3)) table2[,i] <- color_bar_score("violet","lawngreen", mean.crpss, ratio = 0.5)(table[,i])
                #for(i in (3+n.for.months*3):(2+n.for.months*4)) table2[,i] <- color_bar_score("violet","lawngreen", mean.rpss, ratio = 0.5)(table[,i])
                
                #new color scale:
                cols <- rev(rep(c("#ef8a62","#67a9cf"), 4))
                for(i in 3:(2+n.for.months)) table2[,i] <- color_bar_score(cols[1], cols[2], mean.bias, ratio = 0.5)(table[,i])
                for(i in (3+n.for.months):(2+n.for.months*2)) table2[,i] <- color_bar_neg(cols[3], cols[4], ratio = 0.7)(table[,i])
                for(i in (3+n.for.months*2):(2+n.for.months*3)) table2[,i] <- color_bar_score(cols[5], cols[6], mean.crpss, ratio = 0.5)(table[,i])
                for(i in (3+n.for.months*3):(2+n.for.months*4)) table2[,i] <- color_bar_score(cols[7], cols[8], mean.rpss, ratio = 0.5)(table[,i])


                ## replace with "No Data" cells with NaN:
                for(i in 3:n.columns) table2[,i] <- str_replace(table2[,i], "NaN", "")

                ## draw the figure in html: OLD VERSION
                #table.html <- kbl(table2, escape = F, col.names=my.col.names, align = rep("c", 26)) %>%
                #    kable_paper("hover", full_width = F) %>%
                #    add_header_above(c(" " = 2, "Forecast month" = 6, "Forecast month" = 6, "Forecast month" = 6, "Forecast month" = 6)) %>%
                #    ##add_header_above(c("." = 26), font_size = 15, color = "white") %>%
                #    add_header_above(c("(Ref: ERA5 1993-2016)" = 2, " " = 24), align = "left", font_size = 15) %>%
                #    add_header_above(header = my.header.names, font_size = 20) %>%
                #    add_header_above(header = my.header.names2, font_size = 20, align = "left") %>%
                #    column_spec(1, bold = TRUE, width_min = "3.5cm") %>%
                #    column_spec(2, bold = TRUE, width_min = "6cm") %>%
                #    column_spec(3:26, width_min = "3cm") %>%
                #    column_spec(c(1,2,8,14,20), border_right = TRUE) %>%
                #    column_spec(1, border_left = "4px solid gray") %>%
                #    column_spec(26, border_right = "4px solid gray") %>%
                #    #row_spec(seq(from = 0, to = n.start.months * 3, by = 3), extra_css = "border-bottom: 1px solid")
                #    row_spec(seq(from = 0, to = n.start.months * n.regions, by = n.regions), extra_css = "border-bottom: 1px solid")
                ## draw the figure in html:
                #table.html <- kbl(table2, escape = F, col.names=my.col.names, align = rep("c", 26)) %>%
                #    kable_paper("hover", full_width = F) %>%
                #    add_header_above(c(" " = 2, "Forecast month" = 6, "Forecast month" = 6, "Forecast month" = 6, "Forecast month" = 6)) %>%
                #    add_header_above(c("(Ref: ERA5 1993-2016)" = 2, " " = 24), align = "left", font_size = 15) %>%
                #    add_header_above(header = my.header.names, font_size = 20) %>%
                #    add_header_above(header = my.header.names2, font_size = 20, align = "left") %>%
                #    column_spec(1, bold = TRUE, width_min = "3.5cm") %>%
                #    column_spec(2, bold = TRUE, width_min = "6cm") %>%
                #    column_spec(3:26, width_min = "3cm", background = table.col) %>%
                #    column_spec(c(1,2,8,14,20), border_right = "2px solid gray") %>%
                #    column_spec(1, border_left = "4px solid gray") %>%
                #    column_spec(26, border_right = "4px solid gray") %>%
                #    row_spec(seq(from = 0, to = n.start.months * n.regions, by = n.regions), extra_css = "border-bottom: 1px solid") %>%
                   # add_footnote() %>%
                   # footnote(
                   #     general = c("",
                   #         "<i>Note:</i> eventual cells in grey represent start dates with data issues (e.g. corrupted values, missing start dates)."
                   #     ),
                   #     general_title = "<sub>.</sub>",
                   #     footnote_as_chunk = F ,
                   #     escape = F
                   # )
                table.html <- kbl(table2, escape = F, col.names=my.col.names, align = rep("c", 26)) %>%
                    kable_paper("hover", full_width = F) %>%
                    add_header_above(c(" " = 2, "Forecast month" = 6, "Forecast month" = 6, "Forecast month" = 6, "Forecast month" = 6)) %>%
                    add_header_above(c("(Ref: ERA5 1993-2016)" = 2, " " = 24), align = "left", font_size = 15) %>%
                    add_header_above(header = my.header.names, font_size = 20) %>%
                    add_header_above(header = my.header.names2, font_size = 20, align = "left") %>%
                    column_spec(1, bold = TRUE, width_min = "3.5cm") %>%
                    column_spec(2, bold = TRUE, width_min = "6.5cm") %>%
                    column_spec(3:26, width_min = "3cm", background = table.col) %>%
                    column_spec(c(1,2,8,14,20), border_right = "2px solid gray") %>%
                    column_spec(1, border_left = "4px solid gray") %>%
                    column_spec(26, border_right = "4px solid gray") %>%
                    row_spec(seq(from = 0, to = n.start.months * n.regions, by = n.regions), extra_css = "border-bottom: 1px solid")

                print("Saving scorecard. Please wait...")
                ## convert html to .png:
                my.file <- "./scorecard_by_region.png"
                save_kable(table.html, file = my.file)
                
                ## move scorecard to the chosen dir:
                ## (it cannot done in the previous command because of a bug in save_kable)
                # old convention filename:
                #if (is.na(plevel)==TRUE){scorecardname <- paste0("-scorecard_by_region-era5-global-s-l-p", "-", substr(hindcasts.filename,1,4), "_", substr(hindcasts.filename,7,10), ".png")}
                #else{scorecardname <- paste0("-scorecard_by_region-era5-global-s-l-p", plevel, "-", substr(hindcasts.filename,1,4), "_", substr(hindcasts.filename,7,10), ".png")}
                # new convention filename:
                if (is.na(plevel)==TRUE){scorecardname <- paste0("-scorecard_by_region-global-p", "-", substr(hindcasts.filename,1,4), "_", substr(hindcasts.filename,7,10), "-era5.png")}
                else{scorecardname <- paste0("-scorecard_by_region-global-p", plevel, "-", substr(hindcasts.filename,1,4), "_", substr(hindcasts.filename,7,10), "-era5.png")}
            
                if (file.exists(paste0(fileout, "/", gsub("s", "-", system.filename), "-", varParamId, scorecardname)) == TRUE){system(paste0("rm ", paste0(fileout, "/", gsub("s", "-", system.filename), "-", varParamId, scorecardname)))}
                system(paste0("mv ", my.file, paste0(" ", fileout, "/", gsub("s", "-", system.filename), "-", varParamId, scorecardname)))
                
                print(paste0(fileout, "/", gsub("s", "-", system.filename), "-", varParamId, scorecardname))
                return(print(paste0("Scorecard type 1 figure of variable ", var.name, " and system ", system.name," saved")))
            }
            ''')

        R_scorecardfunction2 = ro.r('''
            library(ncdf4) ## to load netCDF files
            library(formattable) ## to plot horizontal color bars
            library(kableExtra) ## to print data in formatted tables
            #library(magick) ## for saving as .png #not necessary
            library(stringr) ## for manipulating mayuscules in the figure title
            library(s2dverification) ## for function ColorBar()
            library(abind) ## for function abind()

            ## plot many figures in the same panel (region x score) with colors in the background instead of bar plots:
            Scorecard_by_start_date <- function(start.year=year0, end.year=year1, system.filename=sc_centersystem, system.name=sc_centersystemname, var.unit=sc_units, var.filename=sc_varname, var.name=sc_varname_long, plevel=scplevel, input.path = sc_inputpath, fileout = sc_outputpath, varParamId = sc_paramID, lead.months = 1:6) {
                
                if(plevel==""){
                    mod.pressure <- ""
                    mod.pressure.title <- ""
                }else{
                    plevel <- as.integer(plevel)
                    mod.pressure <- paste0("-p", plevel)
                    mod.pressure.title <- paste0(" at ", plevel, " hPa")
                }

                unitconversionfactor <- initialfunction_conversionfactor(var.name, system.filename)
                inverse.scale <- initialfunction_colorscale(var.name)
                if (unitconversionfactor != 1){var.unit <- paste0(gsub("e-0", "e-", gsub("+0", "", toString(formatC(1/unitconversionfactor, format="e", digits=0)))), " ", var.unit)}
                n.dec <- initialfunction_roundbias(var.name, plevel)
                
                region.names <- initialfunction_regionnames_and_borders()[,1]
                region.names.figure <- initialfunction_regionnames_and_borders()[,2]
                lat.min <- initialfunction_regionnames_and_borders()[,3]
                lat.max <- initialfunction_regionnames_and_borders()[,4]
                lon.min <- c() #initialfunction_regionnames_and_borders()[,5]
                lon.max <- c() #initialfunction_regionnames_and_borders()[,6]
                n.regions <- length(region.names)

                ## suffix with hindcast period written in the filename:
                hindcasts.filename <- initialfunction_hindcastsperiod(start.year, end.year, "hind")
                ref.caption <- initialfunction_hindcastsperiod(start.year, end.year, "ref")

                ## Load metrics from the 12 netCDF files of the chosen forecast system, one for each start month:
                start.months <- c("01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12")
                n.start.months <- length(start.months)
                
                bias <- initialfunction_read_data(start.months, input.path, system.filename, var.filename, hindcasts.filename, m, mod.pressure, unitconversionfactor, "bias")
                corr <- initialfunction_read_data(start.months, input.path, system.filename, var.filename, hindcasts.filename, m, mod.pressure, unitconversionfactor, "corr")
                frpss <- initialfunction_read_data(start.months, input.path, system.filename, var.filename, hindcasts.filename, m, mod.pressure, unitconversionfactor, "frpss")
                fcrpss <- initialfunction_read_data(start.months, input.path, system.filename, var.filename, hindcasts.filename, m, mod.pressure, unitconversionfactor, "fcrpss")
                rps <- initialfunction_read_data(start.months, input.path, system.filename, var.filename, hindcasts.filename, m, mod.pressure, unitconversionfactor, "rps")
                crps <- initialfunction_read_data(start.months, input.path, system.filename, var.filename, hindcasts.filename, m, mod.pressure, unitconversionfactor, "crps")
                rps.clim <- initialfunction_read_data(start.months, input.path, system.filename, var.filename, hindcasts.filename, m, mod.pressure, unitconversionfactor, "rps.clim")
                crps.clim <- initialfunction_read_data(start.months, input.path, system.filename, var.filename, hindcasts.filename, m, mod.pressure, unitconversionfactor, "crps.clim")

                ## load lat and lon values:
                lat.netCDF <- initialfunction_latlon_values(input.path, system.filename, var.filename, hindcasts.filename, mod.pressure, "latitude")
                lon.netCDF <- initialfunction_latlon_values(input.path, system.filename, var.filename, hindcasts.filename, mod.pressure, "longitude")
                
                ## position of lat and lon min and max values inside the netCDF:
                pos.lat.min <- pos.lat.max <- pos.lon.min <- pos.lon.max <- c()
                for(i in 1:n.regions){
                    if(is.null(lat.min)) pos.lat.min[i] <- length(lat.netCDF) else pos.lat.min[i] <- which(lat.netCDF >= as.integer(lat.min[i]))[length(which(lat.netCDF >= as.integer(lat.min[i])))]
                    if(is.null(lat.max)) pos.lat.max[i] <- 1 else pos.lat.max[i] <- which(lat.netCDF <= as.integer(lat.max[i]))[1]
                    if(is.null(lon.min)) pos.lon.min[i] <- 1 else pos.lon.min[i] <- which(lon.netCDF == as.integer(lon.min[i]))
                    if(is.null(lon.max)) pos.lon.max[i] <- length(lon.netCDF) else pos.lon.max[i] <- which(lon.netCDF == as.integer(lon.max[i]))
                }
    
                ## forecast month to extract:
                my.for.months <- 1:6 ## select only the first 6 forecast months even if there are 8 in total; last two are probably f.months 2-4 and 3-5
                n.for.months <- length(my.for.months)
    
                ### START DIFFERENT SCRIPT ###
                ## empty arrays with the score values to plot:
                mean.bias <- mean.corr <- mean.fcrpss <- mean.frpss <- array(NA, c(n.start.months, n.regions, n.for.months))
                mean.crpss <- mean.rpss <- mean.crps <- mean.rps <- mean.crps.clim <- mean.rps.clim <- array(NA, c(n.start.months, n.regions, n.for.months)) ## newline

                for(i in 1:n.regions){
                    for(m in start.months){
                        mm <- as.numeric(m)

                        ## select only scores inside the target region: [lon, lat, n.for.months]
                        bias.region <- bias[[mm]][pos.lon.min[i]:pos.lon.max[i], pos.lat.max[i]:pos.lat.min[i], my.for.months]
                        corr.region <- corr[[mm]][pos.lon.min[i]:pos.lon.max[i], pos.lat.max[i]:pos.lat.min[i], my.for.months]
                        fcrpss.region <- fcrpss[[mm]][my.for.months, pos.lon.min[i]:pos.lon.max[i], pos.lat.max[i]:pos.lat.min[i]]
                        frpss.region <- frpss[[mm]][my.for.months, pos.lon.min[i]:pos.lon.max[i], pos.lat.max[i]:pos.lat.min[i]]
                        
                        ## measure rps and crps:
                        rps.region <- rps[[mm]][my.for.months, pos.lon.min[i]:pos.lon.max[i], pos.lat.max[i]:pos.lat.min[i]]
                        crps.region <- crps[[mm]][my.for.months, pos.lon.min[i]:pos.lon.max[i], pos.lat.max[i]:pos.lat.min[i]]
                        rps.clim.region <- rps.clim[[mm]][my.for.months, pos.lon.min[i]:pos.lon.max[i], pos.lat.max[i]:pos.lat.min[i]]
                        crps.clim.region <- crps.clim[[mm]][my.for.months, pos.lon.min[i]:pos.lon.max[i], pos.lat.max[i]:pos.lat.min[i]]
                        rpss.region <- 1 - rps.region / rps.clim.region
                        crpss.region <- 1 - crps.region / crps.clim.region

                        ## replace values with (-)Inf with NA or the average will be (-)Inf too: (but infinite values should be absent in theory)
                        rps.region[which(is.infinite(rps.region))] <- NA 
                        crps.region[which(is.infinite(crps.region))] <- NA 
                        rps.clim.region[which(is.infinite(rps.region))] <- NA
                        crps.clim.region[which(is.infinite(crps.region))] <- NA 
                        fcrpss.region[which(is.infinite(fcrpss.region))] <- NA 
                        frpss.region[which(is.infinite(frpss.region))] <- NA 
                        rpss.region[which(is.infinite(rpss.region))] <- NA 
                        crpss.region[which(is.infinite(crpss.region))] <- NA
                            
                        ## average score values inside the target region: 
                        mean.bias[mm, i,] <- apply(bias.region, 3, mean, na.rm = TRUE) ## [n.start.months, n.regions, n.for.months]
                        mean.corr[mm, i,] <- apply(corr.region, 3, mean, na.rm = TRUE)
                        mean.rps[mm, i,] <- apply(rps.region, 1, mean, na.rm = TRUE)
                        mean.crps[mm, i,] <- apply(crps.region, 1, mean, na.rm = TRUE)
                        mean.rps.clim[mm, i,] <- apply(rps.clim.region, 1, mean, na.rm = TRUE)
                        mean.crps.clim[mm, i,] <- apply(crps.clim.region, 1, mean, na.rm = TRUE)
                        mean.rpss[mm, i,] <- apply(rpss.region, 1, mean, na.rm = TRUE)
                        mean.crpss[mm, i,] <- apply(crpss.region, 1, mean, na.rm = TRUE)
                        mean.frpss[mm, i,] <- apply(frpss.region, 1, mean, na.rm = TRUE)
                        mean.fcrpss[mm, i,] <- apply(fcrpss.region, 1, mean, na.rm = TRUE)

                        ## for the debug:
                        ## PlotEquiMap(bias.region[,, 2], lon=lon.netCDF[pos.lon.min[i] : pos.lon.max[i]], lat=lat.netCDF[pos.lat.max[i] : pos.lat.min[i]], filled.continents = FALSE, brks=c(-100, -5, -4, -3, -2, -1, 0, 1, 2, 3, 4, 5, 100))
                        ## PlotEquiMap(corr.region[,,2], lon=lon.netCDF[pos.lon.min[i] : pos.lon.max[i]], lat=lat.netCDF[pos.lat.max[i] : pos.lat.min[i]], filled.continents = FALSE, brks=c(-10, -9, -8, -7, -6, -5, -4, -3, -2, -1, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10)/10)

                    }
                }

                ## set values more negative of -1 to -1:
                mean.fcrpss[which(mean.fcrpss < -1)] <- -1
                mean.frpss[which(mean.frpss < -1)] <- -1

                ## round the scores:
                mean.bias <- round(mean.bias, n.dec)
                mean.corr <- round(mean.corr, 2)
                mean.fcrpss <- round(mean.fcrpss, 2)
                mean.frpss <- round(mean.frpss, 2)
                mean.crpss <- round(mean.crpss, 2)
                mean.rpss <- round(mean.rpss, 2)

                ## for snow variables, remove the Tropics region:
                shortertable <- FALSE
                if(var.name == "Snowfall" || var.name == "Snow density" || var.name == "Snow depth" || var.name == "Sea-ice cover"){
                    mean.bias <- mean.bias[,-1,]
                    mean.corr <- mean.corr[,-1,]
                    mean.crpss <- mean.crpss[,-1,]
                    mean.rpss <- mean.rpss[,-1,]
                    region.names.figure <- region.names.figure[-1]
                    n.regions <- 2
                    shortertable <- TRUE
                }

                 ## row titles:
                region.names.figure2 <- rep("", n.regions * n.for.months)
                if(n.regions == 3) region.names2 <- region.names else region.names2 <- region.names[-1] 
                
                for(rr in 1:n.regions) region.names.figure2[floor(n.for.months/2) + (rr-1) * n.for.months ] = region.names2[rr]
                for(rr in 1:n.regions) region.names.figure2[floor(n.for.months/2) + (rr-1) * n.for.months + 1] = region.names.figure[rr]
                forecast.month.figure <- rep(1:n.for.months, n.regions)

                ## data inside the table to plot:
                table <- data.frame(Region = region.names.figure2, Forecast_month = forecast.month.figure,
                        BiasTarget1 = as.vector(t(mean.bias[1,,])), BiasTarget2 = as.vector(t(mean.bias[2,,])),
                        BiasTarget3 = as.vector(t(mean.bias[3,,])), BiasTarget4 = as.vector(t(mean.bias[4,,])),
                        BiasTarget5 = as.vector(t(mean.bias[5,,])), BiasTarget6 = as.vector(t(mean.bias[6,,])),
                        BiasTarget7 = as.vector(t(mean.bias[7,,])), BiasTarget8 = as.vector(t(mean.bias[8,,])),
                        BiasTarget9 = as.vector(t(mean.bias[9,,])), BiasTarget10 = as.vector(t(mean.bias[10,,])),
                        BiasTarget11 = as.vector(t(mean.bias[11,,])), BiasTarget12 = as.vector(t(mean.bias[12,,])),
                        CorrTarget1 = as.vector(t(mean.corr[1,,])), CorrTarget2 = as.vector(t(mean.corr[2,,])),
                        CorrTarget3 = as.vector(t(mean.corr[3,,])), CorrTarget4 = as.vector(t(mean.corr[4,,])),
                        CorrTarget5 = as.vector(t(mean.corr[5,,])), CorrTarget6 = as.vector(t(mean.corr[6,,])),
                        CorrTarget7 = as.vector(t(mean.corr[7,,])), CorrTarget8 = as.vector(t(mean.corr[8,,])),
                        CorrTarget9 = as.vector(t(mean.corr[9,,])), CorrTarget10 = as.vector(t(mean.corr[10,,])),
                        CorrTarget11 = as.vector(t(mean.corr[11,,])), CorrTarget12 = as.vector(t(mean.corr[12,,])),
                        CrpssTarget1 = as.vector(t(mean.crpss[1,,])), CrpssTarget2 = as.vector(t(mean.crpss[2,,])),
                        CrpssTarget3 = as.vector(t(mean.crpss[3,,])), CrpssTarget4 = as.vector(t(mean.crpss[4,,])),
                        CrpssTarget5 = as.vector(t(mean.crpss[5,,])), CrpssTarget6 = as.vector(t(mean.crpss[6,,])),
                        CrpssTarget7 = as.vector(t(mean.crpss[7,,])), CrpssTarget8 = as.vector(t(mean.crpss[8,,])),
                        CrpssTarget9 = as.vector(t(mean.crpss[9,,])), CrpssTarget10 = as.vector(t(mean.crpss[10,,])),
                        CrpssTarget11 = as.vector(t(mean.crpss[11,,])), CrpssTarget12 = as.vector(t(mean.crpss[12,,])),
                        RpssTarget1 = as.vector(t(mean.rpss[1,,])), RpssTarget2 = as.vector(t(mean.rpss[2,,])),
                        RpssTarget3 = as.vector(t(mean.rpss[3,,])), RpssTarget4 = as.vector(t(mean.rpss[4,,])),
                        RpssTarget5 = as.vector(t(mean.rpss[5,,])), RpssTarget6 = as.vector(t(mean.rpss[6,,])),
                        RpssTarget7 = as.vector(t(mean.rpss[7,,])), RpssTarget8 = as.vector(t(mean.rpss[8,,])),
                        RpssTarget9 = as.vector(t(mean.rpss[9,,])), RpssTarget10 = as.vector(t(mean.rpss[10,,])),
                        RpssTarget11 = as.vector(t(mean.rpss[11,,])), RpssTarget12 = as.vector(t(mean.rpss[12,,])))

                ## cell colors of Bias metric:
                bias.max <- max(abs(mean.bias), na.rm = TRUE)
                bias.minmax_max <- quantile(mean.bias, 0.98, na.rm = TRUE)
                bias.minmax_min <- quantile(mean.bias, 0.02, na.rm = TRUE)
                bias.max <- max(abs(bias.minmax_min), abs(bias.minmax_max))
                bias.int <- bias.max * c(-1, -0.8, -0.6, -0.4, -0.2, 0, 0.2, 0.4, 0.6, 0.8, 1) ## one point more than the colors below (the intervals)
                bias.int <- round(bias.int, n.dec)
                
                if(inverse.scale==TRUE){
                    bias.palette <- rev(c('#2D004B', '#542789', '#8073AC', '#B2ABD2', '#D8DAEB', '#FEE0B6', '#FDB863', '#E08214', '#B35806', '#7F3B08'))
                    colorunder_bias <- "#730C04"
                    colorsup_bias <- "#04040E"
                }else{    
                    bias.palette <- c('#2D004B', '#542789', '#8073AC', '#B2ABD2', '#D8DAEB', '#FEE0B6', '#FDB863', '#E08214', '#B35806', '#7F3B08')
                    colorunder_bias <- "#04040E"
                    colorsup_bias <- "#730C04"
                }
                colorunder <- "#04040E" 
                colorsup <- "#730C04"

                bias.col <- array("gray", c(n.for.months * n.regions, n.start.months)) ## gray is to detect outliers
                bias.text.col <- array("#2A2A2A", c(n.for.months * n.regions, n.start.months)) ## black is the default text color
                bias.text.bold <- array(TRUE, c(n.for.months * n.regions, n.start.months)) ## TRUE is the default bold value

                for(mm in 1:n.start.months){
                    for(ff in 1:n.for.months){
                        for(rr in 1:n.regions){
                            for(pp in 1:(length(bias.int)-1)){
                                if(is.nan(mean.bias[mm, rr, ff])){
                                    bias.col[ff + (rr-1) * n.for.months, mm] <- "gray"
                                } else {
                                    if(mean.bias[mm, rr, ff] >= bias.int[pp] && mean.bias[mm, rr, ff] <= bias.int[pp+1])
                                        bias.col[ff + (rr-1) * n.for.months, mm] <- bias.palette[pp]
                                }

                                ## color text in white and bold if background is gray or dark blue or dark red:
                                if(is.nan(mean.bias[mm, rr, ff]) ||
                                (!is.nan(mean.bias[mm, rr, ff]) && pp == 1 && mean.bias[mm, rr, ff] < bias.int[2]) ||
                                (!is.nan(mean.bias[mm, rr, ff]) && pp == 2 && mean.bias[mm, rr, ff] < bias.int[3]) ||
                                (!is.nan(mean.bias[mm, rr, ff]) && pp == (length(bias.int)-1) && mean.bias[mm, rr, ff] >= bias.int[length(bias.int)-1])){
                                    bias.text.col[ff + (rr-1) * n.for.months, mm] <- "white"
                                    #bias.text.bold[ff + (rr-1) * n.for.months, mm] <- TRUE # T or F to modify the default bold
                                }
                            }
                            if(mean.bias[mm, rr, ff] < bias.int[1]){bias.col[ff + (rr-1) * n.for.months, mm] <- colorunder_bias}
                            if(mean.bias[mm, rr, ff] > bias.int[length(bias.int)]){bias.col[ff + (rr-1) * n.for.months, mm] <- colorsup_bias}
                        }
                    }
                } 

                ## cell colors of Correlation metric:
                Corr.int <- c(-1, -0.8, -0.6, -0.4, -0.2, 0, 0.2, 0.4, 0.6, 0.8, 1) ## one point more than the colors below (the intervals)
                Corr.palette <- c('#2D004B', '#542789', '#8073AC', '#B2ABD2', '#D8DAEB', '#FEE0B6', '#FDB863', '#E08214', '#B35806', '#7F3B08')
                Corr.col <- array("gray", c(n.for.months * n.regions, n.start.months)) ## gray is to detect outliers
                Corr.text.col <- array("#2A2A2A", c(n.for.months * n.regions, n.start.months)) ## black is the default text color
                Corr.text.bold <- array(TRUE, c(n.for.months * n.regions, n.start.months)) ## TRUE is the default bold value

                for(mm in 1:n.start.months){
                    for(ff in 1:n.for.months){
                        for(rr in 1:n.regions){
                            for(pp in 1:(length(Corr.int)-1)){
                                if(is.nan(mean.corr[mm, rr, ff])){
                                    Corr.col[ff + (rr-1) * n.for.months, mm] <- "gray"
                                } else {
                                    if(mean.corr[mm, rr, ff] >= Corr.int[pp] && mean.corr[mm, rr, ff] <= Corr.int[pp+1])
                                        Corr.col[ff + (rr-1) * n.for.months, mm] <- Corr.palette[pp]
                                }

                                ## color text in white and bold if background is gray or dark blue or dark red:
                                if(is.nan(mean.corr[mm, rr, ff]) ||
                                (!is.nan(mean.corr[mm, rr, ff]) && pp == 1 && mean.corr[mm, rr, ff] < Corr.int[2]) ||
                                (!is.nan(mean.corr[mm, rr, ff]) && pp == 2 && mean.corr[mm, rr, ff] < Corr.int[3]) ||
                                (!is.nan(mean.corr[mm, rr, ff]) && pp == (length(Corr.int)-1) && mean.corr[mm, rr, ff] >= Corr.int[length(Corr.int)-1])){
                                    Corr.text.col[ff + (rr-1) * n.for.months, mm] <- "white"
                                    Corr.text.bold[ff + (rr-1) * n.for.months, mm] <- TRUE
                                }
                            }
                        }
                    }
                } 

                ## cell colors of FairCRPSS metric:
                #CRPSS.int <- c(-1, -0.8, -0.6, -0.4, -0.2, 0, 0.2, 0.4, 0.6, 0.8, 1) ## one point more than the colors below (the intervals)
                #CRPSS.palette <- c('#2D004B', '#542789', '#8073AC', '#B2ABD2', '#D8DAEB', '#FEE0B6', '#FDB863', '#E08214', '#B35806', '#7F3B08') #palette as in bias
                #CRPSS.int <- c(0, 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 1) ## one point more than the colors below (the intervals)
                #CRPSS.palette <- c("#FEEACC","#FEEACC","#FDD8A7","#FDC38D","#FCA16C","#F67B51","#E7533A","#AD0000","#AD0000","#7F0000") #palette as in the plots
                CRPSS.int <- c(-0.5, -0.4, -0.3, -0.2, -0.1, 0, 0.1, 0.2, 0.3, 0.4, 0.5) ## one point more than the colors below (the intervals)
                CRPSS.palette <- c('#2D004B', '#542789', '#8073AC', '#B2ABD2', '#D8DAEB', '#FEE0B6', '#FDB863', '#E08214', '#B35806', '#7F3B08') #palette as suggested in meeting
                CRPSS.col <- array(colorunder, c(n.for.months * n.regions, n.start.months)) ## blue is to detect outliers
                CRPSS.text.col <- array("#2A2A2A", c(n.for.months * n.regions, n.start.months)) ## black is the default text color
                CRPSS.text.bold <- array(TRUE, c(n.for.months * n.regions, n.start.months)) ## TRUE is the defaul bold value

                for(mm in 1:n.start.months){
                    for(ff in 1:n.for.months){
                        for(rr in 1:n.regions){
                            for(pp in 1:(length(CRPSS.int)-1)){
                                if(is.nan(mean.crpss[mm, rr, ff])){
                                    CRPSS.col[ff + (rr-1) * n.for.months, mm] <- "gray"
                                } else {
                                    if(mean.crpss[mm, rr, ff] < CRPSS.int[1])
                                        CRPSS.col[ff + (rr-1) * n.for.months, mm] <- colorunder
                                    if(mean.crpss[mm, rr, ff] >= CRPSS.int[length(CRPSS.int)-1])
                                        CRPSS.col[ff + (rr-1) * n.for.months, mm] <- colorsup

                                    if(mean.crpss[mm, rr, ff] >= CRPSS.int[pp] && mean.crpss[mm, rr, ff] <= CRPSS.int[pp+1])
                                        CRPSS.col[ff + (rr-1) * n.for.months, mm] <- CRPSS.palette[pp]
                                }

                                ## color text in white and bold if background is gray or dark blue or dark red:
                                if(is.nan(mean.crpss[mm, rr, ff]) ||
                                (!is.nan(mean.crpss[mm, rr, ff]) && pp == 1 && mean.crpss[mm, rr, ff] < CRPSS.int[2]) ||
                                (!is.nan(mean.crpss[mm, rr, ff]) && pp == 2 && mean.crpss[mm, rr, ff] < CRPSS.int[3]) ||
                                (!is.nan(mean.crpss[mm, rr, ff]) && pp == (length(CRPSS.int)-1) && mean.crpss[mm, rr, ff] >= CRPSS.int[length(CRPSS.int)-1])){
                                    CRPSS.text.col[ff + (rr-1) * n.for.months, mm] <- "white"
                                    CRPSS.text.bold[ff + (rr-1) * n.for.months, mm] <- TRUE
                                }
                            }
                        }
                    }
                }

                ## cell colors of FairRPSS metric:
                RPSS.int <- CRPSS.int
                RPSS.palette <- CRPSS.palette
                RPSS.col <- array(colorunder, c(n.for.months * n.regions, n.start.months)) ## "#045a8d" blue is to detect outliers
                RPSS.text.col <- array("#2A2A2A", c(n.for.months * n.regions, n.start.months)) ## black is the default text color
                RPSS.text.bold <- array(TRUE, c(n.for.months * n.regions, n.start.months)) ## TRUE is the default bold value

                for(mm in 1:n.start.months){
                    for(ff in 1:n.for.months){
                        for(rr in 1:n.regions){
                            for(pp in 1:(length(RPSS.int)-1)){
                                if(is.nan(mean.rpss[mm, rr, ff])){
                                    RPSS.col[ff + (rr-1) * n.for.months, mm] <- "gray"
                                } else {
                                    if(mean.rpss[mm, rr, ff] < RPSS.int[1])
                                        RPSS.col[ff + (rr-1) * n.for.months, mm] <- colorunder
                                    if(mean.rpss[mm, rr, ff] >= RPSS.int[length(RPSS.int)-1])
                                        RPSS.col[ff + (rr-1) * n.for.months, mm] <- colorsup

                                    if(mean.rpss[mm, rr, ff] >= RPSS.int[pp] && mean.rpss[mm, rr, ff] <= RPSS.int[pp+1])
                                        RPSS.col[ff + (rr-1) * n.for.months, mm] <- RPSS.palette[pp]
                                }

                                ## color text in white if background is gray or deep blue:
                                if(is.nan(mean.rpss[mm, rr, ff]) ||
                                (!is.nan(mean.rpss[mm, rr, ff]) && pp == 1 && mean.rpss[mm, rr, ff] < RPSS.int[2]) ||
                                (!is.nan(mean.rpss[mm, rr, ff]) && pp == 2 && mean.rpss[mm, rr, ff] < RPSS.int[3]) ||
                                (!is.nan(mean.rpss[mm, rr, ff]) && pp == (length(RPSS.int)-1) && mean.rpss[mm, rr, ff] >= RPSS.int[length(RPSS.int)-1])){
                                    RPSS.text.col[ff + (rr-1) * n.for.months, mm] <- "white"
                                    RPSS.text.bold[ff + (rr-1) * n.for.months, mm] <- TRUE
                                }
                            }
                        }
                    }
                }

                ## table header:
                my.col.names <- c("Region", "Forecast month", rep(c("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"), 4))

                ## add mayuscule to first letter and remove the eventual mayuscule in the second part of the variable name:
                #var.name.min <- paste0(toupper(substring(var.name, 1, 1)), substring(str_to_lower(var.name), 2, nchar(var.name)))
                var.name.min <- var.name

                options(stringsAsFactors = FALSE)
                my.header.names <- as.data.frame(data.frame(c1=c("", paste0("Mean Bias (", var.unit,")"), "Correlation", "CRPSS", "RPSS"), c2=c(2, rep(n.start.months, 4))))
                my.header.names2 <- data.frame(c1=paste0(var.name.min, mod.pressure.title, " of ", system.name), c2=50)

                #remove "known issue" data from cmcc-3:
                ## remove corrupted start dates of CMCC S3:
                if(system.name == "CMCC-S3"){
                    if(plevel==""){
                        ## case of single-level variables:
                        for(j in c(5, 9, 17, 21, 29, 33, 41, 45)) table[,j] <- NaN
                        bias.col[, c(3,7)] <- Corr.col[, c(3,7)] <- CRPSS.col[, c(3,7)] <- RPSS.col[, c(3,7)] <- "gray"
                        bias.text.col[, c(3, 7)] <- Corr.text.col[, c(3,7)] <- CRPSS.text.col[, c(3,7)] <- RPSS.text.col[, c(3,7)] <- "white"
                    } else { ## case of pressure-levels variables:
                        for(j in c(5:11, 17:23, 29:35, 41:47)) table[,j] <- NaN
                        bias.col[, 3:9] <- Corr.col[, 3:9] <- CRPSS.col[, 3:9] <- RPSS.col[, 3:9] <- "gray"
                        bias.text.col[, 3:9] <- Corr.text.col[, 3:9] <- CRPSS.text.col[, 3:9] <- RPSS.text.col[, 3:9] <- "white"
                    }
                }

                ## as above, but without normalization:
                table2 <- table
                ## select the number of decimals to show, their font size and color:
                for(col in 3:(2 + n.start.months * 4)) {
                    if (col > (2 + n.start.months)) table2[,col] <- format(table[,col], nsmall = 2) else table2[,col] <- format(table[,col], nsmall = n.dec) 
                    table2[,col] <- cell_spec(table2[,col], font_size = 8, color="gray70") ## smaller font size
                }

                ## add colored column bars over the data
                ## without data normalization:

                ## ## this would show the color bards inside the figure, but we want the 2D diagrams instead:
                ## for(ss in 1:n.start.months){
                ##     table2[, 2 + ss] <- color_bar_score("red", "#0571b0", mean.bias, ratio = 0.5)(table[, 2 + ss])
                ##     table2[, 2 + n.start.months + ss] <- color_bar_neg("#998ec3","#f1a340", ratio = 0.7)(table[, 2 + n.start.months + ss])
                ##     table2[, 2 + n.start.months * 2 + ss] <- color_bar_neg("violet","lawngreen", ratio = 1.4)(table[, 2 + n.start.months * 2 + ss])
                ##     table2[, 2 + n.start.months * 3 + ss] <- color_bar_neg("violet","lawngreen", ratio = 1.4)(table[, 2 + n.start.months * 3 + ss])
                ## }

                n.columns <- 2 + n.start.months * 4

                ## replace with "No Data" cells with NaN:
                for(i in 3:n.columns) table2[,i] <- str_replace(table2[,i], "NaN", "")

                ## change the font size of any value in the table lower than -1000 with a smaller one, to fit in its cell: (this usually happens with CRPSS)
                for(i in 3:n.columns) { ss <- which(table[,i] < -1000) ; if(length(ss) > 0) table2[ss,i] <- str_replace(table2[ss,i], "8px", "5px")}
                
                ## draw the figure in html:
                table.html <- kbl(table2, escape = F, col.names=my.col.names, align = rep("c", n.columns)) %>%
                    kable_paper("hover", full_width = F) %>%
                    add_header_above(c(" " = 2, "Start date" = n.start.months, "Start date" = n.start.months, "Start date" = n.start.months, "Start date" = n.start.months)) %>%
                    add_header_above(c("(Ref: ERA5 1993-2016)" = 2, " " = n.start.months * 4), align = "left", font_size = 14) %>%
                    add_header_above(header = my.header.names, font_size = 20) %>%
                    add_header_above(header = my.header.names2, font_size = 20, align = "left") %>%

                    column_spec(2 + n.start.months*0 + 1, background = bias.col[,1], color = bias.text.col[,1], bold = bias.text.bold[,1]) %>%
                    column_spec(2 + n.start.months*0 + 2, background = bias.col[,2], color = bias.text.col[,2], bold = bias.text.bold[,2]) %>%
                    column_spec(2 + n.start.months*0 + 3, background = bias.col[,3], color = bias.text.col[,3], bold = bias.text.bold[,3]) %>%
                    column_spec(2 + n.start.months*0 + 4, background = bias.col[,4], color = bias.text.col[,4], bold = bias.text.bold[,4]) %>%
                    column_spec(2 + n.start.months*0 + 5, background = bias.col[,5], color = bias.text.col[,5], bold = bias.text.bold[,5]) %>%
                    column_spec(2 + n.start.months*0 + 6, background = bias.col[,6], color = bias.text.col[,6], bold = bias.text.bold[,6]) %>%
                    column_spec(2 + n.start.months*0 + 7, background = bias.col[,7], color = bias.text.col[,7], bold = bias.text.bold[,7]) %>%
                    column_spec(2 + n.start.months*0 + 8, background = bias.col[,8], color = bias.text.col[,8], bold = bias.text.bold[,8]) %>%
                    column_spec(2 + n.start.months*0 + 9, background = bias.col[,9], color = bias.text.col[,9], bold = bias.text.bold[,9]) %>%
                    column_spec(2 + n.start.months*0 + 10, background = bias.col[,10], color = bias.text.col[,10], bold = bias.text.bold[,10]) %>%
                    column_spec(2 + n.start.months*0 + 11, background = bias.col[,11], color = bias.text.col[,11], bold = bias.text.bold[,11]) %>%
                    column_spec(2 + n.start.months*0 + 12, background = bias.col[,12], color = bias.text.col[,12], bold = bias.text.bold[,12]) %>%

                    column_spec(2 + n.start.months*1 + 1, background = Corr.col[,1], color = Corr.text.col[,1], bold = Corr.text.bold[,1]) %>%
                    column_spec(2 + n.start.months*1 + 2, background = Corr.col[,2], color = Corr.text.col[,2], bold = Corr.text.bold[,2]) %>%
                    column_spec(2 + n.start.months*1 + 3, background = Corr.col[,3], color = Corr.text.col[,3], bold = Corr.text.bold[,3]) %>%
                    column_spec(2 + n.start.months*1 + 4, background = Corr.col[,4], color = Corr.text.col[,4], bold = Corr.text.bold[,4]) %>%
                    column_spec(2 + n.start.months*1 + 5, background = Corr.col[,5], color = Corr.text.col[,5], bold = Corr.text.bold[,5]) %>%
                    column_spec(2 + n.start.months*1 + 6, background = Corr.col[,6], color = Corr.text.col[,6], bold = Corr.text.bold[,6]) %>%
                    column_spec(2 + n.start.months*1 + 7, background = Corr.col[,7], color = Corr.text.col[,7], bold = Corr.text.bold[,7]) %>%
                    column_spec(2 + n.start.months*1 + 8, background = Corr.col[,8], color = Corr.text.col[,8], bold = Corr.text.bold[,8]) %>%
                    column_spec(2 + n.start.months*1 + 9, background = Corr.col[,9], color = Corr.text.col[,9], bold = Corr.text.bold[,9]) %>%
                    column_spec(2 + n.start.months*1 + 10, background = Corr.col[,10], color = Corr.text.col[,10], bold = Corr.text.bold[,10]) %>%
                    column_spec(2 + n.start.months*1 + 11, background = Corr.col[,11], color = Corr.text.col[,11], bold = Corr.text.bold[,11]) %>%
                    column_spec(2 + n.start.months*1 + 12, background = Corr.col[,12], color = Corr.text.col[,12], bold = Corr.text.bold[,12]) %>%

                    column_spec(2 + n.start.months*2 + 1, background = CRPSS.col[,1], color = CRPSS.text.col[,1], bold = CRPSS.text.bold[,1]) %>%
                    column_spec(2 + n.start.months*2 + 2, background = CRPSS.col[,2], color = CRPSS.text.col[,2], bold = CRPSS.text.bold[,2]) %>%
                    column_spec(2 + n.start.months*2 + 3, background = CRPSS.col[,3], color = CRPSS.text.col[,3], bold = CRPSS.text.bold[,3]) %>%
                    column_spec(2 + n.start.months*2 + 4, background = CRPSS.col[,4], color = CRPSS.text.col[,4], bold = CRPSS.text.bold[,4]) %>%
                    column_spec(2 + n.start.months*2 + 5, background = CRPSS.col[,5], color = CRPSS.text.col[,5], bold = CRPSS.text.bold[,5]) %>%
                    column_spec(2 + n.start.months*2 + 6, background = CRPSS.col[,6], color = CRPSS.text.col[,6], bold = CRPSS.text.bold[,6]) %>%
                    column_spec(2 + n.start.months*2 + 7, background = CRPSS.col[,7], color = CRPSS.text.col[,7], bold = CRPSS.text.bold[,7]) %>%
                    column_spec(2 + n.start.months*2 + 8, background = CRPSS.col[,8], color = CRPSS.text.col[,8], bold = CRPSS.text.bold[,8]) %>%
                    column_spec(2 + n.start.months*2 + 9, background = CRPSS.col[,9], color = CRPSS.text.col[,9], bold = CRPSS.text.bold[,9]) %>%
                    column_spec(2 + n.start.months*2 + 10, background = CRPSS.col[,10], color = CRPSS.text.col[,10], bold = CRPSS.text.bold[,10]) %>%
                    column_spec(2 + n.start.months*2 + 11, background = CRPSS.col[,11], color = CRPSS.text.col[,11], bold = CRPSS.text.bold[,11]) %>%
                    column_spec(2 + n.start.months*2 + 12, background = CRPSS.col[,12], color = CRPSS.text.col[,12], bold = CRPSS.text.bold[,12]) %>%

                    column_spec(2 + n.start.months*3 + 1, background = RPSS.col[,1], color = RPSS.text.col[,1], bold = RPSS.text.bold[,1]) %>%
                    column_spec(2 + n.start.months*3 + 2, background = RPSS.col[,2], color = RPSS.text.col[,2], bold = RPSS.text.bold[,2]) %>%
                    column_spec(2 + n.start.months*3 + 3, background = RPSS.col[,3], color = RPSS.text.col[,3], bold = RPSS.text.bold[,3]) %>%
                    column_spec(2 + n.start.months*3 + 4, background = RPSS.col[,4], color = RPSS.text.col[,4], bold = RPSS.text.bold[,4]) %>%
                    column_spec(2 + n.start.months*3 + 5, background = RPSS.col[,5], color = RPSS.text.col[,5], bold = RPSS.text.bold[,5]) %>%
                    column_spec(2 + n.start.months*3 + 6, background = RPSS.col[,6], color = RPSS.text.col[,6], bold = RPSS.text.bold[,6]) %>%
                    column_spec(2 + n.start.months*3 + 7, background = RPSS.col[,7], color = RPSS.text.col[,7], bold = RPSS.text.bold[,7]) %>%
                    column_spec(2 + n.start.months*3 + 8, background = RPSS.col[,8], color = RPSS.text.col[,8], bold = RPSS.text.bold[,8]) %>%
                    column_spec(2 + n.start.months*3 + 9, background = RPSS.col[,9], color = RPSS.text.col[,9], bold = RPSS.text.bold[,9]) %>%
                    column_spec(2 + n.start.months*3 + 10, background = RPSS.col[,10], color = RPSS.text.col[,10], bold = RPSS.text.bold[,10]) %>%
                    column_spec(2 + n.start.months*3 + 11, background = RPSS.col[,11], color = RPSS.text.col[,11], bold = RPSS.text.bold[,11]) %>%
                    column_spec(2 + n.start.months*3 + 12, background = RPSS.col[,12], color = RPSS.text.col[,12], bold = RPSS.text.bold[,12]) %>% 

                    column_spec(1, bold = TRUE, width_min = "4cm", width_max = "4cm") %>%
                    column_spec(2, bold = TRUE, width_max = "1cm") %>%
                    column_spec(3:n.columns, width_max = "0.9cm", width_min = "0.9cm") %>%
                    #column_spec(c(1, 2, 2+n.start.months, 2+n.start.months*2, 2+n.start.months*3), border_right = TRUE) %>%
                    column_spec(c(1, 2, 2+n.start.months, 2+n.start.months*2, 2+n.start.months*3), border_right = "1px solid black") %>%
                    column_spec(1, border_left = "4px solid gray") %>%
                    column_spec(n.columns, border_right = "4px solid gray") %>%

                    column_spec(c(1,2,14,26,38), border_right = "1px solid black") %>%
                    row_spec(seq(from = 0, to = n.for.months * n.regions, by = n.for.months), extra_css = "border-bottom: 2px solid black", hline_after = TRUE) #1px solid")
                
                ## convert html to .png:
                if(shortertable==TRUE){ #n.regions==2
                    my.file <- "./scorecard_by_start_date_0.png"
                    save_kable(table.html, file = my.file) #density might not work
                    system(paste0("convert ./scorecard_by_start_date_0.png -gravity South -chop 0x200 ./scorecard_by_start_date.png"))
                    my.file <- "./scorecard_by_start_date.png"
                }else{
                    my.file <- "./scorecard_by_start_date_0.png"
                    save_kable(table.html, file = my.file) #density might not work
                    system(paste0("convert ./scorecard_by_start_date_0.png -gravity South -chop 0x20 ./scorecard_by_start_date.png"))
                    my.file <- "./scorecard_by_start_date.png"
                }

                print("Saving scorecard. Please wait...")

                ## add the color legend:
                png(filename= "./scorecard_legend.png", width=455, height=40)
                #ColorBar(brks = CRPSS.int, cols = CRPSS.palette, vertical = FALSE, triangle_ends_scale = 0)
                ColorBar(brks = CRPSS.int, cols = CRPSS.palette, vertical = FALSE, var_limits=c(-10000000, 1), col_inf = colorunder, col_sup = colorsup) # "#000080")
                dev.off()

                #png(filename= "./scorecard_legend_bias.png", width=455, height=40)
                #ColorBar(brks = round(bias.int, n.dec), cols = bias.palette, vertical = FALSE, triangle_ends_scale = 0)
                #dev.off()

                png(filename= "./scorecard_legend_bias.png", width=455, height=40)
                ColorBar(brks = round(bias.int, n.dec), cols = bias.palette, vertical = FALSE, triangle_ends_scale = 1, col_inf = colorunder_bias, col_sup = colorsup_bias) 
                dev.off()
                png(filename= "./scorecard_legend_corr.png", width=450, height=40)
                ColorBar(brks = Corr.int, cols = Corr.palette, vertical = FALSE, triangle_ends_scale = 0, col_inf = colorunder) 
                dev.off()

                ## add white space to the left:
                system(paste0("convert ./scorecard_legend_bias.png -background white -splice 225x0 ./scorecard_legend_bias_full.png"))

                ## put all legends together:
                system(paste0("montage ./scorecard_legend_bias_full.png ./scorecard_legend_corr.png ./scorecard_legend.png ./scorecard_legend.png -tile 4x1 -geometry -4+10 ./scorecard_legend_full.png"))
                
                ## add white space to the top to be cut when adding legend:
                system(paste0("convert ./scorecard_by_start_date.png -background white -splice 0x20 ./scorecard_by_start_date.png"))
                
                ## put legends below the scorecard:
                system(paste0("montage ./scorecard_by_start_date.png ./scorecard_legend_full.png -tile 1x2 -geometry +0-10 ./scorecard_by_start_date.png"))


                ### Add Climate Index scorecard if appropiate:
                dirclimateindex <- paste0("/shared/data_for_scorecards_SF/teleconnections/")
                if(varParamId == 34 && file.exists(paste0(dirclimateindex, "scorecard_nino_start_date_", gsub("s", "_s", system.filename), ".png"))) {
                    print("adding teleconnection png....")
                    system(paste0("montage ./scorecard_by_start_date.png ", paste0(dirclimateindex, "scorecard_nino_start_date_", gsub("s", "_s", system.filename), ".png"), " -tile 1x2 -geometry +0+10 ./scorecard_by_start_date.png"))
                }
                if(varParamId == 151 && file.exists(paste0(dirclimateindex, "scorecard_nao_start_date_", gsub("s", "_s", system.filename), ".png"))) {
                    print("adding teleconnection png....")
                    system(paste0("montage ./scorecard_by_start_date.png ", paste0(dirclimateindex, "scorecard_nao_start_date_", gsub("s", "_s", system.filename), ".png"), " -tile 1x2 -geometry +0+10 ./scorecard_by_start_date.png"))
                }


               # ## put footnote below the legend:
               # png(filename= "./scorecard_footnote.png", width=1600, height=35)
               # par(oma=c(0,0,0,0), mar = c(0,0,0,0))
               # plot(c(0, 1), c(0, 1), ann = F, bty = 'n', type = 'n', xaxt = 'n', yaxt = 'n')
               # text(x = -0.04, y = 0.5, labels = "     Note: eventual cells in grey represent start dates with data issues (e.g. corrupted values, missing start dates).", adj = 0, cex = 1, col = "black")
               # dev.off()
               # system(paste0("montage ./scorecard_by_start_date.png ./scorecard_footnote.png -tile 1x2 -geometry +0+0 ./scorecard_by_start_date.png"))
                
                                
                ## move scorecard to the chosen dir:
                ## (it cannot done in the previous command because of a bug in save_kable)

                # old convention filename:
                #if (is.na(plevel)==TRUE){scorecardname <- paste0("-scorecard_by_start_date-era5-global-s-l-p", "-", substr(hindcasts.filename,1,4), "_", substr(hindcasts.filename,7,10), ".png")}
                #else{scorecardname <- paste0("-scorecard_by_start_date-era5-global-s-l-p", plevel, "-", substr(hindcasts.filename,1,4), "_", substr(hindcasts.filename,7,10), ".png")}
                # new convetion filename:
                if (is.na(plevel)==TRUE){scorecardname <- paste0("-scorecard_by_start_date-global-p", "-", substr(hindcasts.filename,1,4), "_", substr(hindcasts.filename,7,10), "-era5.png")}
                else{scorecardname <- paste0("-scorecard_by_start_date-global-p", plevel, "-", substr(hindcasts.filename,1,4), "_", substr(hindcasts.filename,7,10), "-era5.png")}
            
                if (file.exists(paste0(fileout, "/", gsub("s", "-", system.filename), "-", varParamId, scorecardname)) == TRUE){system(paste0("rm ", paste0(fileout, "/", gsub("s", "-", system.filename), "-", varParamId, scorecardname)))}
                system(paste0("mv ", my.file, paste0(" ", fileout, "/", gsub("s", "-", system.filename), "-", varParamId, scorecardname)))
                
                print(paste0(fileout, "/", gsub("s", "-", system.filename), "-", varParamId, scorecardname))

                ## delete temporary files:
                system("rm ./scorecard_legend_bias.png ./scorecard_legend_corr.png ./scorecard_legend_bias_full.png ./scorecard_legend.png ./scorecard_legend_full.png ./scorecard_by_start_date_0.png")

                return(print(paste0("Scorecard figure by start date of variable ", var.name, " and ", system.name," saved in ", fileout)))


            }
            ''')
        R_scorecardfunction3 = ro.r('''
            library(ncdf4) ## to load netCDF files
            library(formattable) ## to plot horizontal color bars
            library(kableExtra) ## to print data in formatted tables
            #library(magick) ## for saving as .png #not necessary
            library(stringr) ## for manipulating mayuscules in the figure title
            library(s2dverification) ## for function ColorBar()
            library(abind) ## for function abind()

            ## plot many figures in the same panel (region x score) with colors in the backaground instead of bar plots
            ## and with the target month instead of the start date:
            Scorecard_by_target_month <- function(start.year=year0, end.year=year1, system.filename=sc_centersystem, system.name=sc_centersystemname, var.unit=sc_units, var.filename=sc_varname, var.name=sc_varname_long, plevel=scplevel, input.path = sc_inputpath, fileout = sc_outputpath, varParamId=sc_paramID, lead.months = 1:6) {
                
                if(plevel==""){
                    mod.pressure <- ""
                    mod.pressure.title <- ""
                }else{
                    plevel <- as.integer(plevel)
                    mod.pressure <- paste0("-p", plevel)
                    mod.pressure.title <- paste0(" at ", plevel, " hPa")
                }

                unitconversionfactor <- initialfunction_conversionfactor(var.name, system.filename)
                inverse.scale <- initialfunction_colorscale(var.name)
                if (unitconversionfactor != 1){var.unit <- paste0(gsub("e-0", "e-", gsub("+0", "", toString(formatC(1/unitconversionfactor, format="e", digits=0)))), " ", var.unit)}
                n.dec <- initialfunction_roundbias(var.name, plevel)
                
                region.names <- initialfunction_regionnames_and_borders()[,1]
                region.names.figure <- initialfunction_regionnames_and_borders()[,2]
                lat.min <- initialfunction_regionnames_and_borders()[,3]
                lat.max <- initialfunction_regionnames_and_borders()[,4]
                lon.min <- c() #initialfunction_regionnames_and_borders()[,5]
                lon.max <- c() #initialfunction_regionnames_and_borders()[,6]
                n.regions <- length(region.names)

                ## suffix with hindcast period written in the filename:
                hindcasts.filename <- initialfunction_hindcastsperiod(start.year, end.year, "hind")
                ref.caption <- initialfunction_hindcastsperiod(start.year, end.year, "ref")

                ## Load metrics from the 12 netCDF files of the chosen forecast system, one for each start month:
                start.months <- c("01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12")
                n.start.months <- length(start.months)
                
                bias <- initialfunction_read_data(start.months, input.path, system.filename, var.filename, hindcasts.filename, m, mod.pressure, unitconversionfactor, "bias")
                corr <- initialfunction_read_data(start.months, input.path, system.filename, var.filename, hindcasts.filename, m, mod.pressure, unitconversionfactor, "corr")
                frpss <- initialfunction_read_data(start.months, input.path, system.filename, var.filename, hindcasts.filename, m, mod.pressure, unitconversionfactor, "frpss")
                fcrpss <- initialfunction_read_data(start.months, input.path, system.filename, var.filename, hindcasts.filename, m, mod.pressure, unitconversionfactor, "fcrpss")
                rps <- initialfunction_read_data(start.months, input.path, system.filename, var.filename, hindcasts.filename, m, mod.pressure, unitconversionfactor, "rps")
                crps <- initialfunction_read_data(start.months, input.path, system.filename, var.filename, hindcasts.filename, m, mod.pressure, unitconversionfactor, "crps")
                rps.clim <- initialfunction_read_data(start.months, input.path, system.filename, var.filename, hindcasts.filename, m, mod.pressure, unitconversionfactor, "rps.clim")
                crps.clim <- initialfunction_read_data(start.months, input.path, system.filename, var.filename, hindcasts.filename, m, mod.pressure, unitconversionfactor, "crps.clim")

                ## load lat and lon values:
                lat.netCDF <- initialfunction_latlon_values(input.path, system.filename, var.filename, hindcasts.filename, mod.pressure, "latitude")
                lon.netCDF <- initialfunction_latlon_values(input.path, system.filename, var.filename, hindcasts.filename, mod.pressure, "longitude")
                
                ## position of lat and lon min and max values inside the netCDF:
                pos.lat.min <- pos.lat.max <- pos.lon.min <- pos.lon.max <- c()
                for(i in 1:n.regions){
                    if(is.null(lat.min)) pos.lat.min[i] <- length(lat.netCDF) else pos.lat.min[i] <- which(lat.netCDF >= as.integer(lat.min[i]))[length(which(lat.netCDF >= as.integer(lat.min[i])))]
                    if(is.null(lat.max)) pos.lat.max[i] <- 1 else pos.lat.max[i] <- which(lat.netCDF <= as.integer(lat.max[i]))[1]
                    if(is.null(lon.min)) pos.lon.min[i] <- 1 else pos.lon.min[i] <- which(lon.netCDF == as.integer(lon.min[i]))
                    if(is.null(lon.max)) pos.lon.max[i] <- length(lon.netCDF) else pos.lon.max[i] <- which(lon.netCDF == as.integer(lon.max[i]))
                }
    
                ## forecast month to extract:
                my.for.months <- 1:6 ## select only the first 6 forecast months even if there are 8 in total; last two are probably f.months 2-4 and 3-5
                n.for.months <- length(my.for.months)
    
                ### START DIFFERENT SCRIPT ###
                ## empty arrays with the score values to plot:
                mean.bias <- mean.corr <- mean.fcrpss <- mean.frpss <- array(NA, c(n.start.months, n.regions, n.for.months))
                mean.crpss <- mean.rpss <- mean.crps <- mean.rps <- mean.crps.clim <- mean.rps.clim <- array(NA, c(n.start.months, n.regions, n.for.months)) ## newline

                for(i in 1:n.regions){
                    for(m in start.months){
                        mm <- as.numeric(m)
                        
                        ## select only scores inside the target region: [lon, lat, n.for.months]
                        bias.region <- bias[[mm]][pos.lon.min[i]:pos.lon.max[i], pos.lat.max[i]:pos.lat.min[i], my.for.months]
                        corr.region <- corr[[mm]][pos.lon.min[i]:pos.lon.max[i], pos.lat.max[i]:pos.lat.min[i], my.for.months]
                        fcrpss.region <- fcrpss[[mm]][my.for.months, pos.lon.min[i]:pos.lon.max[i], pos.lat.max[i]:pos.lat.min[i]]
                        frpss.region <- frpss[[mm]][my.for.months, pos.lon.min[i]:pos.lon.max[i], pos.lat.max[i]:pos.lat.min[i]]

                        ## measure rps and crps:    
                        rps.region <- rps[[mm]][my.for.months, pos.lon.min[i]:pos.lon.max[i], pos.lat.max[i]:pos.lat.min[i]]
                        crps.region <- crps[[mm]][my.for.months, pos.lon.min[i]:pos.lon.max[i], pos.lat.max[i]:pos.lat.min[i]]
                        rps.clim.region <- rps.clim[[mm]][my.for.months, pos.lon.min[i]:pos.lon.max[i], pos.lat.max[i]:pos.lat.min[i]]
                        crps.clim.region <- crps.clim[[mm]][my.for.months, pos.lon.min[i]:pos.lon.max[i], pos.lat.max[i]:pos.lat.min[i]]
                        rpss.region <- 1 - rps.region / rps.clim.region
                        crpss.region <- 1 - crps.region / crps.clim.region

                        ## replace values with (-)Inf with NA or the average will be (-)Inf too: (but infinite values should be absent in theory)
                        rps.region[which(is.infinite(rps.region))] <- NA 
                        crps.region[which(is.infinite(crps.region))] <- NA 
                        rps.clim.region[which(is.infinite(rps.region))] <- NA
                        crps.clim.region[which(is.infinite(crps.region))] <- NA 
                        fcrpss.region[which(is.infinite(fcrpss.region))] <- NA 
                        frpss.region[which(is.infinite(frpss.region))] <- NA 
                        rpss.region[which(is.infinite(rpss.region))] <- NA 
                        crpss.region[which(is.infinite(crpss.region))] <- NA
                            
                        ## average score values inside the target region: 
                        mean.bias[mm, i,] <- apply(bias.region, 3, mean, na.rm = TRUE) ## [n.start.months, n.regions, n.for.months]
                        mean.corr[mm, i,] <- apply(corr.region, 3, mean, na.rm = TRUE)
                        mean.rps[mm, i,] <- apply(rps.region, 1, mean, na.rm = TRUE)
                        mean.crps[mm, i,] <- apply(crps.region, 1, mean, na.rm = TRUE)
                        mean.rps.clim[mm, i,] <- apply(rps.clim.region, 1, mean, na.rm = TRUE)
                        mean.crps.clim[mm, i,] <- apply(crps.clim.region, 1, mean, na.rm = TRUE)
                        mean.rpss[mm, i,] <- apply(rpss.region, 1, mean, na.rm = TRUE)
                        mean.crpss[mm, i,] <- apply(crpss.region, 1, mean, na.rm = TRUE)
                        mean.frpss[mm, i,] <- apply(frpss.region, 1, mean, na.rm = TRUE)
                        mean.fcrpss[mm, i,] <- apply(fcrpss.region, 1, mean, na.rm = TRUE)

                        ## for the debug:
                        ## PlotEquiMap(bias.region[,, 2], lon=lon.netCDF[pos.lon.min[i] : pos.lon.max[i]], lat=lat.netCDF[pos.lat.max[i] : pos.lat.min[i]], filled.continents = FALSE, brks=c(-100, -5, -4, -3, -2, -1, 0, 1, 2, 3, 4, 5, 100))
                        ## PlotEquiMap(corr.region[,,2], lon=lon.netCDF[pos.lon.min[i] : pos.lon.max[i]], lat=lat.netCDF[pos.lat.max[i] : pos.lat.min[i]], filled.continents = FALSE, brks=c(-10, -9, -8, -7, -6, -5, -4, -3, -2, -1, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10)/10)

                    }
                }

                ## set values more negative of -1 to -1:
                mean.fcrpss[which(mean.fcrpss < -1)] <- -1
                mean.frpss[which(mean.frpss < -1)] <- -1

                ## round the scores:
                mean.bias <- round(mean.bias, n.dec)
                mean.corr <- round(mean.corr, 2)
                mean.fcrpss <- round(mean.fcrpss, 2)
                mean.frpss <- round(mean.frpss, 2)
                ## newlines:
                mean.crpss <- round(mean.crpss, 2)
                mean.rpss <- round(mean.rpss, 2)

                ## for snow variables, remove the Tropics region:
                shortertable <- FALSE
                if(var.name == "Snowfall" || var.name == "Snow density" || var.name == "Snow depth" || var.name == "Sea-ice cover"){
                    mean.bias <- mean.bias[,-1,]
                    mean.corr <- mean.corr[,-1,]
                    mean.crpss <- mean.crpss[,-1,]
                    mean.rpss <- mean.rpss[,-1,]
                    region.names.figure <- region.names.figure[-1]
                    n.regions <- 2
                    shortertable <- TRUE
                }

                ## translate values by 1 to shift from start date to target month:
                mean.bias2 <- abind(mean.bias, mean.bias, mean.bias, along = 1)
                for(ff in 2:n.for.months){
                    mean.bias2[(n.start.months + 1):(n.start.months * 2),,ff] <- mean.bias2[(n.start.months + 2 - ff):(n.start.months * 2 + 1 - ff),,ff]
                }
                mean.bias2 <- mean.bias2[(n.start.months + 1):(n.start.months * 2),,] ## take only central part of the array

                mean.corr2 <- abind(mean.corr, mean.corr, mean.corr, along = 1)
                for(ff in 2:n.for.months){
                    mean.corr2[(n.start.months + 1):(n.start.months * 2),,ff] <- mean.corr2[(n.start.months + 2 - ff):(n.start.months * 2 + 1 - ff),,ff]
                }
                mean.corr2 <- mean.corr2[(n.start.months + 1):(n.start.months * 2),,] ## take only central part of the array

                mean.crpss2 <- abind(mean.crpss, mean.crpss, mean.crpss, along = 1)
                for(ff in 2:n.for.months){
                    mean.crpss2[(n.start.months + 1):(n.start.months * 2),,ff] <- mean.crpss2[(n.start.months + 2 - ff):(n.start.months * 2 + 1 - ff),,ff]
                }
                mean.crpss2 <- mean.crpss2[(n.start.months + 1):(n.start.months * 2),,] ## take only central part of the array

                mean.rpss2 <- abind(mean.rpss, mean.rpss, mean.rpss, along = 1)
                for(ff in 2:n.for.months){
                    mean.rpss2[(n.start.months + 1):(n.start.months * 2),,ff] <- mean.rpss2[(n.start.months + 2 - ff):(n.start.months * 2 + 1 - ff),,ff]
                }
                mean.rpss2 <- mean.rpss2[(n.start.months + 1):(n.start.months * 2),,] ## take only central part of the array

                ## row titles:
                region.names.figure2 <- rep("", n.regions * n.for.months)
                if(n.regions == 3) region.names2 <- region.names else region.names2 <- region.names[-1] 
                for(rr in 1:n.regions) region.names.figure2[floor(n.for.months/2) + (rr-1) * n.for.months ] = region.names2[rr]
                for(rr in 1:n.regions) region.names.figure2[floor(n.for.months/2) + (rr-1) * n.for.months + 1] = region.names.figure[rr]
                forecast.month.figure <- rep(1:n.for.months, n.regions)

                ## data inside the table to plot:
                table <- data.frame(Region = region.names.figure2, Forecast_month = forecast.month.figure,
                        BiasTarget1 = as.vector(t(mean.bias2[1,,])), BiasTarget2 = as.vector(t(mean.bias2[2,,])),
                        BiasTarget3 = as.vector(t(mean.bias2[3,,])), BiasTarget4 = as.vector(t(mean.bias2[4,,])),
                        BiasTarget5 = as.vector(t(mean.bias2[5,,])), BiasTarget6 = as.vector(t(mean.bias2[6,,])),
                        BiasTarget7 = as.vector(t(mean.bias2[7,,])), BiasTarget8 = as.vector(t(mean.bias2[8,,])),
                        BiasTarget9 = as.vector(t(mean.bias2[9,,])), BiasTarget10 = as.vector(t(mean.bias2[10,,])),
                        BiasTarget11 = as.vector(t(mean.bias2[11,,])), BiasTarget12 = as.vector(t(mean.bias2[12,,])),
                        CorrTarget1 = as.vector(t(mean.corr2[1,,])), CorrTarget2 = as.vector(t(mean.corr2[2,,])),
                        CorrTarget3 = as.vector(t(mean.corr2[3,,])), CorrTarget4 = as.vector(t(mean.corr2[4,,])),
                        CorrTarget5 = as.vector(t(mean.corr2[5,,])), CorrTarget6 = as.vector(t(mean.corr2[6,,])),
                        CorrTarget7 = as.vector(t(mean.corr2[7,,])), CorrTarget8 = as.vector(t(mean.corr2[8,,])),
                        CorrTarget9 = as.vector(t(mean.corr2[9,,])), CorrTarget10 = as.vector(t(mean.corr2[10,,])),
                        CorrTarget11 = as.vector(t(mean.corr[11,,])), CorrTarget12 = as.vector(t(mean.corr2[12,,])),
                        CrpssTarget1 = as.vector(t(mean.crpss2[1,,])), CrpssTarget2 = as.vector(t(mean.crpss2[2,,])),
                        CrpssTarget3 = as.vector(t(mean.crpss2[3,,])), CrpssTarget4 = as.vector(t(mean.crpss2[4,,])),
                        CrpssTarget5 = as.vector(t(mean.crpss2[5,,])), CrpssTarget6 = as.vector(t(mean.crpss2[6,,])),
                        CrpssTarget7 = as.vector(t(mean.crpss2[7,,])), CrpssTarget8 = as.vector(t(mean.crpss2[8,,])),
                        CrpssTarget9 = as.vector(t(mean.crpss2[9,,])), CrpssTarget10 = as.vector(t(mean.crpss2[10,,])),
                        CrpssTarget11 = as.vector(t(mean.crpss2[11,,])), CrpssTarget12 = as.vector(t(mean.crpss2[12,,])),
                        RpssTarget1 = as.vector(t(mean.rpss2[1,,])), RpssTarget2 = as.vector(t(mean.rpss2[2,,])),
                        RpssTarget3 = as.vector(t(mean.rpss2[3,,])), RpssTarget4 = as.vector(t(mean.rpss2[4,,])),
                        RpssTarget5 = as.vector(t(mean.rpss2[5,,])), RpssTarget6 = as.vector(t(mean.rpss2[6,,])),
                        RpssTarget7 = as.vector(t(mean.rpss2[7,,])), RpssTarget8 = as.vector(t(mean.rpss2[8,,])),
                        RpssTarget9 = as.vector(t(mean.rpss2[9,,])), RpssTarget10 = as.vector(t(mean.rpss2[10,,])),
                        RpssTarget11 = as.vector(t(mean.rpss2[11,,])), RpssTarget12 = as.vector(t(mean.rpss2[12,,])))

                ## cell colors of Bias metric:
                bias.max <- max(abs(mean.bias2), na.rm = TRUE)
                bias.minmax_max <- quantile(mean.bias2, 0.98, na.rm = TRUE)
                bias.minmax_min <- quantile(mean.bias2, 0.02, na.rm = TRUE)
                bias.max <- max(abs(bias.minmax_min), abs(bias.minmax_max))
                bias.int <- bias.max * c(-1, -0.8, -0.6, -0.4, -0.2, 0, 0.2, 0.4, 0.6, 0.8, 1) ## one point more than the colors below (the intervals)
                bias.int <- round(bias.int, n.dec)
                
                if(inverse.scale==TRUE){
                    bias.palette <- rev(c('#2D004B', '#542789', '#8073AC', '#B2ABD2', '#D8DAEB', '#FEE0B6', '#FDB863', '#E08214', '#B35806', '#7F3B08'))
                    colorunder_bias <- "#730C04"
                    colorsup_bias <- "#04040E"
                }else{    
                    bias.palette <- c('#2D004B', '#542789', '#8073AC', '#B2ABD2', '#D8DAEB', '#FEE0B6', '#FDB863', '#E08214', '#B35806', '#7F3B08')
                    colorunder_bias <- "#04040E"
                    colorsup_bias <- "#730C04"
                }
                colorunder <- "#04040E"
                colorsup <- "#730C04"

                bias.col <- array(colorunder_bias, c(n.for.months * n.regions, n.start.months)) ## gray is to detect outliers
                bias.text.col <- array("#2A2A2A", c(n.for.months * n.regions, n.start.months)) ## black is the default text color
                bias.text.bold <- array(TRUE, c(n.for.months * n.regions, n.start.months)) ## TRUE is the default bold value

                for(mm in 1:n.start.months){
                    for(ff in 1:n.for.months){
                        for(rr in 1:n.regions){
                            for(pp in 1:(length(bias.int)-1)){
                                if(is.nan(mean.bias2[mm, rr, ff])){
                                    bias.col[ff + (rr-1) * n.for.months, mm] <- "gray"
                                } else {
                                    if(mean.bias2[mm, rr, ff] >= bias.int[pp] && mean.bias2[mm, rr, ff] <= bias.int[pp+1])
                                        bias.col[ff + (rr-1) * n.for.months, mm] <- bias.palette[pp]
                                }

                                ## color text in white if background is gray, dark blue or dark red:
                                if(is.nan(mean.bias2[mm, rr, ff]) ||
                                (!is.nan(mean.bias2[mm, rr, ff]) && pp == 1 && mean.bias2[mm, rr, ff] < bias.int[2]) ||
                                (!is.nan(mean.bias2[mm, rr, ff]) && pp == 2 && mean.bias2[mm, rr, ff] < bias.int[3]) ||
                                (!is.nan(mean.bias2[mm, rr, ff]) && pp == (length(bias.int)-1) && mean.bias2[mm, rr, ff] >= bias.int[length(bias.int)-1])){
                                    bias.text.col[ff + (rr-1) * n.for.months, mm] <- "white"
                                    #bias.text.bold[ff + (rr-1) * n.for.months, mm] <- TRUE
                                }
                            }
                            if(mean.bias2[mm, rr, ff] < bias.int[1]){bias.col[ff + (rr-1) * n.for.months, mm] <- colorunder_bias}
                            if(mean.bias2[mm, rr, ff] > bias.int[length(bias.int)]){bias.col[ff + (rr-1) * n.for.months, mm] <- colorsup_bias}
                        }
                    }
                }

                ## cell colors of Correlation metric:
                Corr.int <- c(-1, -0.8, -0.6, -0.4, -0.2, 0, 0.2, 0.4, 0.6, 0.8, 1) ## one point more than the colors below (the intervals)
                Corr.palette <- c('#2D004B', '#542789', '#8073AC', '#B2ABD2', '#D8DAEB', '#FEE0B6', '#FDB863', '#E08214', '#B35806', '#7F3B08')
                Corr.col <- array("gray", c(n.for.months * n.regions, n.start.months)) ## gray is to detect outliers
                Corr.text.col <- array("#2A2A2A", c(n.for.months * n.regions, n.start.months)) ## black is the default text color
                Corr.text.bold <- array(TRUE, c(n.for.months * n.regions, n.start.months)) ## TRUE is the default bold value

                for(mm in 1:n.start.months){
                    for(ff in 1:n.for.months){
                        for(rr in 1:n.regions){
                            for(pp in 1:(length(Corr.int)-1)){
                            if(is.nan(mean.corr2[mm, rr, ff])){
                                    Corr.col[ff + (rr-1) * n.for.months, mm] <- "gray"
                                } else {
                                    if(mean.corr2[mm, rr, ff] >= Corr.int[pp] && mean.corr2[mm, rr, ff] <= Corr.int[pp+1])
                                        Corr.col[ff + (rr-1) * n.for.months, mm] <- Corr.palette[pp]
                                }

                                ## color text in white if background is dark blue:
                                if(is.nan(mean.corr2[mm, rr, ff]) ||
                                (!is.nan(mean.corr2[mm, rr, ff]) && pp == 1 && mean.corr2[mm, rr, ff] < Corr.int[2]) ||
                                (!is.nan(mean.corr2[mm, rr, ff]) && pp == 2 && mean.corr2[mm, rr, ff] < Corr.int[3]) ||
                                (!is.nan(mean.corr2[mm, rr, ff]) && pp == (length(Corr.int)-1) && mean.corr2[mm, rr, ff] >= Corr.int[length(Corr.int)-1])){
                                    Corr.text.col[ff + (rr-1) * n.for.months, mm] <- "white"
                                    Corr.text.bold[ff + (rr-1) * n.for.months, mm] <- TRUE
                                }
                            }
                        }
                    }
                } 
    
                ## cell colors of CRPSS metric:
                #CRPSS.int <- c(-1, -0.8, -0.6, -0.4, -0.2, 0, 0.2, 0.4, 0.6, 0.8, 1) ## one point more than the colors below (the intervals)
                #CRPSS.palette <- c('#2D004B', '#542789', '#8073AC', '#B2ABD2', '#D8DAEB', '#FEE0B6', '#FDB863', '#E08214', '#B35806', '#7F3B08') #palette as in bias
                #CRPSS.int <- c(0, 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 1) ## one point more than the colors below (the intervals)
                #CRPSS.palette <- c("#FEEACC","#FEEACC","#FDD8A7","#FDC38D","#FCA16C","#F67B51","#E7533A","#AD0000","#AD0000","#7F0000") #palette as in the plots
                CRPSS.int <- c(-0.5, -0.4, -0.3, -0.2, -0.1, 0, 0.1, 0.2, 0.3, 0.4, 0.5) ## one point more than the colors below (the intervals)
                CRPSS.palette <- c('#2D004B', '#542789', '#8073AC', '#B2ABD2', '#D8DAEB', '#FEE0B6', '#FDB863', '#E08214', '#B35806', '#7F3B08') #palette as suggested in meeting
                CRPSS.col <- array(colorunder, c(n.for.months * n.regions, n.start.months)) ## "#045a8d" blue is to detect outliers
                CRPSS.text.col <- array("#2A2A2A", c(n.for.months * n.regions, n.start.months)) ## black is the default text color
                CRPSS.text.bold <- array(TRUE, c(n.for.months * n.regions, n.start.months)) ## TRUE is the defaul bold value 
                
                for(mm in 1:n.start.months){
                    for(ff in 1:n.for.months){
                        for(rr in 1:n.regions){
                            for(pp in 1:(length(CRPSS.int)-1)){
                                if(is.nan(mean.crpss2[mm, rr, ff])){
                                    CRPSS.col[ff + (rr-1) * n.for.months, mm] <- "gray"
                                } else {
                                    if(mean.crpss2[mm, rr, ff] < CRPSS.int[1])
                                        CRPSS.col[ff + (rr-1) * n.for.months, mm] <- colorunder
                                    if(mean.crpss2[mm, rr, ff] >= CRPSS.int[length(CRPSS.int)-1])
                                        CRPSS.col[ff + (rr-1) * n.for.months, mm] <- colorsup
                                    
                                    if(mean.crpss2[mm, rr, ff] >= CRPSS.int[pp] && mean.crpss2[mm, rr, ff] <= CRPSS.int[pp+1])
                                        CRPSS.col[ff + (rr-1) * n.for.months, mm] <- CRPSS.palette[pp]
                                }

                                ## color text in white if background is dark blue or dark red:
                                if(is.nan(mean.crpss2[mm, rr, ff]) ||
                                (!is.nan(mean.crpss2[mm, rr, ff]) && pp == 1 && mean.crpss2[mm, rr, ff] < CRPSS.int[2]) ||
                                (!is.nan(mean.crpss2[mm, rr, ff]) && pp == 2 && mean.crpss2[mm, rr, ff] < CRPSS.int[3]) ||
                                (!is.nan(mean.crpss2[mm, rr, ff]) && pp == (length(CRPSS.int)-1) && mean.crpss2[mm, rr, ff] >= CRPSS.int[length(CRPSS.int)-1])){
                                    CRPSS.text.col[ff + (rr-1) * n.for.months, mm] <- "white"
                                    CRPSS.text.bold[ff + (rr-1) * n.for.months, mm] <- TRUE
                                }
                            }
                        }
                    }
                }

                ## cell colors of Non-FairRPSS metric:
                RPSS.int <- CRPSS.int ## one point more than the colors below (the intervals)
                RPSS.palette <- CRPSS.palette
                RPSS.col <- array(colorunder, c(n.for.months * n.regions, n.start.months)) ## "#045a8d" blue is to detect outliers
                RPSS.text.col <- array("#2A2A2A", c(n.for.months * n.regions, n.start.months)) ## black is the default text color
                RPSS.text.bold <- array(TRUE, c(n.for.months * n.regions, n.start.months)) ## TRUE is the default bold value

                for(mm in 1:n.start.months){
                    for(ff in 1:n.for.months){
                        for(rr in 1:n.regions){
                            for(pp in 1:(length(RPSS.int)-1)){
                                if(is.nan(mean.rpss2[mm, rr, ff])){
                                    RPSS.col[ff + (rr-1) * n.for.months, mm] <- "gray"
                                } else {
                                    if(mean.rpss2[mm, rr, ff] < RPSS.int[1])
                                        RPSS.col[ff + (rr-1) * n.for.months, mm] <- colorunder
                                    if(mean.rpss2[mm, rr, ff] >= RPSS.int[length(RPSS.int)-1])
                                        RPSS.col[ff + (rr-1) * n.for.months, mm] <- colorsup
                                    
                                    if(mean.rpss2[mm, rr, ff] >= RPSS.int[pp] && mean.rpss2[mm, rr, ff] <= RPSS.int[pp+1])
                                        RPSS.col[ff + (rr-1) * n.for.months, mm] <- RPSS.palette[pp]
                                }

                                ## color text in white if background is the darkest color (blue or brown):
                                if(is.nan(mean.rpss2[mm, rr, ff]) ||
                                (!is.nan(mean.rpss2[mm, rr, ff]) && pp == 1 && mean.rpss2[mm, rr, ff] < RPSS.int[2]) ||
                                (!is.nan(mean.rpss2[mm, rr, ff]) && pp == 2 && mean.rpss2[mm, rr, ff] < RPSS.int[3]) ||
                                (!is.nan(mean.rpss2[mm, rr, ff]) && pp == (length(RPSS.int)-1) && mean.rpss2[mm, rr, ff] >= RPSS.int[length(RPSS.int)-1])){
                                    RPSS.text.col[ff + (rr-1) * n.for.months, mm] <- "white"
                                    #RPSS.text.bold[ff + (rr-1) * n.for.months, mm] <- TRUE
                                }
                            }
                        }
                    }
                } 

                ## table header:
                my.col.names <- c("Region", "Forecast month", rep(c("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"), 4))

                ## add mayuscule to first letter and remove the eventual mayuscule in the second part of the variable name:
                #var.name.min <- paste0(toupper(substring(var.name.title, 1, 1)), substring(str_to_lower(var.name.title), 2, nchar(var.name.title)))
                var.name.min <- var.name
                
                options(stringsAsFactors = FALSE)
                my.header.names2 <- data.frame(c1=paste0(var.name.min, mod.pressure.title, " of ", system.name), c2=50)
                my.header.names <- as.data.frame(data.frame(c1=c("", paste0("Mean Bias (", var.unit,")"),"Correlation", "CRPSS", "RPSS"), c2=c(2, rep(n.start.months, 4))))

                #remove "known issue" data from cmcc-3:
                ## remove corrupted start dates of CMCC S3:
                if(system.name == "CMCC-S3"){
                    if(plevel==""){
                        ## case of single-level variables:
                        for(i in 1:n.for.months) {
                            for(r in 1:n.regions){
                                for(j in c(5, 9, 17, 21, 29, 33, 41, 45)) table[i + (r-1)*n.for.months, j + (i-1)] <- NaN
                                bias.col[i + (r-1)*n.for.months, c(3,7) + (i-1)] <- Corr.col[i + (r-1)*n.for.months, c(3,7) + (i-1)] <- CRPSS.col[i + (r-1)*n.for.months, c(3,7) + (i-1)] <- RPSS.col[i + (r-1)*n.for.months, c(3,7) + (i-1)] <- "gray"
                                bias.text.col[i + (r-1)*n.for.months, c(3, 7) + (i-1)] <- Corr.text.col[i + (r-1)*n.for.months, c(3,7) + (i-1)] <- CRPSS.text.col[i + (r-1)*n.for.months, c(3,7) + (i-1)] <- RPSS.text.col[i + (r-1)*n.for.months, c(3,7) + (i-1)] <- "white"
                            }
                        }
                    } else { ## case of pressure-levels variables:
                        for(i in 1:n.for.months){
                            for(r in 1:n.regions){
                                for(j in c(5:11, 17:23, 29:35, 41:47)) {
                                    mod1 <- 1; mod2 <- 0    
                                    if(i == 5 && (j == 11 || j == 23 || j == 35 || j == 47)){
                                        mod1 <- 0; mod2 <- -8
                                    }
                                    if(i == 6 && (j == 10 || j == 22 || j == 34 || j == 46)){
                                        mod1 <- 0; mod2 <- -7
                                    }
                                    if(i == 6 && (j == 11 || j == 23 || j == 35 || j == 47)){
                                        mod1 <- 0; mod2 <- -7
                                    }
                                    table[i + (r-1)*n.for.months, j + (i-1)*mod1 + mod2] <- NaN
                                }
                                for(j in 3:9){
                                    mod1 <- 1; mod2 <- 0
                                    if(i == 5 && j == 9){ mod1 <- 0; mod2 <- -8 }
                                    if(i == 6 && j == 8){ mod1 <- 0; mod2 <- -7 }
                                    if(i == 6 && j == 9){ mod1 <- 0; mod2 <- -7 }
                                    bias.col[i + (r-1)*n.for.months, j + (i-1)*mod1 + mod2] <- Corr.col[i + (r-1)*n.for.months, j + (i-1)*mod1 + mod2] <- CRPSS.col[i + (r-1)*n.for.months, j + (i-1)*mod1 + mod2] <- RPSS.col[i + (r-1)*n.for.months, j + (i-1)*mod1 + mod2] <- "gray"
                                    bias.text.col[i + (r-1)*n.for.months, j + (i-1)*mod1 + mod2] <- Corr.text.col[i + (r-1)*n.for.months, j + (i-1)*mod1 + mod2] <- CRPSS.text.col[i + (r-1)*n.for.months, j + (i-1)*mod1 + mod2] <- RPSS.text.col[i + (r-1)*n.for.months, j + (i-1)*mod1 + mod2] <- "white"
                                }
                            }
                        }
                    }
                }

                ## as above, but without normalization:
                table2 <- table
                ## select the number of decimals to show, their font size and color:
                for(col in 3:(2 + n.start.months * 4)) {
                    if (col > (2 + n.start.months)) table2[,col] <- format(table[,col], nsmall = 2) else table2[,col] <- format(table[,col], nsmall = n.dec) 
                    table2[,col] <- cell_spec(table2[,col], font_size = 8, color="gray70") ## smaller font size
                }

                n.columns <- 2 + n.start.months * 4
                for(i in 3:n.columns) table2[,i] <- str_replace(table2[,i], "NaN", "")

                ## change the font size of any value in the table lower than -1000 with a smaller one, to fit in its cell: (this usually happens with CRPSS)
                for(i in 3:n.columns) { ss <- which(table[,i] < -1000) ; if(length(ss) > 0) table2[ss,i] <- str_replace(table2[ss,i], "8px", "5px")}
                                
                ## draw the figure in html:
                table.html <- kbl(table2, escape = F, col.names=my.col.names, align = rep("c", 2 + n.start.months * 4)) %>%
                    kable_paper("hover", full_width = F) %>%
                    add_header_above(c(" " = 2, "Target month" = n.start.months, "Target month" = n.start.months, "Target month" = n.start.months, "Target month" = n.start.months)) %>%
                    add_header_above(c("(Ref: ERA5 1993-2016)" = 2, " " = n.start.months * 4), align = "left", font_size = 14) %>%
                    add_header_above(header = my.header.names, font_size = 20) %>%
                    add_header_above(header = my.header.names2, font_size = 20, align = "left") %>%

                column_spec(2 + n.start.months*0 + 1, background = bias.col[,1], color = bias.text.col[,1], bold = bias.text.bold[,1]) %>%
                column_spec(2 + n.start.months*0 + 2, background = bias.col[,2], color = bias.text.col[,2], bold = bias.text.bold[,2]) %>%
                column_spec(2 + n.start.months*0 + 3, background = bias.col[,3], color = bias.text.col[,3], bold = bias.text.bold[,3]) %>%
                column_spec(2 + n.start.months*0 + 4, background = bias.col[,4], color = bias.text.col[,4], bold = bias.text.bold[,4]) %>%
                column_spec(2 + n.start.months*0 + 5, background = bias.col[,5], color = bias.text.col[,5], bold = bias.text.bold[,5]) %>%
                column_spec(2 + n.start.months*0 + 6, background = bias.col[,6], color = bias.text.col[,6], bold = bias.text.bold[,6]) %>%
                column_spec(2 + n.start.months*0 + 7, background = bias.col[,7], color = bias.text.col[,7], bold = bias.text.bold[,7]) %>%
                column_spec(2 + n.start.months*0 + 8, background = bias.col[,8], color = bias.text.col[,8], bold = bias.text.bold[,8]) %>%
                column_spec(2 + n.start.months*0 + 9, background = bias.col[,9], color = bias.text.col[,9], bold = bias.text.bold[,9]) %>%
                column_spec(2 + n.start.months*0 + 10, background = bias.col[,10], color = bias.text.col[,10], bold = bias.text.bold[,10]) %>%
                column_spec(2 + n.start.months*0 + 11, background = bias.col[,11], color = bias.text.col[,11], bold = bias.text.bold[,11]) %>%
                column_spec(2 + n.start.months*0 + 12, background = bias.col[,12], color = bias.text.col[,12], bold = bias.text.bold[,12]) %>%

                column_spec(2 + n.start.months*1 + 1, background = Corr.col[,1], color = Corr.text.col[,1], bold = Corr.text.bold[,1]) %>%
                column_spec(2 + n.start.months*1 + 2, background = Corr.col[,2], color = Corr.text.col[,2], bold = Corr.text.bold[,2]) %>%
                column_spec(2 + n.start.months*1 + 3, background = Corr.col[,3], color = Corr.text.col[,3], bold = Corr.text.bold[,3]) %>%
                column_spec(2 + n.start.months*1 + 4, background = Corr.col[,4], color = Corr.text.col[,4], bold = Corr.text.bold[,4]) %>%
                column_spec(2 + n.start.months*1 + 5, background = Corr.col[,5], color = Corr.text.col[,5], bold = Corr.text.bold[,5]) %>%
                column_spec(2 + n.start.months*1 + 6, background = Corr.col[,6], color = Corr.text.col[,6], bold = Corr.text.bold[,6]) %>%
                column_spec(2 + n.start.months*1 + 7, background = Corr.col[,7], color = Corr.text.col[,7], bold = Corr.text.bold[,7]) %>%
                column_spec(2 + n.start.months*1 + 8, background = Corr.col[,8], color = Corr.text.col[,8], bold = Corr.text.bold[,8]) %>%
                column_spec(2 + n.start.months*1 + 9, background = Corr.col[,9], color = Corr.text.col[,9], bold = Corr.text.bold[,9]) %>%
                column_spec(2 + n.start.months*1 + 10, background = Corr.col[,10], color = Corr.text.col[,10], bold = Corr.text.bold[,10]) %>%
                column_spec(2 + n.start.months*1 + 11, background = Corr.col[,11], color = Corr.text.col[,11], bold = Corr.text.bold[,11]) %>%
                column_spec(2 + n.start.months*1 + 12, background = Corr.col[,12], color = Corr.text.col[,12], bold = Corr.text.bold[,12]) %>%

                column_spec(2 + n.start.months*2 + 1, background = CRPSS.col[,1], color = CRPSS.text.col[,1], bold = CRPSS.text.bold[,1]) %>%
                column_spec(2 + n.start.months*2 + 2, background = CRPSS.col[,2], color = CRPSS.text.col[,2], bold = CRPSS.text.bold[,2]) %>%
                column_spec(2 + n.start.months*2 + 3, background = CRPSS.col[,3], color = CRPSS.text.col[,3], bold = CRPSS.text.bold[,3]) %>%
                column_spec(2 + n.start.months*2 + 4, background = CRPSS.col[,4], color = CRPSS.text.col[,4], bold = CRPSS.text.bold[,4]) %>%
                column_spec(2 + n.start.months*2 + 5, background = CRPSS.col[,5], color = CRPSS.text.col[,5], bold = CRPSS.text.bold[,5]) %>%
                column_spec(2 + n.start.months*2 + 6, background = CRPSS.col[,6], color = CRPSS.text.col[,6], bold = CRPSS.text.bold[,6]) %>%
                column_spec(2 + n.start.months*2 + 7, background = CRPSS.col[,7], color = CRPSS.text.col[,7], bold = CRPSS.text.bold[,7]) %>%
                column_spec(2 + n.start.months*2 + 8, background = CRPSS.col[,8], color = CRPSS.text.col[,8], bold = CRPSS.text.bold[,8]) %>%
                column_spec(2 + n.start.months*2 + 9, background = CRPSS.col[,9], color = CRPSS.text.col[,9], bold = CRPSS.text.bold[,9]) %>%
                column_spec(2 + n.start.months*2 + 10, background = CRPSS.col[,10], color = CRPSS.text.col[,10], bold = CRPSS.text.bold[,10]) %>%
                column_spec(2 + n.start.months*2 + 11, background = CRPSS.col[,11], color = CRPSS.text.col[,11], bold = CRPSS.text.bold[,11]) %>%
                column_spec(2 + n.start.months*2 + 12, background = CRPSS.col[,12], color = CRPSS.text.col[,12], bold = CRPSS.text.bold[,12]) %>%

                column_spec(2 + n.start.months*3 + 1, background = RPSS.col[,1], color = RPSS.text.col[,1], bold = RPSS.text.bold[,1]) %>%
                column_spec(2 + n.start.months*3 + 2, background = RPSS.col[,2], color = RPSS.text.col[,2], bold = RPSS.text.bold[,2]) %>%
                column_spec(2 + n.start.months*3 + 3, background = RPSS.col[,3], color = RPSS.text.col[,3], bold = RPSS.text.bold[,3]) %>%
                column_spec(2 + n.start.months*3 + 4, background = RPSS.col[,4], color = RPSS.text.col[,4], bold = RPSS.text.bold[,4]) %>%
                column_spec(2 + n.start.months*3 + 5, background = RPSS.col[,5], color = RPSS.text.col[,5], bold = RPSS.text.bold[,5]) %>%
                column_spec(2 + n.start.months*3 + 6, background = RPSS.col[,6], color = RPSS.text.col[,6], bold = RPSS.text.bold[,6]) %>%
                column_spec(2 + n.start.months*3 + 7, background = RPSS.col[,7], color = RPSS.text.col[,7], bold = RPSS.text.bold[,7]) %>%
                column_spec(2 + n.start.months*3 + 8, background = RPSS.col[,8], color = RPSS.text.col[,8], bold = RPSS.text.bold[,8]) %>%
                column_spec(2 + n.start.months*3 + 9, background = RPSS.col[,9], color = RPSS.text.col[,9], bold = RPSS.text.bold[,9]) %>%
                column_spec(2 + n.start.months*3 + 10, background = RPSS.col[,10], color = RPSS.text.col[,10], bold = RPSS.text.bold[,10]) %>%
                column_spec(2 + n.start.months*3 + 11, background = RPSS.col[,11], color = RPSS.text.col[,11], bold = RPSS.text.bold[,11]) %>%
                column_spec(2 + n.start.months*3 + 12, background = RPSS.col[,12], color = RPSS.text.col[,12], bold = RPSS.text.bold[,12]) %>%

                column_spec(1, bold = TRUE, width_min = "4cm", width_max = "4cm") %>%
                column_spec(1, border_left = "4px solid black") %>%
                column_spec(2, bold = TRUE, width_max = "1cm") %>%
                column_spec(3:n.columns, width_max = "0.9cm", width_min = "0.9cm") %>%
                #column_spec(c(1, 2, 2+n.start.months, 2+n.start.months*2, 2+n.start.months*3), border_right = TRUE) %>%
                column_spec(c(1, 2, 2+n.start.months, 2+n.start.months*2, 2+n.start.months*3), border_right = "1px solid black") %>%
                column_spec(n.columns, border_right = "4px solid black") %>%

                column_spec(c(1,2,14,26,38), border_right = "2px solid black") %>%
                row_spec(seq(from = 0, to = n.for.months * n.regions, by = n.for.months), extra_css = "border-bottom: 2px solid black", hline_after = TRUE) #1px solid")
                
                ## convert html to .png:
                if(shortertable==TRUE){ #n.regions==2
                    my.file <- "./scorecard_by_target_month_0.png"
                    save_kable(table.html, file = my.file) #density might not work
                    system(paste0("convert ./scorecard_by_target_month_0.png -gravity South -chop 0x200 ./scorecard_by_target_month.png"))
                    my.file <- "./scorecard_by_target_month.png"
                }else{
                    my.file <- "./scorecard_by_target_month_0.png"
                    save_kable(table.html, file = my.file) #density might not work
                    system(paste0("convert ./scorecard_by_target_month_0.png -gravity South -chop 0x20 ./scorecard_by_target_month.png"))
                    my.file <- "./scorecard_by_target_month.png"
                }
                               
                print("Saving scorecard. Please wait...")

                ## ## manually add the color legend:
                png(filename= "./scorecard_legend.png", width=455, height=40)
                ColorBar(brks = CRPSS.int, cols = CRPSS.palette, vertical = FALSE, var_limits=c(-10000000, 1), col_inf = colorunder, col_sup = colorsup)
                dev.off()
            
                png(filename= "./scorecard_legend_bias.png", width=455, height=40)
                ColorBar(brks = round(bias.int, n.dec), cols = bias.palette, vertical = FALSE, triangle_ends_scale = 1, col_inf = colorunder_bias, col_sup = colorsup_bias) 
                dev.off()
                png(filename= "./scorecard_legend_corr.png", width=455, height=40)
                ColorBar(brks = Corr.int, cols = Corr.palette, vertical = FALSE, triangle_ends_scale = 0, col_inf = colorunder) 
                dev.off()
            
                ## add white space to the left:
                system(paste0("convert ./scorecard_legend_bias.png -background white -splice 225x0 ./scorecard_legend_bias_full.png"))
                
                ## put all legends together:
                system(paste0("montage ./scorecard_legend_bias_full.png ./scorecard_legend_corr.png ./scorecard_legend.png ./scorecard_legend.png -tile 4x1 -geometry -4+10 ./scorecard_legend_full.png"))
            
                ## add white space to the top to be cut when adding legend:
                system(paste0("convert ./scorecard_by_target_month.png -background white -splice 0x20 ./scorecard_by_target_month.png"))
                
                ## put legends below the scorecard:
                system(paste0("montage ./scorecard_by_target_month.png ./scorecard_legend_full.png -tile 1x2 -geometry +0-10 ./scorecard_by_target_month.png"))
                

                ### Add Climate Index scorecard if appropiate:
                dirclimateindex <- paste0("/shared/data_for_scorecards_SF/teleconnections/")
                if(varParamId == 34 && file.exists(paste0(dirclimateindex, "scorecard_nino_target_month_", gsub("s", "_s", system.filename), ".png"))) {
                    print("adding teleconnection png....")
                    system(paste0("montage ./scorecard_by_target_month.png ", paste0(dirclimateindex, "scorecard_nino_target_month_", gsub("s", "_s", system.filename), ".png"), " -tile 1x2 -geometry +0+10 ./scorecard_by_target_month.png"))
                }
                if(varParamId == 151 && file.exists(paste0(dirclimateindex, "scorecard_nao_target_month_", gsub("s", "_s", system.filename), ".png"))) {
                    print("adding teleconnection png....")
                    system(paste0("montage ./scorecard_by_target_month.png ", paste0(dirclimateindex, "scorecard_nao_target_month_", gsub("s", "_s", system.filename), ".png"), " -tile 1x2 -geometry +0+10 ./scorecard_by_target_month.png"))
                }


               # ## put footnote below the legend:
               # png(filename= "./scorecard_footnote.png", width=1600, height=35)
               # par(oma=c(0,0,0,0), mar = c(0,0,0,0))
               # plot(c(0, 1), c(0, 1), ann = F, bty = 'n', type = 'n', xaxt = 'n', yaxt = 'n')
               # text(x = -0.04, y = 0.5, labels = "     Note: eventual cells in grey represent start dates with data issues (e.g. corrupted values, missing start dates).", adj = 0, cex = 1, col = "black")
               # dev.off()
               # system(paste0("montage ./scorecard_by_target_month.png ./scorecard_footnote.png -tile 1x2 -geometry +0+0 ./scorecard_by_target_month.png"))

                ## move scorecard to the chosen dir:
                ## (it cannot done in the previous command because of a bug in save_kable)
                
                # old convention filename:
                #if (is.na(plevel)==TRUE){scorecardname <- paste0("-scorecard_by_target_month-era5-global-s-l-p", "-", substr(hindcasts.filename,1,4), "_", substr(hindcasts.filename,7,10), ".png")}
                #else{scorecardname <- paste0("-scorecard_by_target_month-era5-global-s-l-p", plevel, "-", substr(hindcasts.filename,1,4), "_", substr(hindcasts.filename,7,10), ".png")}
                # new convention filename:
                if (is.na(plevel)==TRUE){scorecardname <- paste0("-scorecard_by_target_month-global-p", "-", substr(hindcasts.filename,1,4), "_", substr(hindcasts.filename,7,10), "-era5.png")}
                else{scorecardname <- paste0("-scorecard_by_target_month-global-p", plevel, "-", substr(hindcasts.filename,1,4), "_", substr(hindcasts.filename,7,10), "-era5.png")}

                if (file.exists(paste0(fileout, "/", gsub("s", "-", system.filename), "-", varParamId, scorecardname)) == TRUE){system(paste0("rm ", paste0(fileout, "/", gsub("s", "-", system.filename), "-", varParamId, scorecardname)))}
                system(paste0("mv ", my.file, paste0(" ", fileout, "/", gsub("s", "-", system.filename), "-", varParamId, scorecardname)))
                
                print(paste0(fileout, "/", gsub("s", "-", system.filename), "-", varParamId, scorecardname))


                ## delete temporary files:
                system("rm ./scorecard_legend_bias.png ./scorecard_legend_corr.png ./scorecard_legend_bias_full.png ./scorecard_legend.png ./scorecard_legend_full.png ./scorecard_by_target_month_0.png")

                return(print(paste0("Scorecard figure by target month of variable ", var.name, " and ", system.name," saved in ", fileout)))

            }
            ''')
        R_scorecardfunction_teleconnections = ro.r('''
            call_scorecard_by_teleconnections <- function(year.start=year0, year.end=year1, sys = sc_centersystemname, center_system = sc_centersystemname_under, system.filename = sc_centersystemname_undernos){
                ##
                ## Measure teleconnections (ENSO, NAO) and plot their scorecards
                ##

                ## name of the forecast systems:
                #system.names <- c("ECMWF System 5", "DWD System 2", "Météo-France System 7", "Météo-France System 6", "CMCC System 3") ##, "UK Met Office System 14")
                
                ## first hindcast year:
                #year.start = 1993
                #
                ## last hindcast year:
                #year.end = 2016

                hindcasts.filename = paste0(year.start, "to", year.end)
                ref.caption = paste0("(Ref: ERA5 ", year.start, "-", year.end, ")")

                ## list with the names of the teleconnections:
                tel.names <- c("Niño3.4", "NAO")

                ## list with the unit of measure of each teleconnection:
                tel.units <- c("K", "none")

                ## Nino3.4() needs SST data; NAO.slp() needs SLP data (monthly data)
                input.path.sys <- "/shared/data_for_scorecards_SF/seasonal/seasonal-monthly-single-levels/monthly_files" ##"/data/cds_downloads/seasonal/seasonal-monthly-single-levels/monthly_files"
                input.path.rean <- "/shared/data_for_scorecards_SF/reanalysis/reanalysis-era5-single-levels-monthly-means"

                ## SST and SLP monthly files of the seasonal systems:
                ##input.path.sys <- "/esarchive/scratch/C3S512/seasonal/seasonal-monthly-single-levels/monthly_files"
                ## SST and SLP monthly file of ERA5:
                ##input.path.rean <- "/esarchive/scratch/C3S512/scorecards-data-ERA5"

                ## load scores of Niño3.4 and NAO:
                #for(sys in 1:length(system.names)){
                #
                #    if(system.names[sys] == "ECMWF System 5") {center_system <- "ecmwf_s5"}
                #    if(system.names[sys] == "CMCC System 3") {center_system <- "cmcc_s3"}
                #    if(system.names[sys] == "DWD System 2") {center_system <- "dwd_s2"}
                #    if(system.names[sys] == "Météo-France System 7") {center_system <- "meteo_france_s7"}
                #
                #    if(system.names[sys] == "ECMWF System 5") {system.filename <- "ecmwf-5"}
                #    if(system.names[sys] == "CMCC System 3") {system.filename <- "cmcc-3"}
                #    if(system.names[sys] == "DWD System 2") {system.filename <- "dwd-2"}
                #    if(system.names[sys] == "Météo-France System 7") {system.filename <- "meteo_france-7"}
                #
                    dirout1 <- paste0("/shared/plots_scientific_assessment/seasonal/seasonal_monthly_single_levels/", center_system, "/34/scorecards/")
                    dirout2 <- paste0("/shared/plots_scientific_assessment/seasonal/seasonal_monthly_single_levels/", center_system, "/151/scorecards/")
                
                    #scores.nino <- Nino3.4.scores(system.name = system.names[sys],
                    scores.nino <- Nino3.4.scores(system.name = sys,
                                                        year.start = year.start, year.end = year.end, lead.months = 1:6,
                                                        input.path.rean = input.path.rean, input.path.sys = input.path.sys)

                    #scores.nao <- NAO.scores(system.name = system.names[sys],
                    scores.nao <- NAO.scores(system.name = sys,
                                                    year.start = year.start, year.end = year.end, lead.months = 1:6,
                                                    input.path.rean = input.path.rean, input.path.sys = input.path.sys)

                    ## create the figure with the scorecards ENSO and NAO in the same figure (1 figure for each system):
                    
                    #Scorecard_by_teleconnection(tel.names = tel.names, tel.units = tel.units, scores = list(scores.nino, scores.nao), system.name = system.names[sys], lead.months = 1:6, dirout1 = dirout1, dirout2 = dirout2, hindcasts.filename = hindcasts.filename, system.filename = system.filename)
                    Scorecard_by_teleconnection(tel.names = tel.names, tel.units = tel.units, scores = list(scores.nino, scores.nao), system.name = sys, lead.months = 1:6, dirout1 = dirout1, dirout2 = dirout2, hindcasts.filename = hindcasts.filename, ref.caption = ref.caption, system.filename = system.filename)

                #} 
            }
            
            ''')
            
        R_scorecardfunction_all_at_once = ro.r('''
            Scorecard_all_variables_and_systems <- function(){

                #### Plot one scorecard for any variable and seasonal forecast system
                ####
                #
                ### name of the variables to plot (shown in the figure header):
                #var.names <- c("10m u-component of wind", "10m v-component of wind", "2m dewpoint temperature", "2m temperature", "Evaporation", "Mean sea level pressure", "Runoff", "Sea surface temperature", "Sea-ice cover", "Snow density", "Snow depth", "Snowfall", "Soil temperature level 1", "Surface latent heat flux", "Surface net solar radiation", "Surface net thermal radiation", "Surface sensible heat flux", "Surface solar radiation downwards", "Surface thermal radiation downwards", "Top net solar radiation", "Top net thermal radiation", "Total cloud cover", "Total precipitation", "10m wind speed")
                #
                ### unit of measure of var.name:
                #var.units <- c("m s-1", "m s-1","K","K","m s-1", "Pa","m s-1","K","0-1","Kg m-3","m","10e-8 m s-1","K","W m-2","W m-2","W m-2","W m-2","W m-2","W m-2","W m-2","W m-2", "0-1", "10e-8 m s-1", "m s-1")
                ### vector of seasonal forecast system names shown in the figure header:
                #system.names <- c("ECMWF System 5", "DWD System 2", "Météo-France System 7", "CMCC System 3") ##, "UK Met Office System 14") 
                #
                ### remove variables not present:
                #system.var <- array(TRUE, c(length(var.names), length(system.names)))
                #var2remove <- array(NA, c(10,2))
                #var2remove[1,] <- c("Runoff", "DWD System 2")
                #var2remove[2,] <- c("Snow density", "DWD System 2")
                #var2remove[3,] <- c("Runoff", "Météo-France System 7")
                #var2remove[4,] <- c("Runoff", "CMCC System 3")
                #var2remove[5,] <- c("Snow density", "CMCC System 3")
                #var2remove[6,] <- c("Snow depth", "CMCC System 3")
                #var2remove[7,] <- c("Top net solar radiation", "CMCC System 3")
                #var2remove[8,] <- c("Top net thermal radiation", "CMCC System 3")
                #
                #for(i in 1:length(var2remove[,1])) system.var[which(var.names == var2remove[i,1]), which(system.names == var2remove[i,2])] <- FALSE
                #
                ### vector of region names (might be expanded in future to include more regions):
                #region.names <- c("Tropics","Extra-tropical NH","Extra-tropical SH")
                #
                ### path of the input netCDF files with the pre-calculated metrics:
                ### input.path <- "/esarchive/scratch/ncortesi/C3S_512"
                #input.path <- "/esarchive/scratch/C3S512/netcdfs_scientific_assessment/seasonal/seasonal-monthly-single-levels"
                #
                ### select only the first 6 forecast months even if there are 8 in total; last two are forecast months 2-4 and 3-5
                #lead.months <- 1:6
                #
                ### directory where to write the scorecard figures:
                #fileout <- "/esarchive/scratch/C3S512/netcdfs_scientific_assessment/seasonal/seasonal-monthly-single-levels/scorecards"
                #    
                ### generate a scorecard figure typing this command from the R interface:
                ### if data is correctly loaded in R, it should return message "Scorecard figure saved"
                #for(var in 1:length(var.names)){
                #    for(sys in 1:length(system.names)){
                #        if(system.var[var, sys]) Scorecard_by_region(var.name = var.names[var], var.unit = var.units[var], system.name = system.names[sys], region.names, lead.months, input.path, fileout)
                #    }
            }


            ''')

        R_save_scores_for_teleconnection_scorecards = ro.r('''
            library(ncdf4) ## to load netCDF files
            library(formattable) ## to plot horizontal color bars
            library(kableExtra) ## to print data in formatted tables
            #library(magick) ## for saving as .png #not necessary
            library(stringr) ## for manipulating mayuscules in the figure title #is it necessary?
            library(s2dverification) ## for function ColorBar()
            library(abind) ## for function abind()

            call_parameters <- function(year.start=year0, year.end=year1, sys = sc_centersystemname, center_system = sc_centersystemname_under, system.filename = sc_centersystemname_undernos, var.units = sc_units, var.name = sc_varname){
                
                hindcasts.filename = paste0(year.start, "to", year.end)
                ref.caption = paste0("(Ref: ERA5 ", year.start, "-", year.end, ")")

                ## list with the names of the teleconnections:
                tel.names <- c("Niño3.4", "NAO")

                ## list with the unit of measure of each teleconnection:
                tel.units <- c("K", "none")

                ## Nino3.4() needs SST data; NAO.slp() needs SLP data (monthly data)
                input.path.sys <- "/shared/data_for_scorecards_SF/seasonal/seasonal-monthly-single-levels/monthly_files" ##"/data/cds_downloads/seasonal/seasonal-monthly-single-levels/monthly_files"
                input.path.rean <- "/shared/data_for_scorecards_SF/reanalysis/reanalysis-era5-single-levels-monthly-means"

                if(center_system == "ukmo_s14"){
                    year.start_data <- year.start #no data January 1993 but for Niño it's not an issue and for NAO it's still not working with 1994, so better use all data since 1993 anyway...
                }else{
                    year.start_data <- year.start
                }
                dirout_scores <- paste0("/shared/data_for_scorecards_SF/teleconnections/")
                
                # save the scores if they don't exist already
                if(file.exists(paste0(dirout_scores, "scores_nino_", center_system,".RData"))){
                    load(paste0(dirout_scores, "scores_nino_", center_system,".RData"))
                } else {
                    scores.nino <- Nino3.4.scores(system.name = sys,
                                year.start = year.start_data, year.end = year.end, lead.months = 1:6,
                                input.path.rean = input.path.rean, input.path.sys = input.path.sys)
                    print('+++++++++++++++ scores.nino computed +++++++++++++++++')
                    
                    save(scores.nino, file=paste0(dirout_scores, "scores_nino_", center_system,".RData")) 
                }

                if(file.exists(paste0(dirout_scores, "scores_nao_", center_system,".RData"))){
                    load(paste0(dirout_scores, "scores_nao_", center_system,".RData"))
                } else {
                    scores.nao <- NAO.scores(system.name = sys,
                                year.start = year.start_data, year.end = year.end, lead.months = 1:6,
                                input.path.rean = input.path.rean, input.path.sys = input.path.sys)
                    print('+++++++++++++++ scores.nao computed +++++++++++++++++')
                    
                    save(scores.nao, file=paste0(dirout_scores, "scores_nao_", center_system,".RData")) 

                    system("rm ./nao_obs.RData ./nao_obs_full.RData ./nao_for.RData")
                }


                # create png of the teleconnection to be added below the scorecard_by_date and by_target_month
                dirout_scorecard_by_index <- dirout_scores
                regionnino <-c("(5°N-5°S,", "120°-170°W)", "Niño3.4") 
                regionnao <- c("(20°-80°N,", "80°W- 40°E)", "NAO")

                scorecard_by_index(scores.nino, system.name = sys, system_internal_name = center_system, lead.months = 1:6, dirout = dirout_scorecard_by_index, var.unit = var.units, var.name = var.name, index = "nino", regiontitle = regionnino, scoretypefilename = "start_date_")
                scorecard_by_index(scores.nino, system.name = sys, system_internal_name = center_system, lead.months = 1:6, dirout = dirout_scorecard_by_index, var.unit = var.units, var.name = var.name, index = "nino", regiontitle = regionnino, scoretypefilename = "target_month_")
                #the difference is "Start date" or "Target month" format

                scorecard_by_index(scores.nao, system.name = sys, system_internal_name = center_system, lead.months = 1:6, dirout = dirout_scorecard_by_index, var.unit = var.units, var.name = var.name, index = "nao", regiontitle = regionnao, scoretypefilename = "start_date_")
                scorecard_by_index(scores.nao, system.name = sys, system_internal_name = center_system, lead.months = 1:6, dirout = dirout_scorecard_by_index, var.unit = var.units, var.name = var.name, index = "nao", regiontitle = regionnao, scoretypefilename = "target_month_")
                #the difference is "Start date" or "Target month" format

            }
            
            ''')

        if (sc_type == 0):
            print('.... saving scores of teleconnetions ....')
            system_names = {"ECMWF-S5": "ECMWF System 5", "DWD-S2": "DWD System 2", "METEO_FRANCE-S7": "Météo-France System 7", "METEO_FRANCE-S6": "Météo-France System 6", "CMCC-S3": "CMCC System 3", "UKMO-S14": "UK Met Office System 14", "NCEP-S2": "NCEP System 2"}
            sc_centersystemname_teleconnections = system_names[sc_centersystemname]
            sc_centersystemname_low = sc_centersystemname.lower()
            sc_centersystemname_under = sc_centersystemname.lower().replace("-", "_")
            sc_centersystemname_undernos = sc_centersystemname_under.replace("_s", "-")
            return R_save_scores_for_teleconnection_scorecards(year0, year1, sc_centersystemname_teleconnections, sc_centersystemname_under, sc_centersystemname_undernos, sc_units, sc_varname_long)

        elif(sc_type==1):
            print('Scorecard by region')
            return R_scorecardfunction1(year0, year1, sc_centersystem, sc_centersystemname, sc_units, sc_varname, sc_varname_long, sc_plevel, sc_inputpath, sc_outputpath, sc_paramID)
        elif(sc_type==2):
            print('Scorecard by start date')
            return R_scorecardfunction2(year0, year1, sc_centersystem, sc_centersystemname, sc_units, sc_varname, sc_varname_long, sc_plevel, sc_inputpath, sc_outputpath, sc_paramID)
        elif(sc_type==3):
            print('Scorecard by target month')
            return R_scorecardfunction3(year0, year1, sc_centersystem, sc_centersystemname, sc_units, sc_varname, sc_varname_long, sc_plevel, sc_inputpath, sc_outputpath, sc_paramID)
        elif(sc_type==4):
            print('Scorecard of teleconnetions')
            system_names = {"ECMWF-S5": "ECMWF System 5", "DWD-S2": "DWD System 2", "METEO_FRANCE-S7": "Météo-France System 7", "METEO_FRANCE-S6": "Météo-France System 6", "CMCC-S3": "CMCC System 3", "UKMO-S14": "UK Met Office System 14", "NCEP-S2": "NCEP System 2"}
            sc_centersystemname_teleconnections = system_names[sc_centersystemname]
            sc_centersystemname_low = sc_centersystemname.lower()
            sc_centersystemname_under = sc_centersystemname.lower().replace("-", "_")
            sc_centersystemname_undernos = sc_centersystemname_under.replace("_s", "-")
            print(sc_centersystemname)
            print(sc_centersystemname_teleconnections)
            print(sc_centersystemname_under)
            print(sc_centersystemname_undernos)
            return R_scorecardfunction_teleconnections(year0, year1, sc_centersystemname_teleconnections, sc_centersystemname_under, sc_centersystemname_undernos)
        elif(sc_type==5):
            return print('type 5 (all variables and systems) not implemented')  
        else:
            return 0        

       
    def lat2NS(self,
                  v
                 ):
        
        # This function convert a numeric value of latitude to a string with the positive value and the N or S accordingly
        if v>0:
            s='N'
        elif v<0:
            s='S'
        elif v == 0:
            s=''
            
        return '{}{}'.format(np.abs(v),s)
    
    def extract_attrs(self,
                      dataarray,
                      attrs_in = ['GRIB_cfVarName', 'GRIB_units'],
                      attrs_out = None
                     ):
        
        # This function extract the specific attributes from the given dataarray providing a dictionary attrs

        if attrs_out is None:
            attrs_out = attrs_in
            
        attrs = dict()
        for in_i, out_i in zip(attrs_in, attrs_out):
            attrs[out_i] = dataarray.attrs[in_i]
            
        return attrs
    
    
    
    def var2longname(self,
                     dataset
                    ):
    
        # This function creates a dictionary with the mapping of each variable name in cdsapi format to the
        # long version shown in the catalogue download forms
        
        form_path = os.path.join('/shared/c3s_repos/cds-forms-c3s', dataset, 'form.json')
        
        with open(form_path, 'r') as cdf:
            form = json.load(cdf)  
         
        if 'reanalysis' in dataset:
            source = form[1]['details']
            if 'pressure' in dataset:
                names_map = source['labels']
            else:
                names_map = {}
                for names_map_i in source['groups']:
                    names_map.update(names_map_i['labels'])
                    
        elif 'seasonal' in dataset:
            names_map = form[2]['details']['labels']
                
        return names_map
    
    
    def check_div(self,
                  field,
                  q = 0.2
                  ):
                  
        # This function checks if the data distribution of field is diverging or not. 
        # To do so, it compares the sign of the quantile q with the sign of the quantile 1-q
        # The output is True/False if diverging/Sequential. 
        
        q_left = field.quantile(q)
        q_right = field.quantile(1-q)
        
        if np.sign(q_left)*np.sign(q_right) < 0:
            div = True
          
        else:
            div = False
            
        return div
    
    
    def round_decimal(self,
                      x, 
                      ndigits
                     ):
        # This function rounds a given array x keeping ndigits non-zero digits.
        # Rounding is done using floor (xmin) and ceil (xmax)

        m = ndigits-1
        m = np.floor(np.log10(np.abs(x)))-m

        xmin = np.floor(x*pow(10, -m))*10**m
        xmax = np.ceil(x*pow(10, -m))*10**m

        return xmin, xmax


    def percentile(self,
                   var,
                   q,
                   ndigits
                  ):
       
        # This functions compute the value of the given percentile (q) for the corresponding xarray.dataarray (var)
        # rounded using round_decimal with parameter ndigits

        p = var.quantile(q = q, dim = None).values

         
        pmin, pmax = self.round_decimal(p, ndigits)

        return pmin, pmax
    

    def minmax_percentile(self,
                          var,
                          minmax,
                          qminmax,
                          cmap_type = 'sequential',
                          ndigits = 2
                         ):
        
        # This function update a given set of minmax = [min, max] limits using the percentiles specified in 
        # qminmax = [qmin, qmax]. Rounded is done using round_decimal with parameter ndigits

        qmin, qmax = qminmax

        if qmin != 'None':
            pmin, _ = self.percentile(var, qmin, ndigits)
            minmax[0] = pmin

        if qmax != 'None':
            _, pmax = self.percentile(var, qmax, ndigits)
            minmax[1] = pmax
            
        if cmap_type == 'diverging':
            pmax = max(np.abs(minmax))
            minmax = [-pmax, pmax]

        return minmax
    
    
    
    def get_levels(self,
                   dataset_parameters
                  ):
        
        if 'pressure' in dataset_parameters['dataset_sf']:
            levels = dataset_parameters['levels']
        else:
            levels = [None]
            
        return levels
    
    
    
    def find_conversion(self,
                        variable
                       ):
        
        # This function provides the conversion coefficient from the units_conversion.yaml
        
         # Units conversion
        with open("./src/units_conversion.yaml") as f:
            conversions = yaml.load(f, Loader=yaml.FullLoader)
          
        coef_conversions = conversions['coef_conversions']
        conversions.pop('coef_conversions')
        
        units_ok = False
        coef_variable = None
        for ki in conversions:
            if variable in conversions[ki]:
                units_ok = True
                coef_variable = coef_conversions[ki]
            
        return coef_variable, units_ok
            
        
        
        
    def clean_coordinates(self,
                          dataarray,
                          coordinates
                         ):
        
        # This function removes unrequired coordinates not contained in "coordinates".
        
        for ci in dataarray.coords:
            if ci not in coordinates:
                dataarray = dataarray.drop(ci)
                
        return dataarray
    
    
    
    def print_header(self, dataset_parameters):
        
        print('\n_________________________________________________________________')
        print('Dataset:               {}'.format(dataset_parameters['dataset_sf']))
        print('Originating_centre:    {}'.format(dataset_parameters['originating_centre']))
        print('System:                {}'.format(dataset_parameters['system']))
        print('Variable:              {}'.format(dataset_parameters['variable']))
        print('Period:                {}'.format(dataset_parameters['years']))
        print('Reference:             {}'.format(dataset_parameters['reference_name']))
        print('_________________________________________________________________\n')
        
    
    def generate_white_centred_cmap(self, nlevels = 10, original_cmap = 'PuOr_r'):
        if (nlevels % 2) == 0:
            middle_nlevels = int(nlevels/2)
            cmap_original = cm.get_cmap(original_cmap, nlevels)
            cmap_original_vector = cmap_original(np.linspace(0, 1, nlevels))
            white_color = np.array([1, 1, 1, 1])
            cmap_original_vector[middle_nlevels-1:middle_nlevels + 1, :] = white_color
            cmap_white_centred = ListedColormap(cmap_original_vector)

        else:
            raise Exception('Value for "nlevels" parameter is {}, not an even number. An even number should be provided'.format(nlevels))        

        return cmap_white_centred
    
        
