CFU_PCA<-function(data, cl = 0.98, ofiles = FALSE) {
#
# Computes a Principal Component Analysis (PCA/EOF) of data.
#
# Description:
#
#      Returns an array of EOFs, an array of PCs, a vector of FVARs (fractions of explained variance), 
#      an array of CORRs (correlation maps), and the threshold for the correlation coefficient based 
#      on a two-tailed Student's t-test.
#      If applied, also returns ascii files for PCs and FVARs.
#
# Usage:
#
#      CFU_PCA(data, sl = 0.98, ofiles = FALSE)
#
# Arguments:
#
#   data:     Array containing the anomalies field for the analysis 
#
#   cl:       Value of the confidence level for the correlation map.
#             It is based on a two-tailed Student's t-test.
#             Default is cl=0.98 (98% confidence level; 2% significance level).
#
#   ofiles:   Logical. 
#
# Output:
#
#   $PCs:    Array of principal components (nt, nm)
#   $FVARs:  Vector of fractions of explained variance (nm)
#   $EOFs:   Array of empirical orthogonal functions (c(dim), nm) 
#   $CORRs:  Array of correlation maps associated with EOFs (c(dim), nm) 
#   $Rtest:  Value of the statistically significant corr.coefficient at cl
#
# Author:
#
#      Javier Garcia-Serrano <jgarcia@ic3.cat> 17 September 2010
#      Modified by jgarcia@ic3.cat (29 August 2011): The calculation is now done by a 
#      singular value decomposition of the data matrix (prcomp), not by using 'eigen'
#      on the covariance matrix (princomp).   
#

 
d=dim(data)
if (length(d) == 3){
    nlon=d[1]; nlat=d[2]; ns=nlon*nlat; nt=d[3]   
} else {
    nlon=1; nlat=d[1]; ns=nlon*nlat; nt=d[2]
}

M=array(dim=c(ns,nt))
for (i in 1:nlat){
    M[(nlon*(i-1)+1):(nlon*(i-1)+nlon),]=data[,i,]
}
not=is.na(M[,1])
yes=array(dim=c(ns))
counter=0
for (i in 1:ns){
    if (not[i]=='FALSE'){counter=counter+1; yes[counter]=i}
}
yes=yes[1:counter]
Myes=M[yes,]          #(ns_with_data,nt)

#covariance matrix

#covM=(Myes%*%t(Myes))/(nt-1) 

#PCA analysis

#PCA=princomp(covmat=covM)
PCA=prcomp(t(Myes))

#outputs

nm=10                  #number of modes to be retained (aprox 80% of FVAR)

std=PCA$sdev
lambda=std*std; fvar=lambda/sum(lambda)
fvar=round(fvar,digits=4); fvar=fvar[1:nm]*100

#U=PCA$loadings   #(ns_with_data,ns_with_data)
U=PCA$rotation
Un=U[,1:nm]

PC=t(Myes)%*%Un       #(nt,nm)
PCstd=array(dim=c(nt,nm))
for (i in 1:nm){
    S=sd(PC[,i]); PCstd[,i]=PC[,i]/S
}

EOFyes=(Myes%*%PCstd)/nt #(ns_with_data,nm)
eof=array(dim=c(ns,nm))
eof[yes,]=EOFyes
EOF=array(dim=c(nlon,nlat,nm))
for (i in 1:nlat){
    EOF[,i,]=eof[(nlon*(i-1)+1):(nlon*(i-1)+nlon),]
}

CORRyes=array(dim=c(counter,nm))
for (i in 1:nm){
    for (j in 1:counter){
        CORRyes[j,i]=cor(Myes[j,],PCstd[,i])
    }
}
corr=array(dim=c(ns,nm))
corr[yes,]=CORRyes
CORR=array(dim=c(nlon,nlat,nm))
for (i in 1:nlat){
    CORR[,i,]=corr[(nlon*(i-1)+1):(nlon*(i-1)+nlon),]
}

#t-Test

cl=cl; cl2=(1-cl)/2
t=qt(cl+cl2, nt-2); R=sqrt((t*t)/((t*t)+nt-2))

#options

#if(ofiles) {
#    save(PCstd, ascii=TRUE, file="$plotsdir/PCs_of_data.dat")
#    save(fvar, ascii=TRUE, file="$plotsdir/FVARs_of_data.dat")
#}

invisible(list(PCs=PCstd,FVARs=fvar,EOFs=EOF,CORRs=CORR,Rtest=R))

}


CFU_MCA<-function(datax, datay, cl = 0.98, ofiles = FALSE) {
#
# Computes a Maximum Covariance Analysis (MCA) between datax and datay.
#
# Description:
#
#      Returns a vector of squared covariance fraction (SCFs) explained by each pair of
#      covariability modes, a vector of correlation coefficient (RUVs) between expansion 
#      coefficients (ECs) that measures their linear relationship, and a set of regression (MCAs)
#      and correlation (CORRs) maps associated with the covariability modes. Note that both, 
#      MCAs and CORRs, are 'homogeneous' patterns obtained as regression/correlation between
#      each field (predictor, predictand) and its expansion coefficient. 
#      The threshold for the correlation coefficient, based on a two-tailed Student's t-test, 
#      is also produced.
#      If applied, also returns ascii files for SCFs, RUVs, and ECs.
#
# Usage:
#
#      CFU_MCA(datax, datay, sl = 0.98, ofiles = FALSE)
#
# Arguments:
#
#   datax:    Array containing the anomalies field for the predictor 
#
#   datay:    Array containing the anomalies field for the predictand 
#
#   cl:       Value of the confidence level for the correlation map.
#             It is based on a two-tailed Student's t-test.
#             Default is cl=0.98 (98% confidence level; 2% significance level).
#
#   ofiles:   Logical. 
#
# Output:
#
#   $SCFs:   Vector of squared covariance fractions (nm)
#   $RUVs:   Vector of correlations between expansion coefficients (nm)
#   $ECs_U:  Array of expansion coefficients of predictor field (nt, nm) 
#   $MCAs_U: Array of covariability patterns of predictor field (c(dim), nm) 
#   $CORRs_U:Array of corr. maps associated with predictor field (c(dim), nm) 
#   $ECs_V:  Array of expansion coefficients of predictand field (nt, nm) 
#   $MCAs_V: Array of covariability patterns of predictand field (c(dim), nm) 
#   $CORRs_V:Array of corr. maps associated with predictand field (c(dim), nm) 
#   $Rtest:  Value of the statitically significant corr. coefficient at cl
#
# Author:
#
#      Javier Garcia-Serrano <jgarcia@ic3.cat> 24 September 2010
#

 
dx=dim(datax)
if (length(dx) == 3){
    nlonx=dx[1]; nlatx=dx[2]; nsx=nlonx*nlatx; nt=dx[3]   
} else {
    nlonx=1; nlatx=dx[1]; nsx=nlonx*nlatx; nt=dx[2]
}

X=array(dim=c(nsx,nt))
for (i in 1:nlatx){
    X[(nlonx*(i-1)+1):(nlonx*(i-1)+nlonx),]=datax[,i,]
}
not=is.na(X[,1])
yesx=array(dim=c(nsx))
counterx=0
for (i in 1:nsx){
    if (not[i]=='FALSE'){counterx=counterx+1; yesx[counterx]=i}
}
yesx=yesx[1:counterx]
Xyes=X[yesx,]          #(nsx_with_data,nt)

dy=dim(datay)
if (length(dy) == 3){
    nlony=dy[1]; nlaty=dy[2]; nsy=nlony*nlaty; nt=dy[3]   
} else {
    nlony=1; nlaty=dy[1]; nsy=nlony*nlaty; nt=dy[2]
}

Y=array(dim=c(nsy,nt))
for (i in 1:nlaty){
    Y[(nlony*(i-1)+1):(nlony*(i-1)+nlony),]=datay[,i,]
}
not=is.na(Y[,1])
yesy=array(dim=c(nsy))
countery=0
for (i in 1:nsy){
    if (not[i]=='FALSE'){countery=countery+1; yesy[countery]=i}
}
yesy=yesy[1:countery]
Yyes=Y[yesy,]          #(nsy_with_data,nt)

#covariance matrix

covXY=(Xyes%*%t(Yyes))/(nt-1) 

#MCA analysis

MCA=svd(covXY)

#outputs

nm=10                  #number of modes to be retained

SV=MCA$d               #singular values
SV2=SV*SV; S=sum(SV2)
SCF=SV2/S              #squared covariance fraction
SCF=SCF[1:nm]*100

Ux=MCA$u
Vy=MCA$v
Un=Ux[,1:nm]; Vn=Vy[,1:nm]
ECu=t(Xyes)%*%Un; ECv=t(Yyes)%*%Vn   #(nt,nm)
ECu_std=array(dim=c(nt,nm))
ECv_std=array(dim=c(nt,nm))
for (i in 1:nm){
    Su=sd(ECu[,i]); ECu_std[,i]=ECu[,i]/Su
    Sv=sd(ECv[,i]); ECv_std[,i]=ECv[,i]/Sv
}

RUV=array(dim=c(1,nm))
for (i in 1:nm){
    RUV[i]=cor(ECu_std[,i],ECv_std[,i])
}

Uyes=(Xyes%*%ECu_std)/nt            #(ns_with_data,nm)
Vyes=(Yyes%*%ECv_std)/nt
mcaU=array(dim=c(nsx,nm)); mcaU[yesx,]=Uyes
mcaV=array(dim=c(nsy,nm)); mcaV[yesy,]=Vyes
MCAU=array(dim=c(nlonx,nlatx,nm))
MCAV=array(dim=c(nlony,nlaty,nm))
for (i in 1:nlatx){
    MCAU[,i,]=mcaU[(nlonx*(i-1)+1):(nlonx*(i-1)+nlonx),]
}
for (i in 1:nlaty){
    MCAV[,i,]=mcaV[(nlony*(i-1)+1):(nlony*(i-1)+nlony),]
}

CORRUyes=array(dim=c(counterx,nm))
CORRVyes=array(dim=c(countery,nm))
for (i in 1:nm){
    for (j in 1:counterx){
        CORRUyes[j,i]=cor(Xyes[j,],ECu_std[,i])
    }
    for (j in 1:countery){
        CORRVyes[j,i]=cor(Yyes[j,],ECv_std[,i])
    }
}
corrU=array(dim=c(nsx,nm)); corrU[yesx,]=CORRUyes
corrV=array(dim=c(nsy,nm)); corrV[yesy,]=CORRVyes
CORRU=array(dim=c(nlonx,nlatx,nm))
CORRV=array(dim=c(nlony,nlaty,nm))
for (i in 1:nlatx){
    CORRU[,i,]=corrU[(nlonx*(i-1)+1):(nlonx*(i-1)+nlonx),]
}
for (i in 1:nlaty){
    CORRV[,i,]=corrV[(nlony*(i-1)+1):(nlony*(i-1)+nlony),]
}

#t-Test

cl=cl; cl2=(1-cl)/2
t=qt(cl+cl2, nt-2); R=sqrt((t*t)/((t*t)+nt-2))

#options

#if(ofiles) {
#    save(SCF, ascii=TRUE, file="$plotsdir/SCFs_of_data.dat")
#    save(RUV, ascii=TRUE, file="$plotsdir/RUVs_of_data.dat")
#    save(ECu_std, ascii=TRUE, file="$plotsdir/ECsU_of_data.dat")
#    save(ECv_std, ascii=TRUE, file="$plotsdir/ECsV_of_data.dat")
#}

invisible(list(SCFs=SCF,RUVs=RUV,ECs_U=ECu_std,MCAs_U=MCAU,CORRs_U=CORRU,ECs_V=ECv_std,MCAs_V=MCAV,CORRs_V=CORRV,Rtest=R))

}


