# Things you might want to change

# options(papersize="a4")
# options(editor="notepad")
# options(pager="internal")

# set the default help type:
# options(help_type="text")
options(help_type="html")

# your list with all R packages you want to load in memory at the beginning of every R session:
my.packages.ic3 <- c("sp","s2dverification","ncdf","ncdf4","statmod","maps","mapdata","parallel",
		"doMC","RColorBrewer","MASS","maptools","scales","abind","reshape","reshape2","data.table","GEOmap") 

# "psych","plotrix"

# GEOmap: for the dataset coastmap needed by PlotEquiDist

############################ Script loaded automatically at startup #####################

.First<-function(){
        # load all my packages in memory at the beginning of the R session:
        options(defaultPackages=c(getOption("defaultPackages"),my.packages.ic3))	
	      cat("\nLeidos todas las librerias opcionales\n")
	      print(paste("Current R session loaded from: ",commandArgs())) # print il nome del file .RData appena aperto
    
        print(paste("Working dir is: ",getwd()))
        print(system("free -m"))
        print(gc())
}


################################### My R Aliases  ############################################
# alias for commonly used functions:

s <- function(x) str(x)
l <- function(x) length(x)  # <- to quickly get the length of a vector
qu <- function() quit("no")  # <- to exit quickly from R typing only qu() instead of q("no")
clear <- function() rm(list=ls()) # to remove all objects in the R session
na <- function(x) length(which(is.na(x)))  # find if there are NA in the object and how many thay are
nna <- function(x) length(which(!is.na(x))) # find if there are NOT NA in the object and how many they are
de <- function() dev.off() # to close a graphic window quickly
pl <-function() plot.new() # to open a void plot quickly
w <- function() windows()   # <- to open a new windows (only works in Windows, in Linux the command in x11() )
last <- function(x) tail(x,1) # to get the last element of a vector instead of writing x[length(x)]
first <- function(x) x[1] # to get the first element of a vector using a function instead of []

################################### my Color Palettes #############################################

library("RColorBrewer")

my.palette1 <- c("lightblue","white",brewer.pal(9, "YlOrRd"))  #rev(brewer.pal(11, "RdYlBu"))  # it has only 11 colors!
my.palette2 <- c("lightblue","white",brewer.pal(9, "YlOrRd")) #rev(brewer.pal(11, "RdYlBu"))  
my.palette3 <- brewer.pal(9, "Greens") # only 9 colors
my.palette4 <- rev(brewer.pal(9, "BuPu"))  
my.palette5 <- brewer.pal(9, "Blues")
my.palette6 <- brewer.pal(9, "Blues")  
my.palette <- list(my.palette1,my.palette2,my.palette3,my.palette4,my.palette5,my.palette6)

# Escala de colores para los mapas de tendencias
my.palette1.trend <- brewer.pal(9,"YlOrBr")
my.palette2.trend <- brewer.pal(9,"YlOrBr")
my.palette3.trend <- brewer.pal(9,"Greens") # Winkler's Index
my.palette4.trend <- brewer.pal(9,"YlOrBr") # rev(brewer.pal(11,"RdBu"))
my.palette5.trend <- rev(brewer.pal(11,"RdBu"))
my.palette6.trend <- rev(brewer.pal(11,"RdBu"))
my.palette.trend <- list(my.palette1.trend,my.palette2.trend,my.palette3.trend,my.palette4.trend,my.palette5.trend,my.palette6.trend)

# others color palettes:
#my.palette7 <-  colorRampPalette(as.character(read.csv("/home/Earth/vtorralb/rgbhex.csv",header=F)[,1]))(length(my.brks)-1)  # blue--yellow-red colors


############################## My (short) Functions #######################################

# save in this function all the commands to download all the packages the first time you install R:
download.my.packages <- function(list.packages)for(p in 1:length(list.packages))install.packages(list.packages[p],repos="http://cran.univ-lyon1.fr")

# Convert degrees to radians:
deg2rad <- function(deg) return(deg*pi/180)

## function to convert histogram values to a time series.
## 'bin.position' is a vector with the value of the center of each bin
## 'numb' is a vector of the same length of bin.position, and with the number of events in each bin
pdf2series <- function(bin.position, numb){
    var.seq <- c()
    for(i in 1:length(bin.position)) var.seq <- c(var.seq, rep(bin.position[i], numb[i]))
    return(var.seq)    
}

################################### My Functions #######################################

# function to show memory usage:
.ls.objects <- function (pos = 1, pattern, order.by, decreasing=FALSE, head=FALSE, n=5) {
    napply <- function(names, fn) sapply(names, function(x)
                                         fn(get(x, pos = pos)))
    names <- ls(pos = pos, pattern = pattern)
    obj.class <- napply(names, function(x) as.character(class(x))[1])
    obj.mode <- napply(names, mode)
    obj.type <- ifelse(is.na(obj.class), obj.mode, obj.class)
    obj.size <- napply(names, object.size)
    obj.dim <- t(napply(names, function(x)
                        as.numeric(dim(x))[1:2]))
    vec <- is.na(obj.dim)[, 1] & (obj.type != "function")
    obj.dim[vec, 1] <- napply(names, length)[vec]
    out <- data.frame(obj.type, obj.size, obj.dim)
    names(out) <- c("Type", "Size", "Rows", "Columns")
    if (!missing(order.by))
        out <- out[order(out[[order.by]], decreasing=decreasing), ]
    if (head)
        out <- head(out, n)
    return(out)
}

# shorthand
lsos <- function(..., n=10) {
    .ls.objects(..., order.by="Size", decreasing=TRUE, head=TRUE, n=n)
    
}

# create function to return matrix of memory consumption:
object.sizes <- function()
{
  return(rev(sort(sapply(ls(envir=.GlobalEnv), function (object.name) 
		object.size(get(object.name))))))
}

# function to resume memory use on Linux:
mem <- function(){
  print(system("free -m"))
  #print(gc())
  print(lsos())
}

#################################################################################################
#                                                                        Calendar functions                                                                                                            #
#################################################################################################

# vector with the month names:
my.month <- c("January","February","March","April","May","June","July","August","September","October","November","December")
my.month.short <- c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
my.month.short2 <- c("Ja", "Fe", "Ma", "Ap", "Ma", "Ju", "Ju", "Au", "Se", "Oc", "No", "De")
my.month.short3 <- my.month.very.short <- c("J","F","M","A","M","J","J","A","S","O","N","D")
my.season <- c("Winter", "Spring", "Summer", "Autumn")
my.period <- period.name <- c(my.month, my.season, "Yearly", "DJFMA")
my.period.short <- c(my.month.short, my.season, "Year","DJFMA")

endmonth <- function(day,month,year){ # day indica un giorno del mese di cui si vuole controllare se e' l'ultimo giorno del mese o meno:
	last=FALSE
	if(month==1 & day==31) last=TRUE; if(month==3 & day==31) last=TRUE; if(month==4 & day==30)last=TRUE; if(month==5 & day==31)last=TRUE
	if(month==6 & day==30) last=TRUE; if(month==7 & day==31) last=TRUE; if(month==8 & day==31)last=TRUE; if(month==9 & day==30)last=TRUE
	if(month==10 & day==31) last=TRUE; if(month==11 & day==30) last=TRUE; if(month==12 & day==31)last=TRUE
	if(year%%400==0 | (year%%4==0 & year%%100!=0)){ # in questo caso l'anno e' bisestile)
	if(month==2 & day==29) last=TRUE } else { # Anno NON bisestile:
	if(month==2 & day==28) last=TRUE }
	return(last)
}

# simile alla precedente, restituisce qual'e'l'ultimo giorno del mese introdotto (ovvero il numero di giorni di quel mese)
lastday <- function(month, year){ 
	if(month==1 | month==3 | month==5 | month==7 | month==8 | month==10 | month==12) last=31
	if(month==4 | month==6 | month==9 | month==11) last=30
	if(month==2){
	  if(year%%400==0 | (year%%4==0 & year%%100!=0)) {last=29} else {last=28}
	}
	#if(year==1 & month==2) last=28.25 # se si mette come anno il numero 1, restituisce il numero medio di giorni di febbraio quando si considerano tanti anni (28.25). Utile per calcolare le frequenze dei WTs del mese di febbraio.
	return(last)
}

# returns TRUE if the input year is a leap year:
leap.year <- function(year) return(ifelse((year%%4==0 & year%%100!=0) | year%%400==0, TRUE, FALSE))

# return the number of days of the input year:
n.days.in.a.year <- function(year) return(ifelse((year%%4==0 & year%%100!=0) | year%%400==0, 366, 365))

# return the number of days of the input month (1=Jan, 12=Dec):
# actually, it is only a wrapper of lastday(), that was kept for consistency with previous scripts
n.days.in.a.month <- function(month,year){
  return(lastday(month, year))
}

# like the previous function, but in case the input month is greater than 12, it enters into the next year:
ndm <- function(month,year){
  if(month < 13){
    return(lastday(month, year))
  } else {
    return(lastday(month-12, year+1))
  }
}

# return the number of days of the input season (1=Winter, 2=Spring, 3=Summer, 4=Autumn):
n.days.in.a.season <- function(season, year){
    return(length(pos.season(year,season)))
}

# return the number of days of the input period (1-12: Jan-Dec, 13: winter, 14. spring, 15:summer, 16:autumn, 17: ear)
n.days.in.a.period <- function(period, year){
     if(period <= 12) return(n.days.in.a.month(period,year))
     if(period > 12 && period < 17) return(n.days.in.a.season(period-12,year))
     if(period == 17) return(n.days.in.a.year(year))
     if(period == 18) return(n.days.in.a.month(12,year) + n.days.in.a.month(1,year) + n.days.in.a.month(2,year) + n.days.in.a.month(3,year) + n.days.in.a.month(4,year))
}

# get the total number of days from year.start to year.end:
n.days.in.a.yearly.period <- function(year.start, year.end){
    days.tot <- 0
    for(y in year.start:year.end){
       days.tot <- days.tot + n.days.in.a.year(y)
    }
    return(days.tot)
}

# get the total number of days from month.start to month.end (included).
# if month.end is smaller than month.start, it considers month.end to be a month of the following year:
n.days.in.a.monthly.period <- function(month.start, month.end, year){
    days.tot <- 0
    if(month.start <= month.end){
      for(m in month.start:month.end) days.tot <- days.tot + n.days.in.a.month(m, year)
    } else {
      for(m in month.start:12) days.tot <- days.tot + n.days.in.a.month(m, year)
      for(m in 1:month.end) days.tot <- days.tot + n.days.in.a.month(m, year+1)
    }
    return(days.tot)
}

# restituisce una sequenza di 365 o 366 numeri, il cui valore rappres.il numero del mese dell'anno associato a quel giorno
seq.months.in.a.year <- function(year){ 
	n.days.febr <- ifelse(n.days.in.a.year(year) == 366, 29, 28)
	return(c(rep(1,31), rep(2,n.days.febr), rep(3,31), rep(4,30), rep(5,31), rep(6,30), rep(7,31), rep(8,31), rep(9,30), rep(10,31), rep(11,30), rep(12,31)))
}

# restituisce una sequenza di 365 o 366 numeri, il cui valore is 1 if it is a month from October to March, or 2 if from April to September.
seq.seasons.in.a.year <- function(year){ 
	n.days.febr <- ifelse(n.days.in.a.year(year) == 366, 29, 28)
	return(c(rep(1,31), rep(1,n.days.febr), rep(1,31), rep(2,30), rep(2,31), rep(2,30), rep(2,31), rep(2,31), rep(2,30), rep(1,31), rep(1,30), rep(1,31)))
}

## restituisce una sequenza di 365 o 366 numeri, il cui valore rappres.il numero della settimana dell'anno associato a quel giorno (partendo dal primo gennaio):
seq.weeks.in.a.year <- function(year){
    ## There are always 52 weeks in any year. Plus, normal years have 1 days more (the first one of the 53th week), while bisestile years have 2 days more.
    return(rep(1:53, each=7)[1:n.days.in.a.year(year)])
}

# restituisce una sequenza di 365 o 366 numeri, il cui valore rappres.il numero del giorno dell'anno associato
seq.days.in.a.year <- function(year){ 
	n.days.febr <- ifelse(n.days.in.a.year(year) == 366, 29, 28)
	return(c(1:31, 1:n.days.febr, 1:31, 1:30, 1:31, 1:30, 1:31, 1:31, 1:30, 1:31, 1:30, 1:31))
}

# interval of days belonging only to the year y, but starting to count from the year year.start:
seq.days.in.a.future.year <- function(year.start, y){
    return(n.days.in.a.yearly.period(year.start,y) - n.days.in.a.yearly.period(y,y) + 1:n.days.in.a.year(y))
}

# number of days from year.start to year y, excluding year y:
n.days.in.a.future.year <- function(year.start, y){
    return(n.days.in.a.yearly.period(year.start,y) - n.days.in.a.yearly.period(y,y))
}

# vector with the number of the days of the input year belonging to the input month (1=January, 12=December):
pos.month <- function(year, month){
        if(month == 1) return(1:31)
        n.feb <- 28 + ifelse(leap.year(year) == TRUE, 1, 0)
        
        if(month == 2) return(31 + 1:n.feb)
        if(month == 3) return(31 + n.feb + 1:31)
        if(month == 4) return(31 + n.feb + 31 + 1:30)
        if(month == 5) return(31 + n.feb + 31 + 30 + 1:31)
        if(month == 6) return(31 + n.feb + 31 + 30 + 31 + 1:30)
        if(month == 7) return(31 + n.feb + 31 + 30 + 31 + 30 + 1:31)
        if(month == 8) return(31 + n.feb + 31 + 30 + 31 + 30 + 31 + 1:31)
        if(month == 9) return(31 + n.feb + 31 + 30 + 31 + 30 + 31 + 31 + 1:30)
        if(month == 10) return(31 + n.feb + 31 + 30 + 31 + 30 + 31 + 31 + 30 + 1:31)
        if(month == 11) return(31 + n.feb + 31 + 30 + 31 + 30 + 31 + 31 + 30 + 31 + 1:30)
        if(month == 12) return(31 + n.feb + 31 + 30 + 31 + 30 + 31 + 31 + 30 + 31 + 30 + 1:31)
}

# as pos.month, but it returns a vector with the days of the imput year belonging to the months before the input month:
pos.months.before <- function(year,month){
    pos <- c()
    if(month == 1) {
       pos <- 0
    } else { 
       for(m in 1:(month-1)){
         pos <- c(pos, pos.month(year, m))
       }
    }
       
   return(pos) 
}

# as pos.month, but also adds the days of the two closer months to the input month:
pos.month.extended <- function(year, month){
    if(month == 1) return(c(pos.month(year,12),pos.month(year,1),pos.month(year,2)))       
    if(month == 2) return(c(pos.month(year,1),pos.month(year,2),pos.month(year,3)))    
    if(month == 3) return(c(pos.month(year,2),pos.month(year,3),pos.month(year,4)))    
    if(month == 4) return(c(pos.month(year,3),pos.month(year,4),pos.month(year,5)))    
    if(month == 5) return(c(pos.month(year,4),pos.month(year,5),pos.month(year,6)))    
    if(month == 6) return(c(pos.month(year,5),pos.month(year,6),pos.month(year,7)))    
    if(month == 7) return(c(pos.month(year,6),pos.month(year,7),pos.month(year,8)))    
    if(month == 8) return(c(pos.month(year,7),pos.month(year,8),pos.month(year,9)))    
    if(month == 9) return(c(pos.month(year,8),pos.month(year,9),pos.month(year,10)))    
    if(month == 10) return(c(pos.month(year,9),pos.month(year,10),pos.month(year,11)))
    if(month == 11) return(c(pos.month(year,10),pos.month(year,11),pos.month(year,12)))
    if(month == 12) return(c(pos.month(year,11),pos.month(year,12),pos.month(year,1)))
}

# as pos.month.extended, but only adds 15 days of the two closer months to the input month:
pos.month.extended15 <- function(year, month){
    if(month == 1) return(c(pos.month(year,12)[(l(pos.month(year,12))-14):l(pos.month(year,12))],pos.month(year,1),pos.month(year,2)[1:15]))       
    if(month == 2) return(c(pos.month(year,1)[(l(pos.month(year,1))-14):l(pos.month(year,1))],pos.month(year,2),pos.month(year,3)[1:15]))    
    if(month == 3) return(c(pos.month(year,2)[(l(pos.month(year,2))-14):l(pos.month(year,2))],pos.month(year,3),pos.month(year,4)[1:15]))    
    if(month == 4) return(c(pos.month(year,3)[(l(pos.month(year,3))-14):l(pos.month(year,3))],pos.month(year,4),pos.month(year,5)[1:15]))    
    if(month == 5) return(c(pos.month(year,4)[(l(pos.month(year,4))-14):l(pos.month(year,4))],pos.month(year,5),pos.month(year,6)[1:15]))    
    if(month == 6) return(c(pos.month(year,5)[(l(pos.month(year,5))-14):l(pos.month(year,5))],pos.month(year,6),pos.month(year,7)[1:15]))    
    if(month == 7) return(c(pos.month(year,6)[(l(pos.month(year,6))-14):l(pos.month(year,6))],pos.month(year,7),pos.month(year,8)[1:15]))    
    if(month == 8) return(c(pos.month(year,7)[(l(pos.month(year,7))-14):l(pos.month(year,7))],pos.month(year,8),pos.month(year,9)[1:15]))    
    if(month == 9) return(c(pos.month(year,8)[(l(pos.month(year,8))-14):l(pos.month(year,8))],pos.month(year,9),pos.month(year,10)[1:15]))    
    if(month == 10) return(c(pos.month(year,9)[(l(pos.month(year,9))-14):l(pos.month(year,9))],pos.month(year,10),pos.month(year,11)[1:15]))
    if(month == 11) return(c(pos.month(year,10)[(l(pos.month(year,10))-14):l(pos.month(year,10))],pos.month(year,11),pos.month(year,12)[1:15]))
    if(month == 12) return(c(pos.month(year,11)[(l(pos.month(year,11))-14):l(pos.month(year,11))],pos.month(year,12),pos.month(year,1)[1:15]))
   
}

# vector with the number of the days of the input year belonging to the input month (1=Winter, 4=Autumn): (Winter is Jan-Feb and Dec of the same year)
pos.season <- function(year, season){
        if(season==1) return(c(pos.month(year,1),pos.month(year,2),pos.month(year,12)))  # winter 
        if(season==2) return(c(pos.month(year,3),pos.month(year,4),pos.month(year,5)))   # spring
        if(season==3) return(c(pos.month(year,6),pos.month(year,7),pos.month(year,8)))   # summer
        if(season==4) return(c(pos.month(year,9),pos.month(year,10),pos.month(year,11))) # autumn
}

# same as pos.month, but for period > 12 returns the seasonal positions instead (13: winter, 14. spring, 15:summer, 16:autumn), or the yearly interval for period = 17
pos.period <- function(year, period){
       if(period <= 12) return(pos.month(year, period))
       if(period > 12 && period < 17) return(pos.season(year, period-12))
       if(period == 17) return(1:n.days.in.a.year(year))
       if(period == 18) return(c(pos.month(year,12), pos.month(year,1), pos.month(year,2), pos.month(year,3), pos.month(year,4)))
}


# sequence of weekly startdates for the chosen year and start day/month:
weekly.seq <- function(year,month,day){
  yr1 <- year  # starting year of the weekly sequence
  mes <- month  # starting month (usually january)
  
  #yr2 <- year # in future you will be able to create a sequence for more than one year
  #day<-2  # starting day
  
  if(mes < 10) {mes0 <- paste0(0, mes)} else {mes0 <- mes}
  if(day < 10) {day0 <- paste0(0, day)} else {day0 <- day}
  
  sdates <- paste0(yr1, mes0, day0)
  nday <- day
  ndaysFebruary <- lastday(2, yr1)
  ndays4month <- c(31, ndaysFebruary, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)
  
  while (nday < 365 - 7) { # ojo a los bisiestos!
    day <- day + 7
    nday <- nday + 7
    if(day > ndays4month[mes]){
      day <- day - ndays4month[mes]
      mes <- mes + 1
    }
    
    if(mes < 10){ mes0 <- paste0(0, mes)} else {mes0 <- mes}
    if(day < 10){ day0 <- paste0(0, day)} else {day0 <- day}
    
    sdates <- c(sdates, paste0(yr1, mes0, day0))
  }  
  return(sdates)
}

# return the position inside the weekly.seq of all the startdates whose months belongs to the chosen period:
months.period <- function(year,mes,day,period){
       sdates.seq <- weekly.seq(year,mes,day)
       months.period <- list()
       
       for(p in 1:12) months.period[[p]] <- which(as.numeric(substr(sdates.seq,5,6)) == p)

       months.period[[13]] <- c(months.period[[1]],months.period[[2]],months.period[[12]])
       months.period[[14]] <- c(months.period[[3]],months.period[[4]],months.period[[5]])
       months.period[[15]] <- c(months.period[[6]],months.period[[7]],months.period[[8]])
       months.period[[16]] <- c(months.period[[9]],months.period[[10]],months.period[[11]])

       return(months.period[[period]])
}

#################################################################################################
#                                      Graphic functions                                        #
#################################################################################################


## table:  a matrix with the values of the table to plot
## set xvert = TRUE to place x labels vertically instead than horizontally
## legend.width is the width of the legend bar to the right of the plot. Change this value if by default it is too small or too big
## figure.width multiplies the width of the whole plot for this number. Useful if the shape of points appears to be more rectangual than squared.

library(s2dverification)

n.start.dates <- 10
n.lead.times <- 12
table <- matrix(rnorm(n=n.start.dates * n.lead.times, mean=0.3), n.start.dates, n.lead.times)
#table <- matrix(-0.05+ 1:10/10, n.start.dates, n.lead.times)

colors <- c('white','#fef0d9','#fdd49e','#fdbb84','#fc8d59','#e34a33','#b30000', '#7f0000')
brks = c(-1, 0, 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 1)
title = "Mean Absolute Error"
title.color = NULL
xvert = FALSE
xtitle = "Lead time (weeks)"
line = 5
ytitle = "Start date (month)"

xlabels = c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
ylabels = NULL

figure.width = 1.3 ##1.3
legend = TRUE
legend.width = 0.15
file = "/esarchive/scratch/ncortesi/test.png"

#'Function to convert any numerical table to a grid made up of coloured squares.
#'
#'@description This function converts a numerical data matrix in a coloured grid. Useful in an article or slide, to present tabular results as colors instead of numbers.
#'
#'@param table Any numerical matrix with the values you want to show as colors.
#'@param colors A vector with the color sequence you want to use in the grid.
#'@param brks A vector with the intervals you want to split your data into. There must be one \code{brks} more than the number of \code{colors}.
#'@param title The title of the grid. Default is NULL (no title). 
#'@param title.color Color to use for the title (default is dark blue).
#'@param xtitle Title of the x-axis (default is NULL). 
#'@param ytitle Title of the y-axis (default is NULL).
#'@param xlabels vector of length ncol(\code{table}) with the labels of the x-axis (default is a sequence from 1 to the number of columns).
#'@param xvert if x-axis labels are too long, you can place them vertically by setting \code{xvert} to TRUE (default is FALSE). 
#'@param ylabels vector of length nrow(\code{table}) with the labels of the y-axis (default is a sequence from 1 to the number of rows).
#'@param line Distance of the title of the x-axis from the x-axis (default is 3 lines). Adjust as necessary if your x-axis labels are long.
#'@param figure.width If you notice the form of the grid cells is not perfectly squared, you can adjust it by multiplying the grid width for this factor (default is 1).
#'@param legend Set it to FALSE if you don't want to draw the grid color legend (default is TRUE).
#'@param legend.width If the width of the color legend is too small or too large, you can adjust it by increasing or decreasing the legend width (default is 0.15)
#'@param file Set the path and the filename where you want to save the .png image of the grid (default is the working directory).
#'
#'@return No data is returned. Only the grid image is saved in a .png file.
#'
#'@import s2dverification
#'
#'@examples 
#'## Example with random data:
#' table2grid(table = matrix(rnorm(n=120, mean=0.3), 10, 12), colors=c('white','#fef0d9','#fdd49e','#fdbb84','#fc8d59','#e34a33','#b30000', '#7f0000'),
#'           brks=c(-1, 0, 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 1),
#'           title="Mean Absolute Error", xtitle="Lead time (weeks)", ytitle="Start date (month)",
#'           xlabels=c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"),
#'           file="/my_path/my_filename.png")
#'
#'@export

table2grid <- function(table, colors, brks, title = NULL, title.color = "royalblue4", xtitle = NULL, ytitle = NULL, xlabels = NULL, xvert = FALSE, ylabels = NULL, line = 3, figure.width = 1, legend = TRUE, legend.width = 0.15, file = NULL, ...){

    ## variable checks:
    if(is.null(colors)) stop("You have to specify a color palette of at least 2 colors")
    if(is.null(brks)) stop("You have to specify 2 or more intervals")
    if(!is.matrix(table)) stop("Input values are not a matrix")    
    n.colors <- length(colors)
    n.brks <- length(brks)
    if(n.brks != n.colors + 1) stop("There must be one break more than the number of colors")
    n.cols <- ncol(table)
    n.rows <- nrow(table)
    if(!is.null(xlabels) && length(xlabels) != n.cols) stop("The number of x labels must be equal to the number of columns of the data matrix")    
    if(!is.null(ylabels) && length(ylabels) != n.rows) stop("The number of y labels must be equal to the number of rows of the data matrix")    
    ##if(xrotate > 90 || xrotate < 0) stop("X-axis rotation must be of a number of degrees from 0 to 90")
    if(!is.numeric(legend.width) || legend.width < 0 || legend.width > 0.5) stop("legend.width must be a number from 0 to 0.5")
    if("s2dverification" %in% (.packages())){ print("Package s2dverification found")} else { stop("You need to load R package s2dverification") }

    ## print output file:
    if(is.null(file)) { file.output <- paste0(getwd(), "/table2grid.png") } else { file.output <- file } 
    print(paste0("Saving grid image in: ", file.output))

    ## generate grid image:
    
    png(file = file, width = 55 * n.cols * figure.width, height = 50 * n.rows) 
    plot.new()
    
    ## Draw empty plot:
    ##par(mar = c(6, 4, 1, 0), fig = c(0.12, 0.47, 0.18, 0.88), new=TRUE)
    par(mar = c(4, 4, 1, 0), fig = c(0.1, 1 - legend.width, 0.1, 0.9), new=TRUE)
    plot(1, 1, type = "n", xaxt = "n", yaxt = "n", ylim = c(0.5, n.rows + 0.5), xlim = c(-0.5, n.cols - 1 + 0.5), ann = F,  bty="n") ## to remove black border
    
    ## Add axes titles:
    label.size <- 1.2 * (max(n.cols, n.rows)/10)^0.5
    mtext(side = 1, text = xtitle, line = line, cex = label.size, font = 3)
    mtext(side = 2, text = ytitle, line = 3, cex = label.size, font = 3)

    ## Add plot title:
    if(is.null(title.color)) title.color <- "royalblue4"
    mtext(side = 3, text = title, cex = 1.75 * (n.rows/10)^0.7, col = title.color)

    ## Add axis labels:
    axis.size <- (max(n.cols, n.rows)/10)^0.3
    if(is.null(xlabels)) xlabels = 1:n.cols
    if(is.null(ylabels)) ylabels = 1:n.rows
    axis(1, at=seq(0, n.cols-1), las=ifelse(xvert, 2, 1), labels=xlabels, cex.axis=axis.size, tck = 0, lwd = 0, line = - 1 - (n.rows/10 - 1))     ## Add x-axis labels
    axis(2, at=seq(1, n.rows), las=1, labels=rev(ylabels), cex.axis=axis.size, tck = 0, lwd = 0, line = 0.5 - n.cols/10)     ## Add y-axis labels

    ## create an array of colors instead of numbers (it starts all gray):                
    array.colors <- array("gray", c(n.rows, n.cols))
    for(int in n.colors:1) array.colors[table <= brks[int + 1]] <- colors[int]

    ## fill with colors the cells in the figure:
    for(p in 1:n.rows){ for(l in 0:(n.cols-1)){ polygon(c(0.5 + l - 1, 0.5 + l - 1, 1.5 + l - 1, 1.5 + l - 1), c(-0.5 + n.rows + 1 - p, 0.5 + n.rows + 1 - p, 0.5 + n.rows + 1 - p, -0.5 + n.rows + 1 - p), col = array.colors[p, 1 + l], border="black") }}

    ## Draw color legend:
    if(legend){
        par(fig=c(1 - legend.width - 0.01, 1 - legend.width + legend.width * min(1, 10 / n.cols), 0.3, 0.8), new=TRUE)
        legend.label.size <- (max(n.cols, n.rows)/10)^0.4
        ColorBar(brks, cols = colors, vert = TRUE, label_scale = legend.label.size, subsample = 1, ...)

        ##ColorBar(brks[2:(n.brks-1)], cols = colors[2:(n.colors-1)], vert = TRUE, label_scale = 1, bar_limits = c(brks[2], brks[n.brks - 1]), col_inf = colors[1], col_sup = colors[n.colors], subsample = 1, ...)
    }
    
    dev.off()  
}





# Like PlotEquiMap, but:
# - with the option to specify with 'contours.col' colours of the contour lines,
# - with the option to specify with 'cex.axis' the size of the lat/lon tick numbers,
# - with the option to specify with 'xlabel.dist' the distance of the x labels from the x axis
# - with the option to specify with 'contours.lty' to use a different line type for negative contour values! (if different from 1); i.e: "F1FF1F"
# - with the option to specify with 'contours.zero' to remove (if FALSE) the contour line corrsponding to zero values (only for contours.lty != 1)
# - with the option 'contours.labels' not to draw the contour labels (if it is FALSE)
# - with the option 'continents.col', the colors of the line of the continents, if filled.continents=FALSE (by default it is gray)
# - with the option 'mod.topmargin', user can increase the distance of the upper border of the plot from the title
# - with the option 'countries' to draw the border of the countries too (only for square = TRUE)
# - with the option 'boxx' to draw a rectangle over one region of the map, at coordinates: W=box[1], S=box[2], E=box[3], N=box[4]
# - with the option 'boxx.col' to specify a color for the rectangle (if boxx is not NULL)
# - with the option 'boxx.lwd' to specify the width of the rectangle

# PlotEquiMap(array(0,c(160,160)),1:160,-80:79)
#

PlotEquiMap2 <- function (var, lon, lat, toptitle = "", sizetit = 1, units = "", 
    brks = NULL, cols = NULL, square = TRUE, filled.continents = TRUE, 
    contours = NULL, brks2 = NULL, dots = NULL, axelab = TRUE, 
    labW = FALSE, intylat = 20, intxlon = 20, drawleg = TRUE, 
    subsampleg = 1, numbfig = 1, colNA = "white", contours.col = par("fg"), col_border = gray(0.5),
    contours.lty = 1, contours.zero = TRUE, contours.labels=TRUE, cex.lab = NULL, xlabel.dist = 1, continents.col = gray(0.5),
    mod.topmargin=0, dot.col="black", countries=FALSE, boxx=NULL, boxx.col="gray50", boxx.lwd=2) 
{
    data(coastmap, envir = environment())
    dims <- dim(var)
    if (length(dims) > 2) {
        stop("Only 2 dimensions expected for var : (lon,lat) ")
    }
    if (dims[1] != length(lon) | dims[2] != length(lat)) {
        if (dims[1] == length(lat) & dims[2] == length(lon)) {
            var <- t(var)
            dims <- dim(var)
        }
        else {
            stop("Inconsistent var dimensions / longitudes +  latitudes")
        }
    }
    latb <- sort(lat, index.return = TRUE)
    dlon <- lon[2:dims[1]] - lon[1:(dims[1] - 1)]
    wher <- which(dlon > (mean(dlon) + 1))
    if (length(wher) > 0) {
        lon[(wher + 1):dims[1]] <- lon[(wher + 1):dims[1]] - 360
    }
    lonb <- sort(lon, index.return = TRUE)
    latmin <- floor(min(lat)/10) * 10
    latmax <- ceiling(max(lat)/10) * 10
    lonmin <- floor(min(lon)/10) * 10
    lonmax <- ceiling(max(lon)/10) * 10
    colorbar <- colorRampPalette(c("dodgerblue4", "dodgerblue1", "forestgreen", "yellowgreen", "white", "white", "yellow", "orange", "red", "saddlebrown"))
    if (is.null(brks) == TRUE) {
        ll <- signif(min(var, na.rm = TRUE), 4)
        ul <- signif(max(var, na.rm = TRUE), 4)
        if (is.null(cols) == TRUE) {
            cols <- colorbar(10)
        }
        nlev <- length(cols)
        brks <- signif(seq(ll, ul, (ul - ll)/nlev), 4)
    }
    else {
        if (is.null(cols) == TRUE) {
            nlev <- length(brks) - 1
            cols <- colorbar(nlev)
        }
        else {
            if (length(cols) != (length(brks) - 1)) {
                stop("Inconsistent colour levels / list of colours")
            }
        }
    }
    if (is.null(brks2) == TRUE) {
        if (is.null(contours)) {
            if (square == FALSE) {
                brks2 <- brks
                contours <- var
            }
        }
        else {
            ll <- signif(min(contours, na.rm = TRUE), 2)
            ul <- signif(max(contours, na.rm = TRUE), 2)
            brks2 <- signif(seq(ll, ul, (ul - ll)/(length(brks) - 
                1)), 2)
        }
    }
    if (axelab == TRUE) {
        ypos <- seq(latmin, latmax, intylat)
        xpos <- seq(lonmin, lonmax, intxlon)
        letters <- array("", length(ypos))
        letters[ypos < 0] <- "S"
        letters[ypos > 0] <- "N"
        ylabs <- paste(as.character(abs(ypos)), letters, sep = "")
        letters <- array("", length(xpos))
        if (labW) {
            nlon <- length(xpos)
            xpos2 <- xpos
            xpos2[xpos2 > 180] <- 360 - xpos2[xpos2 > 180]
        }
        letters[xpos < 0] <- "W"
        letters[xpos > 0] <- "E"
        if (labW) {
            letters[xpos == 0] <- " "
            letters[xpos == 180] <- " "
            letters[xpos > 180] <- "W"
            xlabs <- paste(as.character(abs(xpos2)), letters, sep = "")
        }
        else {
            xlabs <- paste(as.character(abs(xpos)), letters, sep = "")
        }
        xmargin <- 1.2 - (numbfig^0.2) * 0.05
        ymargin <- 3 - (numbfig^0.2)
        spaceticklab <- 1.3 - (numbfig^0.2) * 0.8
        topmargin <- 0.4
        ymargin2 <- 1.5 - (numbfig^0.2) * 0.9
    }
    else {
        xmargin <- 0.2
        ymargin <- 0.2 + switch(as.character(square), `FALSE` = 1.8, 
            0)
        topmargin <- 0.2
        spaceticklab <- 1
        ymargin2 <- 0.2
    }
    
    ##if (toptitle != "") topmargin <- 2.5 - (numbfig^0.2) * 0.6
    if (toptitle != "") topmargin <- 2.5  - (numbfig^0.2) * 0.6 + sizetit + mod.topmargin

    if (min(lon) < 0) {
        continents <- "world"
    } else {
        continents <- "world2"
    }
    
    if (square) {
        if (drawleg) {layout(matrix(1:2, ncol = 1, nrow = 2), heights = c(5,1))}

        par(mar = c(xmargin, ymargin, topmargin, ymargin2), cex = 1.4,mgp = c(3, spaceticklab, 0), las = 0)
        
        if (colNA != "white") {
            blanks <- array(0, dim = c(length(lonb$x), length(latb$x)))
            image(lonb$x, latb$x, blanks, col = c(colNA), breaks = c(-1,1), main = toptitle, cex.main = (1.5/numbfig^(0.2))*sizetit, axes = FALSE, xlab = "", ylab = "")
            flagadd <- TRUE
        }
        else {flagadd <- FALSE}
        
        image(lonb$x, latb$x, var[lonb$ix, latb$ix], col = cols, breaks = brks, main = toptitle, axes = FALSE, xlab = "", ylab = "", cex.main = (1.5/numbfig^(0.2)) * sizetit, add = flagadd)

        if (axelab == TRUE) {
            if(is.null(cex.lab)) {my.cex <- 1/(numbfig^0.3)} else {my.cex <- cex.lab}
            axis(2, at = ypos, labels = ylabs, cex.axis = my.cex, tck = -0.01)
            axis(1, at = xpos, labels = xlabs, cex.axis = my.cex, tck = -0.01, mgp=c(3,xlabel.dist,0))
        }
        
        if (is.null(contours) == FALSE) {
            if(contours.lty == 1){
               contour(lonb$x, latb$x, contours[lonb$ix, latb$ix], levels = brks2, method = "edge", add = TRUE, labcex = 1/numbfig, lwd = 0.5/(numbfig^0.5), lty = 1, col = contours.col, drawlabels=contours.labels)
            } else {
                contour(lonb$x, latb$x, contours[lonb$ix, latb$ix], levels = brks2[which(brks2 < 0)], method = "edge", add = TRUE, labcex = 1/numbfig, lwd = 0.5/(numbfig^0.5), lty = contours.lty, col = contours.col, drawlabels=contours.labels)
                if(contours.zero) contour(lonb$x, latb$x, contours[lonb$ix, latb$ix], levels = brks2[which(brks2 == 0)], method = "edge", add = TRUE, labcex = 1/numbfig, lwd = 3, lty = 1, col = contours.col, drawlabels=contours.labels) 
                contour(lonb$x, latb$x, contours[lonb$ix, latb$ix], levels = brks2[which(brks2 > 0)], method = "edge", add = TRUE, labcex = 1/numbfig, lwd = 0.5/(numbfig^0.5), lty = 1, col = contours.col, drawlabels=contours.labels) 
            }
        }

        if(countries){
           map(continents, interior = FALSE, add = TRUE, lwd = 2, col=continents.col)
           map(continents, interior = TRUE, add = TRUE, lwd = 1, col=continents.col)
        } else {
           map(continents, interior = FALSE, add = TRUE, lwd = 1, col=continents.col)
        }
        
        box()
    }
    else {
        par(mar = c(xmargin + 5, ymargin + 1.5, topmargin, ymargin2), 
            cex.main = (1.6 * numbfig^(0.3)) * sizetit, cex.axis = 1.4, 
            cex.lab = 1.6, mgp = c(3, spaceticklab + 0.5, 0), 
            las = 0)
        if (axelab == TRUE) {
            filled.contour(lonb$x, latb$x, var[lonb$ix, latb$ix], 
                xlab = "", levels = brks, col = cols, ylab = "", 
                main = toptitle, key.axes = axis(4, brks[seq(1, 
                  length(brks), subsampleg)], cex.axis = 1/(numbfig^0.3)), 
                plot.axes = {
                  axis(2, at = ypos, labels = ylabs, cex.axis = 1/(numbfig^0.3), 
                    tck = -0.03)
                  axis(1, at = xpos, labels = xlabs, cex.axis = 1/(numbfig^0.3), 
                    tck = -0.03)
                  contour(lonb$x, latb$x, contours[lonb$ix, latb$ix], 
                    levels = brks2, method = "edge", add = TRUE, 
                    labcex = 1, lwd = 2,col = contours.col)
                  map(continents, interior = FALSE, xlim = c(lonmin, 
                    lonmax), ylim = c(latmin, latmax), add = TRUE, col=continents.col)
                }, key.title = title(main = units, cex.main = (1.2 * 
                  numbfig^(0.3)) * sizetit))
        }
        else {
            filled.contour(lonb$x, latb$x, var[lonb$ix, latb$ix], 
                xlab = "", levels = brks, col = cols, ylab = "", 
                main = toptitle, key.axes = axis(4, brks[seq(1, 
                  length(brks), subsampleg)], cex.axis = 1/(numbfig^0.3)), 
                plot.axes = {
                  contour(lonb$x, latb$x, contours[lonb$ix, latb$ix], 
                    levels = brks2, method = "edge", add = TRUE, 
                    labcex = 1, lwd = 2, col = contours.col)
                  map(continents, interior = FALSE, xlim = c(lonmin, 
                    lonmax), ylim = c(latmin, latmax), add = TRUE, col=continents.col)
                }, key.title = title(main = units, cex.main = (1.2 * 
                  numbfig^(0.3)) * sizetit))
        }
    }
    if (is.null(dots) == FALSE) {
        for (ix in 1:length(lon)) {
            for (jy in 1:length(lat)) {
                if (is.na(var[ix, jy]) == FALSE) {
                  if (dots[ix, jy] == TRUE) {
                    text(x = lon[ix], y = lat[jy], ".", cex = 12/(sqrt(sqrt(length(var))) * numbfig^0.5), col=dot.col)
                  }
                }
            }
        }
    }
    if (square == TRUE & filled.continents == TRUE) {
        if (min(lon) >= 0) {
            ylat <- latmin:latmax
            xlon <- lonmin:lonmax
            proj <- setPROJ(1, LON0 = mean(xlon), LAT0 = mean(ylat), 
                LATS = ylat, LONS = xlon)
            coastmap$STROKES$col[which(coastmap$STROKES$col == "blue")] <- "white"
            par(new = TRUE)
            plotGEOmap(coastmap, PROJ = proj, border = "black",  add = TRUE)
            box()
        }
        else {
            map(continents, interior = FALSE, wrap = TRUE, lwd = 0.7, col = gray(0.5), fill = TRUE, add = TRUE, border = col_border)
        }
    }
    if (square & drawleg) {
        par(mar = c(1.5, ymargin + 1.5, 2.5, ymargin2), mgp = c(1.5, 0.3, 0), las = 1, cex = 1.2)
        image(1:length(cols), 1, t(t(1:length(cols))), axes = FALSE, col = cols, xlab = "", ylab = "", main = units, cex.main = 1.1)
        box()
        axis(1, at = seq(0.5, length(brks) - 0.5, subsampleg), labels = brks[seq(1, length(brks), subsampleg)])
    }

    if(length(boxx == 4)) rect(boxx[1], boxx[2], boxx[3], boxx[4], border = boxx.col, col = NULL, lwd = boxx.lwd, lty = "solid")
}


# Draw points over a PlotEquiMap:
map.points<-function (x, country = "", label = NULL, minpop = 0, 
    maxpop = Inf, capitals = 0, cex = par("cex"), projection = FALSE, 
    parameters = NULL, orientation = NULL, pch = 1, ...) 
{

    usr <- par("usr")
    if (!missing(projection) && projection != FALSE) {
        if (require(mapproj)) {
            if (is.character(projection)) {
                projx <- mapproject(x$long, x$lat, projection = projection, 
                  parameters = parameters, orientation = orientation)
            }
            else {
                if (nchar(.Last.projection()$projection) > 0) {
                  projx <- mapproject(x$long, x$lat)
                }
                else stop("No projection defined\n")
            }
            x$long <- projx$x
            x$lat <- projx$y
        }
        else stop("mapproj package not available\n")
    }
    else {
        if (usr[2] > (180 + 0.04 * (usr[2] - usr[1]))) 
            x$long[x$long < 0] <- 360 + x$long[x$long < 0]
    }
    selection <- x$long >= usr[1] & x$long <= usr[2] & x$lat >= 
        usr[3] & x$lat <= usr[4] & (x$pop >= minpop & x$pop <= 
        maxpop) & ((capitals == 0) | (x$capital >= 1))
    if (is.null(label)) 
        label <- sum(selection) < 20
    cxy <- par("cxy")
    if (sum(selection01) > 0) 
        points(x$long[selection01], x$lat[selection01], pch = pch, 
            cex = cex * 0.6, ...)
    if (sum(selection0) > 0) 
        if (label) 
            text(x$long[selection0], x$lat[selection0] + cxy[2] * 
                cex * 0.7, paste(" ", x$name[selection0], sep = ""), 
                cex = cex * 0.7, ...)
    if (sum(selection1) > 0) {
        points(x$long[selection1], x$lat[selection1], pch = pch, 
            cex = cex, ...)
        text(x$long[selection1], x$lat[selection1] + cxy[2] * 
            cex, paste(" ", x$name[selection1], sep = ""), cex = cex * 
            1.2, ...)
    }
    if (sum(selection2) > 0) {
        points(x$long[selection2], x$lat[selection2], pch = pch, 
            cex = cex, ...)
        text(x$long[selection2], x$lat[selection2] + cxy[2] * 
            cex * 1.1, paste(" ", x$name[selection2], sep = ""), 
            cex = cex * 1.1, ...)
    }
    if (sum(selection3) > 0) {
        points(x$long[selection3], x$lat[selection3], pch = pch, 
            cex = cex, ...)
        text(x$long[selection3], x$lat[selection3] + cxy[2] * 
            cex * 0.9, paste(" ", x$name[selection3], sep = ""), 
            cex = cex * 0.9, ...)
    }
    invisible()
}

my.taylor <- function (ref, model, add = FALSE, col = "red", pch = 19, pos.cor = TRUE, 
    xlab = "", ylab = "", main = "Taylor Diagram", show.gamma = TRUE, 
    ngamma = 3, gamma.col = "darkgreen", sd.arcs = 0, ref.sd = FALSE, sd.method = "sample", 
    grad.corr.lines = c(0.2, 0.4, 0.6, 0.8, 0.9, 0.95, 0.99), pcex = 1, cex.axis = 1, 
    normalize = FALSE, mar = c(5, 4, 6, 6), BIAS = FALSE, my.text = NULL, text.cex = pcex, RMSE.label = FALSE, sd.label = NULL, sd.max = NULL, cex.title = 2, ...) 
{
    ## Taylor diagram modified from function taylor.diagram of package 'Plotrix' to have the lines of the same colors of Nube's taylor diagram and more options:
    ## with option 'my.text', you can specify a text label for each point
    ## with option 'text.cex', you can set the size of the point proportional to its bias
    ## with option 'grad.corr.lines', you can specify the number and position of the correlation lines.
    ## with option 'ngamma', you can increase or decrease the number of curves for the RMSE
    ## with option 'sd.max', you can define the maximum value to show on both the x and y axis
    ## with option 'sd.label', you can add a lable in correspondende of the center of the RMSE circles
   
    ##grad.corr.full <- c(0, 0.2, 0.4, 0.6, 0.8, 0.9, 0.95, 0.99, 1)
    R <- cor(ref, model, use = "na.or.complete")

    if(BIAS==TRUE){
      BIAS <- mean(model-ref,na.rm=TRUE)
      my.equidist<-c(-75,-35,-15,-5,5,15,35,75)
      my.colors<-c("magenta4","blue4","steelblue","skyblue2","orange","orangered","red","red4")
      #my.colorscale<-rev(my.colors(8))
      my.col<-my.colors[which.min(abs(my.equidist-BIAS))]
      #my.labels<-c("0-30%","41-50","41-50","51-70%","61-70%","71-80%","81-90%","91-100%")
      #my.cuts<-c(-100,-50,-20,-10,0,10,20,50,100)
    }
    
    if (is.list(ref)) 
        ref <- unlist(ref)
    if (is.list(model)) 
        ref <- unlist(model)
    SD <- function(x, subn) {
        meanx <- mean(x, na.rm = TRUE)
        devx <- x - meanx
        ssd <- sqrt(sum(devx * devx, na.rm = TRUE)/(length(x[!is.na(x)]) - 
            subn))
        return(ssd)
    }
    subn <- sd.method != "sample"
    sd.r <- SD(ref, subn)
    sd.f <- SD(model, subn)
    if (normalize) {
        sd.f <- sd.f/sd.r
        sd.r <- 1
    }
    if(length(sd.max) > 0) maxsd <- sd.max else maxsd <- 1.5 * max(sd.f, sd.r)
    oldpar <- par("mar", "xpd", "xaxs", "yaxs")
    if (!add) {
        # plot for positive correlations only:
        if (pos.cor) { 
            if (nchar(ylab) == 0) 
                ylab = "Standard deviation"
            par(mar = mar)
           
            plot(0, xlim = c(0, maxsd), ylim = c(0, maxsd), xaxs = "i", 
                yaxs = "i", axes = FALSE, main = main, xlab = xlab, 
                ylab = ylab, type = "n", cex = cex.axis, cex.main = cex.title)
            if (grad.corr.lines[1]) {
                for (gcl in grad.corr.lines) lines(c(0, maxsd * 
                  gcl), c(0, maxsd * sqrt(1 - gcl^2)), lty = 3,col="blue")
            }
            segments(c(0, 0), c(0, 0), c(0, maxsd), c(maxsd, 
                0),col="blue")
            axis.ticks <- pretty(c(0, maxsd),n=6)
            axis.ticks <- axis.ticks[axis.ticks <= maxsd]
            axis(1, at = axis.ticks, cex.axis = cex.axis)
            axis(2, at = axis.ticks, cex.axis = cex.axis)
            if (sd.arcs[1]) {
                if (length(sd.arcs) == 1) 
                  sd.arcs <- axis.ticks
                for (sdarc in sd.arcs) {
                  xcurve <- cos(seq(0, pi/2, by = 0.03)) * sdarc
                  ycurve <- sin(seq(0, pi/2, by = 0.03)) * sdarc
                  lines(xcurve, ycurve, col = "black", lty = 3)
                }
            } # if there is more than one curve for the st.dev:
            if (show.gamma[1]) {
                if (length(show.gamma) > 1) 
                  gamma <- show.gamma
                else gamma <- pretty(c(0, maxsd), n = ngamma)[-1] # [-1] for removing the first value of 0.0
                if (gamma[length(gamma)] > maxsd) 
                  gamma <- gamma[-length(gamma)]
                labelpos <- seq(45, 70, length.out = length(gamma))
                for (gindex in 1:length(gamma)) {
                  xcurve <- cos(seq(0, pi, by = 0.03)) * gamma[gindex] + 
                    sd.r
                  endcurve <- which(xcurve < 0)
                  endcurve <- ifelse(length(endcurve), min(endcurve) - 
                    1, 105)
                  ycurve <- sin(seq(0, pi, by = 0.03)) * gamma[gindex]
                  maxcurve <- xcurve * xcurve + ycurve * ycurve
                  startcurve <- which(maxcurve > maxsd * maxsd)
                  startcurve <- ifelse(length(startcurve), max(startcurve) + 
                    1, 0)
                  lines(xcurve[startcurve:endcurve], ycurve[startcurve:endcurve], 
                    col = gamma.col)
                  if (xcurve[labelpos[gindex]] > 0) 
                    boxed.labels(xcurve[labelpos[gindex]], ycurve[labelpos[gindex]], 
                      gamma[gindex], border = FALSE,cex=1, col=gamma.col)
                }
            }
            xcurve <- cos(seq(0, pi/2, by = 0.01)) * maxsd
            ycurve <- sin(seq(0, pi/2, by = 0.01)) * maxsd
            lines(xcurve, ycurve) # external semicircle
            bigtickangles <- acos(seq(0.1, 0.9, by = 0.1))
            medtickangles <- acos(seq(0.05, 0.95, by = 0.1))
            smltickangles <- acos(seq(0.91, 0.99, by = 0.01))
            segments(cos(bigtickangles) * maxsd, sin(bigtickangles) * 
                maxsd, cos(bigtickangles) * 0.97 * maxsd, sin(bigtickangles) * 
                0.97 * maxsd) # external mayor ticks
            par(xpd = TRUE)
            if (ref.sd) {
                xcurve <- cos(seq(0, pi/2, by = 0.01)) * sd.r
                ycurve <- sin(seq(0, pi/2, by = 0.01)) * sd.r
                lines(xcurve, ycurve)
            }
            points(sd.r, 0, cex = pcex)
            text(cos(c(bigtickangles, acos(c(0.95, 0.99)))) * 
                1.05 * maxsd, sin(c(bigtickangles, acos(c(0.95, 
                0.99)))) * 1.05 * maxsd, c(seq(0.1, 0.9, by = 0.1), 
                0.95, 0.99), col="blue") # correlation numbers
            text(maxsd * 0.8, maxsd * 0.8, "Correlation", srt = 315, col="blue")
            segments(cos(medtickangles) * maxsd, sin(medtickangles) * 
                maxsd, cos(medtickangles) * 0.98 * maxsd, sin(medtickangles) * 
                0.98 * maxsd)
            segments(cos(smltickangles) * maxsd, sin(smltickangles) * 
                maxsd, cos(smltickangles) * 0.99 * maxsd, sin(smltickangles) * 
                0.99 * maxsd)
        }
        else { # plot in case correlations can be negative or positive (pos.cor=FALSE):
            x <- ref
            y <- model
            R <- cor(x, y, use = "pairwise.complete.obs")
            E <- mean(x, na.rm = TRUE) - mean(y, na.rm = TRUE)
            xprime <- x - mean(x, na.rm = TRUE)
            yprime <- y - mean(y, na.rm = TRUE)
            sumofsquares <- (xprime - yprime)^2
            Eprime <- sqrt(sum(sumofsquares)/length(complete.cases(x)))
            E2 <- E^2 + Eprime^2
            if (add == FALSE) {
                maxray <- maxsd
                plot(c(-maxray, maxray), c(0, maxray), type = "n", 
                  asp = 1, bty = "n", xaxt = "n", yaxt = "n", 
                  xlab = xlab, ylab = ylab, main = main, cex = cex.axis, cex.main = cex.title)
                discrete <- seq(180, 0, by = -1)
                listepoints <- NULL
                for (i in discrete) {
                  listepoints <- cbind(listepoints, maxray * 
                    cos(i * pi/180), maxray * sin(i * pi/180))
                }
                listepoints <- matrix(listepoints, 2, length(listepoints)/2)
                listepoints <- t(listepoints)
                lines(listepoints[, 1], listepoints[, 2])
                lines(c(-maxray, maxray), c(0, 0))
                lines(c(0, 0), c(0, maxray))
                for (i in grad.corr.lines) {
                  lines(c(0, maxray * i), c(0, maxray * sqrt(1 - 
                    i^2)), lty = 3, col="blue")
                  lines(c(0, -maxray * i), c(0, maxray * sqrt(1 - 
                    i^2)), lty = 3, col="blue")
                }
                for (i in grad.corr.lines) {
                  text(1.05 * maxray * i, 1.05 * maxray * sqrt(1 - 
                    i^2), i, cex = cex.axis)
                  text(-1.05 * maxray * i, 1.05 * maxray * sqrt(1 - 
                    i^2), -i, cex = cex.axis)
                }
                seq.sd <- seq.int(0, 2 * maxray, by = (maxray/10))[-1]
                for (i in seq.sd) {
                  xcircle <- sd.r + (cos(discrete * pi/180) * 
                    i)
                  ycircle <- sin(discrete * pi/180) * i
                  for (j in 1:length(xcircle)) {
                    if ((xcircle[j]^2 + ycircle[j]^2) < (maxray^2)) {
                      points(xcircle[j], ycircle[j], col = "darkgreen", 
                        pch = ".")
                      if (j == 10) 
                        text(xcircle[j], ycircle[j], signif(i, 
                          2), cex = cex.axis, col = "darkgreen")
                    }
                  }
                }
                seq.sd <- seq.int(0, maxray, length.out = 5)
                for (i in seq.sd) {
                  xcircle <- (cos(discrete * pi/180) * i)
                  ycircle <- sin(discrete * pi/180) * i
                  if (i) 
                    lines(xcircle, ycircle, lty = 3, col = "blue")
                  text(min(xcircle), -0.03 * maxray, signif(i, 
                    2), cex = cex.axis, col = "blue")
                  text(max(xcircle), -0.03 * maxray, signif(i, 
                    2), cex = cex.axis, col = "blue")
                }
                text(0, -0.08 * maxray, "Standard Deviation", 
                  cex = cex.axis, col = "blue")
                text(0, -0.12 * maxray, "Centered RMSE", 
                  cex = cex.axis, col = "darkgreen")
                points(sd.r, 0, pch = 22, bg = "darkgreen", cex = 1.1)
                text(0, 1.1 * maxray, "Correlation Coefficient", 
                  cex = cex.axis)
            }
            S <- (2 * (1 + R))/(sd.f + (1/sd.f))^2
        } # close if on 'pos.cor'
    }

    if(BIAS==TRUE){
      points(sd.f * R, sd.f * sin(acos(R)), pch = pch, col = my.col, cex = pcex)
    } else {
      points(sd.f * R, sd.f * sin(acos(R)), pch = pch, col = col, cex = pcex)
    }
    
    # Label line; You can change the pos argument to your liking:
    if(length(text)>0) text(sd.f * R, sd.f * sin(acos(R)), labels=my.text, cex = text.cex, pos=3) 
    if(RMSE.label) text(0.81, 0.14, "RMSE", srt = 45, cex=1, col=gamma.col)

    if(length(sd.label)>0) text(0.95, 0.10, sd.label, srt = 0, cex=1.2, col="darkgray")

    invisible(oldpar)
}


north.arrow <- function(loc,size,bearing=0,cols,cex=1,...) {
	# checking arguments
	if(missing(loc)) stop("loc is missing")
	if(missing(size)) stop("size is missing")
	# default colors are white and black
	if(missing(cols)) cols <- rep(c("white","black"),8)
	# calculating coordinates of polygons
	radii <- rep(size/c(1,4,2,4),4)
	x <- radii[(0:15)+1]*cos((0:15)*pi/8+bearing)+loc[1]
	y <- radii[(0:15)+1]*sin((0:15)*pi/8+bearing)+loc[2]
	# drawing polygons
	for (i in 1:15) {
	x1 <- c(x[i],x[i+1],loc[1])
	y1 <- c(y[i],y[i+1],loc[2])
	polygon(x1,y1,col=cols[i])
	}
	# drawing the last polygon
	polygon(c(x[16],x[1],loc[1]),c(y[16],y[1],loc[2]),col=cols[16])
	# drawing letters
	b <- c("E","N","W","S")
	for (i in 0:3) text((size+par("cxy")[1])*cos(bearing+i*pi/2)+loc[1],
	(size+par("cxy")[2])*sin(bearing+i*pi/2)+loc[2],b[i+1],
	cex=cex)
}

# funzione che prende un array e restituisce lo stesso array abbassando pero'tutti gli elementi piu'alti di val.max al valore val.max (utile per aggiustare le leggende dei grafici)
rescale.max <- function(my.array,val.max){ 
	ss <- which(my.array > val.max)
	my.array[ss] <- val.max - 0.000000001 
	return(my.array)
}

rescale.min <- function(my.array,val.min){ # come rescale.max ma per i valori piu'piccoli di val.min che vengono cambiati a val.min
	ss <- which(my.array < val.min)
	my.array[ss] <- val.min + 0.0000000001
	return(my.array)
}

rescale <- function(my.array,val.min,val.max){ # unisce rescale.max con rescale.min
	ss <- which(my.array > val.max)
	my.array[ss] <- val.max - 0.0000000001
	ss <- which(my.array < val.min)
	my.array[ss] <- val.min + 0.0000000001  # the 0.0000000001 is just to be able to draw a color with PlotEquiMap (otherwise draw the color for NA)
	return(my.array)
}

ColorBarV <- function(brks, cols = NULL, vert = TRUE, subsampleg = 1,
                     cex = 1, marg=NULL) {
  # Creates a horizontal or vertical colorbar to introduce in multipanels.
  #
  # Args:
  #   brks: Levels.
  #   cols: List of colours, optional.
  #   vert: TRUE/FALSE for vertical/horizontal colorbar.
  #   kharin: Supsampling factor of the interval between ticks on colorbar.
  #           Default: 1 = every level
  #   cex: Multiplicative factor to increase the ticks size, optional.
  #   marg: margins
  #
  # Returns:
  #   This function returns nothing
  #
  # History:
  #   1.0  #  2012-04  (V. Guemas, vguemas@ic3.cat)  #  Original code
  #   1.1  #  2014-11  (C. Prodhomme, chloe.prodhomme@ic3.cat)
                # add cex option
  #
  #
  #  Input arguments
  # ~~~~~~~~~~~~~~~~~
  #
  if (is.null(cols) == TRUE) {
    nlev <- length(brks) - 1
    cols <- rainbow(nlev)
  } else {
    if (length(cols) != (length(brks) - 1)) {
      stop("Inconsistent colour levels / list of colours")
    }
  }
  
  # 
  #  Plotting colorbar
  # ~~~~~~~~~~~~~~~~~~~
  #
  if (vert) {
    if (is.null(marg)== FALSE){
      par(mar = marg, mgp = c(1, 1, 0), las = 1, cex = 1.2)
    }else{
      par(mar = c(1, 1, 1, 1.5 *( 1 + cex)), mgp = c(1, 1, 0), las = 1, cex = 1.2)
    }
    image(1, c(1:length(cols)), t(c(1:length(cols))), axes = FALSE, col = cols, 
          xlab = '', ylab = '')
    box()
    axis(4, at = seq(0.5, length(brks) - 0.5, subsampleg), tick = TRUE, 
         labels = brks[seq(1, length(brks), subsampleg)], cex.axis = cex)
  } else {
    if (marg){
      par(mar = marg, mgp = c(1, 1, 0), las = 1, cex = 1.2)
    }else{
      par(mar = c(0.5 + cex, 1, 1, 1), mgp = c(1.5, max(c(0.3,0.8*(cex-0.625))), 0),
          las = 1, cex = 1.2)
    }
    
    image(1:length(cols), 1, t(t(1:length(cols))), axes = FALSE, col = cols,
          xlab = '', ylab = '')
    box()
    axis(1, at = seq(0.5, length(brks) - 0.5, subsampleg), 
         labels = brks[seq(1, length(brks), subsampleg)], cex.axis = cex)
  }
}

# Creation: 6/2016
# Author: Nicola Cortesi
# Aim:   Remove the grid points above a certain value (argument 'level') [and below '-level' if two.sides=TRUE] that happens to be in areas with few points above that value.
#        Useful to remove from a contour plot all the small spots of significative points that we don't want to contour.
#        To do so, just apply this function inside the option 'contour' of 'PlotEquiMap' to remove the significative points (they are set to the value of 0).
#        Argument 'size' determines the side of the square (in grid points) used to find if there are enough grid points with values above 'level' nearby
#        the chosen point or not. Increasing it will incresase the number of grid points deleted, leaving only the bigger spots of points above the chosen value.
# I/O:   a 2D lat/lon grid in geographic coordinates
# Assumptions: none
# Branch: general
# Example:
# data <- matrix(runif(48000,0,1)^2,300,160) + matrix(c(rep(0,20000),rep(0.6,3000),rep(0,25000)),300,160)
# PlotEquiMap(data,lon=1:300,lat=-80:79,filled.continents=F,cols=c("white","yellow","orange","red","darkred"))
# PlotEquiMap(data,lon=1:300,lat=-80:79,filled.continents=F,cols=c("white","yellow","orange","red","darkred"), contours=data, brks2=0.6)
# PlotEquiMap(data,lon=1:300,lat=-80:79,filled.continents=F,cols=c("white","yellow","orange","red","darkred"), contours=grid2contour(data,0.6,FALSE,5), brks2=0.6, contours.labels=FALSE)
# PlotEquiMap_colored(data,lon=1:300,lat=-80:79,filled.continents=F,cols=c("white","yellow","orange","red","darkred"), contours=grid2contour(data,0.6,FALSE,5), brks2=0.6, contours.labels=FALSE, contours.col="blue", continents.col="gray40")

grid2contour <- function(grid, level, two.sides=FALSE, size=10){
  nrows <- dim(grid)[1]
  ncols <- dim(grid)[2]
  radius <- round(size/2)
  
  grid.weighted <- matrix(NA, nrows, ncols)

  grid.expanded <- rbind(cbind(grid[nrows:1,((ncols/2)+1):ncols],grid[nrows:1,],grid[nrows:1,],grid[nrows:1,1:(ncols/2)]),cbind(grid,grid,grid),cbind(grid[nrows:1,((ncols/2)+1):ncols],grid[nrows:1,],grid[nrows:1,],grid[nrows:1,1:(ncols/2)]))

  if(two.sides==FALSE){
      for(i in 1:nrows){
          for(j in 1:ncols){
              grid.weighted[i,j] <- sum(grid.expanded[(nrows+i-radius):(nrows+i+radius),(ncols+j-radius):(ncols+j+radius)] > level)
          }
      }
  } else {
    for(i in 1:nrows){
          for(j in 1:ncols){
              grid.weighted[i,j] <- sum(grid.expanded[(nrows+i-radius):(nrows+i+radius),(ncols+j-radius):(ncols+j+radius)] > level) + sum(grid.expanded[(nrows+i-radius):(nrows+i+radius),(ncols+j-radius):(ncols+j+radius)] < -level)
          }
      }  
  }
  
  n.points.min <- (2*radius+1)^2*0.3 # 30% of the total points in the square
  ss <- which(grid.weighted < n.points.min)
  grid[ss] <- 0
  return(grid)
}

######################################################################
# 
# RELIABILITY DIAGRAM FOR A COLLECTION OF PROBABILITY FORECASTS #
# Veronica: Like ReliabilityDiagram() function, but
# Modified to include in the outputs the hist.counts
# 
######################################################################

ReliabilityDiagramHist <- function(probs, obs, bins=10, nboot=500,
           plot=FALSE, plot.refin=TRUE, mc.cores=1,
           cons.probs=c(0.025, 0.975))
  {
    #print("RD")
    #
    # Plot reliability diagram for a probability forecast
    #
    # Usage: ReliabilityDiagram(probs, obs, nbins, nboot)
    #
    # Arguments:
    #
    # probs ... vector of length N, probs[k] has the predicted probability for
    # the event obs[k]
    # obs ... obs[k] = 1 if the event happened at instance k, obs[k] = 0
    # otherwise
    # bins ... either scalar: number of equidistant bins to discretize the
    # forecast probabilities,
    # or a vector: user-defined breakpoints of the bins; the `hist`
    # function will produce errors if these are not valid
    # nboot ... number of bootstrap resamples for estimating consistency bars
    # if nboot==0, no resampling is done and NAs are returned as
    # consistency bars
    # plot ... boolean; whether to plot the reliability diagram
    # plot.refin ... boolean; whether to plot the small refinement histogram
    # in lower right corner
    # cons.probs ... a 2-vector, lower and upper confidence limit
    # mc.cores ... number of cores for resampling (if > 1, library `multicore`
    # is required)
    #
    # Return value:
    #
    # a data frame of K+1 rows with the following columns:
    #
    # * p.avgs ... in-bin averages of the forecast probabilities
    # * cond.probs ... observed conditional frequency of event, given i
    # * cbar.lo ... lower limit consistency of consistency bar[i], as specified by user
    # * cbar.hi ... upper limit consistency of consistency bar[i], as specified by user
    #
    # Author:
    #
    # Stefan Siegert
    # s.siegert@exeter.ac.uk
    # December 2013
    #
    # Example:
    #
    # N <- 1000
    # p <- rbeta(N, 1, 3)
    # y <- rbinom(N, 1, p)
    # rd <- rel.diag(p, y, plot=TRUE)
    # print(rd)
    #
    #
    # change log:
    #
    # 2013/12/02
    # * manual definition of bin-breaks
    # * manual definition of consistency intervals
    # * sanity checks
    # * multicore option for resampling
    #
    # 2013/10/31:
    # * return summary data as data frame
    # * added options `plot` and `plot.refin`
    #
    # 2013/08/20:
    # * points are plotted at in-bin-averages, not at bin centres
    # * legend has been removed
    # * consistency bars have been added, calculated by a resampling technique
    # * see Broecker (2007) http://dx.doi.org/10.1175/WAF993.1 for details
    # * the bars are pointwise 2.5% ... 97.5% intervals around the hypothesis of reliability
    # * dependency on package "verification" was removed
    #
    # Author: Stefan Siegert <s.siegert@exeter.ac.uk>
    #
    # based on previous version by Caio Coelho and the routine
    # reliability.plot.default of the R-package `verification`
    #
    
    
    # sanity checks
    if (class(probs) == "data.frame") {
      probs <- c(as.matrix(probs))
    }
    if (class(obs) == "data.frame") {
      obs <- c(as.matrix(obs))
    }
    stopifnot(length(probs) == length(obs))
    stopifnot(nboot >= 0, mc.cores >= 0)
    stopifnot(all(probs >= 0), all(probs <= 1), all(obs %in% c(0,1)))
    stopifnot(length(cons.probs) == 2, all(cons.probs >= 0), all(cons.probs <= 1))
    # optional use of multicore without warning message
    warn <- getOption("warn")
    options(warn=-1)
    if(require(multicore, quietly=TRUE)) {
      mclapply <- multicore::mclapply
    } else {
      mclapply <- function(..., mc.cores) lapply(...)
    }
    options(warn=warn)
    
    # some definitions and corrections
    n <- length(obs)
    mc.cores <- floor(mc.cores)
    nboot <- floor(nboot)
    cons.probs <- sort(cons.probs)
    
    
    #############################################
    # reliability analysis
    #############################################
    # estimate refinement function
    if (length(bins) == 1) {
      nbins <- floor(bins)
      brx <- seq(0, 1, length.out=nbins+1) +
        c(-.1, rep(0, nbins-1), .1)
    } else {
      nbins <- length(bins) - 1
      bins <- sort(bins)
      stopifnot(min(bins)<= 0 & max(bins) >= 1)
      brx <- bins
    }
    h <- hist(probs, breaks=brx, plot=FALSE)$counts
#print(h)
#print(sum(h))
#print(probs)
#print(sum(probs))
    p <- sum(probs)
    #print(sum(probs)/sum(h))
    
    # estimate calibration function
    g <- hist(probs[obs==1], breaks=brx, plot=FALSE)$counts
#print(g)
#print(sum(g))
    obar.i <- g / h
#print(obar.i)
    no_res <- sum(g)/sum(h)
    #print(no_res)
    obar.i[ is.nan(obar.i) ] <- NA
    
    # calculate in-bin averages
    p.bins <- as.numeric(cut(probs, breaks=brx, include.lowest=TRUE))
    p.avgs <- sapply(seq(nbins),
                     function(ii) mean(probs[p.bins == ii], na.rm=TRUE))
    p.avgs[ is.nan(p.avgs) ] <- NA
    
#
#print(p.avgs)
#    vertline <- sum(p.avgs,na.rm = TRUE)/bins
#print(vertline)    
    
    #############################################
    # consistency resampling (broecker and smith 2007)
    #############################################
    if (nboot) {
      resamp.mat <- matrix(nrow=0, ncol=nbins)
      # the resampling function
      sample.rel.diag <- function(dummy=0) {
        p.hat <- sample(x=probs, size=n, replace=TRUE)
        x.hat <- rbinom(n=n, size=1, prob=p.hat)
        hh <- hist(p.hat, breaks=brx, plot=FALSE)$counts
        gg <- hist(p.hat[x.hat==1], breaks=brx, plot=FALSE)$counts
        return(gg / hh)
      }
      # multicore?
      if (mc.cores > 1) {
        l <- mclapply(1:nboot, sample.rel.diag, mc.cores=mc.cores)
        resamp.mat <- do.call(rbind, l)
      } else {
        l <- replicate(nboot, sample.rel.diag())
        resamp.mat <- t(l)
      }
      cons.bars <- apply(resamp.mat, 2,
                         function(z) quantile(z, cons.probs, na.rm=TRUE))
    } else {
      cons.bars <- matrix(NA, ncol=nbins, nrow=2)
    }
    
    
    #############################################
    # plot the reliability diagram
    #############################################
    if (plot) {
      # reliability plot
      old.par <- par(no.readonly = TRUE)
      on.exit(par(old.par))
      plot(NULL, xlim = c(0,1), ylim = c(0,1),
           xlab="Forecast probability",
           ylab="Observed relative frequency")
      # consistency bars
      for (i in 1:length(p.avgs)) {
        lines(rep(p.avgs[i], 2), cons.bars[, i], col="#CCCCCC", lwd=6)
      }
      # reliability points and diagonal
      points(p.avgs, obar.i, col = "black", pch = 1, lwd=2, type="b")
      lines(c(0,1), c(0,1), lty=1)
      if (plot.refin) {
        # refinement histogram in lower corner
        pp<- par("plt")
        par("plt" = c(pp[2] - 0.2 , pp[2], pp[3], pp[3]+ 0.2) )
        par(new = TRUE)
        barplot(h, axes = FALSE, axisnames = FALSE)
        axis(4)
        box()
      }
    }
    
    #############################################
    # return data
    #############################################
    ret.df <- data.frame(p.avgs=p.avgs, cond.probs=obar.i,
                         cbar.lo=cons.bars[1,], cbar.hi=cons.bars[2,],hist.counts=h, obs.counts=g, for.prob=p)
    return(ret.df)
  }


# to plot the reliability diagrams for both upper and below tercile at the same time:
ReliabilityDiagram2 <-function(rel_diag,nbins=10,consbars=F,tit=NULL,colLine=NULL,colBar=NULL,marHist=T,hist_ylim=NULL,Lg=NULL) {

   # print("Plot")
#   rel_diag<-rd # output of ReliabilityDiagramHist()
#   nbins=10
#   consbars=T
#   colLine=col_line
#   colBar=col_bar
#   tit=tit1
#   marHist=T
#   hist_ylim=c(0,100)
#   x11(width=12,height=10)
  #   x11()
  #  PLOT OF THE RELIABILITY DIAGRAM 
  #
  ######################################################################################
  # rd: a list with the reliability diagrams that will be represented in the same plot
  # cons.bars : if the consistency bar must be represented or not.
  # nbins : number of equidistant points used to compute the reliability diagram (optional)
  # tit: the title of the plot (optional)
  # brierScores: The brier score linked to the reliability diagram (optional)
  # marHist: Whether to plot the small refinement histogram is showed
  #####################################################################################
  
  # Some parameters are defined
  nrd <- length(rel_diag)   # nrd = 5, 4 models + mme
  rg <- list()
    
  # Check the dimensions of the rank histogram
  for (i in 1:nrd){
    if (dim(rel_diag[[i]])[1]!=nbins){
      stop ('The bins of the reliability diagram must be the same that nbins')
    }
    rg[[i]]<-range(rel_diag[[i]]$hist.counts)# check the range of the histograms
  }
    
  if (is.null(hist_ylim)){
    rgH<-range(rg)
#print(rgH)
  }else{
    rgH<-hist_ylim
  }
  
  
  ##########################################
  # reliability plot
  # par(mar=c(5,3,2,2)+0.1)
  ##########################################
  
  layout(matrix(c(rep(1,nrd),seq(2,(nrd+1))),nrd,2,byrow=F),width=c(5,2))
  par(oma=c(2.5,4,5,1))
  #layout.show(a)
  
  # The axis are defined
  # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  #x11(width=12,height=10)
#  old.par <- par(no.readonly = TRUE)
#print(old.par)
#  on.exit(par(old.par))
#  par(mar=c(5,5,5,0))
  old.par <- par(mar=c(5,5,5,0))
  on.exit(par(old.par))

  plot(NULL, xlim = c(0,1), ylim = c(0,1),axes=F, xlab='', ylab='')

  axis(1, at=seq(0,1,by=0.1),labels=seq(0,1,by=0.1),cex.axis=2.0)
  title(xlab= "Forecast probability",line=3.9,cex.lab=2.0)

  axis(2, at=seq(0,1,by=0.1), labels=seq(0,1,by=0.1), las=2,cex.axis=2.0)
  #axis(2, at=seq(0,1,by=0.1), labels=seq(0,1,by=0.1), cex.axis=2.0)
  box()
  title(ylab= "Observed relative frequency", line=0.2,cex.lab=2.0,outer=T)
  if(is.null(tit)==F){
#    title(tit,cex.main=4,outer=T,line=-1)
#    title(tit,cex.main=2.0,outer=T,line=-4)
    title(tit,cex.main=2.0,outer=T,line=-3)
  }
  
  # Legend
  # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  yloc <- c(1.0, 0.95, 0.90, 0.85, 0.80)
  legend(0.,yloc[1], legend=Lg[[1]], fill=colLine[[1]], bty="n", cex=1.2)
  legend(0.,yloc[2], legend=Lg[[2]], fill=colLine[[2]], bty="n", cex=1.2)
  legend(0.,yloc[3], legend=Lg[[3]], fill=colLine[[3]], bty="n", cex=1.2)
  legend(0.,yloc[4], legend=Lg[[4]], fill=colLine[[4]], bty="n", cex=1.2)
  legend(0.,yloc[5], legend=Lg[[5]], fill=colLine[[5]], bty="n", cex=1.2)
#  legend("topleft", "(x,y)", pch = 1, title = "topleft, inset = .05", inset = .05)

  # No resolution and No skill lines
  # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  no_res <- sum(rel_diag[[1]]$obs.counts)/sum(rel_diag[[1]]$hist.counts)
#  vt_res <- sum(rel_diag[[1]]$for.prob)/sum(rel_diag[[1]]$hist.counts)
#print(paste("no_res = ",no_res))
  numb <- c(seq(0,1,by=0.1))
#print(numb)
  no_skill <- (numb+no_res)/2.
#print(no_skill)

# diagonal line
  lines(c(0,1), c(0,1), lty=1)
# no_resolution line
  lines(c(0,1), c(no_res,no_res), col="gray", lty=3)
  lines(c(1/3,1/3), c(0,1), col="gray", lty=3)
#  lines(c(vt_res,vt_res), c(0,1), col="gray", lty=3)
#  lines(c(no_res,no_res), c(0,1), col="gray", lty=3)
# no_skill line
  lines(c(0,1), c(no_skill[1],no_skill[11]), col="black", lty=3)


  # Consistency bars
  # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  HI <- matrix(NA, nrow=nrd, ncol=length(rel_diag[[1]]$hist.counts))
  
  for (j in 1:nrd){                    # nrd = 5: 4 models + mme
    HI[j,] <- rel_diag[[j]]$hist.counts
    if (consbars==T){
      # The lower limit of consistency bar i and the upper limit are combined in one list
      consBars<-list()
      consBars[[j]]<-abind(InsertDim(rel_diag[[j]]$cbar.lo,1,1),InsertDim(rel_diag[[j]]$cbar.hi,1,1),along=1)

      # plot consistency bars
      for (i in 1:nbins){              # nbins = 10 bins
#        lines(rep(rel_diag[[j]]$p.avgs[i], 2), consBars[[j]][, i], col=colBar[j], lwd=3)
        lines(rep(rel_diag[[j]]$p.avgs[i], 2), consBars[[j]][, i], col=colBar[j], lwd=2)  # lwd: line width
      }
    }
    
# see plot: "p" for points, "l" for lines, "b" for both points and lines, "c" for empty points joined by lines, "o" for overplotted points and lines, "s" and "S" for stair steps and "h" for histogram-like vertical lines. Finally, "n" does not produce any points or lines.
    points(rel_diag[[j]]$p.avgs, rel_diag[[j]]$cond.probs,  type="b", pch=1 , col =colLine[[j]], cex=2.0 , lwd=3)
    
  }
  
  
  # Number of forecasts
  # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  if (marHist==TRUE){
    
    for (i in 1:nrd){
#      par(mar=c(5,0,5,12))
#      par(mar=c(1.5,1.5,6,7))  # in case num of sharpness diagram is 3 or 4
      par(mar=c(0.5,1.5,5,7))  # in case num of sharpness diagram is 5
      barplot(HI[i,]/10000, beside=T,space=c(0,1.2),axes = F, axis.lty=F, axisnames = F, col = colLine[[i]], ylim=rgH/10000)
#      axis(1, at=seq(0,1,by=0.1),labels=seq(0,1,by=0.1),cex.axis=1.5)
      title(main = "# of forecasts (x10⁴)", font.main = 1.0, line=0.5)
#      grid(1,5,col='#525252')
      axis(4,cex.axis=1.0)
      box(bg='grey') 
    }
    #pp<- par("plt")
    #par("plt" = c(pp[2] - 0.14 , pp[2], pp[3], pp[3]+ 0.15) )
    #par(new = TRUE)
  }
  
}


#################################################################################################
#                                      Interpolation                                            #
#################################################################################################

