diff --git a/R/Start.R b/R/Start.R index 54ebdb8159a5a274f6132964f3ba1bdc00d20bd1..702b77633cfda496eedf865bce1fb5b75b849c5a 100644 --- a/R/Start.R +++ b/R/Start.R @@ -2061,24 +2061,28 @@ Start <- function(..., # dim = indices/selectors, transform_crop_domain[[transform_var]] <- generate_transform_crop_domain_values( transform_crop_domain[[transform_var]], - picked_vars = picked_common_vars_ordered[[transform_var]]) + picked_vars = picked_common_vars_ordered[[transform_var]], + transform_var) } else { transform_crop_domain[[transform_var]] <- generate_transform_crop_domain_values( transform_crop_domain[[transform_var]], - picked_vars = picked_common_vars[[transform_var]]) + picked_vars = picked_common_vars[[transform_var]], + transform_var) } } else { # return_vars if (transform_var %in% names(dim_reorder_params)) { transform_crop_domain[[transform_var]] <- generate_transform_crop_domain_values( transform_crop_domain[[transform_var]], - picked_vars = picked_vars_ordered[[i]][[transform_var]]) + picked_vars = picked_vars_ordered[[i]][[transform_var]], + transform_var) } else { transform_crop_domain[[transform_var]] <- generate_transform_crop_domain_values( transform_crop_domain[[transform_var]], - picked_vars = picked_vars[[i]][[transform_var]]) + picked_vars = picked_vars[[i]][[transform_var]], + transform_var) } } } else if (is.atomic(transform_crop_domain[[transform_var]])) { diff --git a/R/zzz.R b/R/zzz.R index 381c9d3ac69ce95bc4d1b8aa6c68bde291e5437c..22805ff6e46751fbe4c991a08f5f5bb6a38220b1 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -565,9 +565,21 @@ generate_vars_to_transform <- function(vars_to_transform, picked_vars, transform } # Turn indices to values for transform_crop_domain -generate_transform_crop_domain_values <- function(transform_crop_domain, picked_vars) { +generate_transform_crop_domain_values <- function(transform_crop_domain, + picked_vars, + transform_var) { if (any(transform_crop_domain == 'all')) { - transform_crop_domain <- c(picked_vars[1], tail(picked_vars, 1)) + if (transform_var %in% .KnownLatNames()) { + transform_crop_domain <- c(-90, 90) + } else if (transform_var %in% .KnownLonNames()) { + if (any(picked_vars > 180)) { + transform_crop_domain <- c(0, 360) + } else { + transform_crop_domain <- c(-180, 180) + } + } else { + transform_crop_domain <- c(picked_vars[1], tail(picked_vars, 1)) + } } else { # indices() if (is.list(transform_crop_domain)) { transform_crop_domain <- picked_vars[unlist(transform_crop_domain)] diff --git a/tests/testthat/test-Start-transform-all.R b/tests/testthat/test-Start-transform-all.R new file mode 100644 index 0000000000000000000000000000000000000000..8a9ca657f61e7cf32a1f55d4531cdc515c781479 --- /dev/null +++ b/tests/testthat/test-Start-transform-all.R @@ -0,0 +1,141 @@ +# This unit test uses 'all' to do the transformation and tests the output grid. +# The results should be identical and consistent with cdo result (with precision difference). +# The test contains three calls with different target grids: +# two with 'r128x64' (from different original grid) and one with 'r100x50'. + +context("Transform test target grid: lon and lat = 'all'") + +#--------------------------------------------------------------- +# cdo is used to verify the data values +# Test 1: original grid 'r360x180' +library(easyNCDF) +grid1 <- '/esarchive/exp/CMIP6/dcppA-hindcast/CanESM5/DCPP/CCCma/CanESM5/dcppA-hindcast/r1i1p2f1/Omon/tos/gr/v20190429/tos_Omon_CanESM5_dcppA-hindcast_s1980-r1i1p2f1_gr_198101-199012.nc' # 'r128x64' +path <- '/esarchive/exp/CMIP6/dcppA-hindcast/CESM1-1-CAM5-CMIP5/DCPP/NCAR/CESM1-1-CAM5-CMIP5/dcppA-hindcast/r1i1p1f1/Omon/tos/gr/v20191016/tos_Omon_CESM1-1-CAM5-CMIP5_dcppA-hindcast_s2015-r1i1p1f1_gr_201511-202512.nc' # 'r360x180' + +file <- NcOpen(path) +arr <- NcToArray(file, + dim_indices = list(lat = 1:180, lon = 1:360, time = 1:2), + vars_to_read = 'tos') +lats <- NcToArray(file, + dim_indices = list(lat = 1:180), vars_to_read = 'lat') +lons <- NcToArray(file, + dim_indices = list(lon = 1:360), vars_to_read = 'lon') +NcClose(file) + +lons <- as.vector(lons) +lats <- as.vector(lats) +suppressWarnings( + arr1 <- s2dv::CDORemap(arr, lons = as.vector(lons), lats = as.vector(lats), + grid = grid1, method = 'con', crop = FALSE) +) +suppressWarnings( + arr2 <- s2dv::CDORemap(arr, lons = as.vector(lons), lats = as.vector(lats), + grid = 'r100x50', method = 'con', crop = FALSE) +) + +#--------------------------------------------------------------- +# Test 2: Original grid 'r432x324' +path <- '/esarchive/exp/CMIP6/dcppA-hindcast/HadGEM3-GC31-MM/DCPP/MOHC/HadGEM3-GC31-MM/dcppA-hindcast/r1i1p1f2/Amon/tas/gn/v20200417/tas_Amon_HadGEM3-GC31-MM_dcppA-hindcast_s2009-r1i1p1f2_gn_201501-201512.nc' # 'r432x324' +file <- NcOpen(path) +arr <- NcToArray(file, + dim_indices = list(lat = 1:324, lon = 1:432, time = 1:2), + vars_to_read = 'tas') +lats <- NcToArray(file, + dim_indices = list(lat = 1:324), vars_to_read = 'lat') +lons <- NcToArray(file, + dim_indices = list(lon = 1:432), vars_to_read = 'lon') +NcClose(file) + +suppressWarnings( + arr3 <- s2dv::CDORemap(arr, lons = as.vector(lons), lats = as.vector(lats), + grid = 'r128x64', method = 'con', crop = FALSE) +) +#--------------------------------------------------------------- + +path1 <- '/esarchive/exp/CMIP6/dcppA-hindcast/CESM1-1-CAM5-CMIP5/DCPP/NCAR/CESM1-1-CAM5-CMIP5/dcppA-hindcast/r1i1p1f1/Omon/$var$/gr/v20191016/$var$_Omon_CESM1-1-CAM5-CMIP5_dcppA-hindcast_s$sdate$-r1i1p1f1_gr_$sdate$11-202512.nc' # 'r360x180' + +test_that("1. 'all'", { + suppressWarnings( + res1 <- Start(dat = path1, + var = 'tos', + lat = 'all', + lon = 'all', + sdate = '2015', fmonth = indices(1:2), + transform = CDORemapper, transform_extra_cells = 2, + transform_params = list(grid = grid1, method = 'con'), + transform_vars = c('lon','lat'), + synonims = list(lat = c('lat','latitude'), + lon = c('lon','longitude'), fmonth = c('fmonth','time')), + return_vars = list(lat = NULL, lon = NULL), + retrieve = TRUE) + ) + suppressWarnings( + res2 <- Start(dat = path1, + var = 'tos', + lat = 'all', + lon = 'all', + lat_reorder = CircularSort(-90, 90), + lon_reorder = CircularSort(-180, 180), + sdate = '2015', fmonth = indices(1:2), + transform = CDORemapper, transform_extra_cells = 2, + transform_params = list(grid = 'r100x50', method = 'con'), + transform_vars = c('lon','lat'), + synonims = list(lat = c('lat','latitude'), + lon = c('lon','longitude'), fmonth = c('fmonth','time')), + return_vars = list(lat = NULL, lon = NULL), + retrieve = FALSE) + ) + # res1 + expect_equal( + as.vector(res1), + as.vector(arr1$data_array) + ) + expect_equal( + as.vector(attributes(res1)$Variables$common$lon), + as.vector(arr1$lon) + ) + # res2 + expect_equal( + as.vector(attributes(res2)$Variables$common$lon + 180), + as.vector(arr2$lon) + ) + expect_equal( + as.vector(attributes(res2)$Variables$common$lat), + as.vector(arr2$lat) + ) +}) + +#--------------------------------------------------------------- + +path2 <- '/esarchive/exp/CMIP6/dcppA-hindcast/HadGEM3-GC31-MM/DCPP/MOHC/HadGEM3-GC31-MM/dcppA-hindcast/r1i1p1f2/Amon/$var$/gn/v20200417/$var$_Amon_HadGEM3-GC31-MM_dcppA-hindcast_s$sdate$-r1i1p1f2_gn_$sdate$11-201512.nc' # 'r432x324' + +test_that("2. test path 2", { + suppressWarnings( + res3 <- Start(dat = path2, + var = 'tas', + lon = 'all', + lat = 'all', + lon_reorder = CircularSort(-180, 180), + sdate = paste0(2015), fmonth = indices(1:2), + transform = CDORemapper, transform_extra_cells = 2, + transform_params = list(grid = "r128x64", method = 'con'), + transform_vars = c('lon','lat'), + synonims = list(lat = c('lat','latitude'), + lon = c('lon','longitude'), fmonth = c('fmonth','time')), + return_vars = list(lat = NULL, lon = NULL, time = 'sdate'), + retrieve = FALSE) + ) + # res3 + expect_equal( + as.vector(attributes(res3)$Variables$common$lon+180), + as.vector(arr3$lon) + ) + expect_equal( + as.vector(attributes(res3)$Variables$common$lat), + as.vector(arr3$lat) + ) +}) + + + +