CFU_lonlat2ns<-function(data, miss.val = FALSE){
#
# Reshape a 3D array into a 2D array handling only spatial dimensions
#
# Description:
#
#       Returns a 2D array of 3D data placing the spatial dimensions into a vector according
#       to GrADS protocol, and keeps the temporal dimension with no change.   
#       It localizes missing values and returns an (spatial) index with no-missing values positions.   
#
# Usage: CFU_latlon2ns(data, miss.val = FALSE)
#
# Input:
#
#       data:   3-dimensional array, e.g. (longitude, latitude, time)
#
# Output:
#
#       matrix: 2-dimensional array with 'ns' spatial dimensions, e.g. (ns, time)
#
# Authors:
#
#      Javier Garcia-Serrano <jgarcia@ic3.cat> 30 September 2010


d=dim(data)
nlon=d[1]; nlat=d[2]; ns=nlon*nlat; nt=d[3]   

M=array(dim=c(ns,nt))
for (i in 1:nlat){
    M[(nlon*(i-1)+1):(nlon*(i-1)+nlon),]=data[,i,]
}
not=is.na(M[,1])
yes=array(dim=c(ns))
counter=0
for (i in 1:ns){
    if (not[i]=='FALSE'){counter=counter+1; yes[counter]=i}
}
yes=yes[1:counter]
Myes=M[yes,]          #(ns_with_data,nt)

#printed in screen

print(ns)
print(counter) 

#outputs

if(miss.val) { Myes <- M } 

invisible(list(matrix=Myes,nt=nt,ns_original=ns,ns_noNaN=counter,index_noNaN=yes))

}


CFU_ns2lonlat<-function(data, nlon=1, nlat=1, yes=NULL){
#
# Reshape a 2D array into a 3D array handling only spatial dimensions
#
# Description:
#
#       Returns a 2D array of 3D data placing the spatial dimensions into a vector according
#       to GrADS protocol, and keeps the temporal dimension with no change.   
#       It localizes missing values and returns an (spatial) index with no-missing values positions.   
#
# Usage: CFU_latlon2ns(data, miss.val = FALSE)
#
# Input:
#
#       data:   3-dimensional array, e.g. (longitude, latitude, time)
#
# Output:
#
#       matrix: 2-dimensional array with 'ns' spatial dimensions, e.g. (ns, time)
#
# Authors:
#
#      Javier Garcia-Serrano <jgarcia@ic3.cat> 06 October 2010


nlon=max(abs(nlon), 1); nlat=max(abs(nlat), 1); ns=nlon*nlat
d=dim(data)
nt=d[2]   

miss.val=is.null(yes)
if(miss.val=='TRUE'){
    M=array(dim=c(nlon,nlat,nt))
    for (i in 1:nlat){
        M[,i,]=data[(nlon*(i-1)+1):(nlon*(i-1)+nlon),]    
    }
} else {
    Myes=array(dim=c(ns,nt)); Myes[yes,]=data
    M=array(dim=c(nlon,nlat,nt))
    for (i in 1:nlat){
        M[,i,]=Myes[(nlon*(i-1)+1):(nlon*(i-1)+nlon),]    
    }
}

matrix=M
matrix

}


CFU_detrend<-function(vector){
#
# Remove the linear trend in a time-series
#
# Description:
#
#       Returns a vector with the same length as the original (nt) but in which
#       the linear trend has been removed.   
#       No change is produced if vector is a vector of missing values.   
#
# Usage: CFU_detrend(vector)
#
# Input:
#
#       vector:   1-dimensional array, time (nt dimension)
#
# Output:
#
#       1-dimensional array without the linear trend (nt)
#
# Authors:
#
#      Javier Garcia-Serrano <jgarcia@ic3.cat> 05 October 2010
#      Modified by jgarcia & vguemas@ic3.cat (27 April 2011) : to convert output into a vector (before, a list)

nt=length(vector)

if (is.na(vector[1])=='TRUE'){
    print("vector contains missing values")
    detrend=array(dim=nt)
} else {
detrend=resid(lm(vector ~ seq(vector)))
}
detrend=as.vector(detrend)

#outputs

detrend

}


CFU_testRR<-function(R1, N1, R2, N2, cl = 0.95){
#
# Testing the equality of correlation coefficients from independent samples 
#
# Description:
#
#       Statistical test for the equality of correlation coefficients (R1, R2)
#       from two independent samples. These samples should belong to two populations,    
#       e.g. dynamical prediction (GCM) and statistical prediction; and the hypothesis
#       will test the equality of the population correlation (bilateral test).
#
#                     H0: R1==R2       vs.       H1:  R1=/=R2
#
#       The statistic Z follows a N(0,1) distribution; if |Z| > Z_alfa/2, H0 is rejected.
#
# Usage: CFU_testRR(R1, N1, R2, N2, cl)
#
# Input:
#
#       R1:   number, correlation of samples #1
#
#       N1:   number, nº of elements in the sample (length #1)
#
#       R2:   number, correlation of samples #2
#
#       N2:   number, nº of elements in the sample (length #2)
#
#       cl:   Value of the confidence level.
#             Default is cl=0.95 (95% confidence level; 5% significance level).
#
# Output:
#
#       value:   binary output (0,1) / 0 = H0 accepted, 1 = H0 rejected
# 
#       p_value: area under the N(0,1) density curve to the right of endpoint |Z|   
#
# Authors:
#
#      Javier Garcia-Serrano <jgarcia@ic3.cat> 02 December 2010
#      Modified by jgarcia & lrodrigues@ic3.cat (13 December 2011) : Correcting p-values 
#      in two-tailed test (alfa is now multiplied by 2).

Y1=0.5*log((1+R1)/(1-R1)); Y2=0.5*log((1+R2)/(1-R2))

B=(1/(N1-3)) + (1/(N2-3)); Z=abs(Y1-Y2)/sqrt(B)      #abs() -> two-tailed test

cl=cl; cl2=(1-cl)/2; Z_cl=qnorm(cl+cl2)

if (is.na(Z)==FALSE){
    if (Z > Z_cl){ value=1 } else { value=0 }
} else {
    value=NA
}

#
#p=pnorm(Z)-pnorm(-Z)    #two-tailed / bilateral --> confidence level 
#p=1-p                   # --> significance level
#p=p/2                   # alfa/2 --> p_value
#

if (is.na(Z)==FALSE){
    p=2*pnorm(Z,lower.tail=FALSE)
} else {
    p=NA
}

#outputs

invisible(list(value=value, p_value=p))

}


CFU_testR<-function(R, N, cl = 0.95, test="two"){
#
# Testing the Null-Hypothesis of population correlation equal to zero 
# 
# Description:
# 
#       Statistical test for sample correlation coefficient (R) according to 
#       the Null Hypothesis of population correlation coefficient (RO) equal to zero.
# 
#                     H0: RO==0       vs.       H1:  RO=/=0
# 
#       The statistic t follows a Student's (T-test) distribution: 
#
#                     if t > t_alfa,N-2   (one-tailed) H0 is rejected
#
#                     if |t| > t_alfa/2,N-2 (two-tailed) H0 is rejected
# 
# Usage: CFU_testR(R, N, cl, test=c("one","two"))
# 
# Input:
# 
#       R:    number, sample correlation
# 
#       N:    number, nº of elements in the sample
# 
#       cl:   Value of the confidence level.
#             Default is cl=0.95 (95% confidence level; 5% significance level).
#
#       test: string of characters that can be "one" or "two" (by default) according 
#             to required test; one-tailed, unilateral (the former) o two-tailed, 
#             bilateral (the latter). 
# 
# Output:
# 
#       value:   binary output (0,1) / 0 = H0 accepted, 1 = H0 rejected
#  
#       p_value: area under the Student's T density curve to the right of endpoint |t|   
# 
# Authors:
# 
#      Javier Garcia-Serrano <jgarcia@ic3.cat> 08 December 2010
#
#      Modified by jgarcia & lrodrigues@ic3.cat (13 July 2011) : Correcting p-values 
#      in two-tailed test (alfa is now multiplied by 2).

t=R*sqrt((N-2)/(1-R**2))

cl=cl

if (test=="one"){
    t_cl=qt(cl, N-2)     
    if (abs(t) > t_cl){ value=1 } else { value=0 }
#
    if (t > 0){
        p=pt(t, N-2, lower.tail=FALSE) 
    } else { p=pt(t, N-2, lower.tail=TRUE) }
}

if (test=="two"){
    cl2=(1-cl)/2; t_cl=qt(cl+cl2, N-2)
    if (abs(t) > t_cl){ value=1 } else { value=0 }
#
    if (t > 0){
        p=pt(t, N-2, lower.tail=FALSE)*2 
    } else { p=pt(t, N-2, lower.tail=TRUE)*2 }
}

#ouputs

invisible(list(value=value, p_value=p))

}


CFU_AA<-function(data, lat, yes=NULL){
#
# Compute the area-average of a 2D (longitude x latitude) array 
#
# Description:
#
#       Area-average (AA) of "data" over the spatial domain described by 'longitude' and 
#       'latitude'.
#       The weights for the field-mean (AA) are based on the cosine of the latitude at each    
#       gridpoint, i.e. all data in a latitudinal circle (all longitudes) have the same
#       weight, cosine("lat").
#
# Usage: CFU_AA(data, lat, yes)
#
# Input:
#
#       data: 2-dimensional array (longitude, latitude; in this order)
#
#       lat:  vector containing the latitude coordinates
#
#       yes:  vector containing the position of non-NaN values, so 'good' values 
#             (in a ns=nlon*nlat, GrADS format) 
#
# Output:
#
#       data_ave; value of the area-average
#
# Authors:
#
#      Javier Garcia-Serrano <jgarcia@ic3.cat> 03 December 2010
#      Modified by Virginie Guemas <vguemas@ic3.cat> (March 2011) : Weight = 0 for NA grid point


ycos=cos((lat*pi)/180); nlat=dim(data)[2]; nlon=dim(data)[1]; ns=nlon*nlat
weight=array(dim=c(nlon,nlat))
for (i in 1:nlon){
    weight[i,]=ycos
}
#weight=weight/sum(weight)                    #normalization

data=data*weight                             #weightening

miss.val=is.null(yes)
if(miss.val=='TRUE'){
    M=array(dim=c(ns))
    weight2=array(dim=c(ns))
    for (i in 1:nlat){
        M[(nlon*(i-1)+1):(nlon*(i-1)+nlon)]=data[,i]
        weight2[(nlon*(i-1)+1):(nlon*(i-1)+nlon)]=weight[,i]
    }
    not=is.na(M)
    yes=array(dim=c(ns))
    counter=0
    for (i in 1:ns){
        if (not[i]=='FALSE'){counter=counter+1; yes[counter]=i}
    }
    yes=yes[1:counter]
    tmp=sum(M[yes])
    sweight=sum(weight2[yes])
    data_ave=tmp/sweight
    #data_ave=sum(M[yes])    
} else {
    yes=yes
    M=array(dim=c(ns))
    weight2=array(dim=c(ns))
    for (i in 1:nlat){
        M[(nlon*(i-1)+1):(nlon*(i-1)+nlon)]=data[,i]    
        weight2[(nlon*(i-1)+1):(nlon*(i-1)+nlon)]=weight[,i]
    }
    tmp=sum(M[yes])
    sweight=sum(weight2[yes])
    data_ave=tmp/sweight
    #data_ave=sum(M[yes])
}

#outputs

data_ave

}

CFU_neff<-function(vector, fig=FALSE){
#
# Compute the effective degrees of freedom of a time series 
#
# Description:
#
#       Number of effective degrees of freedom of "vector".
#       Based on: Zieba, A. (2010): Effective number of observations and unbiased estimators    
#       of variance for autocorrelated data - an overview. Metrol. Meas. Syst. Vol XVII, No. 1,
#       pp. 3-16; index 330930, ISSN 0860-8229. www.metrology.pg.gda.pl
#
# Usage: CFU_neff(vector)
#
# Input:
#
#       vector: 1-dimensional array, time (nt dimension)
#
#       fig: logical, if plot in the autocorrelation of "vector" is desired 
#
# Output:
#
#       neff; number of effective degrees of freedom
#
# Authors:
#
#      Created by Caio A. S. Coelho <caio.coelho@cptec.inpe.br>
#      Implemented in CFU_Rfunc by Javier García-Serrano <jgarcia@ic3.cat> (August 2011)


dof=length(vector)

a=acf(vector,lag.max=dof-1,plot=fig)$acf[2:dof,1,1]

s=0
for (k in 1:(dof-1)){
    s=s+(((dof-k)/dof)*(a[k]**2))
}

neff=(dof/(1+(2*s)))-1

#if (neff>dof){neff=dof}

#outputs

#list(neff=neff)
neff

}

CFU_BS <- function(obs,pred,thresholds = seq(0,1,0.1)) {
#
# Compute the BS and its decomposition given a set of probability predictions of binary event
#
# Description:
#
#      Returns the values of the BS and its standard decomposition as well as the addition of the
#      two winthin-bin extra components (Stephenson et al., 2008). It also solves the bias-corrected 
#      decomposition of the BS (Ferro and Fricker, 2012). BSS having the climatology as the reference
#      forecast.
#
# Usage:
#
#      CFU_BS(obs,pred,thresholds = seq(0,1,0.1))
#
# Input:
#
#      obs: Vector of binary observations (1 or 0) 
#
#      pred: Vector of probablistic predictions [0,1]
#
#      thresholds: Values used to bin the forecasts.  By default the bins are 
#      {[0,0.1), [0.1, 0.2), ... [0.9, 1]}.
#
# Output:
#
#      $rel:                 standard reliability
#      $res:                 standard resolution
#      $unc:                 standard uncertainty
#      $bs:                  Brier score
#      $bs_check_res:        rel-res+unc
#      $bss_res:             res-rel/unc
#      $gres:                generalized resolution
#      $bs_check_gres:       rel-gres+unc
#      $bss_gres:            gres-rel/unc
#      $rel_bias_corrected:  bias-corrected rel
#      $gres_bias_corrected: bias-corrected gres
#      $unc_bias_corrected:  bias-corrected unc
#      $bss_bias_corrected:  gres_bias_corrected-rel_bias_corrected/unc_bias_corrected
#      $nk:                  number of forecast in each bin
#      $fkbar:               average probability of each bin
#      $okbar:               relative frequency that the observed event occurred
#      $bins:                bins used
#      $pred:                values with which the forecasts are verified
#      $obs:                 probability forecasts of the event 
#
# References:
#
#      Wilks (2006) Statistical Methods in the Atmospheric Sciences.
#      Stephenson et al. (2008). Two extra components in the Brier score decomposition. Weather
#      and Forecasting, 23: 752-757.
#      Ferro and Fricker (2012). A bias-corrected decomposition of the BS. Quarterly Journal of 
#      the Royal Meteorological Society, DOI: 10.1002/qj.1924.
#
# Example:
#
#      a=runif(10)
#      b=round(a)
#      x=CFU_BS(b,a)
#      x$bs-x$bs_check_res
#      x$bs-x$bs_check_gres
#      x$rel_bias_corrected-x$gres_bias_corrected+x$unc_bias_corrected
#
# Author:
#
#      Luis Rodrigues <lrodrigues@ic3.cat> 16 April 2012
#
  if (max(pred) > 1 | min(pred) < 0) {
      cat("Predictions outside [0,1] range.  \n Are you certain this is a probability forecast? \n")
  } else if (max(obs) != 1 & min(obs) != 0) {
      cat("Binary events must be either 0 or 1.  \n Are you certain this is a binary event? \n")
  } else {
    nbins=length(thresholds)-1                     # Number of bins
    n=length(pred)
    bins=as.list(paste("bin",1:nbins,sep=""))
    for (i in 1:nbins) {
      if (i == nbins) {
        bins[[i]]=list(which(pred>=thresholds[i]   & pred<=thresholds[i+1]))
      } else {
        bins[[i]]=list(which(pred>=thresholds[i]   & pred<thresholds[i+1]))
      }
    }
#
    fkbar=okbar=nk=array(0,dim=nbins)
    for (i in 1:nbins) {
      nk[i]=length(bins[[i]][[1]])
      fkbar[i]=sum(pred[bins[[i]][[1]]])/nk[i]
      okbar[i]=sum(obs[bins[[i]][[1]]])/nk[i]
    }
#
    obar=sum(obs)/length(obs)
    relsum=ressum=term1=term2=0
    for (i in 1:nbins) {
      if (nk[i] > 0) {
        relsum=relsum+nk[i]*(fkbar[i]-okbar[i])^2
        ressum=ressum+nk[i]*(okbar[i]-obar)^2
        for (j in 1:nk[i]) {
          term1=term1+(pred[bins[[i]][[1]][j]]-fkbar[i])^2
          term2=term2+(pred[bins[[i]][[1]][j]]-fkbar[i])*(obs[bins[[i]][[1]][j]]-okbar[i])
        }
      }
    }
    rel=relsum/n
    res=ressum/n
    unc=obar*(1-obar)
    bs=sum((pred-obs)^2)/n
    bs_check_res=rel-res+unc
    bss_res=(res-rel)/unc
    gres=res-term1*(1/n)+term2*(2/n)   # Generalized resolution
    bs_check_gres=rel-gres+unc         # BS using GRES
    bss_gres=(gres-rel)/unc            # BSS using GRES
#
# Estimating the bias-corrected components of the BS 
#
    term3=array(0,nbins)
    for (i in 1:nbins) {
      term3[i]=(nk[i]/(nk[i]-1))*okbar[i]*(1-okbar[i])
    }
    term_a=sum(term3,na.rm=T)/n
    term_b=(obar*(1-obar))/(n-1)
    rel_bias_corrected=rel-term_a
    gres_bias_corrected=gres-term_a+term_b
    if (rel_bias_corrected < 0 || gres_bias_corrected < 0 ) {
      rel_bias_corrected2=max(rel_bias_corrected,rel_bias_corrected-gres_bias_corrected,0)
      gres_bias_corrected2=max(gres_bias_corrected,gres_bias_corrected-rel_bias_corrected,0)
      rel_bias_corrected=rel_bias_corrected2
      gres_bias_corrected=gres_bias_corrected2
    }
    unc_bias_corrected=unc+term_b
    bss_bias_corrected=(gres_bias_corrected-rel_bias_corrected)/unc_bias_corrected
#
    if (round(bs,8)==round(bs_check_gres,8) & round(bs_check_gres,8)==round((rel_bias_corrected-gres_bias_corrected+unc_bias_corrected),8)) {
#      cat("No error found \n")
#      cat("BS = REL-GRES+UNC = REL_lessbias-GRES_lessbias+UNC_lessbias \n")
    }
#
    invisible(list(rel=rel,res=res,unc=unc,bs=bs,bs_check_res=bs_check_res,bss_res=bss_res,gres=gres,bs_check_gres=bs_check_gres,bss_gres=bss_gres,rel_bias_corrected=rel_bias_corrected,gres_bias_corrected=gres_bias_corrected,unc_bias_corrected=unc_bias_corrected,bss_bias_corrected=bss_bias_corrected,nk=nk,fkbar=fkbar,okbar=okbar,bins=bins,pred=pred,obs=obs))
#
  }      # end of if
#
}