# function that returns the position of the nearest grid point from a point of coordinates lat, lon
# the grid is represented by two vectors lat.grid and lon.grid:
# if there is more than one point at the same mimimum distance, it returns only the position of the first one
nearest <- function(lat,lon,lat.grid,lon.grid){
    n.lat=length(lat.grid)
    n.lon=length(lon.grid)

    if(lon<0 && min(lon.grid>=0)) lon=360+lon  # convert the negative longitude lon of the point to a positive one, if lon.grid has only positive values

    #lat.grid2<-sort(lat.grid,decreasing=T)  # sort latitudes because they must go from the higher number to the lower one
    #lon.grid2<-sort(lon.grid)  # sort longitudes because they must go from the lower number to the highest one

    grid.dist.lat<-matrix((lat.grid-lat)^2, nrow=n.lat, ncol=n.lon+1, byrow=FALSE)
    #grid.dist.lon<-matrix((lon.grid-lon)^2,nrow=n.lat,ncol=n.lon,byrow=TRUE)
    grid.dist.lon<-matrix((c(lon.grid,lon.grid[1]+360)-lon)^2,nrow=n.lat,ncol=n.lon+1,byrow=TRUE) # add also the forst lon point at the end of lon values

    grid.dist<-(grid.dist.lat+grid.dist.lon)^0.5  # matrix of distance from the point in grados
    nearest.grid.point.pos<-which(grid.dist==min(grid.dist),arr.ind=T)

    if(length(nearest.grid.point.pos)>2) nearest.grid.point.pos <- nearest.grid.point.pos[1,] # remove all points at the same minimum distance beyond the first one
    
    if(nearest.grid.point.pos[2] > n.lon) nearest.grid.point.pos[2] <- 1  # in case the closer point is that with the first longitude value, must change the lon position
    
    return(nearest.grid.point.pos)
}


# interpolates the observed values in grid2 on grid1 with the inverse squared distance method but using the great-circle distances (using Haversine formula) and selecting only the 4 nearest grid points,.;
# lat1.list and lon1.list are vectors of coordinates referring to grid1, while lat2.list and lon2.list to grid2. They must be in degrees. Grid2 format must be: [lat,lon]
# lat2.list and lon2.list can also be in a different order than lat1.list and lon1.list.
# It interpolates at least 2 grids at time (i.e: the monthly grids of a model), so it can use the same distance matrix for all grids (the more computational intensive part of the script)
# and the same weights for each monthly grid; grid2 must have the format: [layer,lat,lon], where <layer> stands for day, month, year, season, etc...
# beware that the 2 rows of points closer to the north and south pole are still not well interpolated because they are still not associated to grid points at the other side of the north pole
# option 'world' specify if the grid cover the whole globe ('TRUE'), so the leftmost border is close to the rightmost border, or not ('FALSE')

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 <- deg2rad(lat1.list)
  lon1.list.rad <- deg2rad(lon1.list)
  nearest.lat.rad <- deg2rad(nearest.lat)
  nearest.lon.rad <- 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){
      
       #lat.deg<-lat1.list[y]  # lat y lon of the grid1 point selected
       #lon.deg<-lon1.list[x]
       #lat1.deg<-nearest.lat[y,1] # lat y lon of its 4 nearest points
       #lon1.deg<-nearest.lon[x,1]
       #lat2.deg<-nearest.lat[y,1]
       #lon2.deg<-nearest.lon[x,2]
       #lat3.deg<-nearest.lat[y,2]
       #lon3.deg<-nearest.lon[x,1]
       #lat4.deg<-nearest.lat[y,2]
       #lon4.deg<-nearest.lon[x,2]
       #latN.deg<-c(lat1.deg,lat2.deg,lat3.deg,lat4.deg)
       #lonN.deg<-c(lon1.deg,lon2.deg,lon3.deg,lon4.deg)

       # 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
       }
    }
  }

  # R bug: values of interp are not true!!!!!!!!!!!
  #interp<-list()
  #for(l in 1:n.layers) interp[[l]]<-pred[l,,]
  #return(interp)
  return(pred)   
}



# interpolates the observed values in grid2 on grid1 assigning to each point of grid1 the value of the closer point of grid 2
# lat1.list and lon1.list are vectors of coordinates referring to grid1, while lat2.list and lon2.list to grid2. They must be in degrees. Grid2 format must be: [lat,lon]
# lat2.list and lon2.list can also be in a different order than lat1.list and lon1.list.
# It interpolates at least 2 grids at time (i.e: the monthly grids of a model), so it can use the same distance matrix for all grids (the more computational intensive part of the script)
# and the same weights for each monthly grid; grid2 must have the format: [layer,lat,lon], where <layer> stands for day, month, year, season, etc...
# beware that at lon=0 is not working well and it dosn't compute the distance with the great-circle!!!
closer <- function(lat1.list,lon1.list,lat2.list,lon2.list,grid2){
  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 closer grid point
  nearest.lat.pos<-array(NA,c(n.lat1,2)) # position inside grid2 of the closer point 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
    nearest.lat[l,1]=lat2.list[pos.first]
    nearest.lat.pos[l,1]=pos.first
  }

  # 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 closer grid point
  nearest.lon.pos<-array(NA,c(n.lon1,2)) # position inside grid2 of the 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
    nearest.lon[l,1]=lon2.list[pos.first]
    nearest.lon.pos[l,1]=pos.first
  }

 
  #lat1.list.rad<-deg2rad(lat1.list)
  #lon1.list.rad<-deg2rad(lon1.list)
  #nearest.lat.rad<-deg2rad(nearest.lat)
  #nearest.lon.rad<-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){
       #lat<--lat1.list.rad[y]  # lat y lon of the grid1 point selected
       #lon<--lon1.list.rad[x]
             
       #latN<-nearest.lat.rad[y,1] # lat y lon of its nearest point
       #lonN<-nearest.lon.rad[x,1]
       
       #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 nearest point
      
       for(l in 1:n.layers){
          pred[l,y,x]<-grid2[l,nearest.lat.pos[y,1],nearest.lon.pos[x,1]] # grid2 value of its nearest point for layer l
       }
    }
  }
  
  interp<-list()
  for(l in 1:n.layers) interp[[l]]<-pred[l,,]
  return(interp)
      
}



# interpolates the observed values in grid2 on grid1 with the IDW method using the great-circle distances (using Haversine formula) and selecting only the grid points close to <dmax> km.;
# lat1.list and lon1.list are vectors of coordinates referring to grid1, while lat2.list and lon2.list to grid2. They must be in degrees. Grid2 format must be: [lat,lon]
# lat2.list and lon2.list can also be in a different order than lat1.list and lon1.list.
# it returns NA if for a given point of grid1 there are no points of grid2 close of less than <dmax> km that can be used to interpolate that point.
# It interpolates at least 2 grids at time (i.e: the monthly grids of a model), so it can use the same distance matrix for all grids (the more computational intensive part of the IDW)
# and the same weights for each monthly grid; grid2 must have the format: [layer,lat,lon], where <layer> stands for day, month, year, season, etc...
# This function is fully vectorialized allowing the faster possible interpolation of grids with any number of points. it uses up to ~8 GB of RAM, but it can
# be decreased by setting a lower value of variable max.memory defined below.
multi.idw <- function(lat1.list,lon1.list,lat2.list,lon2.list,grid2,dmax){
  max.memory<-125000000 # maximum number of elements in a matrix (each element is a double and occupies 8 byte; the maximum size of a matrix in R is 2.1 GB, about 250000000 elements of type double)
  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]
    
  # longitude conversion:
  #if(min(lon1)<0 && min(lon2)>=0) lon1=360+lon1  # convert the negative longitude of the first grid to a positive one, if the second grid has only positive longitudes
  #if(min(lon2)<0 && min(lon1)>=0) lon2=360+lon2  # convert the negative longitude of the second grid to a positive one, if the first grid has only positive longitudes
  
  #lat.grid1<-sort(lat.grid1,decreasing=T)  # sort latitudes because they must go from the higher number to the lower one to simulate a spatial grid
  #lon1<-sort(lon1)  # sort longitudes because they must go from the lower number to the highest one to similuate a spatial grid
  
  #lat.grid2<-sort(lat.grid2,decreasing=T)  # sort latitudes because they must go from the higher number to the lower one to simulate a spatial grid
  #lon2<-sort(lon2)  # sort longitudes because they must go from the lower number to the highest one to similuate a spatial grid
  
  n.max1<-floor(max.memory/n.points2)  # maximum number of points of grid1 that can be used in a matrix of ~1 GB (1 point = 1 double = 8 bytes)
  if(n.points1<=n.max1) {
    n.int<-1
    n.points1.int<-n.points1
    n.points1.last.int<-n.points1
    print("grid fits into memory")
  } else { # in this case, cut grid1 horizontally in smaller grids to work with matrices of size of ~1 GB
    n.int<-floor(n.points1/n.max1)+1
    n.points1.int<-n.max1
    n.points1.last.int<-n.points1 %% n.max1  # number of points of the last interval
    print(paste("grid will be split in",n.int,"subgrid"))
  }
  
  lat1<-rep(lat1.list,each=n.lon1)
  lon1<-rep(lon1.list,n.lat1)
  lat1.rad<-deg2rad(lat1)
  lon1.rad<-deg2rad(lon1)
  cos.lat1<-cos(lat1.rad)
  vert1<-cbind(lat=lat1,lon=lon1,lat.deg=lat1.rad,lon.deg=lon1.rad,cos.lat=cos.lat1)  # list of lat and lon of points of grid1 with the radial values and cosinus too
  
  lat2<-rep(lat2.list,each=n.lon2)
  lon2<-rep(lon2.list,n.lat2)
  lat2.rad<-deg2rad(lat2)
  lon2.rad<-deg2rad(lon2)
  cos.lat2<-cos(lat2.rad)
  vert2<-cbind(lat=lat2,lon=lon2,lat.deg=lat2.rad,lon.deg=lon2.rad,cos.lat=cos.lat2)  # list of lat and lon of points of grid2 with the radial values and cosinus too
  
  pred<-matrix(NA,nrow=n.points1,ncol=n.layers) # matrix with the interpolated values for each layer
  
  for(i in 1:n.int){
    imax<-i*n.max1
    if(i==n.int)imax=n.points1
    imin<-1+(i-1)*n.max1
    if(i==n.int && n.int>1)n.points1.int=n.points1.last.int
    
    lat1.rad.int<-lat1.rad[imin:imax]
    lat2.rad.int<-lat2.rad
    lon1.rad.int<-lon1.rad[imin:imax]
    lon2.rad.int<-lon2.rad
    cos.lat1.int<-cos.lat1[imin:imax]
    cos.lat2.int<-cos.lat2

    print("Calculating distance matrix...")
    
    vert.cos.lat1<-matrix(cos.lat1.int,nrow=n.points1.int,ncol=n.points2)
    vert.cos.lat2<-matrix(cos.lat2.int,nrow=n.points1.int,ncol=n.points2,byrow=TRUE)
    vert.cos.lat = vert.cos.lat1 * vert.cos.lat2
    rm(vert.cos.lat1,vert.cos.lat2);gc()
    
    vert.lon1<-matrix(lon1.rad.int,nrow=n.points1.int,ncol=n.points2)
    vert.lon2<-matrix(lon2.rad.int,nrow=n.points1.int,ncol=n.points2,byrow=TRUE)
    vert.lon <- (vert.lon2 - vert.lon1)/2
    rm(vert.lon1,vert.lon2);gc()
    
    vert.lon.squared<-vert.lon^2
    rm(vert.lon);gc()
    
    vert.mult<-vert.cos.lat * vert.lon.squared
    rm(vert.cos.lat,vert.lon.squared);gc()
    
    vert.lat1<-matrix(lat1.rad.int,nrow=n.points1.int,ncol=n.points2)
    vert.lat2<-matrix(lat2.rad.int,nrow=n.points1.int,ncol=n.points2,byrow=TRUE)
    vert.lat <- (vert.lat2 - vert.lat1)/2
    rm(vert.lat1,vert.lat2);gc()
    
    vert.lat.squared <- vert.lat^2
    rm(vert.lat);gc()
    
    vert.latlon <- vert.lat.squared + vert.mult 
    rm(vert.lat.squared,vert.mult);gc()
    
    vert.root<-sqrt(vert.latlon)
    rm(vert.latlon);gc()
    
    mm<-which(vert.root > 1)
    if(length(mm)>0) vert.root[mm]<-1
    rm(mm);gc()
    
    vert.dist <- Rx2 * asin(vert.root)  # matrix of distances in km
    rm(vert.root);gc()
    
    ss<-which(vert.dist==0)
    weights<-vert.dist^2
    weights[ss]<-0.000000000001  # not to have +inf in the denominator of the weight matrix
    weights=1/weights
    rm(ss);gc()
    
    nn<-which(vert.dist > dmax)
    weights[nn]<-0 #put to 0 the weights of grid points of grid 2 that are not used to compute the idw because they are too far
    sum.weights<-rowSums(weights)
    zz<-which(sum.weights==0)
    rm(vert.dist,nn);gc()
    
    for(l in 1:n.layers){
       # put the grid2 values in each row of a matrix following the lat/lon list of grid2 points, but horizontally:
       horiz2<-as.vector(t(grid2[l,,]))
       horiz2.rep<-rep(horiz2,n.points1.int)
       
       vert2.values.int<-matrix(horiz2.rep,nrow=n.points1.int,ncol=n.points2,byrow=TRUE)
       values.weighted<-vert2.values.int * weights 
       sum.values.weighted<-rowSums(values.weighted)
       
       pred[imin:imax,l]<-sum.values.weighted/sum.weights
       if(length(zz)>0) pred[imin-1+zz]<-NA
       rm(values.weighted,sum.values.weighted,vert2.values.int,horiz2,horiz2.rep); #gc()
       
       print(paste("subgrid:",i,"/",n.int,"  layer:",l,"/",n.layers))
    }
  }
  
  rm(zz,weights,sum.weights);gc()

  interp<-list()
  for(l in 1:n.layers) interp[[l]]<-matrix(pred[,l],nrow=n.lat1,ncol=n.lon1,byrow=TRUE)
  
  return(interp)
}

################################################################################
#                          Regression functions                                #
################################################################################

# Modified version of the lm.fit() base R function, to increase its speed by removing some unnecessary outputs
# dalla versione 2.15 di R non la puoi piu usare, usa invece lm.fit.fast
# occhio che con lm.fit bisogna passare anche una colonna di uno iniziali per simulare il termine noto!!!
lm.fit.fast.old <- function (x, y, offset = NULL, method = "qr", tol = 1e-07, singular.ok = TRUE, ...) 
{
    if (is.null(n <- nrow(x))) 
        stop("'x' must be a matrix")
    if (n == 0L) 
        stop("0 (non-NA) cases")
    p <- ncol(x)
    if (p == 0L) {
        return(list(coefficients = numeric(0L), residuals = y, 
            fitted.values = 0 * y, rank = 0, df.residual = length(y)))
    }
    ny <- NCOL(y)
    if (is.matrix(y) && ny == 1) 
        y <- drop(y)
    if (!is.null(offset)) 
        y <- y - offset
    if (NROW(y) != n) 
        stop("incompatible dimensions")
    if (method != "qr") 
        warning(gettextf("method = '%s' is not supported. Using 'qr'", 
            method), domain = NA)
    if (length(list(...))) 
        warning("extra arguments ", paste(names(list(...)), sep = ", "), 
            " are just disregarded.")
    storage.mode(x) <- "double"
    storage.mode(y) <- "double"
    z <- .Fortran("dqrls", qr = x, n = n, p = p, y = y, ny = ny, 
        tol = as.double(tol), coefficients = mat.or.vec(p, ny), 
        residuals = y, effects = y, rank = integer(1L), pivot = 1L:p, 
        qraux = double(p), work = double(2 * p), PACKAGE = "base")
    if (!singular.ok && z$rank < p) 
        stop("singular fit encountered")
    coef <- z$coefficients
    pivot <- z$pivot
    r1 <- seq_len(z$rank)
    dn <- colnames(x)
    if (is.null(dn)) 
        dn <- paste("x", 1L:p, sep = "")
    r2 <- if (z$rank < p) 
        (z$rank + 1L):p
    else integer(0L)
    if (is.matrix(y)) {
        coef[r2, ] <- NA
        coef[pivot, ] <- coef
        dimnames(coef) <- list(dn, colnames(y))
    }
    else {
        coef[r2] <- NA
        coef[pivot] <- coef
        names(coef) <- dn
    }
    z$coefficients <- coef
    r1 <- y - z$residuals
    if (!is.null(offset)) 
        r1 <- r1 + offset
   c(z[c("coefficients", "residuals", "rank")], list(fitted.values = r1, df.residual = n - z$rank))
}

# Modified version of the lm.fit() base R function, to increase its speed by removing some unnecessary outputs (such as the QR decomposition)
# remember that the first column of the x matrix must be a column of 1, to represent the constant term!
# Dopo la versione 2.15 di R le funzioni .Fortran() sono proibite, bisogna sostituirle con .Call,
# percio' invece di lm.fit.fast.old bisogna chiamare lm.fit.fast:
lm.fit.fast <- function (x, y, offset = NULL, method = "qr", tol = 1e-07, singular.ok = TRUE, ...) 
{
    if (is.null(n <- nrow(x))) 
        stop("'x' must be a matrix")
    if (n == 0L) 
        stop("0 (non-NA) cases")
    p <- ncol(x)
    if (p == 0L) {
        return(list(coefficients = numeric(0L), residuals = y, 
            fitted.values = 0 * y, rank = 0, df.residual = length(y)))
    }
    ny <- NCOL(y)
    if (is.matrix(y) && ny == 1) 
        y <- drop(y)
    if (!is.null(offset)) 
        y <- y - offset
    if (NROW(y) != n) 
        stop("incompatible dimensions")
    if (method != "qr") 
        warning(gettextf("method = '%s' is not supported. Using 'qr'", 
            method), domain = NA)
    if (length(list(...))) 
        warning("extra arguments ", paste(names(list(...)), sep = ", "), 
            " are just disregarded.")
    storage.mode(x) <- "double"
    storage.mode(y) <- "double"
	
	z <- .Call(stats:::C_Cdqrls, x, y, tol, TRUE)
	
    if (!singular.ok && z$rank < p) 
        stop("singular fit encountered")
    coef <- z$coefficients
    pivot <- z$pivot
    r1 <- seq_len(z$rank)
    dn <- colnames(x)
    if (is.null(dn)) 
        dn <- paste("x", 1L:p, sep = "")
    r2 <- if (z$rank < p) 
        (z$rank + 1L):p
    else integer(0L)
    if (is.matrix(y)) {
        coef[r2, ] <- NA
        coef[pivot, ] <- coef
        dimnames(coef) <- list(dn, colnames(y))
    }
    else {
        coef[r2] <- NA
        coef[pivot] <- coef
        names(coef) <- dn
    }
    z$coefficients <- coef
    r1 <- y - z$residuals
    if (!is.null(offset)) 
        r1 <- r1 + offset
   c(z[c("coefficients", "residuals", "rank")], list(fitted.values = r1, df.residual = n - z$rank))
}

# Function to plot the bar chart of the anomalies of a time series of frequencies (by default in % but can be changed with the freq.max option),
# using red colors for anomalies above the climatological value of the frequencies. It also deals with eventual NA in the time series (doesn't plot the correspondent bar)
# and blue color for anomalies below the climatological value (the frequency mean of the variable over the study period).
# it also adds the linear fit if it is found to be significant (with the test of Mann-Kendall).
barplot.freq <- function(time.serie, year.start, year.end, p.value = 0.05, freq.max = 0.8, title=NULL, cex.y = 1, cex.x = 1, ylab="%", mgp=c(1,1,0), ...)
{
    x <- time.serie
    n.years <- length(x)
    years.serie <- year.start:year.end
    # m is the value used to separate positive anomalies from negative anomalies, i.e: the climatology over the whole period
    m <- mean(x, na.rm=TRUE)
    bar3 <- pmax(x - m, 0)
    bar2 <- pmax(m - x, 0 )
    bar1 <- m - bar2
    bar1[is.na(bar1)] <- m # in case there are NA
    bar2[is.na(bar2)] <- 0 # in case there are NA
    bar3[is.na(bar3)] <- 0 # in case there are NA

    bar.matrix <- matrix(c(bar1,bar2,bar3), 3, n.years, byrow=T)
    barplot(bar.matrix, col = c("white","blue","red"), border = NA, names.arg = years.serie, ylim = c(0,freq.max), axis.lty = 1, space = 0.2, main = title, cex.axis=cex.y, cex.names=cex.x, xlab="", ylab=ylab, mgp=mgp)
    
    abline(0,0, col="black") # add a black x-axis line

    # add mean frequency of the simulated ensemble mean time series:
    # text(length(years.serie)/3, freq.max*(29/30),labels=bquote(bar(nu) == .(paste0(round(mean(x),1),"%"))),cex=3)
    
    #z <- lm(x ~ years)
    kendall_pvalue <- MannKendall(x)$sl[1]
    
    # add a line with the linear trend only if it significant:
    #if(summary(z)$coefficients[2,4] < p.value) abline(lsfit(1:n.years,x), lty=1, col="gray10")
    if(kendall_pvalue < p.value) abline(lsfit(1:n.years,x), lty=1, col="gray10")
}

## Alternative but without bars:
## library(lattice) # for xyplot
## library(grid) # for adding a different color for negative values in xyplot
## x<-1:100
## y<-4+rnorm(100)
## x <- zoo(4+rnorm(100))
## xyplot(x, grid=TRUE, panel = function(x, y, ...){
##        panel.xyplot(x, y, col="blue", ...)
##        #panel.abline(h=0, col="black")
##        panel.abline(h=4, col="gray")
##        grid.clip(y=unit(4,"native"),just=c("bottom"))
##        panel.xyplot(x, y, col="red", ...)
## })

# as barplot.freq, but for forecasts:
barplot.freq.sim <- function(time.serie, time.serie.max, time.serie.min, time.serie.obs, year.start, year.end, p.value = 0.05, freq.max = 0.8, title=NULL, cex.y = 1, cex.x = 1, ylab="%", mgp=c(1,1,0), col.bar = c("white","gray70"), col.line="gray50", cex.mean = 1, cex.obs = 1, cex.r = 1.5, ...)
{
    x <- time.serie
    y <- time.serie.max
    z <- time.serie.min
    o <- time.serie.obs
    
    #n.years <- length(x)
    years.serie <- year.start:year.end
    # m is the value used to separate positive anomalies from negative anomalies, i.e: the climatology over the whole period
    m <- mean(x, na.rm=TRUE)

    bar1 <- z
    bar2 <- y
    bar1[is.na(bar1)] <- m # in case there are NA
    bar2[is.na(bar2)] <- 0 # in case there are NA

    bar.matrix <- matrix(c(bar1,bar2), 2, length(years.serie), byrow=T)
    my.bar <- barplot(bar.matrix, col = col.bar, border = NA, names.arg = years.serie, ylim = c(0,freq.max), axis.lty = 1, space = 0.2, main = title, cex.axis=cex.y, cex.names=cex.x, xlab="", ylab=ylab, mgp=mgp)

    abline(m,0, col=col.line) # add a black x-axis line

    # add points with the ensemble mean:
    col.sim <- rep("red",year.end-year.start+1)
    col.sim[which(x < m)] <- "blue"
    points(my.bar, x, type="p", pch=20, xlab="", ylab="", col=col.sim, cex=cex.mean)

    # add crosses with observed values:
    col.obs <- rep("red",year.end-year.start+1)
    col.obs[which(o < m)] <- "blue"
    points(my.bar, o, type="p", pch=4, xlab="", ylab="", col=col.obs, cex=cex.obs, lwd=5)

    # add corr between obs.time series and ensemble mean time series:
    corr <- round(cor(x,o, use="complete.obs"),2)
    text(length(years.serie), freq.max*(19/20), labels=paste0("r= ",corr), cex=cex.r)
    #text(c(length(years.serie-5),length(years.serie)),rep(freq.max*(9/10),2), labels=c(round(o,2),corr))

    #z <- lm(x ~ years)
    kendall_pvalue <- MannKendall(x)$sl[1]
    
    # add a line with the linear trend only if it significant:
    #if(summary(z)$coefficients[2,4] < p.value) abline(lsfit(1:n.years,x), lty=1, col="gray10")
    if(kendall_pvalue < p.value) abline(lsfit(1:n.years,x), lty=1, col="gray10")
}

# as barplot.freq, but for forecasts:
barplot.freq.sim2 <- function(time.serie, time.serie.max, time.serie.min, time.serie.obs, year.start, year.end, p.value = 0.05, freq.min=0, freq.max = 0.8, title=NULL, cex.y = 1, cex.x = 1, ylab="%", mgp=c(1,1,0), col.bar = c("white","gray85","#4393c3","#d6604d","gray80"), col.line="gray50", cex.mean = 1, cex.obs = 1, cex.r = 1.5, ...)
{
    x <- time.serie
    y <- time.serie.max
    z <- time.serie.min
    obs <- time.serie.obs
    
    #n.years <- length(x)
    years.serie <- year.start:year.end
    # m is the value used to separate positive anomalies from negative anomalies, i.e: the climatology over the whole period
    m <- mean(x, na.rm=TRUE)

    bar1 <- z   # white bar
    bar2 <- pmin(x, m) - bar1 # gray bar
    bar3 <- pmax(m - x, 0) # blue bar
    bar4 <- pmax(x - m, 0) # red bar
    bar5 <- y - (bar1+bar2+bar3+bar4) # gray bar
    
    bar1[is.na(bar1)] <- m # in case there are NA
    bar2[is.na(bar2)] <- 0 # in case there are NA
    bar3[is.na(bar3)] <- 0 # in case there are NA
    bar4[is.na(bar4)] <- 0 # in case there are NA
    bar5[is.na(bar5)] <- 0 # in case there are NA

    #bar3 <- pmax(x - m, 0)
    #bar2 <- pmax(m - x, 0 )
    #bar1 <- m - bar2
    
    bar.matrix <- matrix(c(bar1,bar2,bar3,bar4,bar5), 5, length(years.serie), byrow=T)
    my.bar <- barplot(bar.matrix, col = col.bar, border = NA, names.arg = years.serie, ylim = c(freq.min,freq.max), axis.lty = 1, space = 0.2, main = title, cex.axis=cex.y, cex.names=cex.x, xlab="", ylab=ylab, mgp=mgp)

    abline(m,0, col=col.line) # add a black x-axis line

    # add points with the ensemble mean:
    #col.sim <- rep("red",year.end-year.start+1)
    #col.sim[which(x < m)] <- "blue"
    #points(my.bar, x, type="p", pch=20, xlab="", ylab="", col=col.sim, cex=cex.mean)

    # add crosses with observed values:
    col.obs <- rep("#67001f",year.end-year.start+1)
    col.obs[which(obs < m)] <- "#053061"
    points(my.bar, obs, type="p", pch=4, xlab="", ylab="", col=col.obs, cex=cex.obs, lwd=5)

    # add corr between obs.time series and ensemble mean time series:
    #corr <- round(cor(x,obs, use="complete.obs"),2)
    #text(length(years.serie), freq.max*(29/30), labels=paste0("r= ",corr), cex=cex.r)

    # add mean frequency of the simulated ensemble mean time series:
    #text(length(years.serie)/3, freq.max*(29/30),labels=bquote(bar(nu) == .(paste0(round(mean(x),1),"%"))),cex=cex.r)
    
    #z <- lm(x ~ years)
    kendall_pvalue <- MannKendall(x)$sl[1]
    
    # add a line with the linear trend only if it significant:
    #if(summary(z)$coefficients[2,4] < p.value) abline(lsfit(1:n.years,x), lty=1, col="gray10")
    if(kendall_pvalue < p.value) abline(lsfit(1:n.years,x), lty=1, col="gray10")
}


# As ColorBar, but the user MUST supply its own ticks and tick labels:
# (it is used to have a better control over the values shown)
# the option draw.ticks is used to remove the ticks lines
# the option label.dist is used to change the distance from the legend to the labels:
# Example:
#
# ColorBar2(brks=my.brks, cols=my.cols, vert=FALSE, cex=legend1.cex, label.dist=2, my.ticks=-0.5 + 1:length(my.brks), my.labels=my.brks)
#

ColorBar2 <- function (brks, cols = NULL, vert = TRUE, cex = 1, draw.ticks = TRUE, label.dist = 1, my.ticks, my.labels) 
{
    if (is.null(cols) == TRUE) {
        nlev <- length(brks) - 1
        cols <- rainbow(nlev)
    }
    else {
        if (length(cols) != (length(brks) - 1)) {
            stop("Inconsistent colour levels / list of colours")
        }
    }
    if (vert) {
        par(mar = c(1, 1, 1, 1.5 * (1 + cex)), mgp = c(1, 1, 
            0), las = 1, cex = 1.2)
        image(1, c(1:length(cols)), t(c(1:length(cols))), axes = FALSE, 
            col = cols, xlab = "", ylab = "")
        box()
        axis(4, at = my.ticks, tick = draw.ticks, labels = my.labels, cex.axis = cex, mgp=c(3,label.dist,0))
    }
    else {
        par(mar = c(0.5 + cex, 1, 1, 1), mgp = c(1.5, max(c(0.3, 
            0.8 * (cex - 0.625))), 0), las = 1, cex = 1.2)
        image(1:length(cols), 1, t(t(1:length(cols))), axes = FALSE, 
            col = cols, xlab = "", ylab = "")
        box()
        axis(1, at = my.ticks, tick = draw.ticks, labels = my.labels, cex.axis = cex, mgp=c(3,label.dist,0))
    }
}

# ColorBar3: like ColorBar, but the user can specify a subset of the predefined labels to be shown in the legend (more powerful than the resample option)
ColorBar3 <- function (brks, cols = NULL, vert = TRUE, cex = 1, subset = 1:length(brks)) 
{
    if (is.null(cols) == TRUE) {
        nlev <- length(brks) - 1
        cols <- rainbow(nlev)
    }
    else {
        if (length(cols) != (length(brks) - 1)) {
            stop("Inconsistent colour levels / list of colours")
        }
    }
    if (vert) {
        par(mar = c(1, 1, 1, 1.5 * (1 + cex)), mgp = c(1, 1, 
            0), las = 1, cex = 1.2)
        image(1, c(1:length(cols)), t(c(1:length(cols))), axes = FALSE, 
            col = cols, xlab = "", ylab = "")
        box()
        axis(4, at = seq(0.5, length(brks) - 0.5, 1)[subset], 
            tick = TRUE, labels = brks[seq(1, length(brks), 1)][subset], 
            cex.axis = cex)
    }
    else {
        par(mar = c(0.5 + cex, 1, 1, 1), mgp = c(1.5, max(c(0.3, 
            0.8 * (cex - 0.625))), 0), las = 1, cex = 1.2)
        image(1:length(cols), 1, t(t(1:length(cols))), axes = FALSE, 
            col = cols, xlab = "", ylab = "")
        box()
        axis(1, at = seq(0.5, length(brks) - 0.5, 1)[subset], 
            labels = brks[seq(1, length(brks), 1)][subset], 
            cex.axis = cex)
    }
}


# Use the function below by handing it a matrix of numbers. It will plot the matrix with a color scale based on the highest and lowest values in the matrix.
# usage: myImagePlot(m)     where m is a matrix of numbers
# optional arguments: myImagePlot(m, xlabels, ylabels, zlim, title=c("my title"))
# xLabels and yLabels are vectors of strings to label the rows and columns.
# zlim is a vector containing a low and high value to use for the color scale
myImagePlot <- function(x, ...){
     min <- min(x)
     max <- max(x)
     yLabels <- rownames(x)
     xLabels <- colnames(x)
     title <-c()
  # check for additional function arguments
  if( length(list(...)) ){
    Lst <- list(...)
    if( !is.null(Lst$zlim) ){
       min <- Lst$zlim[1]
       max <- Lst$zlim[2]
    }
    if( !is.null(Lst$yLabels) ){
       yLabels <- c(Lst$yLabels)
    }
    if( !is.null(Lst$xLabels) ){
       xLabels <- c(Lst$xLabels)
    }
    if( !is.null(Lst$title) ){
       title <- Lst$title
    }
  }
# check for null values
if( is.null(xLabels) ){
   xLabels <- c(1:ncol(x))
}
if( is.null(yLabels) ){
   yLabels <- c(1:nrow(x))
}

layout(matrix(data=c(1,2), nrow=1, ncol=2), widths=c(4,1), heights=c(1,1))

 # Red and green range from 0 to 1 while Blue ranges from 1 to 0
 ColorRamp <- rgb( seq(0,1,length=256),  # Red
                   seq(0,1,length=256),  # Green
                   seq(1,0,length=256))  # Blue
 ColorLevels <- seq(min, max, length=length(ColorRamp))

 # Reverse Y axis
 reverse <- nrow(x) : 1
 yLabels <- yLabels[reverse]
 x <- x[reverse,]

 # Data Map
 par(mar = c(3,5,2.5,2))
 image(1:length(xLabels), 1:length(yLabels), t(x), col=ColorRamp, xlab="",
 ylab="", axes=FALSE, zlim=c(min,max))
 if( !is.null(title) ){
    title(main=title)
 }
axis(BELOW<-1, at=1:length(xLabels), labels=xLabels, cex.axis=0.7)
 axis(LEFT <-2, at=1:length(yLabels), labels=yLabels, las= HORIZONTAL<-1,
 cex.axis=0.7)

 # Color Scale
 par(mar = c(3,2.5,2.5,2))
 image(1, ColorLevels,
      matrix(data=ColorLevels, ncol=length(ColorLevels),nrow=1),
      col=ColorRamp,
      xlab="",ylab="",
      xaxt="n")

 layout(1)
}

################################################################################
#                            Big data functions                                #
################################################################################

#################################  split.array #################################

# function to split an array in smaller arrays, selecting one dimension of the array as the one used to split the array.
# The function only returns the intervals of each subarray, not the values of the subarrays.
# the subarrays are then used inside a for loop in the main script do do all the required analysis instead of applying them to the whole array.
#
# The array can be for instance an hindcast array with dimensions: c(n.members, n.yrs.hind*n.startdates, n.leadtimes, n.lat, n.lon)
#
# Example:
# 
# hindcasts <- array(rnorm(4*100*4*256*512), c(4,100,4,256,512))
# block <- split.array.old(hindcasts, 5)       # split on longitude
#
# for(subArray in 1:block$n.sub){           # loop on each smaller subarray
#     subLon=block$my.interv[[subArray]]    # longitude interval corresponding to the subarray data
#     nlon<-length(subLon)                  # length of the actual subarray        
#      
#     hindcast.sub <- hindcasts[,,,,subLon] # subarray data
#     # now insert below any calculation you need to do on the hindcast.sub array
#
#  } # close for on subArray  

split.array.old <- function (array, along=tail(dim(array),1), max.n.el=10000000){
    array.dims <- dim(array)            # i.e:  [4,100,4,320,640]
    n.sub <- prod(array.dims)/max.n.el  # number of sub-arrays in which to split the hindcast and rean.data, i.e: 4*100*4*320*640/10000000 = 32.768
    n.sub <- ceiling(n.sub)             # round n.sub to the nearest higher integer, i.e: 33
    n.split <- array.dims[along]        # number of elements along the splitting dimension, i.e: 640 if along=5
    sub.size <- floor(n.split/n.sub)    # number of elements in the splitted dimension (i.e: lon) of each subarray rounded to the lower integer, i.e: 640/33=19.39=19
    if(sub.size<=1) stop("Subarrays too small. Increase ten times the value of max.n.el")
    n.sub <- n.split %/% sub.size       # take only the integer part of the ratio. It is equal to floor(n.split/sub.size). I.e: 640/19=33.68=33 
    add.last <- n.split %% n.sub   # number of additional elements of the last subarray (if %% >0), i.e: 640 %% 33 = 13

    my.interv<-list()
    for(s in 1:n.sub){
          if(s==n.sub) {mod.last <- add.last} else {mod.last <- 0}
          my.interv[[s]] <- (1 + sub.size*(s-1)):((sub.size*s) + mod.last)
    }
    
    return(list(array.dims=array.dims, along=along, n.split=n.split, n.sub=n.sub, sub.size=sub.size, add.last=add.last, sub.size.last=sub.size + mod.last, my.interv=my.interv))
}

# Function to split an array into smaller arrays (chunks)
#
# in the argument 'dimension', you specify the dimensions of the array to split [i.e: c(4,100,4,256,512) for an hindcast array]
# in the argument 'along', you specify which dimension you want to use to split the array. Be default, it is the last dimension of the array.
# in the argument 'max.n.el', you set the size of a chunk.  By default, split.array creates array of exactly 10'000'000 of elements. For array of type numeric (double),
# it is equivalent to 80 MB, because each double occupies 8 byte. 
# in the argument 'chunks', you specify how many chunks do you want to be created exactly. It overrides the option 'max.n.el'. Useful if you already knows
# how many chunks do you need (more or less) and want to run one chunk in a different core at the same time, so you can't exceed the maximum number of cores available on your machine
# in the argument, 'smallest', you specify if you want to run the script with the maximum possible number of chunks (smallest=TRUE),
#   so that the number of chunks is equal to the number of possible values of the along dimensions and the size of each chunk is exactly 1.

split.array <- function (dimensions, along=tail(dimensions,1), max.n.el=10000000, chunks=NULL, smallest=FALSE){
    if(along <= 0 || along > length(dimensions)) stop("Choose a number for the 'along' argument inside the number of available dimensions!")
    
    array.dims <- dimensions                # i.e:  [4,100,4,320,640]
    n.split <- array.dims[along]            # number of elements along the splitting dimension, i.e: 640 if along=5
    
    n.chunk <- prod(array.dims)/max.n.el    # first estimate of the number of chunks (sub-arrays) into which the array will be split, i.e: 4*100*4*320*640/10000000 = 32.768
    n.chunk <- ceiling(n.chunk)             # round n.chunk to the nearest higher integer, i.e: 33
    chunk.size <- floor(n.split/n.chunk)    # number of elements in the splitted dimension (i.e: lon) of each chunk rounded to the lower integer, i.e: 640/33=19.39=19
    if(chunk.size <= 1) stop("Chunks too small. Try increasing 10 times the value of max.n.el")
    
    n.chunk <- n.split %/% chunk.size       # take only the integer part of the ratio. It is equal to floor(n.split/chunk.size). I.e: 640/19=33.68=33
    if(!is.null(chunks)) {n.chunks <- chunks;  chunk.size <- floor(n.split/n.chunk)}
    
    add.last <- n.split %% n.chunk          # number of additional elements of the last chunk (if %% >0), i.e: 640 %% 33 = 13

    if(smallest == TRUE){ # in this case, we want each chunk to be exactly 1 row or column wide:
        n.chunk <- array.dims[along]
        n.split <- n.chunk
        chunk.size <- 1
        add.last <- 0
    }    

    # list with the position of each chunk c inside the chosen dimension of the array:
    int<-list() 
    for(c in 1:n.chunk){
          if(c == n.chunk) {mod.last <- add.last} else {mod.last <- 0}
          int[[c]] <- (1 + chunk.size*(c-1)):((chunk.size*c) + mod.last)
    }

    chunk.size.last <- chunk.size + mod.last  # number of elements of the last chunk

    # list with the number of elements of each chunk c:
    n.int<-list()
    for(c in 1:n.chunk) n.int[[c]] <- length(int[[c]])

    return(list(n.int=n.int, int=int, array.dims=array.dims, along=along, max.n.el=max.n.el, n.split=n.split,
                n.chunk=n.chunk, chunk.size=chunk.size, add.last=add.last, chunk.size.last=chunk.size.last))
}


# Example:
# 
# hindcasts <- array(rnorm(4*100*4*256*512), c(4,100,4,256,512))
#
# chunk <- split.array(dim(hindcasts), 5)       # split on longitude
#
# for(subArray in 1:chunk$n.sub){           # loop on each smaller subarray
#     subLon=chunk$my.interv[[subArray]]    # longitude interval corresponding to the subarray data
#     nlon<-length(subLon)                  # length of the actual subarray        
#      
#     hindcast.sub <- hindcasts[,,,,subLon] # subarray data
#     # now insert below any calculation you need to do on the hindcast.sub array
#
#  } # close for on subArray


####################  veriApplyBig  ############################################


# A wrapper of veriApply() to be able to work even with hindcasts arrays that exceed the memory limits of the workstation
# and to efficently use the option 'parallel=TRUE' also for large data arrays with no memory limits.
# (only 2-5 GB of RAM are necessary, depending on the number of cpus used)
#
# It splits the input hindcast data and the input observed data in smaller arrays based on the longitude value,
# and then applies veriApply() to each sub-array, assembling the results in an array with the same format of the array returned by veriApply()
# A progress bar shows how many sub-arrays have already been processed.
#
# To take advantage of this function, the option parallel=TRUE is enabled by default, 
# and the option 'ncpus' is set to 8, to work with BSC workstations with 4 physical cores (8 with hyperthreading).
# Users in possess of IC3 Intel Xeon workstations with 8 physical cores should set ncpus = 16 to take advantage of hyperthreading.
# With ncpus=8, calculations are 4 times faster, while with ncpus=16, calculations are 8 times faster.
#
# On Moore, you can set ncpus=8, and on Amdahl, ncpus can be set to a maximum of 12; however, it is not raccomendedd to run this function at full power on Moore or Amdahl ,
# since it'd consume all the cores avaiable (8 for Moore and 12 for Amhdal), forbidding other users to employ the cluster for their single-core calculations.
# You can run it during the week-end if there are no other jobs scheduled, or set a lower number of ncpus (4-5) to leave resources for other users, even if performance'll suffer
#
# Parallel computation employs all CPU recurses of the machine: it will go slower until the computation is finished
# If you want to use the machine also for other tasks, you can set a lower number of ncpus (2 or 3), with a loss of performance.
#
# If you get a memory problem error, try decreasing the size of the variable 'max.n.el'.
#
# Example of use:
#
# library(ff)
# bigfile <- "/scratch/Earth/ncortesi/bigfile"           # choose a site where to store the big data array
# source('/scratch/Earth/ncortesi/RESILIENCE/veriApplyBig.R')  # load the veryApplyBig() and the save.big(9 functions
# 
# # create a random hindcast that normally wouldn't fit into memory:
# anom.hind.dim<-c(51,30,1,256,512)
# anom.hind<-array(rnorm(prod(anom.hind.dim)),anom.hind.dim)
#
# save.big(array=anom.hind, path=bigfile)
#
# # create random observed hindcast that fit into memory (because observations only have 1 member):
# anom.rean<-array(rnorm(prod(anom.hind.dim[-1])), anom.hind.dim[-1]) 
#
# ffload(file=bigfile)
# # str(ff.array)
# open(ff.array)
#
# my.score <- veriApplyBig("FairRpss",fcst=ff.array, obs=anom.rean, tdim=2, ensdim=1 , prob=c(1/3, 1/3)) # by default parallel=TRUE and with ncpus=8 to run it on our pc
#
# close(ff.array)

veriApplyBig <- function (verifun, fcst, obs, fcst.ref = NULL, tdim = length(dim(fcst)) - 
    1, ensdim = length(dim(fcst)), prob = NULL, threshold = NULL, 
    na.rm = FALSE, parallel = TRUE, ncpus = 8, max.n.el=5000000, path=NULL, ...) 
{

    sub <- prod(dim(fcst))/max.n.el
    sub <- ceiling(sub)             # number of sub-arrays in which to split the hindcast and rean.data
    n.lon <- tail(dim(fcst),1)      # number of longitude elements
    sub.size <- floor(n.lon/sub)    # number of elements in the last dimension (lon) of each subarray 
    if(sub.size<=1) stop("Subarrays too small. Increase ten times the value of max.n.el")
    last.sub.size<-n.lon %% sub     # number of additional elements of the last subarray
    if(last.sub.size>0) sub<-sub+1

    my.SkillScore<-array(NA,tail(dim(fcst),3)) # take only the leadtime, lat and lon dimensions

    cat('Subarray n. ')      

    for(s in 1:sub){
       cat(paste0(s,'/',sub,' '))
      
       if(s==sub && last.sub.size>0) {last<-sub.size-last.sub.size} else {last<-0}  # because the last subarray is shorter than the others, if last.sub.size>0
       my.interv <- (1+sub.size*(s-1)):((sub.size*s)-last)   # longitude interval where to load data

       #anom.hindcast.sub <- array(NA, c(head(dim(fcst),4), sub.size-last))
       #anom.rean.sub <- array(NA, c(dim(fcst)[2:4], sub.size-last))

       anom.hindcast.sub <- fcst[,,,,my.interv]  
       anom.rean.sub <- obs[,,,my.interv]
      
       my.SkillScore.sub <- veriApply(verifun, fcst=anom.hindcast.sub, obs=anom.rean.sub, tdim=tdim, ensdim=ensdim, prob=prob, threshold=threshold, na.rm=na.rm, parallel=parallel, ncpus=ncpus)[[1]]

       my.SkillScore[,,my.interv]<-my.SkillScore.sub

       gc()
    }

    cat('\n')
    return(my.SkillScore)
  
}



old_veriApplyBig <- function (verifun, fcst, obs, fcst.ref = NULL, tdim = length(dim(fcst)) - 
    1, ensdim = length(dim(fcst)), prob = NULL, threshold = NULL, 
    na.rm = FALSE, parallel = TRUE, ncpus = 8, max.n.el=10000000, path=NULL, ...) 
{

    ffload(file=fcst)
    #str(ff.array)
    open(ff.array)

    sub <- prod(dim(ff.array))/max.n.el
    sub <- ceiling(sub)             # number of sub-arrays in which to split the hindcast and rean.data
    n.lon <- tail(dim(ff.array),1)      # number of longitude elements
    sub.size <- floor(n.lon/sub)    # number of elements in the last dimension (lon) of each subarray 
    if(sub.size<=1) stop("Subarrays too small. Increase ten times the value of max.n.el")
    last.sub.size<-n.lon %% sub     # number of additional elements of the last subarray
    if(last.sub.size>0) sub<-sub+1

    my.SkillScore<-array(NA,tail(dim(ff.array),3)) # take only the leadtime, lat and lon dimensions

    cat('Subarray n. ')      

    for(s in 1:sub){
       cat(paste0(s,'/',sub,' '))
      
       if(s==sub && last.sub.size>0) {last<-sub.size-last.sub.size} else {last<-0}  # because the last subarray is shorter than the others, if last.sub.size>0
       my.interv <- (1+sub.size*(s-1)):((sub.size*s)-last)   # longitude interval where to load data

       #anom.hindcast.sub <- array(NA, c(head(dim(ff.array),4), sub.size-last))
       #anom.rean.sub <- array(NA, c(dim(ff.array)[2:4], sub.size-last))

       anom.hindcast.sub <- ff.array[,,,,my.interv]  
       anom.rean.sub <- obs[,,,my.interv]
      
       my.SkillScore.sub <- veriApply(verifun, fcst=anom.hindcast.sub, obs=anom.rean.sub, tdim=tdim, ensdim=ensdim, prob=prob, threshold=threshold, na.rm=na.rm, parallel=parallel, ncpus=ncpus)[[1]]

       my.SkillScore[,,my.interv]<-my.SkillScore.sub

       gc()
    }

    close(ff.array)

    cat('\n')
    return(my.SkillScore)
  
}


################################################################################
#                                save.big                                      #


# A wrapper of ffsave to save on disk big arrays of a numeric (double) variable
# in format .ffData (by means of the ff package). See veriApplyBig() for an example.

save.big <- function(array, path) {
    ff.array <- as.ff(array, vmode="double", file = path)
    ffsave(ff.array, file= path)
    close(ff.array); rm(ff.array)
}



################################################################################
#                                veriApplyPar                                  #


# A wrapper of veriApply() to efficently use the option 'parallel=TRUE' also for large data arrays with no memory limits,
# but the input hindcast array must fit into the memory to use this function.
#
# the function splits the input hindcast data and the input observed data in smaller arrays based on the longitude value,
# and then applies veriApply() to each sub-array, assembling the results in an array with the same format of the array returned by veriApply()
# A progress bar shows how many sub-arrays have already been processed.
#
# To take advantage of this function, the option parallel=TRUE is enabled by default, 
# and the option 'ncpus' is set to 8, to work with BSC workstations with 4 physical cores (8 with hyperthreading).
# Users in possess of IC3 Intel Xeon workstations with 8 physical cores should set ncpus = 16 to take advantage of hyperthreading.
# With ncpus=8, calculations are 4 times faster, while with ncpus=16, calculations are 8 times faster.
#
# On Moore, you can set ncpus=8, and on Amdahl, ncpus can be set to a maximum of 12; however, it is not raccomendedd to run this function at full power on Moore or Amdahl ,
# since it'd consume all the cores avaiable (8 for Moore and 12 for Amhdal), forbidding other users to employ the cluster for their single-core calculations.
# You can run it during the week-end if there are no other jobs scheduled, or set a lower number of ncpus (4-5) to leave resources for other users, even if performance'll suffer
#
# Parallel computation employs all CPU recurses of the machine: it is not possible to use it for other tasks until the computation is finished.
# If you want to use the machine also for other tasks, you can set a lower number of ncpus (2 or 3), with a loss of performance.
#
# If you get a memory problem error, try decreasing the size of the variable 'max.n.el'.
#
# example of use:
#
# my.score <- veriApplyBig("FairRpss",fcst=anom.hindcast, obs=anom.rean, tdim=2, ensdim=1 , prob=c(1/3, 1/3))  # by default parallel=TRUE and with ncpus=8 to run it on our pc
#
# my.score <- veriApplyBig("FairCrpss",fcst=anom.hindcast, obs=anom.rean, tdim=2, ensdim=1 , ncpus=2)  # to set a lower number of cpus
#

veriApplyPar <- function (verifun, fcst, obs, fcst.ref = NULL, tdim = length(dim(fcst)) - 
    1, ensdim = length(dim(fcst)), prob = NULL, threshold = NULL, 
    na.rm = FALSE, parallel = TRUE, ncpus = 8, max.n.el=10000000, ...) 
{
    sub <- prod(dim(fcst))/max.n.el
    sub <- ceiling(sub)             # number of sub-arrays in which to split the hindcast and rean.data
    n.lon <- tail(dim(fcst),1)      # number of longitude elements
    sub.size <- floor(n.lon/sub)    # number of elements in the last dimension (lon) of each subarray 
    if(sub.size<=1) stop("Subarrays too small. Increase ten times the value of max.n.el")
    last.sub.size<-n.lon %% sub     # number of additional elements of the last subarray
    if(last.sub.size>0) sub<-sub+1

    my.SkillScore<-array(NA,tail(dim(fcst),3)) # take only the leadtime, lat and lon dimensions

    cat('Subarray n. ')      

    for(s in 1:sub){
       cat(paste0(s,'/',sub,' '))
      
       if(s==sub && last.sub.size>0) {last<-sub.size-last.sub.size} else {last<-0}  # because the last subarray is shorter than the others, if last.sub.size>0
       my.interv <- (1+sub.size*(s-1)):((sub.size*s)-last)   # longitude interval where to load data

       anom.hindcast.sub <- array(NA, c(head(dim(fcst),4), sub.size-last))
       anom.rean.sub <- array(NA, c(dim(fcst)[2:4], sub.size-last))

       anom.hindcast.sub <- fcst[,,,,my.interv]  
       anom.rean.sub <- obs[,,,my.interv]
      
       my.SkillScore.sub <- veriApply(verifun, fcst=anom.hindcast.sub, obs=anom.rean.sub, tdim=tdim, ensdim=ensdim, prob=prob, threshold=threshold, na.rm=na.rm, parallel=parallel, ncpus=ncpus)[[1]]

       my.SkillScore[,,my.interv]<-my.SkillScore.sub

       gc()
    }

    cat('\n')
    return(my.SkillScore)
  
}


#######################################################################################
#                               parApplyCal                                           #


# like parApply, but with a check to authorize the parallel computation or not.
# As parApply, it must be applied only to small arrays to be able to fit in memory.
# If your array is too big, consider the possibility to split it in smaller arrays with
# the function split.array.

parApplyCal <- function(cl = NULL, X, MARGIN, FUN, ncpus=4, ... ) {
 
  .cl <- try(parallel::makeCluster(ncpus, type = "FORK"), silent = TRUE)

  if (!"try-error" %in% class(.cl)) hasparallel <- TRUE

  if (hasparallel) {
      on.exit(parallel::stopCluster(.cl))
       
      output <- parallel::parApply(cl = .cl, X = X, MARGIN = MARGIN, FUN = FUN, nmemb=nmemb, nsdates=nsdates)
      
  } else {
      output <- apply(X = X, MARGIN = MARGIN, FUN = FUN, nmemb=nmemb, nsdates=nsdates)
  }

  return(output)

}

#######################################################################################
#                               old_parApplyBig                                       #


# parallel::parApply() needs too much memory when the input array is too big (>400-500 MB on 8GB machines)

# splitdir is the dimension that will be split internally; it must be one of the dimensions used also by MARGIN 8see examples below)

