#' AEMET Downscaling   
#' Precipitation and maximum and minimum temperature downscaling method 
#' based on analogs: synoptic situations and significant predictors. 
#'
#'@author Marta Dom\'inguez Alonso - AEMET, \email{mdomingueza@aemet.es}
#'
#'@description This function downscales low resolution precipitation data (e.g. from 
#' Seasonal Forecast Models) through the association with an observational high 
#' resolution (HR) dataset (AEMET 5 km gridded data of daily precipitation (Peral et al., 2017))
#' and a collection of predictors and past synoptic situations similar to estimated day. 
#' The method uses three domains: 
#' - peninsular Spain and Balearic Islands domain (5 km resolution): HR precipitation 
#'   and the downscaling result domain. 
#' - synoptic domain (low resolution, e.g. 1.5º x 1.5º): it should be centered over Iberian Peninsula 
#'   and cover enough extension to detect as much synoptic situations as possible.  
#' - extended domain (low resolution, e.g. 1.5º x 1.5): 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_rea List of matrix training period 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)
#' - sea level pressure (slp) 
#' - specific humidity at 700 hPa (q700) 
#' For maximum and minimum temperature:
#' - u component of wind at 500 hPa (u500) 
#' - v component of wind at 500 hPa (v500)
#' - temperature at 500 hPa (t500) 
#' - temperature at 700 hPa (t500) 
#' - temperature at 850 hPa (t850)
#' - sea level pressure (slp) 
#' - specific humidity at 700 hPa (q700) 
#' - 2 meters temperature (tm2m) 
#' All matrix must have 'nd' x 'ngp + 1' dimensions (nd = number of training days, 
#' ngp = number of synoptic gridpoints). Ascii files have 'ngp + 1' columns because 
#' first column must include the date in format %Y%m%d (e.g. 19810101).
#' Note: If you have already charged the reanalysis predictors in your R session, you just
#' need to create the pred_rea object as a list that includes proper variables 
#' (see example 1 below).
#'
#'@param pred_mod List of matrix downscaled period seasonal forecast data. The list 
#' has to contain model atmospheric variables (instantaneous 12h data) that must 
#' be indentify by parenthesis name.
#' For precipitation:
#' - u component of wind at 500 hPa (u500_mod) 
#' - v component of wind at 500 hPa (v500_mod)
#' - temperature at 500 hPa (t500_mod) 
#' - temperature at 850 hPa (t850_mod)
#' - sea level pressure (extended domain) (slp_ext_mod) 
#' - specific humidity at 700 hPa (q700_mod) 
#' For temperature:
#' - u component of wind at 500 hPa (u500_mod) 
#' - v component of wind at 500 hPa (v500_mod)
#' - temperature at 500 hPa (t500_mod) 
#' - temperature at 700 hPa (t500_mod) 
#' - temperature at 850 hPa (t850_mod)
#' - sea level pressure (extended domain) (slp_ext_mod) 
#' - specific humidity at 700 hPa (q700_mod) 
#' - 2 meters temperature (tm2m_mod) 
#' Seasonal forecast variables must have the same resolution and synoptic/extended 
#' domain as reanalysis variables.
#' All matrix must have 'nm' x 'ngp + 1' dimensions (nm = number of downscaling 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. The same as for the training function. 
#'
#'@param lat Vector of the synoptic latitude. The vector must go from north to south.
#' The same as for the training function.
#'
#'@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º). The same as for 
#' the training function.
#'
#'@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-20181231). The same as for the training function.

#'@param ddates Downscaling period dates in format %Y%m%d(start)-%Y%m%d(end) (e.g. 20191001-20200331).
#' 
#'@param restrain List of matrix and parameters obtained from training_analogs. 
#' For precipitation, 'restrain' object must contains um, vm, nger, gu92, gv92, 
#' gu52, gv52, neni, vdmin, vref, ccm, lab_pred and cor_pred variables. 
#' For temperature, 'restrain' object must contains um, vm, insol, neni, vdmin y vref.
#' See 'AnalogsPred_train.R' for more information.
#' 
#'@return downscaling_analogs returns seasonal forecast precipitation (mm) or
#' maximum and minimum temperature in a 5km x 5km regular grid over peninsular 
#' Spain and Balearic Islands. The object is a matrix with 'nm' x 'nptos' dimensions.  