CFU_plotmapmostliktercile <- function(lon,lat,ptc,
                    tit='Probability forecast of most likely tercile (%)',file='G_PFC_map.ps') {
#  
# Produce probabilistic forecast map of most likely tercile of a forecast.
#
# Description:
#
#      Generates vector graphics file of a probabilistic forecast map showing the most likely tercile.
#      Based on an adapted version of Caio Coelho's EURO-BRISA function.
#
# Usage:
#
#      CFU_plotmapmostliktercile(lon,lat,ptc,tit='Probability forecast of most likely tercile (%)',file='G_PFC_map.ps')
#
# Arguments:
#
#   	 	lon: A vector of longitudes.
#
#	 	lat: A vector of latitudes.
#  
#               ptc: Array of forecast terciles information for each ensemble member, output of CFU_PB().
#
#               tit: Title of the Figure.
#
#              file: Name of the postscript output file.
#
# Output:
#
#              Vector graphics file of a probabilistic forecast map showing the most likely tercile.
#
# Author:
#
#              Fabian Lienert <flienert@ic3.cat>  29 Oct 2012.
#
  source('/cfu/pub/scripts/R/rclim.txt')
  nlon <- length(lon); nlat <- length(lat)
  nfc <- dim(ptc)[1]
  nlonr <- nlon-ceiling(length(lon[lon<180 & lon > 0]))
  # Probability of most likely tercile.
  PMLT <- (ptc[1,1,,]*NA)
  for (i in 1:nlon) {
    for (j in 1:nlat) {
      lo <- sum(ptc[,1,j,i],na.rm=T)/nfc
      mid <- sum(ptc[,2,j,i],na.rm=T)/nfc
      up <- sum(ptc[,3,j,i],na.rm=T)/nfc
      if (all(up > c(mid,lo))) {
        PMLT[j,i] <- up
      } else if (all(mid > c(up,lo))) {
        PMLT[j,i] <- 0
      } else if (all(lo > c(mid,up))) {
        PMLT[j,i] <- -lo
      }
    }
  }
  # EURO-BRISA figure. Modified Caio Coelho's function.
  plotmapmostliktercile <- function(lon,lat,data,maintit='',legtit='',equi=TRUE,bw=FALSE, 
                    cont=FALSE,reg=FALSE,...,lonlim=c(min(floor(lon)),max(ceiling(lon))),latlim=c(min(floor(lat)),max(ceiling(lat))),orientation=NULL,
		    mapdat="world",xmaplim=c(min(floor(lon)),max(ceiling(lon))),ymaplim=c(min(floor(lat)),max(ceiling(lat))),
		    longrds=NULL,latgrds=NULL,
		    breaks=NULL,n=11,colours=NULL,
		    roundleg=1,invert=FALSE) {
    rg<-range(data, na.rm=T)
    lowerlim <- rg[1]; upperlim <- rg[2]
    maximum <- max(abs(c(lowerlim,upperlim)))
    if(is.null(breaks)){
      if(lowerlim<0) breaks <- seq(-maximum,maximum,(maximum-(-maximum))/n)
      else breaks <- seq(lowerlim,upperlim,(upperlim-(lowerlim))/n)
    }
    if(is.null(colours)){    
      if(!bw){
        # Check if range includes negative values to use appropriate colour scale.
        if (rg[1] <0) {
          if (!invert) { 
            colours <- bluered(seq(0,n-1,by=1), "linear", yellow =TRUE)
          } else {
            colours <- rev(bluered(seq(0,n-1,by=1), "linear", yellow =TRUE))
          }
        } else {
          colours <- bluered(seq(0,n-1,by=1), "linear", white=0, invert=T)
        }
      } else {
        if (rg[1] <0) {
          colours <- grey(seq(0, 1, length = length(breaks)-1))
          colours <- c(colours[1:((n-1)/2)],rev(colours[(((n-1)/2)+1):n]))
        } else {
          colours <- grey(seq(0, 1, length = length(breaks)-1))
        }
      }
    }  
    if (equi) {
      layout(matrix(1:2,ncol=1,nrow=2),heights=c(5,1))
      par(mar=c(6,2,6.5,1),cex.axis=1.0)
      if (reg) {
        layout(matrix(1:2,ncol=1,nrow=2),heights=c(5,1))
        par(mar=c(2,3,4,1),las=1,cex=1.4)
      }
      # Create probabilistic map.
      image(lon,lat,data,axes=F,col=colours,xlab='',ylab='',breaks=breaks)
      par(cex=2.1)
      if (cont) {contour(lon,lat,data,levels=round(breaks,1),labels=round(breaks,1),add=T,...)}
      # Check if lon is from 0 to 360 or -180 to 180 to use appropriate world map.
      if (min(lon)<0) {
        map('world',interior = F,add = T, lwd=2) # Low resolution world map (lon -180 to 180).
      } else {
        map('world2',interior = F,add = T, lwd=2) # Low resolution world map (lon 0 to 360).
      }
      box()
      map.axes()
      par(font.main=1,cex=1.4)
      title(maintit)
      # Adding colorbar.
      par(mar=c(4.5,2,0,1),mgp=c(1.5,0.3,0),las=1)
      if (reg) {
        par(mar=c(3,0.3,1.5,0.3),mgp=c(1.5,0.3,0),las=1)
      }
      image(c(1:n),1,t(t(c(1:n))),axes=F,col=colours,xlab='',ylab='')
      box()
      par(font.main=1,cex=1.3)
      if (maximum > 1) {
        axis(1,at=seq(1,9),tick=F,pos=0.8,cex.axis=1.5,
             labels = c("85-100","70-85","55-70","40-55"," ","40-55","55-70","70-85","85-100"))
        axis(3,at=5,tick=F,cex.axis=1.5,pos=-1.3,labels=c("White=central tercile most likely"))
        axis(3,at=2.5,tick=F,cex.axis=1.5,pos=1.3,labels=c("Below normal"))
        axis(3,at=7.5,tick=F,cex.axis=1.5,pos=1.3,labels=c("Above normal"))
      } else {
        axis(1,at=seq(0.5, length(breaks)-0.5),tick=F,
             labels=round(breaks[1:(length(breaks))],roundleg))
      }
      # Redefine font size.
      par(cex=1.4)
      # Add the title.
      title(xlab = legtit,cex.lab=1.4)
    }
  }
  postscript(paste(file,sep=''),paper="special",width=12,height=9.25,horizontal=F)
  plotmapmostliktercile(c(lons[c((nlonr+1):nlon)]-360,lons[1:nlonr]),rev(lats),t(PMLT[nlat:1,c((nlonr+1):nlon,1:nlonr)]*100),
                        reg=T,maintit=tit,invert=F,breaks=c(-100,-85,-70,-55,-40,40,55,70,85,100),n=9)
  dev.off()
}

CFU_PB <- function(lon,lat,ano,fcavt=2:4,fcyr,fcsys=1,qt=3,ncpu=4) {
#  
# Compute probabilistic bins (qt) of a forecast (fcyr) relative to the forecast climatology of the residual
# forecasts excluding the selected forecast year (fcyr).
# The maximal values of the lowest/highest quantiles is +/-10^+06 due to limitation in the function hist().
# By default (qt=3) CFU_PB() computes terciles that can be plotted with CFU_plotmapmostliktercile().
#
# Description:
#
#      Returns probabilistic bins of a forecast (fcyr) relative to the forecast climatology without selected forecast.
#
# Usage:
#
#      CFU_PB(lon,lat,ano,fcavt=2:4,fcyr,fcsys=1,qt=3,ncpu=4) 
#
# Arguments:
#
#   	 	lon: A vector of longitudes.
#
#	 	lat: A vector of latitudes.
#  
#               ano: Array of forecast anomalies in CFU_load format.
#
#             fcavt: A vector of time steps to average across.
#
#              fcyr: Number of the forecast start year of the forecast.
#
#             fcsys: Number of the forecast system.
#
#                qt: Number of probabilistic bins 3: terciles, 4: quartiles, etc.
#
#              ncpu: Number of CPUs to be used.
#
# Output:
#
#              Probabilistic forecast information (1 or 0) at each grid point with
#              dimensions (number of ensemble members, qt, number of longitudes, latitudes).
# Author:
#
#              Fabian Lienert <flienert@ic3.cat>  29 Oct 2012.
#
  library(doMC)
  registerDoMC(ncpu)
  # Probabilistic forecast.
  nlon <- length(lon); nlat <- length(lat)
  nyr <- dim(ano)[3]; nfc <- dim(ano)[2]; lt <- dim(ano)[4]
  PTC <- array(NA, dim=c(nfc,3,nlat,nlon))
  for (im in 1:nfc) {
    XY.p <- foreach(i=1:nlon) %dopar% {
      PL <- array(NA, dim=c(qt,nlat))
      for (j in 1:nlat) {
        # Mean over forecast range.
        f.p <- apply(ano[fcsys,im,-fcyr,fcavt,j,i],c(1),mean)
        # PDF of model climatology without selected forecast. 
        qum <- quantile(f.p,probs=c((1:(qt-1))/qt),prob,na.rm=F,names=F,type=7)
        # Bins of selected forecast.
        f.p <- mean(ano[fcsys,im,fcyr,fcavt,j,i])
        if (all(c(qum,f.p)==0)) {
          f0 <- rep(0,qt)
          if (!is.integer(qt/2)) { f0[median(1:qt)] <- 1 }
          PL[,j] <- f0
        } else {
          PL[,j] <- hist(f.p,breaks=c(-1e+06,qum,1e+06),plot=F)$counts
        }
      }
      PL
    }
    for (i in 1:nlon) { PTC[im,,,i] <- XY.p[[i]] }
  }
  PTC
}

CFU_MODE <- function(lon,lat,ano,eof,mode=1) {
#
# Project anomalies onto modes to get temporal evolution of the EOF mode selected.
#  
# Description:
#  
#      Returns principal components (PCs) by area-weighted projection onto EOF pattern (from CFU_EOF()).
#      Able to handle NAs.
#
# Usage:
#
#      CFU_DTF(lon,lat,ano,gmt)
#    
# Arguments:
#
#   	 	lon: A vector of longitudes.
#
#	 	lat: A vector of latitudes.
#
#               ano: Array of observed or forecast anomalies from CFU_ano() with dimensions
#                    (number of forecast systems, ensemble members, start years, forecast months, latitudes, longitudes).  
#  
#               eof: EOF object from CFU_EOF() 
#
#             neofs: Number of leading EOFs to be considered.
#  
#              ncpu: Number of CPUs to be used.
#
# Output:
#   
#    	     PC.ver: Array of PCs in verification format
#                    (number of forecast systems, ensemble members, start years, forecast months).  
#    	  PC.ver.em: Array of ensemble-mean PCs in verification format
#                    (number of forecast systems, start years, forecast months).  
#
# Author:
#
#              Fabian Lienert <flienert@ic3.cat>  19 Nov 2012.
#
  nlon <- length(lon); nlat <- length(lat)
  nyr <- dim(ano)[3]; lt <- dim(ano)[4]
  nfc <- dim(ano)[2]; nmod <- dim(ano)[1]
  pc.ver <- array(NA,dim=c(nmod,nfc,nyr,lt))
  e.1 <- eof$EOFs[mode,,]; mask <- eof$mask; wght <- eof$wght
  # For one realization only.
  if (nmod==1 & nfc==1) {
    pc.ver.em <- FALSE
    for (iy in 1:nyr) {
      for (il in 1:lt) {
        t1 <- (t(ano[nmod,nfc,iy,il,nlat:1,])*e.1)
        nominator <- (sum(t1*wght*mask,na.rm=TRUE)/sum(wght*mask,na.rm=TRUE))
        denominator <- (sum(e.1^2*wght*mask,na.rm=TRUE)/sum(wght*mask,na.rm=TRUE))
        pc.ver[nmod,nfc,iy,il] <- nominator/denominator
      }
    }
  } else {
    pc.ver.em <- array(NA,dim=c(nmod,nyr,lt))
    for (imo in 1:nmod) {
      # Ensemble mean anomalies.
      ano.em <- apply(ano[imo,,,,,],c(2,3,4,5),mean)
      for (iy in 1:nyr) {
        for (il in 1:lt) {
          t1 <- (t(ano.em[iy,il,nlat:1,])*e.1)
          nominator <- (sum(t1*wght*mask,na.rm=TRUE)/sum(wght*mask,na.rm=TRUE))
          denominator <- (sum(e.1^2*wght*mask,na.rm=TRUE)/sum(wght*mask,na.rm=TRUE))
          pc.ver.em[imo,iy,il] <- nominator/denominator
        }
      }
      # Ensemble member anomalies.
      for (im in 1:nfc) {
        for (iy in 1:nyr) {
          for (il in 1:lt) {
            t1 <- (t(ano[imo,im,iy,il,nlat:1,])*e.1)
            nominator <- (sum(t1*wght*mask,na.rm=TRUE)/sum(wght*mask,na.rm=TRUE))
            denominator <- (sum(e.1^2*wght*mask,na.rm=TRUE)/sum(wght*mask,na.rm=TRUE))
            pc.ver[imo,im,iy,il] <- nominator/denominator
          }
        }
      }
    }
  }
  return(list(PC.ver=pc.ver,PC.ver.em=pc.ver.em))
}

CFU_DTF <- function(lon,lat,ano,gmt,ncpu=4) {
#
# Linearly regress out forecast global mean temperature trend (GMT) from forecast monthly anomalies
# of ten-year hindcasts started each year. The regression depends on the forecast lead month across all forecasts.
# NAs are excluded from the linear model fit, but kept in the output.
#  
# Description:
#  
#      Returns linearly detrended forecast anomalies in the verification format (from CFU_ano()).
#
# Usage:
#
#      CFU_DTF(lon,lat,ano,gmt)
#    
# Arguments:
#
#   	 	lon: A vector of longitudes.
#
#	 	lat: A vector of latitudes.
#
#               ano: Array of forecast anomalies from CFU_ano() with dimensions
#                    (number of forecast systems, ensemble members, start years, forecast months, latitudes, longitudes).
#  
#               gmt: Array of forecast global mean temperature anomalies with dimensions 
#                    (number of forecast systems, ensemble members, start years, forecast months).
#                      
#              ncpu: Number of CPUs to be used.
#
# Output:
#   
#    	 ano.dt.ver: Array of detrended forecast anomalies from CFU_ano() with dimensions
#                    (number of forecast systems, ensemble members, start years, forecast months, latitudes, longitudes).
#
# Author:
#
#              Fabian Lienert <flienert@ic3.cat>  16 Nov 2012.
#
  library(doMC)
  registerDoMC(ncpu)
  nlon <- length(lon); nlat <- length(lat)
  nyr <- dim(ano)[3]; lt <- dim(ano)[4]
  nfc <- dim(ano)[2]; nmod <- dim(ano)[1]
  ano.dt.ver <- array(NA,dim=c(nmod,nfc,nyr,lt,nlat,nlon))
  for (imo in 1:nmod) {
    for (im in 1:nfc) {
      XY.p <- foreach(i=1:nlon) %dopar% {
        PL <- array(NA,dim=c(nyr,lt,nlat))
        for (j in 1:nlat) {
          if (!is.na(ano[1,1,1,1,j,i])) {
            for (iy in 1:lt) {
              # Forecast anomaly.
              fctpr <- ano[imo,im,,iy,j,i]
              # Forecast trend wrt. 1961-2011.
              trend.f <- gmt[imo,im,,iy]
              trend <- trend.f-mean(trend.f)
              # Regress forecast anomaly onto trend and remove it from the forecast. Keep residual forecast anomaly.
              fit <- lm(fctpr~trend,na.action=na.exclude)
              fctpr.dt <- residuals(fit)
              PL[,iy,j] <- fctpr.dt 
            }
          }
        }
        PL
      }
      for (i in 1:nlon) { ano.dt.ver[imo,im,,,,i] <- XY.p[[i]] }
    }
  }
  gc()
  return(list(ano.dt.ver=ano.dt.ver))
}

CFU_DTO <- function(lon,lat,ano,yr1,yr2,yrint,gmt=F) {
#
# Linearly regress out global mean temperature trend (GMT) from observed monthly anomalies
# that coincide with hindcasts started on November 1st every 1,2,3, etc. years.
# The anomalies are selected from the first year that coincide with each hindcast.
# NAs are excluded from the linear model fit, but kept in the output.
#  
# Description:
#  
#      Returns linearly detrended and original anomalies in a format to be used for CFU_EOF().
#
# Usage:
#
#      CFU_DTO(lon,lat,ano,yr1,yr2,yrint,gmt=F)
#    
# Arguments:
#
#   	 	lon: A vector of longitudes.
#
#	 	lat: A vector of latitudes.
#
#               ano: Array of anomalies from CFU_ano() with dimensions
#                    (1, 1, number of start years, forecast months, latitudes, longitudes).
#  
#               yr1: First start year.
#
#               yr2: Last start year.
#
#             yrint: Interval between hindcasts in years.
#
#               gmt: Global mean temperature time series. (optional)
#  
# Output:
#  
#        ano.dt.ver: An array of the linearly detrended anomalies in CFU verification format.
#   
#    	     ano.dt: An array of the linearly detrended anomalies with dimensions
#                    (number of months, latitudes, longitudes).
#
#   	        ano: An array of the original input anomalies with dimensions
#                    (number of months, latitudes, longitudes).
#  
# 	 	reg: An array containing a map of regression coefficients
#                    (number of latitudes, longitudes).
#
# Author:
#
#              Fabian Lienert <flienert@ic3.cat>  19 Apr 2013.
#
  nlon <- length(lon); nlat <- length(lat)
  nyr <- dim(ano)[3]; lt <- dim(ano)[4]
  print(nyr); print(lt)
  if (all(gmt==F)) {
    # Global mean temperature GMT from HadCRUT, climate explorer.
    # http://climexp.knmi.nl/data/icrutem3_hadsst2_0-360E_-90-90N_n.dat
    T1 <- read.table("/cfu/data/ukmo/hadcrut/icrutem3_hadsst2_0-360E_-90-90N_n.dat",row.names=1)
    XT <- array(NA,dim=c(12,113))
    for (im in 1:12) {
      XT[im,] <- T1[[im]]
    }
    XT[XT==-9.999000e+02] <- NA
    # GMT anomaly wrt 1356 mo, 113 yr.
    tgl.obs <- ts(c(as.vector(XT),rep(NA,120)),deltat=1/12,start=c(1900,1),end=c(2022,12))
    # GMT anomaly wrt verification period.
    tgl.vp.nov.obs <- window(tgl.obs,start=c(yr1,11),end=c((yr2+lt/12),10))
    tgl.vp.nov.obs <- tgl.vp.nov.obs*((yr2-yr1+lt/12)/113)
    gmt <- tgl.vp.nov.obs
  }
  o.XY <- array(NA,dim=c(((yr2-yr1+lt/12)*12),nlat,nlon))
  TP1 <- ano[1,1,,1:(yrint*12),nlat:1,]
  TP1 <- aperm(TP1, c(2,1,3,4))
  dim(TP1) <- c(nyr*yrint*12,nlat,nlon)
  o.XY[1:(nyr*yrint*12),,] <- TP1
  o.XY[((nyr*yrint*12)+1):((yr2-yr1+lt/12)*12),,] <- ano[1,1,nyr,((yrint*12)+1):lt,nlat:1,]
  if (length(gmt)!=((yr2-yr1+lt/12)*12)) {
    print(paste('GMT time series has not the same length than the array of anomalies.',length(gmt),((yr2-yr1+lt/12)*12)))
    stop()
  }
  # Remove trend from the obs for the whole period.
  o.XY.dt <- array(NA,dim=c(((yr2-yr1+lt/12)*12),nlat,nlon))
  r.XY <- (o.XY.dt[1,,]*NA)
  for (i in 1:nlon) {
    for (j in 1:nlat) {
      if (!is.na(o.XY[1,j,i])) {
        # Regress anomaly onto GMT and remove it from the anomaly.
        a1 <- o.XY[,j,i] 
        # Exclude NAs from linear model estimate, but keep them in the residual time series. (!=$residuals)
        fit <- lm(a1~as.vector(gmt),na.action=na.exclude)
        a1.dt <- residuals(fit)
        o.XY.dt[,j,i] <- a1.dt
        # Regression coefficient map.
        r.XY[j,i] <- coefficients(fit)[[2]]
      }
    }
  }
  # Put detrended obs in verification format.
  ano.dt.ver <- array(NA,dim=c(1,1,nyr,lt,nlat,nlon))
  # Works for forecast start date in each year.
  for (i in 1:nlon) {
    for (j in 1:nlat) {
      d.all <- ts(o.XY.dt[,j,i],deltat=1/12,start=c(yr1,11),end=c((yr2+lt/12),10))
      if (!is.na(o.XY[1,j,i])) {
        for (iy in 1:nyr) {
          d.sl <- window(d.all,start=c((yr1+iy*yrint-yrint),11),end=c((yr1+lt/12+iy*yrint-yrint),10))
          ano.dt.ver[1,1,iy,,((nlat+1)-j),i] <- d.sl
        }
      }
    }
  }
  return(list(ano.dt=o.XY.dt,ano=o.XY,reg=r.XY,ano.dt.ver=ano.dt.ver,gmt=gmt,tgl.obs=tgl.obs))
}

