Commit 9afcad46 authored by aho's avatar aho
Browse files

Merge branch 'develop-calendar-NULL' into 'master'

Avoid crash if calendar type doesn't exist

See merge request !191
parents d4a711c7 ba874e12
Pipeline #7832 passed with stage
in 44 minutes and 53 seconds
......@@ -210,6 +210,17 @@ NcDataReader <- function(file_path = NULL, file_object = NULL,
} else if (grepl(' since ', units)) {
# Find the calendar
calendar <- attr(result, 'variables')[[var_name]]$calendar
# Calendar types recognized by as.PCICt()
cal.list <- c("365_day", "365", "noleap", "360_day", "360", "gregorian", "standard", "proleptic_gregorian")
if (is.null(calendar)) {
warning("Calendar is missing. Use the standard calendar to calculate time values.")
calendar <- 'gregorian'
} else if (!calendar %in% cal.list) {
# if calendar is not recognized by as.PCICt(), forced it to be standard
warning("The calendar type '", calendar, "' is not recognized by NcDataReader(). It is forced to be standard type.")
calendar <- 'gregorian'
}
if (calendar == 'standard') calendar <- 'gregorian'
parts <- strsplit(units, ' since ')[[1]]
......@@ -291,6 +302,7 @@ NcDataReader <- function(file_path = NULL, file_object = NULL,
result <- result * 30 * 24 * 60 * 60 # day to sec
} else { #old code. The calendar is not in any of the above.
#NOTE: Should not have a chance to be used because the calendar types are forced to be standard above already.
result <- result * 30.5
result <- result * 24 * 60 * 60 # day to sec
}
......
......@@ -10,8 +10,8 @@
library(startR)
library(s2dv)
path <- paste0('/esarchive/exp/CMIP6/dcppA-hindcast/cmcc-cm2-sr5/cmip6-dcppA-hindcast_i1p1/',
'DCPP/CMCC/CMCC-CM2-SR5/dcppA-hindcast/$member$/Omon/$var$/gn/v20210312/',
path <- paste0('/esarchive/exp/CMIP6/dcppA-hindcast/CMCC-CM2-SR5/',
'DCPP/CMCC/CMCC-CM2-SR5/dcppA-hindcast/$member$/Omon/$var$/gn/v20200101/',
'$var$_*_s$sdate$-$member$_gn_$aux$.nc')
data <- Start(dataset = path,
......@@ -19,38 +19,35 @@ data <- Start(dataset = path,
sdate = c('1960', '1961'),
aux = 'all',
aux_depends = 'sdate',
j = indices(2:361), # remove two indices to avoid white strips
i = indices(2:291), # remove two indices to avoid white strips
x = indices(2:361), # remove two indices to avoid white strips
y = indices(2:291), # remove two indices to avoid white strips
time = indices(1:12),
member = 'r1i1p1f1',
return_vars = list(j = NULL, i = NULL,
latitude = NULL, longitude = NULL),
return_vars = list(nav_lat = NULL, nav_lon = NULL),
retrieve = F)
attr(data, 'Dimensions')
#dataset var sdate aux j i time member
#dataset var sdate aux x y time member
# 1 1 2 1 360 290 12 1
dim(attr(data, 'Variables')$common$longitude)
# j i
#360 290
dim(attr(data, 'Variables')$common$latitude)
# j i
#360 290
dim(attr(data, 'Variables')$common$nav_lon)
# x y
#362 292
dim(attr(data, 'Variables')$common$nav_lat)
# x y
#362 292
func_regrid <- function(data) {
lons <- attr(data, 'Variables')$common$longitude
lats <- attr(data, 'Variables')$common$latitude
data <- s2dv::CDORemap(data, lons, lats, grid = 'r360x180',
method = 'bil', crop = FALSE)
lons <- attr(data, 'Variables')$common$nav_lon
lats <- attr(data, 'Variables')$common$nav_lat
data <- s2dv::CDORemap(data, lons[2:361, 2:291], lats[2:361, 2:291],
grid = 'r360x180', method = 'bil', crop = FALSE)
lons_reg <- data[['lons']]
lats_reg <- data[['lats']]
return(list(data = data[[1]], lats = lats_reg, lons = lons_reg))
}
#NOTE: The data transposes if target_dims are only 'j' and 'i'.
# If only 'j' and 'i', output_dims will be 'lat', 'lon'.
step <- Step(fun = func_regrid,
target_dims = list(data = c('j', 'i')),
target_dims = list(data = c('x', 'y')),
output_dims = list(data = c('lon', 'lat'),
lats = 'lat', lons = 'lon'),
use_attributes = list(data = "Variables"))
......
......@@ -5,7 +5,7 @@ context("Irregular regriding in the workflow")
test_that("1. ex2_13", {
path <- paste0('/esarchive/exp/CMIP6/dcppA-hindcast/CMCC-CM2-SR5/',
'DCPP/CMCC/CMCC-CM2-SR5/dcppA-hindcast/$member$/Omon/$var$/gn/v20210312/',
'DCPP/CMCC/CMCC-CM2-SR5/dcppA-hindcast/$member$/Omon/$var$/gn/v20200101/',
'$var$_*_s$sdate$-$member$_gn_$aux$.nc')
suppressWarnings(
data <- Start(dataset = path,
......@@ -13,28 +13,27 @@ data <- Start(dataset = path,
sdate = '1960',
aux = 'all',
aux_depends = 'sdate',
j = indices(2:361), # remove two indices to avoid white strips
i = indices(2:291), # remove two indices to avoid white strips
x = indices(2:361), # remove two indices to avoid white strips
y = indices(2:291), # remove two indices to avoid white strips
time = indices(1),
member = 'r1i1p1f1',
return_vars = list(j = NULL, i = NULL,
latitude = NULL, longitude = NULL),
# synonims = list(j = c(j, x), i = c(i, y)),
return_vars = list(#x = NULL, y = NULL,
nav_lat = NULL, nav_lon = NULL),
retrieve = F)
)
func_regrid <- function(data) {
lons <- attr(data, 'Variables')$common$longitude
lats <- attr(data, 'Variables')$common$latitude
data <- s2dv::CDORemap(data, lons, lats, grid = 'r360x180',
lons <- attr(data, 'Variables')$common$nav_lon
lats <- attr(data, 'Variables')$common$nav_lat
data <- s2dv::CDORemap(data, lons[2:361, 2:291], lats[2:361, 2:291], grid = 'r360x180',
method = 'bil', crop = FALSE)
lons_reg <- data[['lons']]
lats_reg <- data[['lats']]
return(list(data = data[[1]], lats = lats_reg, lons = lons_reg))
}
#NOTE: The data transposes if target_dims are only 'j' and 'i'.
# If only 'j' and 'i', output_dims will be 'lat', 'lon'.
step <- Step(fun = func_regrid,
target_dims = list(data = c('j', 'i')),
target_dims = list(data = c('x', 'y')),
output_dims = list(data = c('lon', 'lat'),
lats = 'lat', lons = 'lon'),
use_attributes = list(data = "Variables"))
......@@ -55,11 +54,11 @@ c(lon = 360, dataset = 1, var = 1, sdate = 1, aux = 1, time = 1, member = 1)
)
expect_equal(
attr(data, 'Dimensions'),
c(dataset = 1, var = 1, sdate = 1, aux = 1, j = 360, i = 290, time = 1, member = 1)
c(dataset = 1, var = 1, sdate = 1, aux = 1, x = 360, y = 290, time = 1, member = 1)
)
expect_equal(
mean(res$data, na.rm = T),
13.20951,
8.782398,
tolerance = 0.0001
)
expect_equal(
......@@ -67,5 +66,10 @@ drop(res$data)[120,105:110],
c(28.32521, 28.07044, 27.59033, 27.02514, 26.55184, 26.67090),
tolerance = 0.0001
)
expect_equal(
range(res$data),
c(-1.799982, 31.130471),
tolerance = 0.0001
)
})
......@@ -211,7 +211,7 @@ suppressWarnings(
expect_equal(
attr(obs, 'Variables')$common$time[1],
as.POSIXct('2005-05-16 12:00:00', tz = 'UTC')
as.POSIXct('2005-05-01', tz = 'UTC')
)
expect_equal(
dim(attr(obs, 'Variables')$common$time),
......
......@@ -872,13 +872,13 @@ res <- Start(dat = list(list(path=path_exp)),
})
##############################################
test_that("1-3. Selector type: indices(list)", {
})
#test_that("1-3. Selector type: indices(list)", {
#
#})
##############################################
test_that("1-4. Selector type: indices(vector)", {
})
#test_that("1-4. Selector type: indices(vector)", {
#
#})
##############################################
test_that("4-x-2-12-123-2-1-x", {
......
......@@ -876,15 +876,15 @@ res <- Start(dat = list(list(path=path_exp)),
})
##############################################
test_that("1-3. Selector type: indices(list)", {
})
#test_that("1-3. Selector type: indices(list)", {
#
#})
##############################################
test_that("1-4. Selector type: indices(vector)", {
})
#test_that("1-4. Selector type: indices(vector)", {
#
#})
##############################################
test_that("1-4. Selector type: indices(vector)", {
})
#test_that("1-4. Selector type: indices(vector)", {
#
#})
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment