
#' Training (Significant predictors) 
#'@param  
#'@return training_analog 
#'@useDynLib CSTools
#'@export 

library(data.table)

training_analogs <- function() {

# Input data files

pathSI <- "/home/sclim/cle/regionalizacion/asun/eraint/datosAscii_SI/"
pathLR <- "/home/sclim/cle/regionalizacion/asun/eraint/datosAscii_LR/"
obspath <- "/MASIVO/cle/datos/REJ5/"

u500_file <- paste(pathSI,'u500.dat',sep="")
v500_file <- paste(pathSI,'v500.dat',sep="")
t500_file <- paste(pathSI,'t500.dat',sep="")
t850_file <- paste(pathSI,'t850.dat',sep="")
t1000_file <- paste(pathSI,'t1000.dat',sep="")
z500_file <- paste(pathSI,'z500.dat',sep="")
z1000_file <- paste(pathSI,'z1000.dat',sep="")
msl_file_si <- paste(pathSI,'msl.dat',sep="")
msl_file_lr <- paste(pathLR,'msl.dat',sep="")
q700_file <- paste(pathSI,'q700.dat',sep="")

# mestro file has "est", "lon", "lat" and "alt" in columns (vector structure)
maestro_hr_file <- paste(obspath, "maestro_red_hr",sep="")
assign("prec_hr_file",paste(obspath, "pcp_red_1981-1996.geo",sep=""))

# ERAInterim grid parameters
# ngridd=((2*nlat)-1)*((2*nlon)-1) (LR grid)
ngridd <- 14076
nlat <- 18
nlon <- 30
ic <- nlat*nlon
nlatt <- 25 
nlont <- 37
id <- nlatt*nlont
slat <- 55.5
slon <- "-28.5"
rlat <- "-1.5"
rlon <- 1.5
slatt <- 63.
slont <- "-36."

# grid points number of AEMET HR dataset 
nptos <- 20945

# 10 predictors in 2D format

preu500 <- matrix(scan(u500_file), nrow=5844, ncol=544, byrow=TRUE)
u500 <- preu500[,-c(1:4)]
prev500 <- matrix(scan(v500_file), nrow=5844, ncol=544, byrow=TRUE)
v500 <- prev500[,-c(1:4)]
pret500 <- matrix(scan(t500_file), nrow=5844, ncol=544, byrow=TRUE)
t500 <- pret500[,-c(1:4)]
pret850 <- matrix(scan(t850_file), nrow=5844, ncol=544, byrow=TRUE)
t850 <- pret850[,-c(1:4)]
pret1000 <- matrix(scan(t1000_file), nrow=5844, ncol=544, byrow=TRUE)
t1000 <- pret1000[,-c(1:4)]
prez500 <- matrix(scan(z500_file), nrow=5844, ncol=544, byrow=TRUE)
z500 <- prez500[,-c(1:4)]
prez1000 <- matrix(scan(z1000_file), nrow=5844, ncol=544, byrow=TRUE)
z1000 <- prez1000[,-c(1:4)]
premslsi <- matrix(scan(msl_file_si), nrow=5844, ncol=544, byrow=TRUE)
msl_si <- premslsi[,-c(1:4)]
premsllr <- matrix(scan(msl_file_lr), nrow=5844, ncol=929, byrow=TRUE)
msl_lr <- premsllr[,-c(1:4)]
preq700 <- matrix(scan(q700_file), nrow=5844, ncol=544, byrow=TRUE)
q700 <- preq700[,-c(1:4)]

# high-resolution observational dataset
maestro <- read.table(maestro_hr_file)
lon_hr <- unlist(maestro[2])
lat_hr <- unlist(maestro[3])
preprec_hr <- matrix(scan(prec_hr_file), nrow=5844 ,ncol= 20946, byrow=TRUE)
prec_hr <- preprec_hr[,-c(1:2)]

#! nd: number of training days
#! nm: number of estimated days
#! f.i, nm = 36600 -> regionalization of 100 years daily data 
#nd <- 5844
nd <- 200
#nd <- 50

#! Number of analog situations to consider
nanx <- 155
#nanx <- 20

npx <- 11

  prePro <- .Fortran("training_part1", 
                      u500 = as.numeric(u500[1:nd,]),
                      v500 = as.numeric(v500[1:nd,]),
                      t1000 = as.numeric(t1000[1:nd,]),
                      z500 = as.numeric(z500[1:nd,]),
                      z1000 = as.numeric(z1000[1:nd,]),
                      msl_si = as.numeric(msl_si[1:nd,]),
                      msl_lr = as.numeric(msl_lr[1:nd,]),
                      ngridd = as.integer(ngridd),
                      nlat = as.integer(nlat),
                      nlon = as.integer(nlon),
                      ic = as.integer(ic),
                      nlatt = as.integer(nlatt),
                      nlont = as.integer(nlont),
                      id = as.integer(id),
                      slat = as.numeric(slat),
                      slon = as.numeric(slon),
                      rlat = as.numeric(rlat),
                      rlon = as.numeric(rlon),
                      slatt = as.numeric(slatt),
                      slont = as.numeric(slont),
                      nd = as.integer(nd),
                      um = matrix(as.double(seq(1,nd*ic)),c(nd,ic)),
                      vm = matrix(as.double(seq(1,nd*ic)),c(nd,ic)),
                      gu92 = matrix(as.double(seq(1,nd*ic)),c(nd,ic)),
                      gv92 = matrix(as.double(seq(1,nd*ic)),c(nd,ic)),
                      gu52 = matrix(as.double(seq(1,nd*ic)),c(nd,ic)),
                      gv52 = matrix(as.double(seq(1,nd*ic)),c(nd,ic)),
                      nger = as.integer(1),
                      PACKAGE = 'CSTools') 

             a <- prePro$um
             b <- prePro$vm
             c <- prePro$gu92
             d <- prePro$gv92
             e <- prePro$gu52
             f <- prePro$gv52
 
             g <- prePro$nger

     predSig <- .Fortran("training_part2",
                      u500 = as.numeric(u500[1:nd,]),
                      v500 = as.numeric(v500[1:nd,]),
                      t500 = as.numeric(t500[1:nd,]),
                      t850 = as.numeric(t850[1:nd,]),
                      msl_si = as.numeric(msl_si[1:nd,]),
                      q700 = as.numeric(q700[1:nd,]),
                      lon_hr = as.numeric(lon_hr),
                      lat_hr = as.numeric(lat_hr),
                      prec_hr = as.numeric(prec_hr[1:nd,]),
                      nanx = as.integer(nanx),
                      nlat = as.integer(nlat),
                      nlon = as.integer(nlon),
                      ic = as.integer(ic),
                      nlatt = as.integer(nlatt),
                      nlont = as.integer(nlont),
                      id = as.integer(id),
                      slat = as.numeric(slat),
                      slon = as.numeric(slon),
                      rlat = as.numeric(rlat),
                      rlon = as.numeric(rlon),
                      slatt = as.numeric(slatt),
                      slont = as.numeric(slont),
                      nd = as.integer(nd),
                      um = as.double(a),
                      vm = as.double(b),
                      gu92 = as.double(c),
                      gv92 = as.double(d),
                      gu52 = as.double(e),
                      gv52 = as.double(f),
                      nger = as.integer(g),
                      mi = matrix(as.integer(seq(1,prePro$nger*nptos)),c(prePro$nger,nptos)),
                      ccm = matrix(as.double(seq(1,prePro$nger*nptos)),c(prePro$nger,nptos)),
                      lab_pred = matrix(as.integer(seq(1,prePro$nger*nptos*npx)),c(prePro$nger,nptos,npx)),
                      cor_pred = matrix(as.double(seq(1,prePro$nger*nptos*npx)),c(prePro$nger,nptos,npx)), 
                      PACKAGE = 'CSTools')

             h <- predSig$mi
             i <- predSig$ccm
             j <- predSig$lab_pred
             k <- predSig$cor_pred

#             output1 <- array(c(a,b,c,d,e,f),c(nd,ic,6))
#             dimnames(output1)[[3]] <- c("um","vm","gu92","gv92","gu52","gv52")

#             output2 <- array(c(h,i),c(g,nptos,2))
#             dimnames(output2)[[3]] <- c("mi","ccm")

             output3 <- array(c(j,k),c(g,nptos,npx,2))
             dimnames(output3)[[4]] <- c("lab_pred","cor_pred")

             output <- list("um" = a,
                            "vm" = b,
                            "gu92" = c,
                            "gv92" = d,
	                    "gu52" = e,
	                    "gv52" = f,
	                    "numSig" = h,
	                    "ccm" = i,
                            "indices" = output3) 
#	                    "labSig" = j,
#	                    "corSig" = k)

             return(output)

}
                                 