#'@import data.table
#'@examples
#' # Example 1 (precipitation): reading both 'pred_rea' and 'pred_mod' lists from ascii files 
#' #(training period = 200 days).  
#' #(downscaling period =  70 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)
#' slp <- matrix(scan("slp.txt"), nrow=200, ncol=541, byrow=TRUE)
#' q700 <- matrix(scan("q700.txt"), nrow=200, ncol=541, byrow=TRUE)
#' pred_rea <- list ("u500" = u500,
#'               "v500" = v500,
#'               "t500" = t500,
#'               "t850" = t850,
#'               "slp" = slp,
#'               "q700" = q700)
#' u500_mod <- matrix(scan("u500_mod.txt"), nrow=70, ncol=541, byrow=TRUE)
#' v500_mod <- matrix(scan("v500_mod.txt"), nrow=70, ncol=541, byrow=TRUE)
#' t500_mod <- matrix(scan("t500_mod.txt"), nrow=70, ncol=541, byrow=TRUE)
#' t850_mod <- matrix(scan("t850_mod.txt"), nrow=70, ncol=541, byrow=TRUE)
#' slp_ext_mod <- matrix(scan("slp_ext_mod.txt"), nrow=70, ncol=926, byrow=TRUE)
#' q700_mod <- matrix(scan("q700_mod.txt"), nrow=70, ncol=541, byrow=TRUE)
#' pred_mod <- list ("u500_mod" = u500_mod,
#'               "v500_mod" = v500_mod,
#'               "t500_mod" = t500_mod,
#'               "t850_mod" = t850_mod,
#'               "slp_ext_mod" = slp_ext_mod,
#'               "q700_mod" = q700_mod)
#' HR_path <- "/home/localhrpath/" 
#' tdates <- "19810101-19810719"
#' ddates <- "20191001-20191209"
#' resdowns <- downscaling_analogs(prec,pred_rea, pred_mod, lon, lat, nw_ext, HR_path, tdates, ddates,
#'                                 restrain)
#' str(resdowns)
#' num [1:70, 1:20945] 11.567 11.14 26.602 0.042 11.532 ...
#' 
#'@useDynLib CSTools
#'
#'@export

downscaling_analogs <- function(var,
                                pred_rea,
                                pred_mod,
                                lon,
                                lat,
                                nw_ext,
                                HR_path,
                                tdates,
                                ddates,
                                restrain) {

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

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

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

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

if (var == "prec") {
   if (length(pred_rea) != 6) {
       stop("Parameter 'pred_rea' must be a length of 6.")
     }
   if (length(pred_mod) != 6) {
       stop("Parameter 'pred_mod' must be a length of 6.")
     }
} else {
   if (length(pred_rea) != 8) {
       stop("Parameter 'pred_rea' must be a length of 8.")
     }
   if (length(pred_mod) != 8) {
       stop("Parameter 'pred_mod' must be a length of 8.")
     }
}

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.")
  }

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

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

#! 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_rea,nrow))==nrow(pred_rea[[1]]))){
    nd <- nrow(pred_rea[[1]])
    var_dateini_rea <- as.Date(as.character(pred_rea[[1]][1,1]), format="%Y%m%d")
    var_dateend_rea <- as.Date(as.character(pred_rea[[1]][nd,1]), format="%Y%m%d")
    period_rea <- as.numeric(difftime(as.POSIXct(var_dateend_rea), as.POSIXct(var_dateini_rea, tz="UTC"), units="days") + 1)   
    if (nd != period_rea) {
      stop("Dates from reanalysis variables does not match with training number days.")
    }
  } else {
    stop("All 'pred_rea' variables must be in the same period.")
  }

  if (all((sapply(pred_mod,nrow))==nrow(pred_mod[[1]]))){
    nm <- nrow(pred_mod[[1]])
    var_dateini_mod <- as.Date(as.character(pred_mod[[1]][1,1]), format="%Y%m%d")
    var_dateend_mod <- as.Date(as.character(pred_mod[[1]][nm,1]), format="%Y%m%d")
    period_mod <- as.numeric(difftime(as.POSIXct(var_dateend_mod), as.POSIXct(var_dateini_mod, tz="UTC"), units="days") + 1)
    if (nm != period_mod) {
       stop("Dates from seasonal forecast model variables does not match with downscaling number days.")
    }
  } else {
    stop("All 'pred_mod' variables must be in the same period.")
  }

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


#! TRAINING REANALYSIS VARIABLES
u500 <- pred_rea[['u500']][1:nd,-c(1)]
v500 <- pred_rea[['v500']][1:nd,-c(1)]
t500 <- pred_rea[['t500']][1:nd,-c(1)]
t850 <- pred_rea[['t850']][1:nd,-c(1)]
msl_si <- pred_rea[['slp']][1:nd,-c(1)]
q700 <- pred_rea[['q700']][1:nd,-c(1)]

if (var == "temp") {
t700 <- pred_rea[['t700']][1:nd,-c(1)]
tm2m <- pred_rea[['tm2m']][1:nd,-c(1)]
}