old_parApplyBig <- function(cl = NULL, X, MARGIN, FUN, splitdim = tail(dim(X),1), max.n.el=10000000, ... ) {

    sub <- prod(dim(X))/max.n.el
    sub <- ceiling(sub)              # number of sub-arrays in which to split the hindcast and rean.data
    n.el <- dim(X)[splitdim]         # number of elements in the splitdir dimension
    sub.size <- floor(n.el/sub)      # number of elements in the splitting dimension of each subarray 
    if(sub.size<=1) stop("Subarrays too small. Increase ten times the value of max.n.el")
    last.sub.size<-n.el %% sub       # number of additional elements of the last subarray
    if(last.sub.size>0) sub<-sub+1
    n.dim.X <- length(dim(X))        # number of dimensions of array X

    # swap the splitdim dimension with the last one:
    my.seq <- 1:n.dim.X
    my.seq[n.dim.X] <- splitdim
    my.seq[splitdim] <- n.dim.X
    if(splitdim < n.dim.X) X <- aperm(X, my.seq)
    if(splitdim < n.dim.X && length(which(MARGIN==n.dim.X))==0) MARGIN[splitdim] <- n.dim.X

    output<-array(NA,dim(X)[MARGIN]) # take only the dimensions used by MARGIN

    print('Subarray n. ')      

    for(s in 1:sub){
       cat(paste0(s,'/',sub,' '))
      
       if(s==sub && last.sub.size>0) {last<-sub.size-last.sub.size} else {last<-0}  # because the last subarray is shorter than the others, if last.sub.size>0
       my.interv <- (1+sub.size*(s-1)):((sub.size*s)-last)   # longitude interval where to load data

       if(n.dim.X == 2) subarray <- X[,my.interv]  
       if(n.dim.X == 3) subarray <- X[,,my.interv]  
       if(n.dim.X == 4) subarray <- X[,,,my.interv]  
       if(n.dim.X == 5) subarray <- X[,,,,my.interv]  
       if(n.dim.X == 6) subarray <- X[,,,,,my.interv]  
       if(n.dim.X == 7) subarray <- X[,,,,,,my.interv]  
       if(n.dim.X == 8) subarray <- X[,,,,,,,my.interv]  
       if(n.dim.X == 9) subarray <- X[,,,,,,,,my.interv]  
       if(n.dim.X == 10) subarray <- X[,,,,,,,,,my.interv]  
       if(n.dim.X > 10) stop("input array has too many dimensions")

       .cl <- try(parallel::makeCluster(ncpus, type = "FORK"), silent = TRUE)

       if (!"try-error" %in% class(.cl)) hasparallel <- TRUE

       if (hasparallel) {
          on.exit(parallel::stopCluster(.cl))
          suboutput <- parallel::parApply(cl = .cl, X = X, MARGIN = MARGIN, FUN = FUN)
       }
       else {
          suboutput <- apply(X = X, MARGIN = MARGIN, FUN = FUN, ...)
       }

       if(length(MARGIN) == 2) output[,my.interv] <- suboutput
       if(length(MARGIN) == 3) output[,,my.interv] <- suboutput
       if(length(MARGIN) == 4) output[,,,my.interv] <- suboutput
       if(length(MARGIN) == 5) output[,,,,my.interv] <- suboutput
       if(length(MARGIN) == 6) output[,,,,,my.interv] <- suboutput

       if(splitdim < n.dim.X) X <- aperm(X, my.seq) ## sistema!!!

       gc()
    }

    cat('\n')
    return(output)
  
}



#################################################################################################
#                                           Wine indexes                                        #
#################################################################################################

# 1. Annual mean temperature
# temp must have the format [month,lat,lon] or [month,lon,lat], and num.months must be a multiple of 12
# and can be smaller than the number of months in temp: it defines the number of months we want to use to calculate the index, starting from the first month in the temp array.
# It must also be a multiple of 12 to reflect the yearly data; i.e: num.months=24 considers the first 24 months of the temp array to do the average.
index1<-function(temp,num.months){
  my.temp<-temp[1:num.months,,] # select only the months actually used
  if(!is.array(my.temp)) my.temp<-array(my.temp,c(length(my.temp),1,1)) # if temp is a dumb array we must convert it back to an array before applying apply
  my.index<-apply(my.temp,c(2,3),mean) # calculate the mean temperature
  return(my.index)
}

#2. Mean temperature for growing season, for the WHOLE period
# (promedio de las temperaturas medias mensuales para el periodo de octubre a abril)
# you must provide at least 24 months of data starting from January to compute the index
# because the first 4 months and the last 3 cannot be used for calculation.
# if you want to calculate the yearly value for year XXXX, just introduce its 12 months more the 12 months of the following year
# temp must have the format [month,lat,lon] or [month,lon,lat], num.months must be a multiple of 12
index2<-function(temp,num.months){
  my.seq1<-rep(12*seq(0,num.months/12-1),each=7)
  my.seq2<-rep(c(1:4,10:12),num.months/12)
  my.months<-my.seq1 + my.seq2  # all the months inside num.months from october to april
  
  my.months<-my.months[-(1:4)] # remove the first four months because they miss the oct:dec months
  n.months<-length(my.months)
  my.months<-my.months[-((n.months-2):n.months)] # remove the last three months because they miss the jan:apr months
  
  temp.oct.apr<-temp[my.months,,] # select only months from octuber to april
  if(!is.array(temp.oct.apr)) temp.oct.apr<-array(temp.oct.apr,c(length(temp.oct.apr),1,1)) # if temp.oct.apr is a dumb array we must convert it back to an array

  my.index<-apply(temp.oct.apr,c(2,3),mean) # calculate the mean temperature
  return(my.index)
}

#3. Winkler index for the vegetative period
# temp data must start from january and num.months must be at least 24 months long and a multiple of 12 months 
# temp must have the format [month,lat,lon] or [month,lon,lat]
index3<-function(temp,num.months){
  n.years=num.months/12

  temp.minus.ten<-temp-10  # decrease each month of 10 degrees
  ss<-which(temp.minus.ten<0,arr.ind=T) # select elements < 0 degrees
  temp.minus.ten[ss]=0 # set to 0 elements lower than 0 degrees

  month31=c(1,3,5,7,8,10,12) # meses con 31 dias
  my.months31<-rep(month31,n.years)+rep(0:(n.years-1)*12,each=length(month31)) # select only months with 31 days
  temp.minus.ten[my.months31,,]<-temp.minus.ten[my.months31,,]*31 # multiply temperature of these months for 31

  month30=c(4,6,9,11) # meses con 30 dias
  my.months30<-rep(month30,n.years)+rep(0:(n.years-1)*12,each=length(month30)) # select only months with 30 days
  temp.minus.ten[my.months30,,]<-temp.minus.ten[my.months30,,]*30 # multiply temperature of these months for 30

  month28=2 # meses con 28 dias
  my.months28<-rep(month28,n.years)+rep(0:(n.years-1)*12,each=length(month28)) # select only months with 28 days
  temp.minus.ten[my.months28,,]<-temp.minus.ten[my.months28,,]*28.25 # multiply temperature of these months for 28.25

  my.seq1<-rep(12*seq(0,num.months/12-1),each=7)
  my.seq2<-rep(c(1:4,10:12),num.months/12)
  my.months<-my.seq1 + my.seq2  # all the months inside num.months from october to april
  
  my.months<-my.months[-(1:4)] # remove the first four months because they are missing the oct:dec months
  n.months<-length(my.months)
  my.months<-my.months[-((n.months-2):n.months)] # remove the last three months because they miss the jan:apr months
  
  temp.oct.apr<-temp.minus.ten[my.months,,] # select only months from octuber to april
  if(!is.array(temp.oct.apr)) temp.oct.apr<-array(temp.oct.apr,c(length(temp.oct.apr),1,1)) # if temp is a dumb array we must convert it back to an array before applying apply
  my.index<-apply(temp.oct.apr,c(2,3),sum) # calculate the sum of the (aproximately) daily degrees above 10 degrees
  return(my.index/(n.years-1))  # normalize for the number of years used taking into account that one vegetative period is always lost 
}

#4. Winter Severity Index (old version, as the absolute minimum of the mean temperature)
# temp must have the format [month,lat,lon] or [month,lon,lat], num.months must be a multiple of 12
index4_old<-function(temp,num.months){
  my.temp<-temp[1:num.months,,] # select only the months actually used
  if(!is.array(my.temp)) my.temp<-array(my.temp,c(length(my.temp),1,1)) # if temp is a dumb array we must convert it back to an array before applying apply
  my.index<-apply(my.temp,c(2,3),min)
  return(my.index)
}


#4. Winter Severity Index (temp media del mes mas frio) 
# temp must have the format [month,lat,lon] or [month,lon,lat], num.months must be a multiple of 12
index4<-function(temp,num.months){
  n.years=num.months/12
  
  month.coldest=7 # mese mas frio en el emisferio austral
  my.months.coldest<-rep(month.coldest,n.years)+rep(0:(n.years-1)*12,each=1) # select only months with 28 days
  my.temp<-temp[1:num.months,,] # select only the months in the chosen period
  
  if(!is.array(my.temp)) my.temp<-array(my.temp,c(length(my.temp),1,1)) # if temp is a dumb array we must convert it back to an array before applying apply
  my.temp<-my.temp[my.months.coldest,,] # select only the coldest months
  if(is.null(dim(my.temp))) {my.index<-my.temp} else {my.index<-apply(my.temp,c(2,3),mean)}
  return(my.index)
}



#5. Precipitacion annual
# prec must have the format [month,lat,lon] or [month,lon,lat], num.months must be a multiple of 12
index5<-function(prec,num.months){
  my.prec<-prec[1:num.months,,] # select only the months actually used
  if(!is.array(my.prec)) my.prec<-array(my.prec,c(length(my.prec),1,1)) # if prec is a dumb array we must convert it back to an array before applying apply
  my.index<-apply(my.prec,c(2,3),sum)
  n.years=num.months/12
  return(my.index/n.years) # normaliza por el numero de años para devolver el valor promedio anual del indice
}

#6. Precipitacion durante el ciclo vegetativo (octubre a abril)
# prec must have the format [month,lat,lon] or [month,lon,lat], num.months must be a multiple of 12 and at least with 24 months
index6<-function(prec,num.months){
  my.seq1<-rep(12*seq(0,num.months/12-1),each=7)
  my.seq2<-rep(c(1:4,10:12),num.months/12)
  my.months<-my.seq1 + my.seq2  # all the months inside num.months from october to april
  
  my.months<-my.months[-(1:4)] # remove the first four months because they belongs to the previous year
  n.months<-length(my.months)
  my.months<-my.months[-((n.months-2):n.months)] # remove the last three months of the last year
  
  prec.oct.apr<-prec[my.months,,] # select only months from octuber to april
  if(!is.array(prec.oct.apr)) prec.oct.apr<-array(prec.oct.apr,c(length(prec.oct.apr),1,1)) # if prec is a dumb array we must convert it back to an array before applying apply
  my.index<-apply(prec.oct.apr,c(2,3),sum) # calculate the total precipitation
  n.years=num.months/12

  return(my.index/(n.years-1)) # normaliza por el numero de periodos vegetativos introducidos para devolver el valor promedio anual del indice
}

# function to select one of the above six indices:
# temp and prec must have the format [month,lat,lon] or [month,lon,lat], num.months must be a multiple of 12
choose.index<-function(num.index,temp,prec,num.months){
  if(num.index==1) return(index1(temp,num.months))
  if(num.index==2) return(index2(temp,num.months))
  if(num.index==3) return(index3(temp,num.months))
  if(num.index==4) return(index4(temp,num.months))
  if(num.index==5) return(index5(prec,num.months))
  if(num.index==6) return(index6(prec,num.months))
}

# same function as above but returns all six indices:
indices<-function(temp,prec,num.months){
  return(list(TempMediaAnual=index1(temp,num.months),
              TempMediaVeget=index2(temp,num.months),
              IndiceWinklerVeg=index3(temp,num.months),
              WinterSeverityIndex=index4(temp,num.months),
              PrecAnual=index5(prec,num.months),
              PrecVeget=index6(prec,num.months)))
}


#################################################################################################
#                                        Error indexes                                          #
#################################################################################################


RMSE<-function(obs,pred){ # semplice funzione per calcolare l'errore quadratico medio dato il vettore con la grandezza osservata e quello con la previsione (possono esserci anche NA nel vettore obs)
	# i pred hanno sempre tutti i valori predetti annuali, mentre potrebbero esserci anni senza valori osservati, dunque devo togliere solo le file corrispondenti agli anni con NA tra i valori obs:
	years.right <- which(is.na(obs) == FALSE)
	obs2 <- obs[years.right]
	pred2 <- pred[years.right]
	sum.scarti.quad <- sum((obs2-pred2)^2,na.rm=TRUE)
	RMSE <- (sum.scarti.quad/(length(years.right)))^0.5 # devi togliere dal denominatore gli anni con NA!!! 
	return(RMSE)
}

MAE<-function(obs,pred){ # semplice funzione per calcolare il mean Absolute Error dato il vettore con la grandezza osservata e quello con la previsione (possono esserci anche NA nel vettore obs)
	# i pred hanno sempre tutti i valori predetti annuali, mentre potrebbero esserci anni senza valori osservati, dunque devo togliere solo le file corrispondenti agli anni con NA tra i valori obs:
	years.right<-which(is.na(obs)==FALSE)
	obs2<-obs[years.right]
	pred2<-pred[years.right]
	MAE<-sum(abs(obs2-pred2))/(length(years.right)) # devi togliere dal denominatore gli anni con NA!!! 
	return(MAE)
}

MAEp<-function(obs,pred){ # semplice funzione per calcolare il Mean Absolute Error in percentuale (%) dato il vettore con la grandezza osservata e quello con la previsione (possono esserci anche NA nel vettore obs)
	# i pred hanno sempre tutti i valori predetti annuali, mentre potrebbero esserci anni senza valori osservati, dunque devo togliere solo le file corrispondenti agli anni con NA tra i valori obs:
	years.right<-which(is.na(obs)==FALSE)
	obs2<-obs[years.right]
	pred2<-pred[years.right]
	MAE<-sum(abs(obs2-pred2))/(length(years.right)) # devi togliere dal denominatore gli anni con NA!!! 
	obs.prom<-sum(obs2)/length(years.right)
	MAE<-MAE/obs.prom
	return(MAE)
}

MBE<-function(obs,pred){ # semplice funzione per calcolare l'errore medio (Mean Bias Error) (ci possono essere anche elementi con NA nel vettore obs)
	# i pred hanno sempre tutti i valori predetti annuali, mentre potrebbero esserci anni senza valori osservati, dunque devo togliere le file corrispondenti agli anni con NA tra i valori obs:
	years.right<-which(is.na(obs)==FALSE)
	obs2<-obs[years.right]
	pred2<-pred[years.right]
	MBE<-sum(pred2-obs2)/(length(years.right))
	return(MBE)
}

AGREE<-function(obs,pred){ # per calcolare la d di Willmott o Index of agreement OCCHIO che e' insensibile a sovra/sottostime quasi come l'R2
	years.right<-which(is.na(obs)==FALSE)
	obs2<-obs[years.right]
	pred2<-pred[years.right]
	sum.scarti.quad<-sum((obs2-pred2)^2,na.rm=TRUE)
	obs2.mean<-mean(obs2)
	d<-1-(sum.scarti.quad/(sum((abs(pred2-obs2.mean)+abs(obs2-obs2.mean))^2)))
	return(d)
}

AGREE.1<-function(obs,pred){ # d di Willmott corretto senza i quadrati
	years.right<-which(is.na(obs)==FALSE)
	obs2<-obs[years.right]
	pred2<-pred[years.right]
	sum.scarti<-sum(abs(obs2-pred2),na.rm=TRUE)
	obs2.mean<-mean(obs2)
	d1<-1-(sum.scarti/(sum(abs(pred2-obs2.mean)+abs(obs2-obs2.mean))))
	return(d1)
}

AGREE.2011<-function(obs,pred){ # nuova d di Willmott introdotta da lui nel 2011 
	years.right<-which(is.na(obs)==FALSE)
	obs2<-obs[years.right]
	pred2<-pred[years.right]
	sum.scarti<-sum(abs(obs2-pred2),na.rm=TRUE)
	obs2.mean<-mean(obs2)
	denom<-2*sum(abs(obs2-obs2.mean)) # denominatore della formula di d(r)
	if(sum.scarti<=denom){d.2011<-1-(sum.scarti/denom)}else{d.2011<-(denom/sum.scarti)-1}
	return(d.2011)
}

RMSE.freedom<-function(obs,pred,degree.freedom){ # funzione per calcolare l'errore quadratico medio dato il vettore con la grandezza osservata e quello con la previsione (possono esserci anche NA nel vettore obs)
	# i pred hanno sempre tutti i valori predetti annuali, mentre potrebbero esserci anni senza valori osservati, dunque devo togliere le file corrispondenti agli anni con NA tra i valori obs:
	years.right<-which(is.na(obs)==FALSE)
	obs2<-obs[years.right]
	pred2<-pred[years.right]
	sum.scarti.quad<-sum((obs2-pred2)^2,na.rm=TRUE)
	RMSE<-(sum.scarti.quad/degree.freedom)^0.5
	return(RMSE)
}

SumSquared<-function(obs,pred){ # semplice funzione per calcolare la somma dei quadrati degli scarti dato il vettore con la grandezza osservata e quello con la previsione (possono esserci anche NA nel vettore obs)
	# i pred hanno sempre tutti i valori predetti annuali, mentre potrebbero esserci anni senza valori osservati, dunque devo togliere le file corrispondenti agli anni con NA tra i valori obs:
	years.right<-which(is.na(obs)==FALSE)
	obs2<-obs[years.right]
	pred2<-pred[years.right]
	sum.scarti.quad<-sum((obs2-pred2)^2,na.rm=TRUE)
	return(sum.scarti.quad)
}





#################################################################################################
#                                            Others                                             #
#################################################################################################


## test <- REOF(anom, lon, lat, 30)
## ProjEOF(anom, lat, lon, PCs[,1:4])

## REOF <- function(ano, lat, lon, 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 > ntimes) stop(paste0("Parameter 'ntrunc' must be equal or smaller than ", ntimes))

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

##     ## Measure loadings, weight them for latitude and convert them into 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))

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

##     ## measure the rotated PCs (RPCs):
##     invLoadings <- t(pracma::pinv(varim$loadings)) ## invert and traspose the rotated loadings
##     ano.wght <- ano *  InsertDim(eofs$wght, 1, ntimes)
##     dim(ano.wght) <- c(ntimes, nlat * nlon)
##     RPCs <- scale(ano.wght) %*% invLoadings ## check if it is ano or ano.wght

##     return(list(REOFs=REOFs, RPCs=RPCs, wgth=eofs$wght)) ## add variance explained?
## }

## ProjEOF <- function(ano, lat, lon, PCs){
##     nlat <- length(lat)
##     nlon <- length(lon)
##     nPCs <- dim(PCs)[2]
    
##     proj.cor <- proj.reg <- array(NA, c(nPCs, nlat, nlon))
    
##     for(t in 1:nPCs) proj.cor[t,,] <- apply(ano, c(2,3), function(x) cor(x, PCs[,t], use = "na.or.complete"))
##     for(t in 1:nPCs) {
##         PCs.stand <- (PCs[,t] - mean(PCs[,t])) / sd(PCs[,t]) ## Standardize the PCs
##         proj.reg[t,,] <- regressionMaps(anom=ano, index=PCs.stand)
##     }
    
##     brks.corr <- c(-1, -0.8, -0.6, -0.4, -0.2, 0,  0.2, 0.4, 0.6, 0.8, 1)
##     cols.corr <- colorRampPalette(rev(brewer.pal(11,"RdBu")))(length(brks.corr)-1)    # blue--red colors
##     PlotLayout(PlotEquiMap, c(2,3), var=proj.cor, lat=lat, lon=lon, filled.continents=FALSE, brks=brks.corr, cols=cols.corr)
    
##     invisible(list(proj.cor, proj.reg))
## }
    

## ## function for projecting with the regression method:
## regressionMaps<-function(anom,index){
##     ##anom <- psl_anom
##     ##index <- stand
##     postime <- which(dim(anom)==length(index))
##     lm_fun <- function(x,y){                     
##         lm(y~x)$coefficients[[2]]                                  
##     }
    
##     regress_map <- apply(anom,(1:length(dim(anom)))[-postime],lm_fun,x=index)
##     return(regress_map)
## }

## ## function for projecting with the regression method:
## regressionMaps<-function(anom,index){
##     postime <- which(dim(anom) == length(index))
##     lm_fun <- function(x,y) lm(y~x)$coefficients[[2]]                                  
##     regress_map <- apply(anom,(1:length(dim(anom)))[-postime], lm_fun, x=index)
##     return(regress_map)
## }

   
Telec <- function (ano_exp = NULL, ano_obs = NULL, lon, lat, ftime_average = 2:4, obsproj = TRUE, nmodes = 1) {
    if (!is.null(ano_exp)) {
        if (!is.numeric(ano_exp) || !is.array(ano_exp)) {
            stop("Parameter 'ano_exp' must be a numeric array.")
        }
        if (length(dim(ano_exp)) != 6) {
            stop("'ano_exp' must have dimensions c(n. experimental data sets, n. members, n. start dates, n. forecast time steps, n. latitudes, n. longitudes).")
        }
    }
    if (!is.null(ano_obs)) {
        if (!is.numeric(ano_obs) || !is.array(ano_obs)) {
            stop("Parameter 'ano_obs' must be a numeric array.")
        }
        if (length(dim(ano_obs)) != 6) {
            stop("'ano_obs' must have dimensions c(n. observational data sets, n. obs. members, n. start dates, n. forecast time steps, n. latitudes, n. longitudes).")
        }
    }
    if (!is.null(ano_obs) && !is.null(ano_exp)) {
        if (!identical(dim(ano_exp)[3:6], dim(ano_obs)[3:6])) {
            stop("'ano_obs' and 'ano_exp' must have the same number of start dates, forecast time steps, latitudes and longitudes.")
        }
    }
    if (!is.numeric(lon) || !is.numeric(lat)) {
        stop("'lon' and 'lat' must be numeric vectors.")
    }
    if (is.null(attr(lon, "first_lon")) || is.null(attr(lon, 
        "last_lon")) || is.null(attr(lon, "array_across_gw")) || 
        is.null(attr(lon, "data_across_gw"))) {
        print("Warning: at least one of the attributes 'first_lon', 'last_lon', 'data_across_gw' or 'array_across_gw' of the parameter 'lon' is not defined (see documentation on output 'lon' of ?Load). The spatial domain of the provided data may be unnoticedly wrong.")
    }
    if (is.null(attr(lat, "last_lat"))) {
        attr(lat, "last_lat") <- tail(lat, 1)
    }
    if (is.null(attr(lat, "first_lat"))) {
        attr(lat, "first_lat") <- head(lat, 1)
    }
    if (!is.null(ano_exp)) {
        dims <- dim(ano_exp)
    } else if (!is.null(ano_obs)) {
        dims <- dim(ano_obs)
    }
    else {
        stop("Either one of 'ano_exp' or 'ano_obs' must be provided.")
    }
    nlon <- dims[6]
    nlat <- dims[5]
    nftimes <- dims[4]
    nyr <- dims[3]
    nmemb <- dims[2]
    nexp <- dims[1]
    if (length(lon) != nlon) {
        stop("Inconsistent number of longitudes and input field dimensions.")
    }
    if (length(lat) != nlat) {
        stop("Inconsistent number of latitudes and input field dimensions.")
    }
    if (nyr < 2) {
        stop("At least data for 2 start dates must be provided.")
    }
    if (!is.numeric(ftime_average)) {
        stop("'ftime_average' must be a numeric vector.")
    }
    if (any(ftime_average > nftimes)) {
        stop("'ftime_averages' contains indexes to non-existing forecast time steps.")
    }
    if (!is.logical(obsproj)) {
        stop("'obsproj' must be either TRUE or FALSE.")
    }
    if (obsproj) {
        if (is.null(ano_obs)) {
            stop("Parameter 'obsproj' set to TRUE but no 'ano_obs' provided.")
        }
        if (is.null(ano_exp)) {
            print("Warning: parameter 'obsproj' set to TRUE but no 'ano_exp' provided.")
        }
    }
    ## check if 'nmodes' is integer and greater than 0:
    if (nmodes%%1!=0 || nmodes <= 0) {
        stop("'nmodes' must be an integer, positive and not-null vector ")
    }

    fcsys <- 1
    NAOF.ver <- NULL
    NAOO.ver <- NULL
    OEOF <- NULL
    if (!is.null(ano_exp)) {
        ano_exp <- ano_exp[fcsys, , , ftime_average, , , drop = FALSE] ## select only data of chosen lead times and forecast system
        f1 <- Mean1Dim(ano_exp, posdim = 4, narm = TRUE) ## Mean of the selected lead times
        dim(f1) <- c(1, nmemb, nyr, 1, nlat, nlon) ## Add empty dimensions
        time.series.telec.for <- array(NA, c(nmodes, nmemb, nyr))
    }
    if (!is.null(ano_obs)) {
        ano_obs <- ano_obs[1, 1, , ftime_average, , , drop = FALSE]  ## select only data of chosen lead time
        o1 <- drop(Mean1Dim(ano_obs, posdim = 4, narm = TRUE))  ## Mean of the selected lead times
        ##dim(o1) <- c(1, 1, nyr, 1, nlat, nlon) ## Add empty dimensions
        time.series.telec.obs <- array(NA, c(nmodes, nyr))
    }
    
    ##for (iy in 1:nyr) { ## not necessary, remove it!
    
        if (!is.null(ano_obs)) {
            ##o2 <- o1[1, 1, , 1, , ] ## remove year y (for leave-one-out cross-validation)
            ##dim(o2) <- c(nyr, nlat, nlon) ## remove empty dimensions
            OEOF <- EOF(o1, lon, lat, neofs = 4)
            sign <- 1
            ## change sign to EOFs and PCs if necesary:
            if (0 < mean(OEOF$EOFs[1, which.min(abs(lat - 65)), 
                ], na.rm = T)) {
                sign <- -1
            }
            OEOF$EOFs[1,,] <- OEOF$EOFs[1,,] * sign
            OEOF$PCs[,1] <- OEOF$PCs[,1] * sign

            ## ## Project anomalies (o1) onto the mode of variability num. 'nm' to get its temporal variability:
            ## for(nm in 1:nmodes){
            ##     PCO <- ProjectField(o1, OEOF, mode = nm)
            ##     time.series.telec.obs[nm, iy] <-  PCO[1, 1, iy, 1]
            ## }                    
     
        }
    
        if (!is.null(ano_exp)) {
            if (!obsproj) {
                f2 <- f1[1, , -iy, 1, , ]
                dim(f2) <- c(nmemb * (nyr - 1), nlat, nlon)
                FEOF <- EOF(f2, lon, lat, neofs = 4)
                sign <- 1
                if (0 < FEOF$EOFs[1, which.min(abs(lat - 65)), 
                  ]) {
                  sign <- -1
                }
                FEOF$EOFs[1,,] <- FEOF$EOFs[1,,] * sign
                FEOF$PCs[,1] <- FEOF$PCs[,1] * sign

                for(nm in 1:nmodes){
                    PCF <- ProjectField(f1, FEOF, mode = nm)
                    for (imemb in 1:nmemb) time.series.telec.for[nm, imemb, iy] <- PCF[1, imemb, iy, 1]
                    
                }
                
            }
            else {
                for(nm in 1:nmodes){
                    PCF <- ProjectField(f1, OEOF, mode = nm)
                    time.series.telec.for[nm,, iy] <- PCF[1, , iy, 1]
                }
            }
        }                               
    ## } ## close if on iy
    
    ##return(list(telec_exp = time.series.telec.for, telec_obs = time.series.telec.obs, EOFs_obs = OEOF))
    return(list(telec_exp = NULL, telec_obs = NULL, EOFs_obs = OEOF))

}