#  # check inputs
#  # check exp
#  # check exp_lat
## completar los checks (depende de lo exigente que seamos con la funcion)
#  if (!is.numeric(exp_lat)) {
#    stop("Parameter 'exp_lat' must be a numeric vector.")
#  }
#  if (length(exp_lat) < 2) {
#    stop("Parameter 'exp_lat' must be a vector with multiple values.")
#  }
## En esta parte calculamos todo lo que nuestra funcion necesite como argumento
#  exp_res <- c(exp_lat, NA) - c(NA, exp_lat)
#  exp_res <- exp_res[!is.na(exp_res)]
#  if (!all(exp_res == exp_res[1])) {
#    stop("Parameter 'exp_lat' must be in regular grid.")
#  } else {
#    exp_res <- exp_res[1]
#  }
#  nlat <- (exp_lat[length(exp_lat)] - exp_lat[1]) / exp_res
#  nlon <- (exp_lon[length(exp_lon)] - exp_lon[1]) / exp_res
#  ic <- nlat * nlon
#  extra_nw_dom <- 7.5 
#  extra_se_dom <- 3 
#  dif_grids <- extra_nw_dom+extra_se_dom
#  nlatt <- nlat + (dif_grids / exp_res)
#  nlont <- nlon + (dif_grids / exp_res)
#  id <- nlatt * nlont
#  slat <- max(exp_lat)
#  slon <- exp_lon[1] # if -180 : 180
#  slon <- min(c(exp_lon[which(exp_lon > 180)] - 360, 
#                exp_lon[which(exp_lon <= 180)])) # if lon 0 :360
#
#  if (any(names(dim(obs_psl)) == 'time')) {
#    time_dim <- which(names(dim(obs_psl)) == 'time')
#  } else if (any(names(dim(obs_psl)) == 'sdate')) {
#    if (any(names(dim(obs_psl)) == 'ftime')) {
#        obs_psl <- MergeDims(obs_psl, c('ftime', 'sdate'), rename_dim = 'time')
#        time_dim <- which(names(dim(obs_psl)) == 'time')
#  }
#  if (any(names(dim(obs_psl)) == 'gridpoint')) {
#    gp_dim <- which(names(dim(obs_psl)) == 'gridpoint')
#  } else if (any(names(dim(obs_psl)) == 'lat')) {
#    if (any(names(dim(obs_psl)) == 'lon')) {
#        obs_psl <- MergeDims(obs_psl, c('lat', 'lon'), rename_dim = 'gridpoint')
#        gp_dim <- which(names(dim(obs_psl)) == 'gridpoint')
#  }  
  
#  nm <- exp$time 
#  nd <- obs$time 
  
# completar los argumentos de la funcion training (basado en los programas de fortran)
# y ver la manera de obtenerlos de la informacion que nos pasa la funcion AnalogPredictors.
# Una vez que tenga todo claro, ir probandolo en R a ver si funciona (habria que hacerlo con el
# dyn.load como habia hecho la prueba).