CFU_DTO_an <- function(lon,lat,ano,yr1,yr2,yrint,gmt=F) {
#
# Linearly regress out global mean temperature trend (GMT) from observed annual anomalies
# that coincide with hindcasts started on November 1st every 1,2,3, etc. years.
# The anomalies are selected from the first year that coincide with each hindcast.
# NAs are excluded from the linear model fit, but kept in the output.
#  
# Description:
#  
#      Returns linearly detrended and original anomalies in a format to be used for CFU_EOF().
#
# Usage:
#
#      CFU_DTO_an(lon,lat,ano,yr1,yr2,yrint,gmt=F)
#    
# Arguments:
#
#   	 	lon: A vector of longitudes.
#
#	 	lat: A vector of latitudes.
#
#               ano: Array of anomalies from CFU_ano() with dimensions
#                    (1, 1, number of start years, forecast years, latitudes, longitudes).
#  
#               yr1: First start year.
#
#               yr2: Last start year.
#
#             yrint: Interval between hindcasts in years.
#
#               gmt: Global mean temperature time series. (optional)
#  
# Output:
#  
#        ano.dt.ver: An array of the linearly detrended anomalies in CFU verification format.
#  
#    	     ano.dt: An array of the linearly detrended anomalies with dimensions
#                    (number of years, latitudes, longitudes).
#
#   	        ano: An array of the original input anomalies with dimensions
#                    (number of years, latitudes, longitudes).
#  
# 	 	reg: An array containing a map of regression coefficients
#                    (number of latitudes, longitudes).
#
# Author:
#
#              Fabian Lienert <flienert@ic3.cat>  15 May 2013.
#
  nlon <- length(lon); nlat <- length(lat)
  nyr <- dim(ano)[3]; lt <- dim(ano)[4]
  if (all(gmt==F)) {
    # Global mean temperature GMT from HadCRUT, climate explorer.
    # http://climexp.knmi.nl/data/icrutem3_hadsst2_0-360E_-90-90N_n.dat
    T1 <- read.table("/cfu/data/ukmo/hadcrut/icrutem3_hadsst2_0-360E_-90-90N_n.dat",row.names=1)
    XT <- array(NA,dim=c(12,113))
    for (im in 1:12) {
      XT[im,] <- T1[[im]]
    }
    XT[XT==-9.999000e+02] <- NA
    # GMT anomaly wrt 1356 mo, 113 yr.
    tgl.obs <- ts(c(as.vector(XT),rep(NA,120)),deltat=1/12,start=c(1900,1),end=c(2022,12))
    # GMT anomaly wrt verification period.
    tgl.vp.nov.obs <- window(tgl.obs,start=c(yr1,11),end=c(((yr2+lt)),10))
    tgl.vp.nov.obs <- tgl.vp.nov.obs*((yr2-yr1+lt)/113)
    gmt <- aggregate(tgl.vp.nov.obs,FUN=mean)
  }
  o.XY <- array(NA,dim=c(((yr2-yr1+lt)),nlat,nlon))
  if (yrint>1) {
    TP1 <- ano[1,1,,1:(yrint),nlat:1,] 
    TP1 <- aperm(TP1, c(2,1,3,4))
  } else {
    TP1 <- ano[1,1,,1,nlat:1,]
  }
  dim(TP1) <- c(nyr*yrint,nlat,nlon)
  o.XY[1:(nyr*yrint),,] <- TP1
  o.XY[((nyr*yrint)+1):((yr2-yr1+lt)),,] <- ano[1,1,nyr,((yrint)+1):lt,nlat:1,]
  if (length(gmt)!=((yr2-yr1+lt))) {
    print(paste('GMT time series has not the same length than the array of anomalies.',length(gmt),((yr2-yr1+lt))))
    stop()
  }
  # Remove trend from the obs for the whole period.
  o.XY.dt <- array(NA,dim=c(((yr2-yr1+lt)),nlat,nlon))
  r.XY <- (o.XY.dt[1,,]*NA)
  for (i in 1:nlon) {
    for (j in 1:nlat) {
      if (!is.na(o.XY[1,j,i])) {
        # Regress anomaly onto GMT and remove it from the anomaly.
        a1 <- o.XY[,j,i] 
        # Exclude NAs from linear model estimate, but keep them in the residual time series. (!=$residuals)
        fit <- lm(a1~as.vector(gmt),na.action=na.exclude)
        a1.dt <- residuals(fit)
        o.XY.dt[,j,i] <- a1.dt
        # Regression coefficient map.
        r.XY[j,i] <- coefficients(fit)[[2]]
      }
    }
  }
  # Put detrended obs in verification format.
  ano.dt.ver <- array(NA,dim=c(1,1,nyr,lt,nlat,nlon))
  # Works for forecast start date in each year.
  for (i in 1:nlon) {
    for (j in 1:nlat) {
      d.all <- ts(o.XY.dt[,j,i],deltat=1,start=c(yr1,11),end=c((yr2+lt),10))
      if (!is.na(o.XY[1,j,i])) {
        for (iy in 1:nyr) {
          d.sl <- window(d.all,start=c((yr1+iy*yrint-yrint),11),end=c((yr1+lt+iy*yrint-yrint),10))
          ano.dt.ver[1,1,iy,,((nlat+1)-j),i] <- d.sl
        }
      }
    }
  }
  return(list(ano.dt=o.XY.dt,ano=o.XY,reg=r.XY,ano.dt.ver=ano.dt.ver,gmt=gmt))
}

