#' AEMET Training   
#' Training method (pre-downscaling) based on analogs: 
#' synoptic situations and significant predictors. 
#'
#'@author Marta Dom\'inguez Alonso - AEMET, \email{mdomingueza@aemet.es}
#'
#'@description This function caracterizes the synoptic situations in a past period based on 
#' low resolution reanalysis data (e.g, ERAInterim 1.5km x 1.5km) and an observational high 
#' resolution (HR) dataset (AEMET 5 km gridded daily precipitation and maximum and 
#' minimum temperature) (Peral et al., 2017)). 
#' The method uses three domains: 
#' - peninsular Spain and Balearic Islands domain (5 km resolution): HR domain
#' - synoptic domain (low resolution): it should be centered over Iberian Peninsula and 
#'   cover enough extension to detect as much synoptic situations as possible.  
#' - extended domain (low resolution): it is an extension of the synoptic 
#'   domain to west and nothward. See 'nw_ext' parameter below.
#'
#'@param var Variable name to downscale. There are two options: 'prec' for
#' precipitation and 'temp' for maximum and minimum temperature.
#'
#'@param pred List of matrix reanalysis data. The list has to contain reanalysis atmospheric variables
#' (instantaneous 12h data) that must be indentify by parenthesis name.
#' For precipitation:
#' - u component of wind at 500 hPa (u500) 
#' - v component of wind at 500 hPa (v500)
#' - temperature at 500 hPa (t500) 
#' - temperature at 850 hPa (t850)
#' - temperature at 1000 hPa (t1000)
#' - geopotential at 500 hPa (z500) 
#' - geopotential at 1000 hPa (z1000) 
#' - sea level pressure (slp) 
#' - sea level pressure (extended domain) (slp_ext) 
#' - specific humidity at 700 hPa (q700) 
#' For maximum and minimum temperature:
#' - temperature at 1000 hPa (t1000)
#' - sea level pressure (slp) 
#' - sea level pressure (extended domain) (slp_ext) 
#' All matrix must have 'nd' x 'ngp + 1' dimensions (nd = number of training days, ngp = number of 
#' synoptic/extended gridpoints). 
#' Ascii files have 'ngp + 1' columns because first column must include the date in format %Y%m%d (e.g. 19810101)
#' Consider that 'ngp' of extended domain > 'ngp' of synoptic domain. 
#'
#'@param lon Vector of the synoptic longitude (from (-180º) to 180º), 
#' The vector must go from west to east. 
#'
#'@param lat Vector of the synoptic latitude. The vector must go from north to south.
#'
#'@param nw_ext Number of extra degrees adding to north and west synoptic domain
#' to obtain the extended one. This parameter should be multiple of synoptic grid 
#' resolution (e.g. nw_ext = 10.5 to ERA Interim 1.5º x 1.5º). 
#'
#'@param HR_path Local path of HR observational files (maestro and pcp/tmx-tmn). 
#' For precipitation can be downloaded from http://www.aemet.es/documentos/es/serviciosclimaticos/cambio_climat/datos_diarios/dato_observacional/rejilla_5km/v2/Serie_AEMET_v2_pcp_1951a201903_txt.tar.gz   
#' For maximum and minimum temperature can be downloaded from XX.
#' Maestro file (maestro_red_hr_SPAIN.txt) has gridpoint (nptos), longitude (lon), latitude (lat) and 
#' altitude (alt) in columns (vector structure).
#' Data file (pcp/tmx/tmn_red_SPAIN_1951-201903.txt) includes 5km resolution spanish daily data 
#' (precipitation or maximum and minimum temperature from january 1951 to march 2019. See README 
#' file for more information.
#' IMPORTANT!: HR observational period must be the same as for reanalysis variables.
#' It is assumed that the training period is smaller than the HR original one (1951-2019), so it is 
#' needed to make a new ascii file with the new period and the same structure as original, 
#' specifying the training dates in the name (e.g. 'pcp_red_SPAIN_19810101-19961231.txt' for 
#' '19810101-19961231' period). See 'tdates' parameter below. 
#' 
#'@param tdates Training period dates in format %Y%m%d(start)-%Y%m%d(end) (e.g. 19810101-19961231). 
#' 
#'@return training_analogs() returns a parameters list (e.g. restrain) as a result of 
#' characterize the past synoptic situations and the significant predictors needed to  
#' downscale seasonal forecast variables. 
#' For precipitation the output includes:
#' um: u component of geostrophic wind in all period (numeric matrix with [nd,ngp] dimensions) 
#' vm: v component of geostrophic wind in all period (numeric matrix with [nd,ngp] dimensions) 
#' nger: number of synoptic situations (integer parameter)  
#' gu92: u component of geostrophic wind for each synoptic situation (numeric matrix with 
#'       [nger,ngp] dimensions)
#' gv92: v component of geostrophic wind for each synoptic situation (numeric matrix with
#'       [nger,ngp] dimensions)
#' gu52: u component of wind at 500 hPa for each synotic situation (numeric matrix with
#'       [nger,ngp] dimensions)
#' gv52: v component of wind at 500 hPa for each synotic situation (numeric matrix with
#'       [nger,ngp] dimensions)
#' neni: number of reference centers where predictors are calculated (integer parameter)
#' vdmin: minimum distances between each HR gridpoint and the four nearest synoptic 
#'        gridpoints (numeric matrix with [nptos,4] dimensions) (nptos = number of HR gridpoints)
#' vref: four nearest synoptic gridpoints to each HR gridpoint (integer matrix with 
#'       [nptos,4] dimensions) 
#' ccm: multiple correlation coeficients (numeric matrix with [nger,nptos] dimensions)
#' indices (2 elements corresponding to last dimension): 
#'         - lab_pred: numeric labels of selected predictors (integer matrix 
#'                     with [nger,nptos,npx,1] dimensions) 
#'         - cor_pred: partial correlation of selected predictors (numeric matrix with 
#'                     [nger,nptos,npx,2] dimensions) 
#' For maximum and minimum temperature the output includes:
#' um: u component of geostrophic wind in all training period (numeric matrix with [nd,ngp] dimensions) 
#' vm: v component of geostrophic wind in all training period (numeric matrix with [nd,ngp] dimensions) 
#' insol: insolation in all training period (numeric vector with [nd] dimension)
#' neni: number of reference centers where predictors are calculated (integer parameter)
#' vdmin: minimum distances between each HR gridpoint and the four nearest synoptic 
#'        gridpoints (numeric matrix with [nptos,4] dimensions) (nptos = number of HR gridpoints)
#' vref: four nearest synoptic gridpoints to each HR gridpoint (integer matrix with 
#'       [nptos,4] dimensions) 
#'
#' The output can directly use as argument to 'downscaling_analogs' function 
#' (e.g. resdowns <- downscaling_analogs(...,restrain))
#'
#'@import data.table
#' 
#'@examples
#' # Example 1 (precipitation): 'pred' list from ascii reanalysis files (training period = 200 days).  
#' lon <- seq(from = -28.5, to = 15, by = 1.5)
#' lat <- seq(from = 55.5, to = 30, by = -1.5)  
#' nw_ext <- 10.5
#' u500 <- matrix(scan("u500.txt"), nrow=200, ncol=541, byrow=TRUE)
#' v500 <- matrix(scan("v500.txt"), nrow=200, ncol=541, byrow=TRUE)
#' t500 <- matrix(scan("t500.txt"), nrow=200, ncol=541, byrow=TRUE)
#' t850 <- matrix(scan("t850.txt"), nrow=200, ncol=541, byrow=TRUE)
#' t1000 <- matrix(scan("t1000.txt"), nrow=200, ncol=541, byrow=TRUE)
#' z500 <- matrix(scan("z500.txt"), nrow=200, ncol=541, byrow=TRUE)
#' z1000 <- matrix(scan("z1000.txt"), nrow=200, ncol=541, byrow=TRUE)
#' slp <- matrix(scan("slp.txt"), nrow=200, ncol=541, byrow=TRUE)
#' slp_ext <- matrix(scan("slp_ext.txt"), nrow=200, ncol=926, byrow=TRUE)
#' q700 <- matrix(scan("q700.txt"), nrow=200, ncol=541, byrow=TRUE)
#' pred <- list ("u500" = u500,
#'               "v500" = v500,
#'               "t500" = t500,
#'               "t850" = t850,
#'               "t1000" = t1000,
#'               "z500" = z500,
#'               "z1000" = z1000,
#'               "slp" = slp,
#'               "slp_ext" = slp_ext,
#'               "q700" = q700)
#' HR_path <- "/home/localhrpath/" 
#' tdates <- "19810101-19810719"
#' restrain <- training_analogs(prec, pred, lon, lat, nw_ext, HR_path, tdates)
#' str(restrain)
#' List of 12
#'  $ um     : num [1:200, 1:540] 24.26 22.17 -11.29 11.46 9.76 ...
#'  $ vm     : num [1:200, 1:540] 14.572 0.435 -0.433 0 10.768 ...
#'  $ nger   : int 94
#'  $ gu92   : num [1:94, 1:540] 20.21 5.19 10.6 6.47 12.04 ...
#'  $ gv92   : num [1:94, 1:540] 6.155 4.459 15.211 -0.132 6.413 ...
#'  $ gu52   : num [1:94, 1:540] 41.9 25.9 25.9 20.9 16.1 ...
#'  $ gv52   : num [1:94, 1:540] 16.27 11.5 19.96 12.04 8.41 ...
#'  $ neni   : int 74
#'  $ vdmin  : num [1:20945, 1:4] 77 56.6 62.1 33.8 39.3 ...
#'  $ vref   : int [1:20945, 1:4] 408 406 406 406 406 406 406 406 406 406 ...
#'  $ ccm    : num [1:94, 1:20945] 0.452 0.452 0.452 0.452 0.452 ...
#'  $ indices: num [1:94, 1:20945, 1:11, 1:2] 1 1 1 1 1 1 1 1 1 1 ...
#'   ..- attr(*, "dimnames")=List of 4
#'   .. ..$ : NULL
#'   .. ..$ : NULL
#'   .. ..$ : NULL
#'   .. ..$ : chr [1:2] "lab_pred" "cor_pred"

