GMST.R 9.46 KB
Newer Older
#'Compute the Global Mean Surface Temperature (GMST) anomalies
#'
#'@description The Global Mean Surface Temperature (GMST) anomalies are computed as the weighted-averaged 
#'surface air temperature anomalies over land and sea surface temperature anomalies over the ocean.
#'@author Carlos Delgado-Torres, \email{carlos.delgado@bsc.es}
#'@author Roberto Bilbao, \email{roberto.bilbao@bsc.es}
#'@author Núria Pérez-Zanón, \email{nuria.perez@bsc.es}
#'
#'@param data_tas Surface air temperature data to be used for the index computation with latitude, longitude, start date, forecast month, and member dimensions (in case of decadal predictions),
#'  with latitude, longitude, year, month and member dimensions (in case of historical simulations), or with latitude, longitude, year and month (in case of observations or reanalyses).
#'  This data has to be provided, at least, over the whole region needed to compute the index. The dimensions must be identical to those of data_tos.
#'@param data_tos Sea surface temperature data to be used for the index computation with latitude, longitude, start date, forecast month, and member dimensions (in case of decadal predictions),
#'  with latitude, longitude, year, month and member dimensions (in case of historical simulations), or with latitude, longitude, year and month (in case of observations or reanalyses).
#'  This data has to be provided, at least, over the whole region needed to compute the index. The dimensions must be identical to those of data_tas.
#'@param data_lats An array with the latitudes of the data.
#'@param data_lons An array with the longitudes of the data.
#'@param mask_sea_land # mask for blending the surface air temperature over land and the sea surface temperature over the ocean. It must have lat_dim and lon_dim dimensions, and their lengths
#'  must be equal to the length of data_lats and data_lons.
#'@param sea_value Value of the sea grid points in the mask.
#'@param type A string the the type of data ('dcpp' for decadal predictions, 'hist' for historical simulations, or 'obs' for observations or reanalyses).
#'@param lat_dim A string with the name of the latitude dimension ('lat' by default).
#'@param lon_dim A string with the name of the longitude dimension ('lon' by default).
#'@param mask An array with a mask (with 0's in the grid points that have to be masked) or NULL (NULL by default, i.e., no mask is used). This parameter allows to remove the values over land in case the dataset is a 
#'  combination of surface air temperature over land and sea surface temperature over the ocean. Also, it can be used to mask those grid points that are missing in the 
#'  observational dataset for a fair comparison between the forecast system and the reference dataset.
#'@param monini Month in which the forecast system is initialized (11 by default, i.e., initialized in November). Only used if type='dcpp'.
#'@param fmonth_dim A string with the name of the forecast month dimension ('fmonth' by default). Only used if type='dcpp'.
#'@param sdate_dim A string with the name of the start date dimension ('sdate' by default). Only used if type='dcpp'.
#'@param indices_for_clim Indices of the years to compute the climatology. If NULL, the climatology is calculated over the whole period (NULL by default).
#'  In case of type='dcpp', indices_for_clim must be relative to the first forecast year, and the climatology is automatically computed over the actual common period for the different forecast years.
#'@param year_dim A string with the name of the year dimension ('year' by default). Only used if type='hist' or type='obs'.
#'@param month_dim A string with the name of the month dimension ('month' by default). Only used if type='hist' or type='obs'.
#'@param member_dim A string with the name of the member dimension ('member' by default). Only used if type='dcpp' or type='hist'.
#'
#'@return The GMST anomalies as function of the sdate, forecast year, and member (in case of decadal predictions);
#'  as function of the year and the member (in case of historical simulations); or as function of the year (in case of observations or reanalyses).
#'
#'@examples
#' ## Observations or reanalyses
#' obs_tas = array(1:100, dim = c(year = 5, lat = 19, lon = 37, month = 12))
#' obs_tos = array(2:101, dim = c(year = 5, lat = 19, lon = 37, month = 12))
#' mask_sea_land = array(c(1,0,1), dim = c(lat = 19, lon = 37))
#' sea_value = 1
#' lat = seq(-90, 90, 10)
#' lon = seq(0, 360, 10)
#' index_obs = GMST(data_tas = obs_tas, data_tos = obs_tos, data_lats = lat, data_lons = lon, type = 'obs', mask_sea_land = mask_sea_land, sea_value = sea_value)
#' 
#' ## Historical simulations
#' hist_tas = array(1:100, dim = c(year = 5, lat = 19, lon = 37, month = 12, member = 5))
#' hist_tos = array(2:101, dim = c(year = 5, lat = 19, lon = 37, month = 12, member = 5))
#' mask_sea_land = array(c(1,0,1), dim = c(lat = 19, lon = 37))
#' sea_value = 1
#' lat = seq(-90, 90, 10)
#' lon = seq(0, 360, 10)
#' index_hist = GMST(data_tas = hist_tas, data_tos = hist_tos, data_lats = lat, data_lons = lon, type = 'hist', mask_sea_land = mask_sea_land, sea_value = sea_value)
#' 
#' ## Decadal predictions
#' dcpp_tas = array(1:100, dim = c(sdate = 5, lat = 19, lon = 37, fmonth = 24, member = 5))
#' dcpp_tos = array(2:101, dim = c(sdate = 5, lat = 19, lon = 37, fmonth = 24, member = 5))
#' mask_sea_land = array(c(1,0,1), dim = c(lat = 19, lon = 37))
#' sea_value = 1
#' lat = seq(-90, 90, 10)
#' lon = seq(0, 360, 10)
#' index_dcpp = GMST(data_tas = dcpp_tas, data_tos = dcpp_tos, data_lats = lat, data_lons = lon, type = 'dcpp', monini = 1, mask_sea_land = mask_sea_land, sea_value = sea_value)
#'
#'@import ClimProjDiags
#'@import multiApply
#'@export
GMST <- function(data_tas, data_tos, data_lats, data_lons, mask_sea_land, sea_value, 
                 type, mask = NULL, lat_dim = 'lat', lon_dim = 'lon', monini = 11,
                 fmonth_dim = 'fmonth', sdate_dim = 'sdate', indices_for_clim = NULL, 
                 year_dim = 'year', month_dim = 'month', member_dim = 'member'){
  
  ## Checkings
  if (!is.array(data_tas)){
    stop('data_tas must be an array')
  }
  if (!is.array(data_tos)){
    stop('data_tos must be an array')
  }
  if (!identical(dim(data_tas),dim(data_tos))){
    stop('The dimension of data_tas and data_tos must be identical')
  }
  if(!class(data_lats)=='numeric'){
    stop('data_lats must be a numeric vector')
  }
  if (!class(data_lons)=='numeric'){
    stop('data_lons must be a numeric vector or NULL')
  }
  if (!type %in% c('dcpp','hist','obs')){
    stop("type must be 'dcpp', 'hist' or 'obs'")
  }
  if (!is.character(lat_dim)){
    stop('lat_dim must be a string')
  }
  if (!is.character(lon_dim)){
    stop('lon_dim must be a string')
  }
  if (!monini){
    stop("monini must be an integer from 1 to 12")
  }
  if (!is.character(fmonth_dim)){
    stop('fmonth_dim must be a string')
  }
  if (!is.character(sdate_dim)){
    stop('sdate_dim must be a string')
  }
  if (!is.null(indices_for_clim) & !class(indices_for_clim) %in% c('numeric','integer') & !is.null(indices_for_clim) & !isFALSE(indices_for_clim)){
    stop("indices_for_clim must be a numeric vector, NULL to compute the anomalies based on the whole period, or FALSE if data are already anomalies")
  }
  if (!is.character(year_dim)){
    stop('year_dim must be a string')
  }
  if (!is.character(month_dim)){
    stop('month_dim must be a string')
  }
  if (!is.array(mask_sea_land)){
    stop('mask_sea_land must be an array with c(lat_dim,lon_dim) dimensions')
  } else if (!identical(names(dim(mask_sea_land)),c(lat_dim,lon_dim))){
    stop('mask_sea_land must be an array with c(lat_dim,lon_dim) dimensions')
  } else if (!identical(as.integer(dim(mask_sea_land)),c(length(data_lats),length(data_lons)))){
    stop('mask_sea_land dimension must be equal to the data_lats and data_lons lengths')
  }
  ## combination of tas and tos (data)
  mask_tas_tos <- function(data_tas, data_tos, mask_sea_land, sea_value) {
    data <- data_tas
    data[mask_sea_land==sea_value] <- data_tos[mask_sea_land==sea_value]
    return(data)
  }
  mask_sea_land <- s2dv::Reorder(data = mask_sea_land, order = c(lat_dim,lon_dim))
  data <- multiApply::Apply(data = list(data_tas, data_tos), target_dims = c(lat_dim,lon_dim), 
                            fun = mask_tas_tos, mask_sea_land = mask_sea_land, sea_value = sea_value)$output1
  data <- drop(data)
  rm(data_tas, data_tos)
  
  if (!is.null(mask)){
    if (is.array(mask) & identical(names(dim(mask)),c(lat_dim,lon_dim)) & identical(as.integer(dim(mask)),c(length(data_lats),length(data_lons)))){
      ## To mask those grid point that are missing in the observations
      mask <- s2dv::Reorder(data = mask, order = c(lat_dim,lon_dim))
      fun_mask <- function(data, mask){
        data[mask == 0] <- NA
        return(data)
      }
      data <- multiApply::Apply(data = data, target_dims = c(lat_dim,lon_dim), fun = fun_mask, mask = mask)$output1
    } else {
      stop('mask must be NULL (no mask) or an array with c(lat_dim,lon_dim) dimensions and 0 in those grid points that have to be masked')
    }
  }
  
  data <- ClimProjDiags::WeightedMean(data = data, lon = data_lons, lat = data_lats, region = NULL,
                                      londim = which(names(dim(data))==lon_dim), latdim = which(names(dim(data))==lat_dim))
  
  INDEX <- .Indices(data = data, type = type, monini = monini,
                    indices_for_clim = indices_for_clim, fmonth_dim = fmonth_dim,
                    sdate_dim = sdate_dim, year_dim = year_dim, 
                    month_dim = month_dim, member_dim = member_dim)