#' @rdname CST_RFTemp
#' @title Temperature downscaling of a CSTools object using lapse rate correction
#' @author Jost von Hardenberg - ISAC-CNR, \email{j.vonhardenberg@isac.cnr.it}
#' @description This function implements a simple lapse rate correction of a
#' temperature field (an object of class 's2dv_cube' as provided by `CST_Load`) as input.
#' @references Method described in H2020 ECOPOTENTIAL Deliverable No. 8.1: High resolution (1-10 km) climate, land use and ocean change scenarios \link[https://www.ecopotential-project.eu/images/ecopotential/documents/D8.1.pdf]
#' @param data An object of the class 's2dv_cube' as returned by `CST_Load`, 
#' containing the temperature fields to downscale.
#' The data object is expected to have an element named \code{$data} with at least two 
#' The number of longitudes and latitudes in the input data is expected to be even and the same. If not
#' spatial dimensions named "lon" and "lat".
#' @param oro An object of the class 's2dv_cube' as returned by `CST_Load`, 
#' containing fine scale orography (in meters).
#' @param xlim vector with longitude bounds for downscaling
#' @param ylim vector with latitude bounds for downscaling
#' @param lapse float with environmental lapse rate 
#' @param lon_dim string with name of longitude dimension
#' @param lat_dim string with name of latitude dimension
#' @return CST_RFTemp() returns a downscaled CSTools object (i.e., of the class 's2dv_cube').
#' @export
#' @import multiApply
#' @import rainfarmr
#' @examples
#'

CST_RFTemp <- function(data, oro, xlim, ylim, lapse=6.5, lon_dim = "lon", lat_dim = "lat") {

  res <- RFTemp(data$data, data$lon, data$lat,
                oro$data, oro$lon, oro$lat,
                xlim, ylim, lapse, lon_dim = lon_dim, lat_dim = lat_dim)

  data$data <- res$data
  data$lon <- res$lon
  data$lat <- res$lat

  return(data)
}

#' @rdname RFTemp
#' @title Temperature downscaling of a CSTools object using lapse rate correction (reduced version)
#' @author Jost von Hardenberg - ISAC-CNR, \email{j.vonhardenberg@isac.cnr.it}
#' @description This function implements a simple lapse rate correction of a
#' temperature field (a multidimensional array) as input
#' @references Method described in H2020 ECOPOTENTIAL Deliverable No. 8.1: High resolution (1-10 km) climate, land use and ocean change scenarios \link[https://www.ecopotential-project.eu/images/ecopotential/documents/D8.1.pdf]
#' @param data Temperature array to downscale.
#' The input array is expected to have at least two dimensions named "lon" and "lat" by default
#' (these default names can be changed with the \code{lon_dim} and \code{lat_dim} parameters)
#' @param lon Vector or array of longitudes.
#' @param lat Vector or array of latitudes.
#' @param oro Array containing fine-scale orography (in m)
#' @param xlim vector with longitude bounds for downscaling
#' @param ylim vector with latitude bounds for downscaling
#' @param lapse float with environmental lapse rate 
#' @param lon_dim string with name of longitude dimension
#' @param lat_dim string with name of latitude dimension
#' @return RFTemp() returns a list containing the fine-scale longitudes, latitudes and the downscaled fields.
#' @export
#' @import multiApply
#' @import rainfarmr
#' @examples
#'

RFTemp <- function(data, lon, lat, oro, lonoro, latoro,
                   xlim, ylim, lapse = 6.5, lon_dim = "lon", lat_dim = "lat") {

  # Repeatedly apply .downscalet
  result <- Apply(data, target_dims=c(lon_dim, lat_dim), fun=.downscalet,
                  lon, lat, oro, lonoro, latoro, xlim, ylim, lapse=lapse)$output1
  names(dim(result))[1] <- names(dim(tas))[names(dim(tas))==lon_dim]
  names(dim(result))[2] <- names(dim(tas))[names(dim(tas))==lat_dim]

  return(list(data = result, lon = lonoro, lat = latoro))
}


#' Lapse-rate temperature correction downscaling
#'
#' @description Downscales a temperature field using a lapse-rate
#' correction based on a reference orography
#' @author Jost von Hardenberg, \email{j.vonhardenberg@isac.cnr.it}
#' @param lon vector of input longitudes
#' @param lat vector of input latitudes
#' @param t matrix of input temperature data
#' @param lono vector of orography longitudes
#' @param lato vector of orography latitudes
#' @param oro matrix of topographical elevations (in meters) 
#' @param xlim vector of longitude bounds
#' @param ylim vector of latitude bounds
#' @param radius smoothing radius expressed in longitude units (default is half a large-scale pixel)
#' @param lapse environmental lapse rate (in K/Km)
#' @return A downscaled temperature matrix
#' @export
#' @examples
#' lon=5:20
#' lat=35:40
#' t=runif(16*6); dim(t)=c(16,6)
#' lono=seq(5,20,0.1)
#' lato=seq(35,40,0.1)
#' o=runif(151*51)*2000; dim(o)=c(151,51)
#' td=downscalet(lon, lat,t,lono,lato,o,c(8,12),c(36,38))