CFU_EOF <- function(lon,lat,ano,neofs=15) {
# 
# Perform EOF analysis using SVD based on a covariance matrix.
#   
# Description: 
#
#      Returns an area-weighted EOF analysis using SVD based on a covariance matrix. Able to handle NAs.
#
# Arguments:
#
#   	 	lon: A vector of longitudes.
#
#	 	lat: A vector of latitudes.
#  
#               ano: Array of anomalies from CFU_DT() with dimensions
#                    (number of months, number of latitudes, longitudes).
#
#             neofs: Number of modes to be kept.
#
# Output:
#
#   	       EOFs: An array of EOF patterns with dimensions
#                    (number of modes, number of longitudes, latitudes).
#  
#   	       PCs: An array of principal components with dimensions
#                    (number of modes, months).  
#  
#              Var: Percentage (%) of variance fraction of total variance explained by each mode (number of modes).
#  
#             mask: Mask with dimensions (number of longitudes, latitudes).
#  
#             wght: Weights with dimensions (number of longitudes, latitudes).
#                    
# Author:
#
#              Fabian Lienert <flienert@ic3.cat>  29 Oct 2012. Inspired by R. Benestad's EOF() in R-package clim.pact.
#    
  nlon <- length(lon); nlat <- length(lat)
  mask <- ano[1,,]; mask[!is.finite(mask)] <- NA
  mask[is.finite(mask)] <- 1
  # Replace mask of NAs with 0s for EOF analysis.
  ano[!is.finite(ano)] <- 0
  dim.dat <- dim(ano)
  ny <- dim.dat[2]; nx <- dim.dat[3]; nt <- dim.dat[1]
  # Area weighting. Weights for EOF ana and area average.
  wght <- array(cos(rev(lats)*pi/180),dim=(c(nlat,nlon)))
  stdv <- sd(ano,na.rm=T)
  for (it in 1:nt) {ano[it,,] <- ano[it,,]*wght/stdv}
  # Time/space matrix for SVD.
  dim(ano) <- c(nt,ny*nx)
  dim.dat <- dim(ano)
  LINPACK <- FALSE
  if (dim.dat[2] < dim.dat[1]) {transposed <- TRUE} else {transposed <- FALSE}
  if (LINPACK) {
    if (transposed) {pca <- svd(ano, LINPACK = TRUE)} else {pca <- svd(t(ano), LINPACK = TRUE)}
  } else {
    if (transposed) {pca <- La.svd(ano)} else {pca <- La.svd(t(ano))}
  }
  if (neofs > dim(ano)[2]) {neofs <- dim(ano)[2]}
  dim.v <- dim(pca$v); dim.u <- dim(pca$v); dim.x <- dim(ano)
  if (transposed) {
    if (!LINPACK) {
      pca.v <- pca$v
      pca$v <- pca$u
      pca$u <- t(pca.v)
    } else {
      pca.v <- pca$v
      pca$v <- pca$u
      pca$u <- pca.v
    }
  } else {
    d.v <- dim(pca$v)
    d.u <- dim(pca$u)
    if (d.v[1] != d.u[1]) {
      if (!LINPACK) {
        pca$v <- t(pca$v)
        pca$u <- pca$u
      }
    }
    else {
      pca$v <- t(pca$v)
      pca$u <- pca$u
    }
  }
  PC <- pca$v[,1:neofs]
  EOF <- t(pca$u[,1:neofs])
  W <- pca$d[1:neofs]
  tot.var <- sum(pca$d^2)
  Var.eof <- 100 * pca$d[1:neofs]^2/tot.var
  EOF.1 <- EOF[1:neofs,]
  dim(EOF.1) <- c(neofs,ny,nx)
  EOF.2 <- EOF.1
  dim(EOF.2) <- c(neofs,nx,ny)
  PC.2 <- t(PC)
  for (e in 1:neofs) { 
    sg <- 1
    eof.pc.sd <- sd(PC[,e])
    eof.patt.nn <- t(EOF.1[e,,]*mask)
    eof.patt.ms <- sum(eof.patt.nn^2*t(wght*mask),na.rm=TRUE)/sum(t(wght*mask),na.rm=TRUE)
    # Normalize pattern, divide pattern and PC by the square root of the mean of eof.patt^2.
    eof.patt <- eof.patt.nn/sqrt(eof.patt.ms)
    eof.pc <- PC[,e]/sqrt(eof.patt.ms)
    # Change sign of first EOF pattern for PDO, IPO, etc.
    if (e==1) if (eof.patt[round(nlon/2),round(nlat/2)] > 0) sg <- -1
    EOF.2[e,,] <- eof.patt*sg
    PC.2[e,] <- eof.pc*sg
  }
  return(list(EOFs=EOF.2,PCs=PC.2,Var=Var.eof,mask=t(mask),wght=t(wght)))
}

CFU_AMO <- function(lon.na,lat.na,ano.na.f,ano.na.o,lon.gl,lat.gl,ano.gl.f,ano.gl.o,ncpu=4) {
#
# Compute the Atlantic Multidecadal Oscillation (AMO) index.
#  
# Description:
#  
#      Returns the Atlantic Multidecadal Oscillation (AMO) index based on the area-averaged North Atlantic
#      (0-60N, 80W-0) SST anomalies with the global (60S-60N) SST anomalies removed.
#
# Usage:
#
#      CFU_AMO(lon.na,lat.na,ano.na,lon.gl,lat.gl,ano.gl)
#    
# Arguments:
#
#   	     lon.na: A vector of North Atlantic longitudes.
#
#	     lat.na: A vector of North Atlantic latitudes.
#
#          ano.na.f: Array of North Atlantic SST (0-60N, 80W-0) forecast anomalies from CFU_ano() with dimensions
#                    (number of forecast systems, ensemble members, start years, forecast months, latitudes, longitudes).
#  
#          ano.na.o: Array of North Atlantic SST (0-60N, 80W-0) observed anomalies from CFU_ano() with dimensions
#                    (number of forecast systems, ensemble members, start years, forecast months, latitudes, longitudes).  
#
#   	     lon.gl: A vector of global longitudes.
#
#	     lat.gl: A vector of global latitudes.
#
#          ano.gl.f: Array of global (60S-60N) SST forecast anomalies from CFU_ano() with dimensions
#                    (number of forecast systems, ensemble members, start years, forecast months, latitudes, longitudes).
#  
#          ano.gl.o: Array of global (60S-60N) SST observed anomalies from CFU_ano() with dimensions
#                    (number of forecast systems, ensemble members, start years, forecast months, latitudes, longitudes).  
#
#              ncpu: Number of CPUs to be used.
#
# Output:
#   
#    	   AMOF.ver: Array of forecast AMO index in verification format
#                    (number of forecast systems, ensemble members, start years, forecast months).
#  
#    	   AMOO.ver: Array of observed AMO index in verification format
#                    (1, 1, number of start years, forecast months).  
#
# Author:
#
#              Fabian Lienert <flienert@ic3.cat>  27 Nov 2012.
#
  # Global mean SST.
  nlon <- length(lon.gl); nlat <- length(lat.gl)
  nyr <- dim(ano.gl.f)[3]; lt <- dim(ano.gl.f)[4]
  nfc <- dim(ano.gl.f)[2]; nmod <- dim(ano.gl.f)[1]
  # Mask of NAs. Use mask of obs. No NAs in EC-Earth output.
  mask <- ano.gl.o[1,1,1,1,,]; mask[!is.finite(mask)] <- NA; mask[is.finite(mask)] <- 1
  # Weights for area averaging.
  wght <- array(cos(rev(lats)*pi/180),dim=(c(nlat,nlon)))
  ano.gmt.f <- array(NA,dim=c(nmod,nfc,nyr,lt))
  ano.gmt.o <- array(NA,dim=c(1,1,nyr,lt))
  library(doMC)
  registerDoMC(ncpu)  
  XY.p <- foreach(iy=1:nyr) %dopar% {
    PL.f <- array(NA,dim=c(nmod,nfc,lt))
    PL.o <- array(NA,dim=c(1,1,lt))
    for (il in 1:lt) {
      for (imo in 1:nmod) {
        for (im in 1:nfc) {
          PL.f[imo,im,il] <- sum(ano.gl.f[imo,im,iy,il,,]*wght*mask,na.rm=TRUE)/sum(wght*mask,na.rm=TRUE)
        }
      }
      PL.o[1,1,il] <- sum(ano.gl.o[1,1,iy,il,,]*wght*mask,na.rm=TRUE)/sum(wght*mask,na.rm=TRUE)
    }
    return(list(PL.f,PL.o))
  }
  for (iy in 1:nyr) {  ano.gmt.f[,,iy,] <- XY.p[[iy]][[1]]; ano.gmt.o[,,iy,] <- XY.p[[iy]][[2]] }
  # North Atlantic mean SST.
  nlon <- length(lon.na); nlat <- length(lat.na)
  nyr <- dim(ano.na.f)[3]; lt <- dim(ano.na.f)[4]
  nfc <- dim(ano.na.f)[2]; nmod <- dim(ano.na.f)[1]
  # Mask of NAs. Use mask of obs. No NAs in EC-Earth output.
  mask <- ano.na.o[1,1,1,1,,]; mask[!is.finite(mask)] <- NA; mask[is.finite(mask)] <- 1
  # Weights for area averaging.
  wght <- array(cos(rev(lats)*pi/180),dim=(c(nlat,nlon)))
  ano.nat.f <- array(NA,dim=c(nmod,nfc,nyr,lt))
  ano.nat.o <- array(NA,dim=c(1,1,nyr,lt))  
  XY.p <- foreach(iy=1:nyr) %dopar% {
    PL.f <- array(NA,dim=c(nmod,nfc,lt))
    PL.o <- array(NA,dim=c(1,1,lt))
    for (il in 1:lt) {
      for (imo in 1:nmod) {
        for (im in 1:nfc) {
          PL.f[imo,im,il] <- sum(ano.na.f[imo,im,iy,il,,]*wght*mask,na.rm=TRUE)/sum(wght*mask,na.rm=TRUE)
        }
      }
      PL.o[1,1,il] <- sum(ano.na.o[1,1,iy,il,,]*wght*mask,na.rm=TRUE)/sum(wght*mask,na.rm=TRUE)
    }
    return(list(PL.f,PL.o))
  }
  for (iy in 1:nyr) {  ano.nat.f[,,iy,] <- XY.p[[iy]][[1]]; ano.nat.o[,,iy,] <- XY.p[[iy]][[2]] }
  # AMO.
  amo.f <- ano.nat.f-ano.gmt.f
  amo.o <- ano.nat.o-ano.gmt.o
  return(list(AMOF.ver=amo.f,AMOO.ver=amo.o))
}