#! SEASONAL FORECAST MODEL VARIABLES
u500_mod <- pred_mod[['u500_mod']][1:nm,-c(1)]
v500_mod <- pred_mod[['v500_mod']][1:nm,-c(1)]
t500_mod <- pred_mod[['t500_mod']][1:nm,-c(1)]
t850_mod <- pred_mod[['t850_mod']][1:nm,-c(1)]
msl_lr_mod <- pred_mod[['slp_ext_mod']][1:nm,-c(1)]
q700_mod <- pred_mod[['q700_mod']][1:nm,-c(1)]

if (var == "temp") {
t700_mod <- pred_mod[['t700_mod']][1:nm,-c(1)]
tm2m_mod <- pred_mod[['tm2m_mod']][1:nm,-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 temperature predictors
nvar <- 7

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

if (var == "prec") {

     downs <- .Fortran("down_prec",
                      ic = as.integer(ic),
                      id = as.integer(id),
                      nd = as.integer(nd),
                      nm = as.integer(nm),
                      nlat = as.integer(nlat),
                      nlon = as.integer(nlon),
                      nlatt = as.integer(nlatt),
                      nlont = as.integer(nlont),
                      slat = as.numeric(slat),
                      slon = as.numeric(slon),
                      rlat = as.numeric(rlat),
                      rlon = as.numeric(rlon),
                      slatt = as.numeric(slatt),
                      slont = as.numeric(slont),
                      ngridd = as.integer(ngridd),
                      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),
                      prec_hr = as.numeric(prec_hr),
                      nanx = as.integer(nanx),
                      restrain$um,
                      restrain$vm,
                      restrain$nger,
                      restrain$gu92,
                      restrain$gv92,
                      restrain$gu52,
                      restrain$gv52,
                      restrain$neni,
                      restrain$vdmin,
                      restrain$vref,  
                      restrain$ccm,
                      restrain$indices[,,,1],#lab_pred
                      restrain$indices[,,,2],#cor_pred 
                      u500_mod = as.numeric(u500_mod),
                      v500_mod = as.numeric(v500_mod),
                      t500_mod = as.numeric(t500_mod),
                      t850_mod = as.numeric(t850_mod),
                      msl_lr_mod = as.numeric(msl_lr_mod),
                      q700_mod = as.numeric(q700_mod),
                      pp=matrix(as.double(seq(1,nm*nptos)),c(nm,nptos)),
                      PACKAGE = 'CSTools')

             output <- downs$pp
#             output <- list("down_prec"=downs$pp,
#                            "lon_hr"=lon_hr,
#                            "lat_hr"=lat_hr)

} else {

     downs <- .Fortran("down_temp",
                      ic = as.integer(ic),
                      id = as.integer(id),
                      nd = as.integer(nd),
                      nm = as.integer(nm),
                      nlat = as.integer(nlat),
                      nlon = as.integer(nlon),
                      nlatt = as.integer(nlatt),
                      nlont = as.integer(nlont),
                      slat = as.numeric(slat),
                      slon = as.numeric(slon),
                      rlat = as.numeric(rlat),
                      rlon = as.numeric(rlon),
                      slatt = as.numeric(slatt),
                      slont = as.numeric(slont),
                      ngridd = as.integer(ngridd),
                      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),
                      t700 = as.numeric(t700),
                      tm2m = as.numeric(tm2m),
                      tmx_hr = as.numeric(tmx_hr),
                      tmn_hr = as.numeric(tmn_hr),
                      nanx = as.integer(nanx),
                      nvar = as.integer(nvar),
                      day = as.integer(day),
                      month = as.integer(month),
                      restrain$um,
                      restrain$vm,
                      restrain$insol,
                      restrain$neni,
                      restrain$vdmin,
                      restrain$vref,  
                      u500_mod = as.numeric(u500_mod),
                      v500_mod = as.numeric(v500_mod),
                      t500_mod = as.numeric(t500_mod),
                      t850_mod = as.numeric(t850_mod),
                      msl_lr_mod = as.numeric(msl_lr_mod),
                      q700_mod = as.numeric(q700_mod),
                      t700_mod = as.numeric(t700_mod),
                      tm2m_mod = as.numeric(tm2m_mod),
                      tmx=matrix(as.double(seq(1,nm*nptos)),c(nm,nptos)),
                      tmn=matrix(as.double(seq(1,nm*nptos)),c(nm,nptos)),
                      PACKAGE = 'CSTools')

             output <- list("tmax" = downs$tmx,
                            "tmin" = downs$tmn)

}
             return(output)
}
                                 