.downscalet <- function(t, lon, lat, oro, lono, lato, xlim, ylim, radius = 0, lapse = 6.5) {

    if (length(dim(t))==3) {
        nt = dim(t)[3]
    } else {
        nt = 1
        dim(t) <- c(dim(t), 1)
    }

    dxl <- lon[2] - lon[1]
    if(radius==0) {
        radius <- dxl/2
    }
    #Add buffer
    lon1 <- xlim[1] - radius
    lon2 <- xlim[2] + radius
    lat1 <- ylim[1] - radius
    lat2 <- ylim[2] + radius

    orocut <- oro[(lono <= lon2) & (lono >= lon1),
                  (lato <= lat2) & (lato >= lat1)]
    lonocut <- lono[(lono <= lon2) & (lono >= lon1)]
    latocut <- lato[(lato <= lat2) & (lato >= lat1)]

    if (length(dim(tcut0))<3) {
        dim(tcut0) <- c(dim(tcut0), 1)
    }

    nx <- length(lonocut)
    ny <- length(latocut)
    
    # Interpolate nn assuming a regular grid 
    tcut <- array(0., c(nx, ny, nt))
    dy <- lat[2]-lat[1]
    dx <- lon[2]-lon[1]
    jj <- ((latocut-(lat[1]-dy/2)) %/% dy + 1)  
    ii <- ((lonocut-(lon[1]-dx/2)) %/% dx + 1)  

    if((ii[1]<0)|(ii[length(ii)]>length(lon))|
       (jj[1]<0)|(jj[length(jj)]>length(lat))) { 
           stop("Downscaling area not contained in input data")
    }
    for (k in seq_len(nt)) {
        for (j in seq_along(jj)) {
            tcut[,j,k] <- t[ii,jj[j],k]
        }
    }

    dxol <- lonocut[2] - lonocut[1]
    nrad <- as.integer(radius / abs(dxol) + 0.5)

    ns = length(lonocut)
    orocuts=.smooth(orocut, nrad)
    t1 <- -(orocut-orocuts)*lapse/1000.

    tout <- array(0., c(nx, ny, nt))
    for (i in seq_len(nt)) {
        tout[,, i] <- .smooth(tcut[,,i], nrad) + t1
    }
    downscalet <- tout[(lonocut <= xlim[2]) & (lonocut >= xlim[1]),
                       (latocut <= ylim[2]) & (latocut >= ylim[1]),]
}

#' Smoothening using convolution with a circular kernel
#'
#' @description The input field is convolved with a circular kernel with equal
#' weights. Takes into account missing values.
#' @author Jost von Hardenberg, \email{j.vonhardenberg@isac.cnr.it}
#' @param z matrix with the input field to smoothen, with dimensions `c(ns, ns)`
#' @param sdim the smoothing kernel radius in pixel
#' @return The smoothened field.
#' @export
#' @examples
#' z <- rnorm(64 * 64)
#' dim(z) <- c(64, 64)
#' zs <- smooth(z, 8)
#' sd(zs)
#' # [1] 0.1334648

.smooth <- function(z, sdim) {
  imask <- !is.finite(z)
  z[imask] <- 0.
  nsx <- dim(z)[1]
  nsy <- dim(z)[2]

  mask <- matrix(0., nsx, nsy)
  for (i in 1:nsx) {
    for (j in 1:nsy) {
      kx <- i - 1
      ky <- j - 1
      if (i > nsx / 2 + 1) {
        kx <- i - nsx - 1
      }
      if (j > nsy / 2 + 1) {
        ky <- j - nsy - 1
      }
      r2 <- kx * kx + ky * ky
      #mask[i, j] <- exp( - (r2 / (sdim * sdim)) / 2)
      mask[i, j] <- (r2 <= (sdim * sdim))
    }
  }
  fm <- fft(mask)
  zf <- Re(fft(fm * fft(z), inverse = TRUE)) / sum(mask) / length(fm)
  if (sum(imask) > 0) {
           z[!imask] <- 1.0
           zf <- zf / (Re(fft(fm * fft(z), inverse = TRUE)) /
                       sum(mask) / length(fm))
  }
  zf[imask] <- NA
  return(zf)
}
