Newer
Older
Carlos Delgado Torres
committed
#'Compute the Global Mean Surface Temperature (GMST) anomalies
#'
#'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.
Carlos Delgado Torres
committed
#'
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
#'@param data_tas A numerical array indicating the surface air temperature data
#' to be used for the index computation with the dimensions: 1) latitude,
#' longitude, start date, forecast month, and member (in case of decadal
#' predictions), 2) latitude, longitude, year, month and member (in case of
#' historical simulations), or 3) 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 A numerical array indicating the sea surface temperature data
#' to be used for the index computation with the dimensions: 1) latitude,
#' longitude, start date, forecast month, and member (in case of decadal
#' predictions), 2) latitude, longitude, year, month and member (in case of
#' historical simulations), or 3) 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 A numeric vector indicating the latitudes of the data.
#'@param data_lons A numeric vector indicating the longitudes of the data.
#'@param mask_sea_land An array with dimensions [lat_dim = data_lats, lon_dim =
#' data_lons] for blending 'data_tas' and 'data_tos'.
#'@param sea_value A numeric value indicating the sea grid points in
#' 'mask_sea_land'.
#'@param type A character string indicating the type of data ('dcpp' for
#' decadal predictions, 'hist' for historical simulations, or 'obs' for
#' observations or reanalyses).
#'@param lat_dim A character string of the name of the latitude dimension. The
#' default value is 'lat'.
#'@param lon_dim A character string of the name of the longitude dimension. The
#' default value is 'lon'.
#'@param mask An array of a mask (with 0's in the grid points that have to be
#' masked) or NULL (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. The default value is NULL.
#'@param monini An integer indicating the month in which the forecast system is
#' initialized. Only used when parameter 'type' is 'dcpp'. The default value
#' is 11, i.e., initialized in November.
#'@param fmonth_dim A character string indicating the name of the forecast
#' month dimension. Only used if parameter 'type' is 'dcpp'. The default value
#' is 'fmonth'.
#'@param sdate_dim A character string indicating the name of the start date
#' dimension. Only used if parameter 'type' is 'dcpp'. The default value is
#' 'sdate'.
#'@param indices_for_clim A numeric vector of the indices of the years to
#' compute the climatology for calculating the anomalies, or NULL so the
#' climatology is calculated over the whole period. If the data are already
#' anomalies, set it to FALSE. The default value is NULL.\cr
#' In case of parameter 'type' is '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 character string indicating the name of the year dimension
#' The default value is 'year'. Only used if parameter 'type' is 'hist' or
#' 'obs'.
#'@param month_dim A character string indicating the name of the month
#' dimension. The default value is 'month'. Only used if parameter 'type' is
#' 'hist' or 'obs'.
#'@param member_dim A character string indicating the name of the member
#' dimension. The default value is 'member'. Only used if parameter 'type' is
#' 'dcpp' or 'hist'.
Carlos Delgado Torres
committed
#'
#'@return A numerical array of the GMST anomalies with the dimensions of:
#' 1) sdate, forecast year, and member (in case of decadal predictions);
#' 2) year and member (in case of historical simulations); or
#' 3) year (in case of observations or reanalyses).
Carlos Delgado Torres
committed
#'
#'@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)
Carlos Delgado Torres
committed
#'
#' ## 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)
Carlos Delgado Torres
committed
#'
#' ## 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)
Carlos Delgado Torres
committed
#'
#'@importFrom ClimProjDiags WeightedMean
Carlos Delgado Torres
committed
#'@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') {
Carlos Delgado Torres
committed
## Input Checks
# data_tas and data_tos
if (is.null(data_tas) | is.null(data_tos)) {
stop("Parameter 'data_tas' and 'data_tos' cannot be NULL.")
Carlos Delgado Torres
committed
}
if (!is.numeric(data_tas) | !is.numeric(data_tos)) {
stop("Parameter 'data_tas' and 'data_tos' must be a numeric array.")
Carlos Delgado Torres
committed
}
if (!identical(dim(data_tas), dim(data_tos))) {
stop("The dimension of data_tas and data_tos must be identical.")
Carlos Delgado Torres
committed
}
# data_lats and data_lons part1
if (!(class(data_lats) == 'numeric' | class(data_lats) == 'integer')) {
stop("Parameter 'data_lats' must be a numeric vector.")
Carlos Delgado Torres
committed
}
if (!(class(data_lons) == 'numeric' | class(data_lons) == 'integer')) {
stop("Parameter 'data_lons' must be a numeric vector.")
Carlos Delgado Torres
committed
}
# lat_dim
if (!(is.character(lat_dim) & length(lat_dim) == 1)) {
stop("Parameter 'lat_dim' must be a character string.")
Carlos Delgado Torres
committed
}
if (!lat_dim %in% names(dim(data_tas)) | !lat_dim %in% names(dim(data_tos))) {
stop("Parameter 'lat_dim' is not found in 'data_tas' or 'data_tos' dimension.")
Carlos Delgado Torres
committed
}
# lon_dim
if (!(is.character(lon_dim) & length(lon_dim) == 1)) {
stop("Parameter 'lon_dim' must be a character string.")
Carlos Delgado Torres
committed
}
if (!lon_dim %in% names(dim(data_tas)) | !lon_dim %in% names(dim(data_tos))) {
stop("Parameter 'lon_dim' is not found in 'data_tas' or 'data_tos' dimension.")
Carlos Delgado Torres
committed
}
# data_lats and data_lons part2
if (dim(data_tas)[lat_dim] != length(data_lats) |
dim(data_tos)[lat_dim] != length(data_lats)) {
stop(paste0("The latitude dimension of parameter 'data_tas' and 'data_tos'",
" must be the same length of parameter 'data_lats'."))
Carlos Delgado Torres
committed
}
if (dim(data_tas)[lon_dim] != length(data_lons) |
dim(data_tos)[lon_dim] != length(data_lons)) {
stop(paste0("The longitude dimension of parameter 'data_tas' and 'data_tos'",
" must be the same length of parameter 'data_lons'."))
Carlos Delgado Torres
committed
}
# sea_value
if (!is.numeric(sea_value) | length(sea_value) != 1) {
stop("Parameter 'sea_value' must be a numeric value.")
}
stop("Parameter 'mask_sea_land' must be an array with dimensions [lat_dim, lon_dim].")
} else if (!identical(names(dim(mask_sea_land)), c(lat_dim, lon_dim))) {
stop("Parameter 'mask_sea_land' must be an array with dimensions [lat_dim, lon_dim].")
} else if (!identical(as.integer(dim(mask_sea_land)),
c(length(data_lats), length(data_lons)))) {
stop("Parameter 'mask_sea_land' dimensions must be equal to the length of 'data_lats' and 'data_lons'.")
Carlos Delgado Torres
committed
}
# type
if (!type %in% c('dcpp', 'hist', 'obs')) {
stop("Parameter 'type' must be 'dcpp', 'hist', or 'obs'.")
}
# mask
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)))) {
stop(paste0("Parameter 'mask' must be NULL (no mask) or a numerical array ",
"with c(lat_dim, lon_dim) dimensions and 0 in those grid ",
"points that have to be masked."))
Carlos Delgado Torres
committed
}
}
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
# monini
if (type == 'dcpp') {
if (!is.numeric(monini) | monini %% 1 != 0 | monini < 1 |
monini > 12) {
stop("Parameter 'monini' must be an integer from 1 to 12.")
}
}
# fmonth_dim
if (type == 'dcpp') {
if (!(is.character(fmonth_dim) & length(fmonth_dim) == 1)) {
stop("Parameter 'fmonth_dim' must be a character string.")
}
if (!fmonth_dim %in% names(dim(data_tas)) | !fmonth_dim %in% names(dim(data_tos))) {
stop("Parameter 'fmonth_dim' is not found in 'data_tas' or 'data_tos' dimension.")
}
}
# sdate_dim
if (type == 'dcpp') {
if (!(is.character(sdate_dim) & length(sdate_dim) == 1)) {
stop("Parameter 'sdate_dim' must be a character string.")
}
if (!sdate_dim %in% names(dim(data_tas)) | !sdate_dim %in% names(dim(data_tos))) {
stop("Parameter 'sdate_dim' is not found in 'data_tas' or 'data_tos' dimension.")
}
}
# indices_for_clim
if (!is.null(indices_for_clim)) {
if (!class(indices_for_clim) %in% c('numeric', 'integer')
& !(is.logical(indices_for_clim) & !any(indices_for_clim))) {
stop(paste0("The parameter 'indices_for_clim' must be a numeric vector ",
"or NULL to compute the anomalies based on the whole period, ",
"or FALSE if data are already anomalies"))
}
}
# year_dim
if (type == 'hist' | type == 'obs') {
if (!(is.character(year_dim) & length(year_dim) == 1)) {
stop("Parameter 'year_dim' must be a character string.")
}
if (!year_dim %in% names(dim(data_tas)) | !year_dim %in% names(dim(data_tos))) {
stop("Parameter 'year_dim' is not found in 'data_tas' or 'data_tos' dimension.")
}
}
# month_dim
if (type == 'hist' | type == 'obs') {
if (!(is.character(month_dim) & length(month_dim) == 1)) {
stop("Parameter 'month_dim' must be a character string.")
}
if (!month_dim %in% names(dim(data_tas)) | !month_dim %in% names(dim(data_tos))) {
stop("Parameter 'month_dim' is not found in 'data_tas' or 'data_tos' dimension.")
}
}
# member_dim
if (type == 'hist' | type == 'dcpp') {
if (!(is.character(member_dim) & length(member_dim) == 1)) {
stop("Parameter 'member_dim' must be a character string.")
}
if (!member_dim %in% names(dim(data_tas)) | !member_dim %in% names(dim(data_tos))) {
stop("Parameter 'member_dim' is not found in 'data_tas' or 'data_tos' dimension.")
}
}
## 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)
## To mask those grid point that are missing in the observations
if (!is.null(mask)) {
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
}
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))
Carlos Delgado Torres
committed
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)
Carlos Delgado Torres
committed
return(INDEX)