myboxplot.stats <-  function (x, coef = NULL, do.conf = TRUE, do.out =TRUE)
{
  nna <- !is.na(x)
  n <- sum(nna)
  stats <- quantile(x, c(.05,.25,.5,.75,.95), na.rm = TRUE)
  iqr <- diff(stats[c(2, 4)])
  out <- x < stats[1] | x > stats[5]
  conf <- if (do.conf) stats[3] + c(-1.58, 1.58) * diff(stats[c(2, 4)])/sqrt(n)
  list(stats = stats, n = n, conf = conf, out = x[out & nna])
} 

Load2 <- function (var, exp = NULL, obs = NULL, sdates, nmember = NULL, 
    nmemberobs = NULL, nleadtime = NULL, leadtimemin = 1, leadtimemax = NULL, 
    storefreq = "monthly", sampleperiod = 1, lonmin = 0, lonmax = 360, 
    latmin = -90, latmax = 90, output = "areave", method = "conservative", 
    grid = NULL, maskmod = vector("list", 15), maskobs = vector("list", 
        15), configfile = NULL, varmin = NULL, varmax = NULL, 
    silent = FALSE, nprocs = NULL, dimnames = NULL, remapcells = 2) 
{
    parameter_names <- ls()
    if (length(parameter_names) < 3 || is.null(var) || is.null(sdates) || 
        (is.null(exp) && is.null(obs))) {
        stop("Error: At least 'var', 'exp'/'obs' and 'sdates' must be provided.")
    }
    load_parameters <- lapply(parameter_names, get, envir = environment())
    names(load_parameters) <- parameter_names
    parameters_to_show <- c("var", "exp", "obs", "sdates", "grid", 
        "output", "storefreq")
    load_parameters <- c(load_parameters[parameters_to_show], 
        load_parameters[-match(parameters_to_show, names(load_parameters))])
    cat(paste("* The load call you issued is:\n*   Load(", paste(strwrap(paste(unlist(lapply(names(load_parameters[1:length(parameters_to_show)]), 
        function(x) paste(x, "=", if (x == "sdates" && length(load_parameters[[x]]) > 
            4) {
            paste0("c('", load_parameters[[x]][1], "', '", load_parameters[[x]][2], 
                "', ..., '", tail(load_parameters[[x]], 1), "')")
        }
        else {
            paste(deparse(load_parameters[[x]]), collapse = "")
        }))), collapse = ", "), width = getOption("width") - 
        9, indent = 0, exdent = 8), collapse = "\n*"), ", ...)\n* See the full call in '$load_parameters' after Load() finishes.\n", 
        sep = ""))
    errors <- try({
        if (is.null(var) || !(is.character(var) && nchar(var) > 
            0)) {
            stop("Error: parameter 'var' should be a character string of length >= 1.")
        }
        exps_to_fetch <- c()
        exp_info_names <- c("name", "path", "nc_var_name", "suffix", 
            "var_min", "var_max", "dimnames")
        if (!is.null(exp) && !(is.character(exp) && all(nchar(exp) > 
            0)) && !is.list(exp)) {
            stop("Error: parameter 'exp' should be a vector of strings or a list with information of the experimental datasets to load. Check 'exp' in ?Load for details.")
        }
        else if (!is.null(exp)) {
            if (!is.list(exp)) {
                exp <- lapply(exp, function(x) list(name = x))
            }
            for (i in 1:length(exp)) {
                if (!is.list(exp[[i]])) {
                  stop("Error: parameter 'exp' is incorrect. It should be a list of lists.")
                }
                if (!(all(names(exp[[i]]) %in% exp_info_names))) {
                  stop("Error: parameter 'exp' is incorrect. There are unrecognized components in the information of some of the experiments. Check 'exp' in ?Load for details.")
                }
                if (!("name" %in% names(exp[[i]]))) {
                  exp[[i]][["name"]] <- paste0("exp", i)
                  if (!("path" %in% names(exp[[i]]))) {
                    stop("Error: parameter 'exp' is incorrect. A 'path' should be provided for each experimental dataset if no 'name' is provided. See 'exp' in ?Load for details.")
                  }
                }
                else if (!("path" %in% names(exp[[i]]))) {
                  exps_to_fetch <- c(exps_to_fetch, i)
                }
                if ("path" %in% names(exp[[i]])) {
                  if (!("nc_var_name" %in% names(exp[[i]]))) {
                    exp[[i]][["nc_var_name"]] <- "$VAR_NAME$"
                  }
                  if (!("suffix" %in% names(exp[[i]]))) {
                    exp[[i]][["suffix"]] <- ""
                  }
                  if (!("var_min" %in% names(exp[[i]]))) {
                    exp[[i]][["var_min"]] <- ""
                  }
                  if (!("var_max" %in% names(exp[[i]]))) {
                    exp[[i]][["var_max"]] <- ""
                  }
                }
            }
            if ((length(exps_to_fetch) > 0) && (length(exps_to_fetch) < 
                length(exp))) {
                cat("! Warning: 'path' was provided for some experimental datasets in 'exp'. Any \n*   information in the configuration file related to these will be ignored.\n")
            }
        }
        obs_to_fetch <- c()
        obs_info_names <- c("name", "path", "nc_var_name", "suffix", 
            "var_min", "var_max")
        if (!is.null(obs) && !(is.character(obs) && all(nchar(obs) > 
            0)) && !is.list(obs)) {
            stop("Error: parameter 'obs' should be a vector of strings or a list with information of the observational datasets to load. Check 'obs' in ?Load for details.")
        }
        else if (!is.null(obs)) {
            if (!is.list(obs)) {
                obs <- lapply(obs, function(x) list(name = x))
            }
            for (i in 1:length(obs)) {
                if (!is.list(obs[[i]])) {
                  stop("Error: parameter 'obs' is incorrect. It should be a list of lists.")
                }
                if (!(all(names(obs[[i]]) %in% obs_info_names))) {
                  stop("Error: parameter 'obs' is incorrect. There are unrecognized components in the information of some of the observations. Check 'obs' in ?Load for details.")
                }
                if (!("name" %in% names(obs[[i]]))) {
                  obs[[i]][["name"]] <- paste0("obs", i)
                  if (!("path" %in% names(obs[[i]]))) {
                    stop("Error: parameter 'obs' is incorrect. A 'path' should be provided for each observational dataset if no 'name' is provided. See 'obs' in ?Load for details.")
                  }
                }
                else if (!("path" %in% names(obs[[i]]))) {
                  obs_to_fetch <- c(obs_to_fetch, i)
                }
                if ("path" %in% names(obs[[i]])) {
                  if (!("nc_var_name" %in% names(obs[[i]]))) {
                    obs[[i]][["nc_var_name"]] <- "$VAR_NAME$"
                  }
                  if (!("suffix" %in% names(obs[[i]]))) {
                    obs[[i]][["suffix"]] <- ""
                  }
                  if (!("var_min" %in% names(obs[[i]]))) {
                    obs[[i]][["var_min"]] <- ""
                  }
                  if (!("var_max" %in% names(obs[[i]]))) {
                    obs[[i]][["var_max"]] <- ""
                  }
                }
            }
            if (length(c(obs_to_fetch, exps_to_fetch) > 1) && 
                (length(obs_to_fetch) < length(obs))) {
                cat("! Warning: 'path' was provided for some observational datasets in 'obs'. Any \n*   information in the configuration file related to these will be ignored.\n")
            }
        }
        if (is.null(sdates)) {
            stop("Error: parameter 'sdates' must be provided.")
        }
        if (!is.character(sdates) || !all(nchar(sdates) == 8) || 
            any(is.na(strtoi(sdates)))) {
            stop("Error: parameter 'sdates' is incorrect. All starting dates should be a character string in the format 'YYYYMMDD'.")
        }
        if (!is.null(nmember) && !is.null(exp)) {
            if (!is.numeric(nmember)) {
                stop("Error: parameter 'nmember' is incorrect. It should be numeric.")
            }
            if (length(nmember) == 1) {
                cat(paste("! Warning: 'nmember' should specify the number of members of each experimental dataset. Forcing to", 
                  nmember, "for all experiments.\n"))
                nmember <- rep(nmember, length(exp))
            }
            if (length(nmember) != length(exp)) {
                stop("Error: 'nmember' must contain as many values as 'exp'.")
            }
            else if (any(is.na(nmember))) {
                nmember[which(is.na(nmember))] <- max(nmember, 
                  na.rm = TRUE)
            }
        }
        if (!is.null(nmemberobs) && !is.null(obs)) {
            if (!is.numeric(nmemberobs)) {
                stop("Error: parameter 'nmemberobs' is incorrect. It should be numeric.")
            }
            if (length(nmemberobs) == 1) {
                cat(paste("! Warning: 'nmemberobs' should specify the number of members of each observational dataset. Forcing to", 
                  nmemberobs, "for all observations.\n"))
                nmemberobs <- rep(nmemberobs, length(obs))
            }
            if (length(nmemberobs) != length(obs)) {
                stop("Error: 'nmemberobs' must contain as many values as 'obs'.")
            }
            else if (any(is.na(nmemberobs))) {
                nmemberobs[which(is.na(nmemberobs))] <- max(nmemberobs, 
                  na.rm = TRUE)
            }
        }
        if (!is.null(nleadtime) && !is.numeric(nleadtime)) {
            stop("Error: parameter 'nleadtime' is wrong. It should be numeric.")
        }
        if (is.null(leadtimemin) || !is.numeric(leadtimemin)) {
            stop("Error: parameter 'leadtimemin' is wrong. It should be numeric.")
        }
        if (!is.null(leadtimemax) && !is.numeric(leadtimemax)) {
            stop("Error: parameter 'leadtimemax' is wrong. It should be numeric.")
        }
        if (!is.character(storefreq) || !(storefreq %in% c("monthly", 
            "daily"))) {
            stop("Error: parameter 'storefreq' is wrong, can take value 'daily' or 'monthly'.")
        }
        if (is.null(sampleperiod) || !is.numeric(sampleperiod)) {
            stop("Error: parameter 'sampleperiod' is wrong. It should be numeric.")
        }
        if (is.null(lonmin) || !is.numeric(lonmin)) {
            stop("Error: parameter 'lonmin' is wrong. It should be numeric.")
        }
        if (lonmin < -360 || lonmin > 360) {
            stop("Error: parameter 'lonmin' must be in the range [-360, 360]")
        }
        if (lonmin < 0) {
            lonmin <- lonmin + 360
        }
        if (is.null(lonmax) || !is.numeric(lonmax)) {
            stop("Error: parameter 'lonmax' is wrong. It should be numeric.")
        }
        if (lonmax < -360 || lonmax > 360) {
            stop("Error: parameter 'lonmax' must be in the range [-360, 360]")
        }
        if (lonmax < 0) {
            lonmax <- lonmax + 360
        }
        if (is.null(latmin) || !is.numeric(latmin)) {
            stop("Error: parameter 'latmin' is wrong. It should be numeric.")
        }
        if (latmin > 90 || latmin < -90) {
            stop("Error: 'latmin' must be in the interval [-90, 90].")
        }
        if (is.null(latmax) || !is.numeric(latmax)) {
            stop("Error: parameter 'latmax' is wrong. It should be numeric.")
        }
        if (latmax > 90 || latmax < -90) {
            stop("Error: 'latmax' must be in the interval [-90, 90].")
        }
        if (is.null(output) || !(output %in% c("lonlat", "lon", 
            "lat", "areave"))) {
            stop("Error: 'output' can only take values 'lonlat', 'lon', 'lat' or 'areave'.")
        }
        if (is.null(method) || !(method %in% c("bilinear", "bicubic", 
            "conservative", "distance-weighted"))) {
            stop("Error: parameter 'method' is wrong, can take value 'bilinear', 'bicubic', 'conservative' or 'distance-weighted'.")
        }
        remap <- switch(method, bilinear = "remapbil", bicubic = "remapbic", 
            conservative = "remapcon", `distance-weighted` = "remapdis")
        if (!is.null(grid)) {
            if (is.character(grid)) {
                supported_grids <- list("r[0-9]{1,}x[0-9]{1,}", 
                  "t[0-9]{1,}grid")
                grid_matches <- unlist(lapply(lapply(supported_grids, 
                  regexpr, grid), .IsFullMatch, grid))
                if (sum(grid_matches) < 1) {
                  stop("The specified grid in the parameter 'grid' is incorrect. Must be one of r<NX>x<NY> or t<RES>grid.")
                }
            }
            else {
                stop("Error: parameter 'grid' should be a character string, if specified.")
            }
        }
        if (!is.list(maskmod)) {
            stop("Error: parameter 'maskmod' must be a list.")
        }
        if (length(maskmod) < length(exp)) {
            stop("Error: 'maskmod' must contain a numeric mask or NULL for each experiment in 'exp'.")
        }
        for (i in 1:length(maskmod)) {
            if (is.list(maskmod[[i]])) {
                if ((length(maskmod[[i]]) > 2) || !all(names(maskmod[[i]]) %in% 
                  c("path", "nc_var_name"))) {
                  stop("Error: all masks in 'maskmod' must be a numeric matrix, or a list with the components 'path' and optionally 'nc_var_name', or NULL.")
                }
            }
            else if (!(is.numeric(maskmod[[i]]) || is.null(maskmod[[i]]))) {
                stop("Error: all masks in 'maskmod' must be a numeric matrix, or a list with the components 'path' and optionally 'nc_var_name', or NULL.")
            }
        }
        if (!is.list(maskobs)) {
            stop("Error: parameter 'maskobs' must be a list.")
        }
        if (length(maskobs) < length(obs)) {
            stop("Error: 'maskobs' must contain a numeric mask or NULL for each obseriment in 'obs'.")
        }
        for (i in 1:length(maskobs)) {
            if (is.list(maskobs[[i]])) {
                if ((length(maskobs[[i]]) > 2) || !all(names(maskobs[[i]]) %in% 
                  c("path", "nc_var_name"))) {
                  stop("Error: all masks in 'maskobs' must be a numeric matrix, or a list with the components 'path' and optionally 'nc_var_name', or NULL.")
                }
            }
            else if (!(is.numeric(maskobs[[i]]) || is.null(maskobs[[i]]))) {
                stop("Error: all masks in 'maskobs' must be a numeric matrix, or a list with the components 'path' and optionally 'nc_var_name', or NULL.")
            }
        }
        if ((output != "areave" || !is.null(grid)) && length(exp) > 
            0) {
            if (!all(unlist(lapply(maskobs, is.null)))) {
                cat("! Warning: 'maskobs' will be ignored. 'maskmod[[1]]' will be applied to observations instead.\n")
            }
            maskobs <- lapply(maskobs, function(x) x <- maskmod[[1]])
        }
        if (is.null(configfile)) {
            configfile <- system.file("config", "BSC.conf", package = "s2dverification")
        }
        else if (!is.character(configfile) || !(nchar(configfile) > 
            0)) {
            stop("Error: parameter 'configfile' must be a character string with the path to an s2dverification configuration file, if specified.")
        }
        if (!is.null(varmin) && !is.numeric(varmin)) {
            stop("Error: parameter 'varmin' must be numeric, if specified.")
        }
        if (!is.null(varmax) && !is.numeric(varmax)) {
            stop("Error: parameter 'varmax' must be numeric, if specified.")
        }
        if (!is.logical(silent)) {
            stop("Error: parameter 'silent' must be TRUE or FALSE.")
        }
        if (!is.null(nprocs) && (!is.numeric(nprocs) || nprocs < 
            1)) {
            stop("Error: parameter 'nprocs' must be a positive integer, if specified.")
        }
        if (!is.null(dimnames) && (!is.list(dimnames))) {
            stop("Error: parameter 'dimnames' must be a list, if specified.")
        }
        if (!all(names(dimnames) %in% c("member", "lat", "lon"))) {
            stop("Error: parameter 'dimnames' is wrong. There are unrecognized component names. See 'dimnames' in ?Load for details.")
        }
        if (!is.numeric(remapcells) || remapcells < 0) {
            stop("Error: 'remapcells' must be an integer >= 0.")
        }
        if (length(exps_to_fetch) > 0 || length(obs_to_fetch) > 
            0) {
            cat("* Some 'path's not explicitly provided in 'exp' and 'obs', so will now proceed to open the configuration file.\n")
            data_info <- ConfigFileOpen(configfile, silent, TRUE)
            matches <- ConfigApplyMatchingEntries(data_info, 
                var, sapply(exp[exps_to_fetch], "[[", "name"), 
                sapply(obs[obs_to_fetch], "[[", "name"), show_entries = FALSE, 
                show_result = FALSE)
            replace_values <- data_info$definitions
            if (!is.null(exp) && length(exps_to_fetch) > 0) {
                counter <- 1
                exp[exps_to_fetch] <- lapply(matches$exp_info, 
                  function(x) {
                    x[names(exp[[exps_to_fetch[counter]]])] <- exp[[exps_to_fetch[counter]]]
                    x[["path"]] <- paste0(x[["main_path"]], x[["file_path"]])
                    counter <<- counter + 1
                    x
                  })
            }
            if (!is.null(obs) && length(obs_to_fetch) > 0) {
                counter <- 1
                obs[obs_to_fetch] <- lapply(matches$obs_info, 
                  function(x) {
                    x[names(obs[[obs_to_fetch[counter]]])] <- obs[[obs_to_fetch[counter]]]
                    x[["path"]] <- paste0(x[["main_path"]], x[["file_path"]])
                    counter <<- counter + 1
                    x
                  })
            }
            if (!silent) {
                cat("* All pairs (var, exp) and (var, obs) have matching entries.\n")
            }
        }
        else {
            replace_values <- list(DEFAULT_NC_VAR_NAME = "$VAR_NAME$", 
                DEFAULT_VAR_MIN = "", DEFAULT_VAR_MAX = "", DEFAULT_SUFFIX = "", 
                DEFAULT_DIM_NAME_LONGITUDES = "longitude", DEFAULT_DIM_NAME_LATITUDES = "latitude", 
                DEFAULT_DIM_NAME_MEMBERS = "ensemble")
        }
        dimnames <- list(lon = ifelse(is.null(dimnames[["lon"]]), 
            replace_values[["DEFAULT_DIM_NAME_LONGITUDES"]], 
            dimnames[["lon"]]), lat = ifelse(is.null(dimnames[["lat"]]), 
            replace_values[["DEFAULT_DIM_NAME_LATITUDES"]], dimnames[["lat"]]), 
            member = ifelse(is.null(dimnames[["member"]]), replace_values[["DEFAULT_DIM_NAME_MEMBERS"]], 
                dimnames[["member"]]))
        if (!is.null(exp)) {
            exp <- lapply(exp, function(x) {
                if (!("dimnames" %in% names(x))) {
                  x[["dimnames"]] <- dimnames
                  x
                }
                else {
                  dimnames2 <- dimnames
                  dimnames2[names(x[["dimnames"]])] <- x[["dimnames"]]
                  x[["dimnames"]] <- dimnames2
                  x
                }
            })
        }
        if (!is.null(obs)) {
            obs <- lapply(obs, function(x) {
                if (!("dimnames" %in% names(x))) {
                  x[["dimnames"]] <- dimnames
                  x
                }
                else {
                  dimnames2 <- dimnames
                  dimnames2[names(x[["dimnames"]])] <- x[["dimnames"]]
                  x[["dimnames"]] <- dimnames2
                  x
                }
            })
        }
        single_dataset <- (length(obs) + length(exp) == 1)
        replace_values[["VAR_NAME"]] <- var
        replace_values[["STORE_FREQ"]] <- storefreq
        latitudes <- longitudes <- NULL
        leadtimes <- NULL
        var_exp <- var_obs <- NULL
        units <- var_long_name <- NULL
        is_2d_var <- FALSE
        nmod <- length(exp)
        nobs <- length(obs)
        nsdates <- length(sdates)
        if (!silent) {
            cat("* Fetching first experimental files to work out 'var_exp' size...\n")
        }
        dataset_type <- "exp"
        dim_exp <- NULL
        filename <- file_found <- tmp <- nltime <- NULL
        dims2define <- TRUE
        is_file_per_member_exp <- rep(nmod, FALSE)
        exp_work_pieces <- list()
        jmod <- 1
        while (jmod <= nmod) {
            tags_to_find <- c("MEMBER_NUMBER")
            position_of_tags <- na.omit(match(tags_to_find, names(replace_values)))
            if (length(position_of_tags) > 0) {
                quasi_final_path <- .ConfigReplaceVariablesInString(exp[[jmod]][["path"]], 
                  replace_values[-position_of_tags], TRUE)
            }
            else {
                quasi_final_path <- .ConfigReplaceVariablesInString(exp[[jmod]][["path"]], 
                  replace_values, TRUE)
            }
            is_file_per_member_exp[jmod] <- grepl("$MEMBER_NUMBER$", 
                quasi_final_path, fixed = TRUE)
            replace_values[["EXP_NAME"]] <- exp[[jmod]][["name"]]
            replace_values[["NC_VAR_NAME"]] <- exp[[jmod]][["nc_var_name"]]
            namevar <- .ConfigReplaceVariablesInString(exp[[jmod]][["nc_var_name"]], 
                replace_values)
            replace_values[["SUFFIX"]] <- exp[[jmod]][["suffix"]]
            if (is.null(varmin)) {
                mod_var_min <- as.numeric(.ConfigReplaceVariablesInString(exp[[jmod]][["var_min"]], 
                  replace_values))
            }
            else {
                mod_var_min <- varmin
            }
            if (is.null(varmax)) {
                mod_var_max <- as.numeric(.ConfigReplaceVariablesInString(exp[[jmod]][["var_max"]], 
                  replace_values))
            }
            else {
                mod_var_max <- varmax
            }
            jsdate <- 1
            while (jsdate <= nsdates) {
                replace_values[["START_DATE"]] <- sdates[jsdate]
                replace_values[["YEAR"]] <- substr(sdates[jsdate], 
                  1, 4)
                replace_values[["MONTH"]] <- substr(sdates[jsdate], 
                  5, 6)
                replace_values[["DAY"]] <- substr(sdates[jsdate], 
                  7, 8)
                if (dims2define) {
                  if (is_file_per_member_exp[jmod]) {
                    replace_values[["MEMBER_NUMBER"]] <- "*"
                  }
                  work_piece <- list(dataset_type = dataset_type, 
                    filename = .ConfigReplaceVariablesInString(exp[[jmod]][["path"]], 
                      replace_values), namevar = namevar, grid = grid, 
                    remap = remap, remapcells = remapcells, is_file_per_member = is_file_per_member_exp[jmod], 
                    is_file_per_dataset = FALSE, lon_limits = c(lonmin, 
                      lonmax), lat_limits = c(latmin, latmax), 
                    dimnames = exp[[jmod]][["dimnames"]], single_dataset = single_dataset)
                  found_data <- .LoadDataFile(work_piece, explore_dims = TRUE, 
                    silent = silent)
                  found_dims <- found_data$dims
                  var_long_name <- found_data$var_long_name
                  units <- found_data$units
                  if (!is.null(found_dims)) {
                    is_2d_var <- found_data$is_2d_var
                    if (!is_2d_var && (output != "areave")) {
                      cat(paste("! Warning: '", output, "' output format not allowed when loading global mean variables. Forcing to 'areave'.\n", 
                        sep = ""))
                      output <- "areave"
                    }
                    if (output != "areave" && is.null(grid)) {
                      grid <- found_data$grid
                    }
                    if (is.null(nmember)) {
                      if (is.null(found_dims[["member"]])) {
                        cat("! Warning: loading data from a server but 'nmember' not specified. Loading only one member.\n")
                        nmember <- rep(1, nmod)
                      }
                      else {
                        nmember <- rep(found_dims[["member"]], 
                          nmod)
                      }
                    }
                    if (is.null(nleadtime)) {
                      nleadtime <- found_dims[["time"]]
                    }
                    if (is.null(leadtimemax)) {
                      leadtimemax <- nleadtime
                    }
                    else if (leadtimemax > nleadtime) {
                      stop("Error: 'leadtimemax' argument is greater than the number of loaded leadtimes. Put first the experiment with the greatest number of leadtimes or adjust properly the parameters 'nleadtime' and 'leadtimemax'.")
                    }
                    leadtimes <- seq(leadtimemin, leadtimemax, 
                      sampleperiod)
                    latitudes <- found_dims[["lat"]]
                    longitudes <- found_dims[["lon"]]
                    if (output == "lon" || output == "lonlat") {
                      dim_exp[["lon"]] <- length(longitudes)
                    }
                    if (output == "lat" || output == "lonlat") {
                      dim_exp[["lat"]] <- length(latitudes)
                    }
                    dim_exp[["time"]] <- length(leadtimes)
                    dim_exp[["member"]] <- max(nmember)
                    dim_exp[["sdate"]] <- nsdates
                    dim_exp[["dataset"]] <- nmod
                    dims2define <- FALSE
                  }
                }
                if (is_file_per_member_exp[jmod]) {
                  jmember <- 1
                  while (jmember <= nmember[jmod]) {
                    replace_values[["MEMBER_NUMBER"]] <- sprintf(paste("%.", 
                      (nmember[jmod]%/%10) + 1, "i", sep = ""), 
                      jmember - 1)
                    work_piece <- list(filename = .ConfigReplaceVariablesInString(exp[[jmod]][["path"]], 
                      replace_values), namevar = namevar, indices = c(1, 
                      jmember, jsdate, jmod), nmember = nmember[jmod], 
                      leadtimes = leadtimes, mask = maskmod[[jmod]], 
                      is_file_per_dataset = FALSE, dimnames = exp[[jmod]][["dimnames"]], 
                      var_limits = c(mod_var_min, mod_var_max), 
                      remapcells = remapcells)
                    exp_work_pieces <- c(exp_work_pieces, list(work_piece))
                    jmember <- jmember + 1
                  }
                }
                else {
                  work_piece <- list(filename = .ConfigReplaceVariablesInString(exp[[jmod]][["path"]], 
                    replace_values), namevar = namevar, indices = c(1, 
                    1, jsdate, jmod), nmember = nmember[jmod], 
                    leadtimes = leadtimes, mask = maskmod[[jmod]], 
                    is_file_per_dataset = FALSE, dimnames = exp[[jmod]][["dimnames"]], 
                    var_limits = c(mod_var_min, mod_var_max), 
                    remapcells = remapcells)
                  exp_work_pieces <- c(exp_work_pieces, list(work_piece))
                }
                jsdate <- jsdate + 1
            }
            jmod <- jmod + 1
        }
        if (dims2define && length(exp) > 0) {
            cat("! Warning: no data found in file system for any experimental dataset.\n")
        }
        dims <- dim_exp[na.omit(match(c("dataset", "member", 
            "sdate", "time", "lat", "lon"), names(dim_exp)))]
        if (is.null(dims[["member"]]) || any(is.na(unlist(dims))) || 
            any(unlist(dims) == 0)) {
            dims <- 0
            dim_exp <- NULL
        }
        if (!silent) {
            message <- "* Success. Detected dimensions of experimental data: "
            cat(paste0(message, paste(unlist(dims), collapse = ", "), 
                "\n"))
            cat("* Fetching first observational files to work out 'var_obs' size...\n")
        }
        if (is.null(exp) || dims == 0) {
            if (is.null(leadtimemax)) {
                cat("! Warning: loading observations only and no 'leadtimemax' specified. Data will be loaded from each starting date to current time.\n")
                diff <- Sys.time() - as.POSIXct(paste(substr(sdates[1], 
                  1, 4), "-", substr(sdates[1], 5, 6), "-", substr(sdates[1], 
                  7, 8), sep = ""))
                if (storefreq == "monthly") {
                  leadtimemax <- as.integer(diff/30)
                }
                else {
                  leadtimemax <- as.integer(diff)
                }
            }
            if (is.null(nleadtime)) {
                nleadtime <- leadtimemax
            }
            leadtimes <- seq(leadtimemin, leadtimemax, sampleperiod)
        }
        dataset_type <- "obs"
        dim_obs <- NULL
        dims2define <- TRUE
        lat_indices <- lon_indices <- NULL
        obs_work_pieces <- list()
        is_file_per_dataset_obs <- rep(FALSE, nobs)
        is_file_per_member_obs <- rep(FALSE, nobs)
        jobs <- 1
        while (jobs <= nobs) {
            tags_to_find <- c("MONTH", "DAY", "YEAR", "MEMBER_NUMBER")
            position_of_tags <- na.omit(match(tags_to_find, names(replace_values)))
            if (length(position_of_tags) > 0) {
                quasi_final_path <- .ConfigReplaceVariablesInString(obs[[jobs]][["path"]], 
                  replace_values[-position_of_tags], TRUE)
            }
            else {
                quasi_final_path <- .ConfigReplaceVariablesInString(obs[[jobs]][["path"]], 
                  replace_values, TRUE)
            }
            is_file_per_dataset_obs[jobs] <- !any(sapply(c("$MONTH$", 
                "$DAY$", "$YEAR$"), grepl, quasi_final_path, 
                fixed = TRUE))
            is_file_per_member_obs[jobs] <- grepl("$MEMBER_NUMBER$", 
                quasi_final_path, fixed = TRUE)
            replace_values[["OBS_NAME"]] <- obs[[jobs]][["name"]]
            replace_values[["NC_VAR_NAME"]] <- obs[[jobs]][["nc_var_name"]]
            namevar <- .ConfigReplaceVariablesInString(obs[[jobs]][["nc_var_name"]], 
                replace_values)
            replace_values[["SUFFIX"]] <- obs[[jobs]][["suffix"]]
            if (is.null(varmin)) {
                obs_var_min <- as.numeric(.ConfigReplaceVariablesInString(obs[[jobs]][["var_min"]], 
                  replace_values))
            }
            else {
                obs_var_min <- varmin
            }
            if (is.null(varmax)) {
                obs_var_max <- as.numeric(.ConfigReplaceVariablesInString(obs[[jobs]][["var_max"]], 
                  replace_values))
            }
            else {
                obs_var_max <- varmax
            }
            if (is_file_per_dataset_obs[jobs]) {
                if (dims2define) {
                  work_piece <- list(dataset_type = dataset_type, 
                    filename = .ConfigReplaceVariablesInString(obs[[jobs]][["path"]], 
                      replace_values), namevar = namevar, grid = grid, 
                    remap = remap, remapcells = remapcells, is_file_per_member = is_file_per_member_obs[jobs], 
                    is_file_per_dataset = is_file_per_dataset_obs[jobs], 
                    lon_limits = c(lonmin, lonmax), lat_limits = c(latmin, 
                      latmax), dimnames = obs[[jobs]][["dimnames"]], 
                    single_dataset = single_dataset)
                  found_data <- .LoadDataFile(work_piece, explore_dims = TRUE, 
                    silent = silent)
                  found_dims <- found_data$dims
                  var_long_name <- found_data$var_long_name
                  units <- found_data$units
                  if (!is.null(found_dims)) {
                    is_2d_var <- found_data$is_2d_var
                    if (!is_2d_var && (output != "areave")) {
                      cat(paste("! Warning: '", output, "' output format not allowed when loading global mean variables. Forcing to 'areave'.\n", 
                        sep = ""))
                      output <- "areave"
                    }
                    if (output != "areave" && is.null(grid)) {
                      grid <- found_data$grid
                    }
                    if (is.null(nmemberobs)) {
                      if (is.null(found_dims[["member"]])) {
                        cat("! Warning: loading observational data from a server but 'nmemberobs' not specified. Loading only one member.\n")
                        nmemberobs <- rep(1, nobs)
                      }
                      else {
                        nmemberobs <- rep(found_dims[["member"]], 
                          nobs)
                      }
                    }
                    if (is.null(dim_exp)) {
                      longitudes <- found_dims[["lon"]]
                      latitudes <- found_dims[["lat"]]
                    }
                    if (output == "lon" || output == "lonlat") {
                      dim_obs[["lon"]] <- length(longitudes)
                    }
                    if (output == "lat" || output == "lonlat") {
                      dim_obs[["lat"]] <- length(latitudes)
                    }
                    dim_obs[["time"]] <- length(leadtimes)
                    dim_obs[["member"]] <- max(nmemberobs)
                    dim_obs[["sdate"]] <- nsdates
                    dim_obs[["dataset"]] <- nobs
                    dims2define <- FALSE
                  }
                }
                work_piece <- list(filename = .ConfigReplaceVariablesInString(obs[[jobs]][["path"]], 
                  replace_values), namevar = namevar, indices = c(1, 
                  1, 1, jobs), nmember = nmemberobs[jobs], mask = maskobs[[jobs]], 
                  leadtimes = leadtimes, is_file_per_dataset = is_file_per_dataset_obs[jobs], 
                  startdates = sdates, dimnames = obs[[jobs]][["dimnames"]], 
                  var_limits = c(obs_var_min, obs_var_max), remapcells = remapcells)
                obs_work_pieces <- c(obs_work_pieces, list(work_piece))
            }
            else {
                jsdate <- 1
                while (jsdate <= nsdates) {
                  replace_values[["START_DATE"]] <- sdates[jsdate]
                  sdate <- sdates[jsdate]
                  if (storefreq == "daily") {
                    day <- substr(sdate, 7, 8)
                    if (day == "") {
                      day <- "01"
                    }
                    day <- as.integer(day)
                    startdate <- as.POSIXct(paste(substr(sdate, 
                      1, 4), "-", substr(sdate, 5, 6), "-", day, 
                      " 12:00:00", sep = "")) + (leadtimemin - 
                      1) * 86400
                    year <- as.integer(substr(startdate, 1, 4))
                    month <- as.integer(substr(startdate, 6, 
                      7))
                  }
                  else {
                    month <- (as.integer(substr(sdate, 5, 6)) + 
                      leadtimemin - 2)%%12 + 1
                    year <- as.integer(substr(sdate, 1, 4)) + 
                      (as.integer(substr(sdate, 5, 6)) + leadtimemin - 
                        2)%/%12
                  }
                  jleadtime <- 1
                  while (jleadtime <= length(leadtimes)) {
                    replace_values[["YEAR"]] <- paste(year, "", 
                      sep = "")
                    replace_values[["MONTH"]] <- sprintf("%2.2i", 
                      month)
                    if (storefreq == "daily") {
                      replace_values[["DAY"]] <- sprintf("%2.2i", 
                        day)
                      days_in_month <- ifelse(LeapYear(year), 
                        29, 28)
                      days_in_month <- switch(paste(month, "", 
                        sep = ""), `1` = 31, `3` = 31, `4` = 30, 
                        `5` = 31, `6` = 30, `7` = 31, `8` = 31, 
                        `9` = 30, `10` = 31, `11` = 30, `12` = 31, 
                        days_in_month)
                      obs_file_indices <- seq(day, min(days_in_month, 
                        (length(leadtimes) - jleadtime) * sampleperiod + 
                          day), sampleperiod)
                    }
                    else {
                      obs_file_indices <- 1
                    }
                    if (dims2define) {
                      if (is_file_per_member_obs[jobs]) {
                        replace_values[["MEMBER_NUMBER"]] <- "*"
                      }
                      work_piece <- list(dataset_type = dataset_type, 
                        filename = .ConfigReplaceVariablesInString(obs[[jobs]][["path"]], 
                          replace_values), namevar = namevar, 
                        grid = grid, remap = remap, remapcells = remapcells, 
                        is_file_per_member = is_file_per_member_obs[jobs], 
                        is_file_per_dataset = is_file_per_dataset_obs[jobs], 
                        lon_limits = c(lonmin, lonmax), lat_limits = c(latmin, 
                          latmax), dimnames = obs[[jobs]][["dimnames"]], 
                        single_dataset = single_dataset)
                      found_data <- .LoadDataFile(work_piece, 
                        explore_dims = TRUE, silent = silent)
                      found_dims <- found_data$dims
                      var_long_name <- found_data$var_long_name
                      units <- found_data$units
                      if (!is.null(found_dims)) {
                        is_2d_var <- found_data$is_2d_var
                        if (!is_2d_var && (output != "areave")) {
                          cat(paste("! Warning: '", output, "' output format not allowed when loading global mean variables. Forcing to 'areave'\n.", 
                            sep = ""))
                          output <- "areave"
                        }
                        if (output != "areave" && is.null(grid)) {
                          grid <- found_data$grid
                        }
                        if (is.null(nmemberobs)) {
                          if (is.null(found_dims[["member"]])) {
                            cat("! Warning: loading observational data from a server but 'nmemberobs' not specified. Loading only one member.\n")
                            nmemberobs <- rep(1, nobs)
                          }
                          else {
                            nmemberobs <- rep(found_dims[["member"]], 
                              nobs)
                          }
                        }
                        if (is.null(dim_exp)) {
                          longitudes <- found_dims[["lon"]]
                          latitudes <- found_dims[["lat"]]
                        }
                        if (output == "lon" || output == "lonlat") {
                          dim_obs[["lon"]] <- length(longitudes)
                        }
                        if (output == "lat" || output == "lonlat") {
                          dim_obs[["lat"]] <- length(latitudes)
                        }
                        dim_obs[["time"]] <- length(leadtimes)
                        dim_obs[["member"]] <- max(nmemberobs)
                        dim_obs[["sdate"]] <- nsdates
                        dim_obs[["dataset"]] <- nobs
                        dims2define <- FALSE
                      }
                    }
                    if (is_file_per_member_obs[jobs]) {
                      jmember <- 1
                      while (jmember <= nmemberobs[jobs]) {
                        replace_values[["MEMBER_NUMBER"]] <- sprintf(paste("%.", 
                          (nmemberobs[jobs]%/%10) + 1, "i", sep = ""), 
                          jmember - 1)
                        work_piece <- list(filename = .ConfigReplaceVariablesInString(obs[[jobs]][["path"]], 
                          replace_values), namevar = namevar, 
                          indices = c(jleadtime, jmember, jsdate, 
                            jobs), nmember = nmemberobs[jobs], 
                          leadtimes = obs_file_indices, mask = maskobs[[jobs]], 
                          dimnames = obs[[jobs]][["dimnames"]], 
                          is_file_per_dataset = is_file_per_dataset_obs[jobs], 
                          var_limits = c(obs_var_min, obs_var_max), 
                          remapcells = remapcells)
                        obs_work_pieces <- c(obs_work_pieces, 
                          list(work_piece))
                        jmember <- jmember + 1
                      }
                    }
                    else {
                      work_piece <- list(filename = .ConfigReplaceVariablesInString(obs[[jobs]][["path"]], 
                        replace_values), namevar = namevar, indices = c(jleadtime, 
                        1, jsdate, jobs), nmember = nmemberobs[jobs], 
                        leadtimes = obs_file_indices, mask = maskobs[[jobs]], 
                        dimnames = obs[[jobs]][["dimnames"]], 
                        is_file_per_dataset = is_file_per_dataset_obs[jobs], 
                        var_limits = c(obs_var_min, obs_var_max), 
                        remapcells)
                      obs_work_pieces <- c(obs_work_pieces, list(work_piece))
                    }
                    if (storefreq == "daily") {
                      startdate <- startdate + 86400 * sampleperiod * 
                        length(obs_file_indices)
                      year <- as.integer(substr(startdate, 1, 
                        4))
                      month <- as.integer(substr(startdate, 6, 
                        7))
                      day <- as.integer(substr(startdate, 9, 
                        10))
                    }
                    else {
                      month <- month + sampleperiod
                      year <- year + (month - 1)%/%12
                      month <- (month - 1)%%12 + 1
                    }
                    jleadtime <- jleadtime + length(obs_file_indices)
                  }
                  jsdate <- jsdate + 1
                }
            }
            jobs <- jobs + 1
        }
        if (dims2define && length(obs) > 0) {
            cat("! Warning: no data found in file system for any observational dataset.\n")
        }
        dims <- dim_obs[na.omit(match(c("dataset", "member", 
            "sdate", "time", "lat", "lon"), names(dim_obs)))]
        if (is.null(dims[["member"]]) || any(is.na(unlist(dims))) || 
            any(unlist(dims) == 0)) {
            dims <- 0
            dim_obs <- NULL
        }
        if (!silent) {
            message <- "* Success. Detected dimensions of observational data: "
            cat(paste0(message, paste(unlist(dims), collapse = ", "), 
                "\n"))
        }
        if (!(is.null(dim_obs) && is.null(dim_exp))) {
            pointer_var_exp <- pointer_var_obs <- NULL
            if (!is.null(dim_exp) && (length(unlist(dim_exp)) == 
                length(dim_exp)) && !any(is.na(unlist(dim_exp))) && 
                !any(unlist(dim_exp) == 0)) {
                var_exp <- big.matrix(nrow = prod(unlist(dim_exp)), 
                  ncol = 1)
                pointer_var_exp <- describe(var_exp)
            }
            if (!is.null(dim_obs) && (length(unlist(dim_obs)) == 
                length(dim_obs)) && !any(is.na(unlist(dim_obs))) && 
                !any(unlist(dim_obs) == 0)) {
                var_obs <- big.matrix(nrow = prod(unlist(dim_obs)), 
                  ncol = 1)
                pointer_var_obs <- describe(var_obs)
            }
            if (is.null(nprocs)) {
                nprocs <- detectCores()
            }
            exp_work_piece_percent <- prod(dim_exp)/(prod(dim_obs) + 
                prod(dim_exp))
            obs_work_piece_percent <- prod(dim_obs)/(prod(dim_obs) + 
                prod(dim_exp))
            exp_work_pieces <- lapply(exp_work_pieces, function(x) c(x, 
                list(dataset_type = "exp", dims = dim_exp, out_pointer = pointer_var_exp)))
            obs_work_pieces <- lapply(obs_work_pieces, function(x) c(x, 
                list(dataset_type = "obs", dims = dim_obs, out_pointer = pointer_var_obs)))
            work_pieces <- c(exp_work_pieces, obs_work_pieces)
            if (length(work_pieces)/nprocs >= 2 && !silent) {
                if (length(work_pieces)/nprocs < 10) {
                  amount <- 100/ceiling(length(work_pieces)/nprocs)
                  reps <- ceiling(length(work_pieces)/nprocs)
                }
                else {
                  amount <- 10
                  reps <- 10
                }
                progress_steps <- rep(amount, reps)
                if (length(exp_work_pieces) == 0) {
                  selected_exp_pieces <- c()
                }
                else if (length(exp_work_pieces) < floor(reps * 
                  exp_work_piece_percent) + 1) {
                  selected_exp_pieces <- length(exp_work_pieces)
                  progress_steps <- c(sum(head(progress_steps, 
                    floor(reps * exp_work_piece_percent))), tail(progress_steps, 
                    ceiling(reps * obs_work_piece_percent)))
                }
                else {
                  selected_exp_pieces <- round(seq(1, length(exp_work_pieces), 
                    length.out = floor(reps * exp_work_piece_percent) + 
                      1))[-1]
                }
                if (length(obs_work_pieces) == 0) {
                  selected_obs_pieces <- c()
                }
                else if (length(obs_work_pieces) < ceiling(reps * 
                  obs_work_piece_percent) + 1) {
                  selected_obs_pieces <- length(obs_work_pieces)
                  progress_steps <- c(head(progress_steps, floor(reps * 
                    exp_work_piece_percent)), sum(tail(progress_steps, 
                    ceiling(reps * obs_work_piece_percent))))
                }
                else {
                  selected_obs_pieces <- round(seq(1, length(obs_work_pieces), 
                    length.out = ceiling(reps * obs_work_piece_percent) + 
                      1))[-1]
                }
                selected_pieces <- c(selected_exp_pieces, selected_obs_pieces + 
                  length(exp_work_pieces))
                progress_steps <- paste0(" + ", round(progress_steps, 
                  2), "%")
                progress_message <- "* Progress: 0%"
            }
            else {
                progress_message <- ""
                selected_pieces <- NULL
            }
            piece_counter <- 1
            step_counter <- 1
            work_pieces <- lapply(work_pieces, function(x) {
                wp <- c(x, list(is_2d_var = is_2d_var, grid = grid, 
                  remap = remap, lon_limits = c(lonmin, lonmax), 
                  lat_limits = c(latmin, latmax), output = output, 
                  remapcells = remapcells, single_dataset = single_dataset))
                if (piece_counter %in% selected_pieces) {
                  wp <- c(wp, list(progress_amount = progress_steps[step_counter]))
                  step_counter <<- step_counter + 1
                }
                piece_counter <<- piece_counter + 1
                wp
            })
            if (!silent) {
                cat(paste("* Will now proceed to read and process ", 
                  length(work_pieces), " data files:\n", sep = ""))
                if (length(work_pieces) < 30) {
                  lapply(work_pieces, function(x) cat(paste("*   ", 
                    x[["filename"]], "\n", sep = "")))
                }
                else {
                  cat(paste("*   The list of files is long. You can check it after Load() finishes in the output '$source_files'.\n"))
                }
                if (length(dim_obs) == 0) {
                  bytes_obs <- 0
                  obs_dim_sizes <- "0"
                }
                else {
                  bytes_obs <- prod(c(dim_obs, 8))
                  obs_dim_sizes <- paste(na.omit(as.vector(dim_obs[c("dataset", 
                    "member", "sdate", "time", "lat", "lon")])), 
                    collapse = " x ")
                }
                if (length(dim_exp) == 0) {
                  bytes_exp <- 0
                  exp_dim_sizes <- "0"
                }
                else {
                  bytes_exp <- prod(c(dim_exp, 8))
                  exp_dim_sizes <- paste(na.omit(as.vector(dim_exp[c("dataset", 
                    "member", "sdate", "time", "lat", "lon")])), 
                    collapse = " x ")
                }
                cat(paste("* Total size of requested data: ", 
                  bytes_obs + bytes_exp, "bytes.\n"))
                cat(paste("*   - Experimental data:  (", exp_dim_sizes, 
                  ") x 8 bytes =", bytes_exp, "bytes.\n"))
                cat(paste("*   - Observational data: (", obs_dim_sizes, 
                  ") x 8 bytes =", bytes_obs, "bytes.\n"))
                cat(paste("* If size of requested data is close to or above the free shared RAM memory, R will crash.\n"))
            }
            if (nprocs == 1) {
                found_files <- lapply(work_pieces, .LoadDataFile, 
                  silent = silent)
            }
            else {
                cluster <- makeCluster(nprocs, outfile = "")
                if (!silent) {
                  cat(paste("* Loading... This may take several minutes...\n", 
                    sep = ""))
                  cat(progress_message)
                }
                work_errors <- try({
                  found_files <- clusterApplyLB(cluster, work_pieces, 
                    .LoadDataFile, silent = silent)
                })
                stopCluster(cluster)
            }
            if (!silent) {
                if (progress_message != "") {
                  cat("\n")
                }
                if (any(unlist(lapply(found_files, is.null)))) {
                  if (sum(unlist(lapply(found_files, is.null))) < 
                    30) {
                    cat("! WARNING: The following files were not found in the file system. Filling with NA values instead.\n")
                    lapply(work_pieces[which(unlist(lapply(found_files, 
                      is.null)))], function(x) cat(paste("*   ", 
                      x[["filename"]], "\n", sep = "")))
                  }
                  else {
                    cat("! WARNING: Some files were not found in the file system. The list is long. You can check it in the output '$not_found_files'. Filling with NA values instead.\n")
                  }
                }
            }
            source_files <- unlist(found_files[which(!unlist(lapply(found_files, 
                is.null)))])
            not_found_files <- unlist(lapply(work_pieces[which(unlist(lapply(found_files, 
                is.null)))], "[[", "filename"))
        }
        else {
            error_message <- "Error: No found files for any dataset. Check carefully the file patterns and correct either the pattern or the provided parameters:\n"
            if (!is.null(exp)) {
                lapply(exp, function(x) error_message <<- paste0(error_message, 
                  paste0(x[["path"]], "\n")))
            }
            if (!is.null(obs)) {
                lapply(obs, function(x) error_message <<- paste0(error_message, 
                  paste0(x[["path"]], "\n")))
            }
            stop(error_message)
        }
    })
    if (class(errors) == "try-error") {
        invisible(list(load_parameters = load_parameters))
    }
    else {
        variable <- list()
        variable[["varName"]] <- var
        variable[["level"]] <- NULL
        attr(variable, "is_standard") <- FALSE
        attr(variable, "units") <- units
        attr(variable, "longname") <- var_long_name
        attr(variable, "daily_agg_cellfun") <- "none"
        attr(variable, "monthly_agg_cellfun") <- "none"
        attr(variable, "verification_time") <- "none"
        if (is.null(var_exp)) {
            mod_data <- NULL
        }
        else {
            dim_reorder <- length(dim_exp):1
            dim_reorder[2:3] <- dim_reorder[3:2]
            old_dims <- dim_exp
            dim_exp <- dim_exp[dim_reorder]
            mod_data <- aperm(array(bigmemory::as.matrix(var_exp), 
                dim = old_dims), dim_reorder)
            attr(mod_data, "dimensions") <- names(dim_exp)
        }
        if (is.null(var_obs)) {
            obs_data <- NULL
        }
        else {
            dim_reorder <- length(dim_obs):1
            dim_reorder[2:3] <- dim_reorder[3:2]
            old_dims <- dim_obs
            dim_obs <- dim_obs[dim_reorder]
            obs_data <- aperm(array(bigmemory::as.matrix(var_obs), 
                dim = old_dims), dim_reorder)
            attr(obs_data, "dimensions") <- names(dim_obs)
        }
        if (is.null(latitudes)) {
            lat <- 0
            attr(lat, "cdo_grid_name") <- "none"
        }
        else {
            lat <- latitudes
            attr(lat, "cdo_grid_name") <- if (is.null(grid)) 
                "none"
            else grid
        }
        attr(lat, "projection") <- "none"
        if (is.null(longitudes)) {
            lon <- 0
            attr(lon, "cdo_grid_name") <- "none"
        }
        else {
            lon <- longitudes
            attr(lon, "cdo_grid_name") <- if (is.null(grid)) 
                "none"
            else grid
        }
        attr(lon, "projection") <- "none"
        dates <- list()
        dates[["start"]] <- NULL
        dates[["end"]] <- NULL
        models <- NULL
        if (length(exp) > 0 && !is.null(dim_exp)) {
            models <- list()
            for (jmod in 1:length(exp)) {
                models[[exp[[jmod]][["name"]]]] <- list(members = paste0("Member_", 
                  1:nmember[jmod]), source = if ((nchar(exp[[jmod]][["path"]]) - 
                  nchar(gsub("/", "", exp[[jmod]][["path"]])) > 
                  2) && (length(sdates) > 1 && !is_file_per_member_exp[jmod])) {
                  parts <- strsplit(exp[[jmod]][["path"]], "/")[[1]]
                  paste(parts[-length(parts)], sep = "", collapse = "/")
                } else {
                  exp[[jmod]][["path"]]
                })
            }
        }
        observations <- NULL
        if (length(obs) > 0 && !is.null(dim_obs)) {
            observations <- list()
            for (jobs in 1:length(obs)) {
                observations[[obs[[jobs]][["name"]]]] <- list(members = paste0("Member_", 
                  1:nmemberobs[jobs]), source = if ((nchar(obs[[jobs]][["path"]]) - 
                  nchar(gsub("/", "", obs[[jobs]][["path"]])) > 
                  2) && !is_file_per_dataset_obs[jobs]) {
                  parts <- strsplit(obs[[jobs]][["path"]], "/")[[1]]
                  paste(parts[-length(parts)], sep = "", collapse = "/")
                } else {
                  obs[[jobs]][["path"]]
                })
            }
        }
        invisible(list(mod = mod_data, obs = obs_data, lon = lon, 
            lat = lat, Variable = variable, Datasets = list(exp = models, 
                obs = observations), Dates = dates, InitializationDates = lapply(sdates, 
                function(x) {
                  sink("/dev/null")
                  date <- print(as.POSIXct(as.Date(x, format = "%Y%m%d")))
                  sink()
                  date
                }), when = Sys.time(), source_files = source_files, 
            not_found_files = not_found_files, load_parameters = load_parameters))
    }
}

mergePDF <- function(..., file, gsversion = NULL, in.file = NULL) {
    if (is.null(in.file)) {
      in.file <- substitute(...())
    } 
    infiles <- paste(unlist(lapply(in.file, function(y) as.character(y))), 
        collapse = " ")
    if (is.null(gsversion)) {
      gsversion <- names(which(Sys.which(c("gs", "gswin32c", "gswin64c")) != ""))
      if (length(gsversion) == 0) 
        stop("Please install Ghostscript and ensure it is in your PATH")
      if (length(gsversion) > 1)
        stop("More than one Ghostscript executable was found:", 
             paste(gsversion, collapse = " "), 
             ". Please specify which version should be used with the gsversion argument")
    }   
    pre = " -dBATCH -dNOPAUSE -q -sDEVICE=pdfwrite -sOutputFile="
    system(paste(paste(gsversion, pre, file, sep = ""), infiles, collapse = " "))
}
