From b250393ddc1683c8efe81cc498fdb54a4874bf34 Mon Sep 17 00:00:00 2001 From: nperez Date: Tue, 13 Apr 2021 14:52:17 +0200 Subject: [PATCH 1/4] CDORemap works for curvilinear ocean grid --- R/CDORemap.R | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/R/CDORemap.R b/R/CDORemap.R index ea6ff137..edc67030 100644 --- a/R/CDORemap.R +++ b/R/CDORemap.R @@ -726,6 +726,17 @@ CDORemap <- function(data_array = NULL, lons, lats, grid, method, if (!is.null(dims_to_iterate)) { slice_indices <- which(slices_to_iterate == i, arr.ind = TRUE) subset <- Subset(data_array, dims_to_iterate, as.list(slice_indices), drop = 'selected') + # Fix issue 259, curvilinear grid, the order needs to match + if (is_irregular) { + pos_lon <- which(names(dim(subset)) == lon_dim) + pos_lat <- which(names(dim(subset)) == lat_dim) + if (all(dim(lons) != dim(subset)[c(1,2)])) { + new_pos <- 1:length(dim(subset)) + new_pos[pos_lon] <- pos_lat + new_pos[pos_lat] <- pos_lon + subset <- .aperm2(subset, new_pos) + } + } # dims_before_crop <- dim(subset) # Make sure subset goes along with metadata ArrayToNetCDF(setNames(list(subset, lons, lats), c('var', lon_var_name, lat_var_name)), tmp_file) @@ -818,6 +829,17 @@ CDORemap <- function(data_array = NULL, lons, lats, grid, method, if (return_array) { new_dims <- dim(data_array) new_dims[c(lon_dim, lat_dim)] <- c(found_lon_dim_size, found_lat_dim_size) + lon_pos <- which(names(new_dims) == lon_dim) + lat_pos <- which(names(new_dims) == lat_dim) + # Fix issue 259, expected order from CDO output is lon lat + if (is_irregular) { + if (lon_pos > lat_pos) { + new_pos <- 1:length(new_dims) + new_pos[lon_pos] <- lat_pos + new_pos[lat_pos] <- lon_pos + new_dims <- new_dims[new_pos] + } + } result_array <- array(dim = new_dims) store_indices <- as.list(rep(TRUE, length(dim(result_array)))) } -- GitLab From a28f5830c4f3f8ac681e6675765063c53f7d6d3c Mon Sep 17 00:00:00 2001 From: nperez Date: Thu, 15 Apr 2021 18:30:13 +0200 Subject: [PATCH 2/4] Fix CDO with irregular grid for several input files --- R/CDORemap.R | 46 +++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 43 insertions(+), 3 deletions(-) diff --git a/R/CDORemap.R b/R/CDORemap.R index edc67030..07e718ad 100644 --- a/R/CDORemap.R +++ b/R/CDORemap.R @@ -726,17 +726,29 @@ CDORemap <- function(data_array = NULL, lons, lats, grid, method, if (!is.null(dims_to_iterate)) { slice_indices <- which(slices_to_iterate == i, arr.ind = TRUE) subset <- Subset(data_array, dims_to_iterate, as.list(slice_indices), drop = 'selected') - # Fix issue 259, curvilinear grid, the order needs to match + # Fix issue 259, curvilinear grid, the order of the dimensions in slices and + # coordinates needs to match if (is_irregular) { pos_lon <- which(names(dim(subset)) == lon_dim) pos_lat <- which(names(dim(subset)) == lat_dim) - if (all(dim(lons) != dim(subset)[c(1,2)])) { + pos_lon_dim_in_lons <- which(names(dim(lons)) == lon_dim) + pos_lat_dim_in_lons <- which(names(dim(lons)) == lat_dim) + if ((pos_lon > pos_lat && pos_lon_dim_in_lons < pos_lat_dim_in_lons) || + (pos_lon < pos_lat && pos_lon_dim_in_lons > pos_lat_dim_in_lons)) { new_pos <- 1:length(dim(subset)) new_pos[pos_lon] <- pos_lat new_pos[pos_lat] <- pos_lon - subset <- .aperm2(subset, new_pos) + subset <- .aperm2(subset, new_pos) + } + # The unlimited dimension should be placed in the last position + if ('time' %in% names(dim(subset)) && + which(names(dim(subset)) == 'time') != length(dim(subset))) { + new_pos <- 2:length(dim(subset)) + new_pos[length(dim(subset))] <- 1 + subset <- .aperm2(subset, new_pos) } } +print("START") # dims_before_crop <- dim(subset) # Make sure subset goes along with metadata ArrayToNetCDF(setNames(list(subset, lons, lats), c('var', lon_var_name, lat_var_name)), tmp_file) @@ -832,6 +844,7 @@ CDORemap <- function(data_array = NULL, lons, lats, grid, method, lon_pos <- which(names(new_dims) == lon_dim) lat_pos <- which(names(new_dims) == lat_dim) # Fix issue 259, expected order from CDO output is lon lat +# If is irregular, lat and lon position need to be checked: if (is_irregular) { if (lon_pos > lat_pos) { new_pos <- 1:length(new_dims) @@ -846,6 +859,21 @@ CDORemap <- function(data_array = NULL, lons, lats, grid, method, } if (return_array) { store_indices[dims_to_iterate] <- as.list(slice_indices) + # If is irregular, the order of dimenesions in result_array and file may be different and need to be checked before reading the temporal file: + if (is_irregular) { + test_dims <- dim(ncvar_get(ncdf_remapped, 'var', + collapse_degen = FALSE)) + test_dims <- test_dims[which(test_dims > 1)] + pos_test_dims <- match(dim(result_array), test_dims) + if (is.unsorted(pos_test_dims, na.rm = TRUE)) { + # pos_new_dims is used later in the code. Don't overwrite + pos_new_dims <- 1:length(dim(result_array)) + pos_new_dims[which(!is.na(pos_test_dims))] <- + match(test_dims, dim(result_array)) + backup_result_array_dims <- dim(result_array) + dim(result_array) <- dim(result_array)[pos_new_dims] + } + } result_array <- do.call('[<-', c(list(x = result_array), store_indices, list(value = ncvar_get(ncdf_remapped, 'var', collapse_degen = FALSE)))) } @@ -857,7 +885,19 @@ CDORemap <- function(data_array = NULL, lons, lats, grid, method, } nc_close(ncdf_remapped) file.remove(tmp_file2) +print("END") } + # If is irregular, the order of dimension may need to be recovered after reading all the file: + if (is_irregular) { + if (exists('pos_new_dims')) { + pos_new_dims <- 1:length(dim(result_array)) + dims_to_change <- match(backup_result_array_dims, dim(result_array)) + pos_new_dims[which(dims_to_change != 1)] <- + dims_to_change[which(dims_to_change != 1)] + result_array <- .aperm2(result_array, pos_new_dims) + } + } + if (!is.null(permutation)) { dim_backup <- dim(result_array) result_array <- aperm(result_array, permutation_back) -- GitLab From 5b2d1cdf10821962d488704d2f559b3070dbe43e Mon Sep 17 00:00:00 2001 From: nperez Date: Thu, 15 Apr 2021 18:31:04 +0200 Subject: [PATCH 3/4] Remove prints --- R/CDORemap.R | 2 -- 1 file changed, 2 deletions(-) diff --git a/R/CDORemap.R b/R/CDORemap.R index 07e718ad..63e5498d 100644 --- a/R/CDORemap.R +++ b/R/CDORemap.R @@ -748,7 +748,6 @@ CDORemap <- function(data_array = NULL, lons, lats, grid, method, subset <- .aperm2(subset, new_pos) } } -print("START") # dims_before_crop <- dim(subset) # Make sure subset goes along with metadata ArrayToNetCDF(setNames(list(subset, lons, lats), c('var', lon_var_name, lat_var_name)), tmp_file) @@ -885,7 +884,6 @@ print("START") } nc_close(ncdf_remapped) file.remove(tmp_file2) -print("END") } # If is irregular, the order of dimension may need to be recovered after reading all the file: if (is_irregular) { -- GitLab From b29de08411440ded062af77714c27dcd140f4b6d Mon Sep 17 00:00:00 2001 From: nperez Date: Wed, 2 Jun 2021 13:43:36 +0200 Subject: [PATCH 4/4] Fix case 2 dimensional array input --- R/CDORemap.R | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/R/CDORemap.R b/R/CDORemap.R index 63e5498d..4db209cf 100644 --- a/R/CDORemap.R +++ b/R/CDORemap.R @@ -752,6 +752,19 @@ CDORemap <- function(data_array = NULL, lons, lats, grid, method, # Make sure subset goes along with metadata ArrayToNetCDF(setNames(list(subset, lons, lats), c('var', lon_var_name, lat_var_name)), tmp_file) } else { + if (is_irregular) { + pos_lon <- which(names(dim(data_array)) == lon_dim) + pos_lat <- which(names(dim(data_array)) == lat_dim) + pos_lon_dim_in_lons <- which(names(dim(lons)) == lon_dim) + pos_lat_dim_in_lons <- which(names(dim(lons)) == lat_dim) + if ((pos_lon > pos_lat && pos_lon_dim_in_lons < pos_lat_dim_in_lons) || + (pos_lon < pos_lat && pos_lon_dim_in_lons > pos_lat_dim_in_lons)) { + new_pos <- 1:length(dim(data_array)) + new_pos[pos_lon] <- pos_lat + new_pos[pos_lat] <- pos_lon + data_array <- .aperm2(data_array, new_pos) + } + } # dims_before_crop <- dim(data_array) ArrayToNetCDF(setNames(list(data_array, lons, lats), c('var', lon_var_name, lat_var_name)), tmp_file) } @@ -879,6 +892,7 @@ CDORemap <- function(data_array = NULL, lons, lats, grid, method, } else { new_dims <- dim(data_array) new_dims[c(lon_dim, lat_dim)] <- c(found_lon_dim_size, found_lat_dim_size) + result_array <- ncvar_get(ncdf_remapped, 'var', collapse_degen = FALSE) dim(result_array) <- new_dims } @@ -886,7 +900,7 @@ CDORemap <- function(data_array = NULL, lons, lats, grid, method, file.remove(tmp_file2) } # If is irregular, the order of dimension may need to be recovered after reading all the file: - if (is_irregular) { + if (is_irregular & (!is.null(dims_to_iterate))) { if (exists('pos_new_dims')) { pos_new_dims <- 1:length(dim(result_array)) dims_to_change <- match(backup_result_array_dims, dim(result_array)) -- GitLab