#'@useDynLib CSTools
#'
#'@export 

training_analogs <- function(var,
                             pred,
                             lon,
                             lat,
                             nw_ext,
                             HR_path,
                             tdates) {

if (!is.list(pred)) {
    stop("Parameter 'pred' must be list of 'matrix' objects")
  }

if (!(all(sapply(pred, inherits, 'matrix')))) {
     stop("Elements of the list in parameter 'pred' must be of the class ",
          "'matrix'.")
  }

if (var == "prec") {
if (length(pred) != 10) {
    stop("Parameter 'pred' must be a length of 10.")
  }
} else {
if (length(pred) != 3) {
    stop("Parameter 'pred' must be a length of 3.")
  }
}

if (!is.vector(lon) || !is.numeric(lon)) {
    stop("Parameter 'lon' must be a numeric vector")
  }

if (!is.vector(lat) || !is.numeric(lat)) {
    stop("Parameter 'lat' must be a numeric vector")
  }

if (!is.character(HR_path)){
    stop("Parameter 'HR_path' must be a character.")
  }

if (!is.character(tdates)) {
   stop("Parameter 'tdates' must be a character.")
  }

#! REANALYSIS GRID PARAMETERS

  rlon <- c(lon, NA) - c(NA, lon)
  rlon <- rlon[!is.na(rlon)]
  if (!all(rlon == rlon[1])) {
    stop("Parameter 'lon' must be in regular grid.")
  } else {
    rlon <- rlon[1]
  }

  rlat <- c(lat, NA) - c(NA, lat)
  rlat <- rlat[!is.na(rlat)]
  if (!all(rlat == rlat[1])) {
    stop("Parameter 'lat' must be in regular grid.")
  } else {
    rlat <- rlat[1]
  }

  if (rlon != (-rlat)) {
    stop("Parameters 'lon' and 'lat' must have the same resolution.")
  } else {
    res <- rlon
  }

  nlat <- ((lat[length(lat)] - lat[1]) / rlat) + 1
  nlon <- ((lon[length(lon)] - lon[1]) / rlon) + 1

  ic <- nlat * nlon

  nlatt <- nlat + (nw_ext / (-rlat))
  nlont <- nlon + (nw_ext / rlon)

  id <- nlatt * nlont

  slat <- max(lat)
  slon <- min(c(lon[which(lon > 180)] - 360, 
                lon[which(lon <= 180)])) 
  
  slatt <- slat + nw_ext
  slont <- slon - nw_ext

  ngridd <- ((2*nlatt)-1)*((2*nlont)-1)

  if (all((sapply(pred,nrow))==nrow(pred[[1]]))){
    nd <- nrow(pred[[1]]) 
    var_dateini <- as.Date(as.character(pred[[1]][1,1]), format="%Y%m%d")
    var_dateend <- as.Date(as.character(pred[[1]][nd,1]), format="%Y%m%d")
    period <- as.numeric(difftime(as.POSIXct(var_dateend), as.POSIXct(var_dateini, tz="UTC"), units="days") + 1)  
  
    if (nd != period) {
       stop("Dates from reanalysis variables does not match with training number days.")
    }
  } else {
    stop("All 'pred' variables must be in the same period.")
  }

    seqdates <- seq(as.Date(substr(tdates,start=1,stop=8),format="%Y%m%d"),as.Date(substr(tdates,start=10,stop=18),format="%Y%m%d"),by="days")
#    seqdates <- seq(var_dateini,var_dateend,by="days")
    month <- format(seqdates,format="%m")
    day <- format(seqdates,format="%d")

#! TRAINING REANALYSIS VARIABLES
t1000 <- pred[['t1000']][1:nd,-c(1)]
msl_si <- pred[['slp']][1:nd,-c(1)]
msl_lr <- pred[['slp_ext']][1:nd,-c(1)]

if (var == "prec") {
u500 <- pred[['u500']][1:nd,-c(1)]
v500 <- pred[['v500']][1:nd,-c(1)]
t500 <- pred[['t500']][1:nd,-c(1)]
t850 <- pred[['t850']][1:nd,-c(1)]
z500 <- pred[['z500']][1:nd,-c(1)]
z1000 <- pred[['z1000']][1:nd,-c(1)]
q700 <- pred[['q700']][1:nd,-c(1)]
}

#! HIGH-RESOLUTION (HR) OBSERVATIONAL DATASET
maestro_hr_file <- paste(HR_path, "maestro_red_hr_SPAIN.txt",sep="")
maestro <- read.table(maestro_hr_file)
lon_hr <- unlist(maestro[2])
lat_hr <- unlist(maestro[3])
nptos <- length(readLines(maestro_hr_file))

if (var == "prec") {
   prec_hr_file <- paste(HR_path, "pcp_red_SPAIN_",tdates,".txt",sep="")
   nd_hr <- length(readLines(prec_hr_file))
   preprec_hr <- matrix(scan(prec_hr_file), nrow=nd_hr ,ncol= nptos+1, byrow=TRUE)
   prec_hr <- preprec_hr[1:nd_hr,-c(1)]
} else {
   tmx_hr_file <- paste(HR_path, "tmx_red_SPAIN_",tdates,".txt",sep="")
   tmn_hr_file <- paste(HR_path, "tmn_red_SPAIN_",tdates,".txt",sep="")
   nd_hr <- length(readLines(tmx_hr_file))
   pretmx_hr <- matrix(scan(tmx_hr_file), nrow=nd_hr ,ncol= nptos+1, byrow=TRUE)
   tmx_hr <- pretmx_hr[1:nd_hr,-c(1)]
   pretmn_hr <- matrix(scan(tmn_hr_file), nrow=nd_hr ,ncol= nptos+1, byrow=TRUE)
   tmn_hr <- pretmn_hr[1:nd_hr,-c(1)]
}

  if (nd_hr != nd) {
    stop("Reanalysis variables and HR observations must have the same period.")
  } else {
    dateini_re <- pred[[1]][1,1] 
    if (var == "prec") {
        dateini_hr <- matrix(scan(prec_hr_file), nrow=1 ,ncol= 1, byrow=TRUE)
    } else {
        dateini_hr <- matrix(scan(tmx_hr_file), nrow=1 ,ncol= 1, byrow=TRUE)
    }
    if (dateini_re != dateini_hr) {
    stop("Reanalysis variables and HR observations must start in the same date.")
    }
  }

#! OTHER PARAMETERS that should not be changed
#! Number of analog situations to consider 
nanx <- 155
#! Number of predictors
npx <- 11
nvar <- 7

#!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

if (var == "prec") {

  prePro <- .Fortran("training_part1_prec", 
                      u500 = as.numeric(u500),
                      v500 = as.numeric(v500),
                      t1000 = as.numeric(t1000),
                      z500 = as.numeric(z500),
                      z1000 = as.numeric(z1000),
                      msl_si = as.numeric(msl_si),
                      msl_lr = as.numeric(msl_lr),
                      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[1:prePro$nger,]
             d <- prePro$gv92[1:prePro$nger,]
             e <- prePro$gu52[1:prePro$nger,]
             f <- prePro$gv52[1:prePro$nger,]
 
             g <- prePro$nger

     predSig <- .Fortran("training_part2_prec",
                      u500 = as.numeric(u500),
                      v500 = as.numeric(v500),
                      t500 = as.numeric(t500),
                      t850 = as.numeric(t850),
                      msl_si = as.numeric(msl_si),
                      q700 = as.numeric(q700),
                      lon_hr = as.numeric(lon_hr),
                      lat_hr = as.numeric(lat_hr),
                      prec_hr = as.numeric(prec_hr),
                      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),
                      vdmin = matrix(as.double(seq(1,nptos*4)),c(nptos,4)),
                      vref = matrix(as.integer(seq(1,nptos*4)),c(nptos,4)),  
                      neni = as.integer(1),
                      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
             l <- predSig$vdmin
             m <- predSig$vref  

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

             output <- list("um" = a,
                            "vm" = b,
                            "nger" = g,
                            "gu92" = c,
                            "gv92" = d,
	                    "gu52" = e,
	                    "gv52" = f,
                            "neni" = predSig$neni, 
                            "vdmin" = l,
                            "vref" = m, 
	                    "ccm" = i,
                            "indices" = indices)
} else {

  prePro <- .Fortran("training_temp", 
                      t1000 = as.numeric(t1000),
                      msl_si = as.numeric(msl_si),
                      msl_lr = as.numeric(msl_lr),
                      lon_hr = as.numeric(lon_hr),
                      lat_hr = as.numeric(lat_hr),
                      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),
                      day = as.integer(day),
                      month = as.integer(month),
                      um = matrix(as.double(seq(1,nd*ic)),c(nd,ic)),
                      vm = matrix(as.double(seq(1,nd*ic)),c(nd,ic)),
                      insol = as.numeric(nd),
                      vdmin = matrix(as.double(seq(1,nptos*4)),c(nptos,4)),
                      vref = matrix(as.integer(seq(1,nptos*4)),c(nptos,4)),  
                      neni = as.integer(1),
                      PACKAGE = 'CSTools') 

             a <- prePro$um
             b <- prePro$vm
             c <- prePro$insol
             d <- prePro$vdmin
             e <- prePro$vref
             f <- prePro$neni

              output <- list("um" = a,
                             "vm" = b,
                             "insol" = c,
                             "vdmin" = d,
                             "vref" = e, 
                             "neni" = f) 
          
}

             return(output)

}
                                 
