diff --git a/R/Load.R b/R/Load.R index 5ff1dd4c2f969b0fe51a6acbe8bece051834c3ef..58d465634357e36511ceb2797d9c0d22df2ad87e 100644 --- a/R/Load.R +++ b/R/Load.R @@ -74,9 +74,9 @@ Load <- function(var, exp = NULL, obs = NULL, sdates, nmember = NULL, if (!is.list(exp[[i]])) { stop("Error: parameter 'exp' is incorrect. It should be a list of lists.") } - if (!(all(names(exp[[i]]) %in% exp_info_names))) { - stop("Error: parameter 'exp' is incorrect. There are unrecognized components in the information of some of the experiments. Check 'exp' in ?Load for details.") - } + #if (!(all(names(exp[[i]]) %in% exp_info_names))) { + # stop("Error: parameter 'exp' is incorrect. There are unrecognized components in the information of some of the experiments. Check 'exp' in ?Load for details.") + #} if (!('name' %in% names(exp[[i]]))) { exp[[i]][['name']] <- paste0('exp', i) if (!('path' %in% names(exp[[i]]))) { @@ -119,9 +119,9 @@ Load <- function(var, exp = NULL, obs = NULL, sdates, nmember = NULL, if (!is.list(obs[[i]])) { stop("Error: parameter 'obs' is incorrect. It should be a list of lists.") } - if (!(all(names(obs[[i]]) %in% obs_info_names))) { - stop("Error: parameter 'obs' is incorrect. There are unrecognized components in the information of some of the observations. Check 'obs' in ?Load for details.") - } + #if (!(all(names(obs[[i]]) %in% obs_info_names))) { + # stop("Error: parameter 'obs' is incorrect. There are unrecognized components in the information of some of the observations. Check 'obs' in ?Load for details.") + #} if (!('name' %in% names(obs[[i]]))) { obs[[i]][['name']] <- paste0('obs', i) if (!('path' %in% names(obs[[i]]))) { @@ -439,30 +439,58 @@ Load <- function(var, exp = NULL, obs = NULL, sdates, nmember = NULL, member = ifelse(is.null(dimnames[["member"]]), replace_values[["DEFAULT_DIM_NAME_MEMBERS"]], dimnames[['member']])) + mandatory_defaults <- c('DEFAULT_EXP_MAIN_PATH', 'DEFAULT_EXP_FILE_PATH', + 'DEFAULT_OBS_MAIN_PATH', 'DEFAULT_OBS_FILE_PATH', + 'DEFAULT_NC_VAR_NAME', 'DEFAULT_SUFFIX', + 'DEFAULT_VAR_MIN', 'DEFAULT_VAR_MAX', + 'DEFAULT_DIM_NAME_LONGITUDES', + 'DEFAULT_DIM_NAME_LATITUDES', + 'DEFAULT_DIM_NAME_MEMBERS') + extra_vars_with_default_ind <- (1:length(replace_values))[grep('^DEFAULT_', names(replace_values))] + extra_vars_with_default_ind <- extra_vars_with_default_ind[ + grep(paste0(paste0('^', mandatory_defaults), + collapse = '|'), + names(replace_values)[extra_vars_with_default_ind], + invert = TRUE) + ] + extra_vars_with_default <- gsub('^DEFAULT_', '', + names(replace_values)[extra_vars_with_default_ind]) if (!is.null(exp)) { exp <- lapply(exp, function (x) { if (!('dimnames' %in% names(x))) { x[['dimnames']] <- dimnames - x } else { dimnames2 <- dimnames dimnames2[names(x[['dimnames']])] <- x[['dimnames']] x[['dimnames']] <- dimnames2 - x } + i <- 1 + while (i <= length(extra_vars_with_default)) { + if (!(extra_vars_with_default[i] %in% names(x))) { + x[[extra_vars_with_default[i]]] <- replace_values[[extra_vars_with_default_ind[i]]] + } + i <- i + 1 + } + x }) } if (!is.null(obs)) { obs <- lapply(obs, function (x) { if (!('dimnames' %in% names(x))) { x[['dimnames']] <- dimnames - x } else { dimnames2 <- dimnames dimnames2[names(x[['dimnames']])] <- x[['dimnames']] x[['dimnames']] <- dimnames2 - x } + i <- 1 + while (i <= length(extra_vars_with_default)) { + if (!(extra_vars_with_default[i] %in% names(x))) { + x[[extra_vars_with_default[i]]] <- replace_values[[extra_vars_with_default_ind[i]]] + } + i <- i + 1 + } + x }) } single_dataset <- (length(obs) + length(exp) == 1) @@ -511,6 +539,8 @@ Load <- function(var, exp = NULL, obs = NULL, sdates, nmember = NULL, replace_values[["EXP_NAME"]] <- exp[[jmod]][['name']] replace_values[["NC_VAR_NAME"]] <- exp[[jmod]][['nc_var_name']] replace_values[["SUFFIX"]] <- exp[[jmod]][['suffix']] + extra_vars <- names(exp[[jmod]])[which(!(names(exp[[jmod]]) %in% exp_info_names))] + replace_values[extra_vars] <- exp[[jmod]][extra_vars] namevar <- .ConfigReplaceVariablesInString(exp[[jmod]][['nc_var_name']], replace_values) tags_to_find <- c('START_DATE', 'YEAR', 'MONTH', 'DAY', 'MEMBER_NUMBER') position_of_tags <- na.omit(match(tags_to_find, names(replace_values))) @@ -618,7 +648,7 @@ Load <- function(var, exp = NULL, obs = NULL, sdates, nmember = NULL, if (!first_dataset_file_found) { found_path <- Sys.glob(.ConfigReplaceVariablesInString(quasi_final_path, replace_values)) if (length(found_path) > 0) { - found_path <- tail(found_path, 1) + found_path <- head(found_path, 1) if (replace_globs) { quasi_final_path <- .ReplaceGlobExpressions(quasi_final_path, found_path, replace_values, tags_to_find, @@ -651,6 +681,7 @@ Load <- function(var, exp = NULL, obs = NULL, sdates, nmember = NULL, } jsdate <- jsdate + 1 } + replace_values[extra_vars] <- NULL jmod <- jmod + 1 } if (dims2define && length(exp) > 0) { @@ -705,6 +736,8 @@ Load <- function(var, exp = NULL, obs = NULL, sdates, nmember = NULL, replace_values[["OBS_NAME"]] <- obs[[jobs]][['name']] replace_values[["NC_VAR_NAME"]] <- obs[[jobs]][['nc_var_name']] replace_values[["SUFFIX"]] <- obs[[jobs]][['suffix']] + extra_vars <- names(obs[[jobs]])[which(!(names(obs[[jobs]]) %in% obs_info_names))] + replace_values[extra_vars] <- exp[[jobs]][extra_vars] namevar <- .ConfigReplaceVariablesInString(obs[[jobs]][['nc_var_name']], replace_values) tags_to_find <- c('START_DATE', 'MONTH', 'DAY', 'YEAR', 'MEMBER_NUMBER') position_of_tags <- na.omit(match(tags_to_find, names(replace_values))) @@ -792,7 +825,7 @@ Load <- function(var, exp = NULL, obs = NULL, sdates, nmember = NULL, if (!first_dataset_file_found) { found_path <- Sys.glob(.ConfigReplaceVariablesInString(quasi_final_path, replace_values)) if (length(found_path) > 0) { - found_path <- tail(found_path, 1) + found_path <- head(found_path, 1) if (replace_globs) { quasi_final_path <- .ReplaceGlobExpressions(quasi_final_path, found_path, replace_values, tags_to_find, @@ -908,7 +941,7 @@ Load <- function(var, exp = NULL, obs = NULL, sdates, nmember = NULL, if (!first_dataset_file_found) { found_path <- Sys.glob(.ConfigReplaceVariablesInString(quasi_final_path, replace_values)) if (length(found_path) > 0) { - found_path <- tail(found_path, 1) + found_path <- head(found_path, 1) if (replace_globs) { quasi_final_path <- .ReplaceGlobExpressions(quasi_final_path, found_path, replace_values, tags_to_find, @@ -957,6 +990,7 @@ Load <- function(var, exp = NULL, obs = NULL, sdates, nmember = NULL, jsdate <- jsdate + 1 } } + replace_values[extra_vars] <- NULL jobs <- jobs + 1 } if (dims2define && length(obs) > 0) { @@ -1201,6 +1235,11 @@ Load <- function(var, exp = NULL, obs = NULL, sdates, nmember = NULL, position_of_tags <- na.omit(match(tags_to_find, names(replace_values))) if (!is.null(exp)) { lapply(exp, function (x) { + replace_values[["EXP_NAME"]] <- x[['name']] + replace_values[["NC_VAR_NAME"]] <- x[['nc_var_name']] + replace_values[["SUFFIX"]] <- x[['suffix']] + extra_vars <- names(x)[which(!(names(x) %in% exp_info_names))] + replace_values[extra_vars] <- x[extra_vars] if (length(position_of_tags) > 0) { quasi_final_path <- .ConfigReplaceVariablesInString(x[['path']], replace_values[-position_of_tags], TRUE) @@ -1209,10 +1248,16 @@ Load <- function(var, exp = NULL, obs = NULL, sdates, nmember = NULL, replace_values, TRUE) } error_message <<- paste0(error_message, paste0(quasi_final_path, '\n')) + replace_values[extra_vars] <- NULL }) } if (!is.null(obs)) { lapply(obs, function (x) { + replace_values[["OBS_NAME"]] <- x[['name']] + replace_values[["NC_VAR_NAME"]] <- x[['nc_var_name']] + replace_values[["SUFFIX"]] <- x[['suffix']] + extra_vars <- names(x)[which(!(names(x) %in% obs_info_names))] + replace_values[extra_vars] <- x[extra_vars] if (length(position_of_tags) > 0) { quasi_final_path <- .ConfigReplaceVariablesInString(x[['path']], replace_values[-position_of_tags], TRUE) @@ -1221,6 +1266,7 @@ Load <- function(var, exp = NULL, obs = NULL, sdates, nmember = NULL, replace_values, TRUE) } error_message <<- paste0(error_message, paste0(quasi_final_path, '\n')) + replace_values[extra_vars] <- NULL }) } stop(error_message) diff --git a/R/PlotAno.R b/R/PlotAno.R index 495ad6700636063ac23773035285938506ed6ad7..c2b6bfb30becc137b4a25d5360da03a813955bd1 100644 --- a/R/PlotAno.R +++ b/R/PlotAno.R @@ -212,10 +212,10 @@ PlotAno <- function(exp_ano, obs_ano = NULL, sdates, } if (is.null(legends) == FALSE) { if (points) { - legend(0, ul, legends[1:nobs], lty = 3, lwd = 10, col = 1, + legend('topleft', legends[1:nobs], lty = 3, lwd = 10, col = 1, cex = legsize) } else { - legend(0, ul, legends[1:nobs], lty = type[1:nobs], + legend('topleft', ul, legends[1:nobs], lty = type[1:nobs], lwd = thickness[1:nobs], col = 1, cex = legsize) } } diff --git a/R/Utils.R b/R/Utils.R index 9c73fa5f783d2fab507ef571d888ff3383080ca7..4a5e2df950570990c6c4662af3be14d353631fc4 100644 --- a/R/Utils.R +++ b/R/Utils.R @@ -110,7 +110,7 @@ # If we don't find any, we leave the flag 'found_file' with a NULL value. if (length(files) > 0) { # The first file that matches the pattern is chosen and read. - filename <- files[length(files)] + filename <- head(files, 1) filein <- filename found_file <- filename mask <- work_piece[['mask']] @@ -135,6 +135,19 @@ } var_long_name <- fnc$var[[namevar]]$longname units <- fnc$var[[namevar]]$units + file_dimnames <- unlist(lapply(fnc$var[[namevar]][['dim']], '[[', 'name')) + # The following two 'ifs' are to allow for 'lon'/'lat' by default, instead of + # 'longitude'/'latitude'. + if (!(work_piece[['dimnames']][['lon']] %in% file_dimnames) && + (work_piece[['dimnames']][['lon']] == 'longitude') && + ('lon' %in% file_dimnames)) { + work_piece[['dimnames']][['lon']] <- 'lon' + } + if (!(work_piece[['dimnames']][['lat']] %in% file_dimnames) && + (work_piece[['dimnames']][['lat']] == 'latitude') && + ('lat' %in% file_dimnames)) { + work_piece[['dimnames']][['lat']] <- 'lat' + } if (is.null(work_piece[['is_2d_var']])) { is_2d_var <- all(c(work_piece[['dimnames']][['lon']], work_piece[['dimnames']][['lat']]) %in% diff --git a/inst/config/BSC.conf b/inst/config/BSC.conf index 8ebcec9e29e381f0ee2ef4192725fbf25731aaba..c6c7e917d2d2ec78119453cf85386cc56181a5e0 100644 --- a/inst/config/BSC.conf +++ b/inst/config/BSC.conf @@ -6,22 +6,27 @@ ############# !!definitions ############# +# Mandatory defaults DEFAULT_EXP_MAIN_PATH = /es*/exp/*/$EXP_NAME$/ -DEFAULT_SUFFIX = _mean -DEFAULT_EXP_FILE_PATH = $STORE_FREQ$$SUFFIX$/$VAR_NAME$*/$EXP_FILE$ -EXP_FILE = $VAR_NAME$_*$START_DATE$*.nc +DEFAULT_EXP_FILE_PATH = $STORE_FREQ$$SUFFIX$/$VAR_NAME$$FILE_GRID$*/$EXP_FILE$ DEFAULT_OBS_MAIN_PATH = /es*/obs/*/$OBS_NAME$/ DEFAULT_OBS_FILE_PATH = $STORE_FREQ$$SUFFIX$/$VAR_NAME$*/$OBS_FILE$ -OBS_FILE = $VAR_NAME$_$YEAR$$MONTH$*.nc DEFAULT_NC_VAR_NAME = $VAR_NAME$ +DEFAULT_SUFFIX = _mean DEFAULT_VAR_MIN = -1e19 DEFAULT_VAR_MAX = 1e19 DEFAULT_DIM_NAME_LONGITUDES = longitude DEFAULT_DIM_NAME_LATITUDES = latitude DEFAULT_DIM_NAME_MEMBERS = ensemble +# Helper variables +EXP_FILE = $VAR_NAME$_*$START_DATE$*.nc +OBS_FILE = $VAR_NAME$_$YEAR$$MONTH$*.nc RECON_LIST = (20thcr_v2|copernicus012|ds083.2|ecco|era40|era40-erainterim|eraclim|erainterim|erainterim-lores|eraland|gecco_v2|gfs|glorys2_v1|glorys2_v3|glosea5|ishii-kimoto|jra55|merra|merra_v2|ncep-reanalysis|oaflux|oi_v2|orap5|piomas|seaice-lim2|sst|tropflux) +# Defaults for extra variables from Load +DEFAULT_FILE_GRID = -regular + ###################### !!table of experiments ###################### @@ -83,7 +88,7 @@ $RECON_LIST$, .*, /es*/recon/*/$OBS_NAME$/, *, *, *, *, * ", sies, *, $STORE_FREQ$_mean/ice/ice_hadisst_S.nc, sie, *, *, * ", sias, *, ", sia, *, *, * ", si(a|e|v)_.*, *, $STORE_FREQ$_mean/ice/siasie_HadISST.nc,*, *, *, * -(nasa/)?nsidc-nasa, sien, *, $STORE_FREQ$_mean/ice/ice_nsidc_N.nc, sie, *, *, * +(nasa/)?nsidc-siasie, sien, *, $STORE_FREQ$_mean/ice/ice_nsidc_N.nc, sie, *, *, * ", sian, *, ", sia, *, *, * ", sies, *, $STORE_FREQ$_mean/ice/ice_nsidc_S.nc, sie, *, *, * ", sias, *, ", sia, *, *, * diff --git a/inst/doc/plot_timeseries.R b/inst/doc/plot_timeseries.R index 2012797d70761383363284f4f6711f47bb69bebb..092cc5bf8b322f9c982bff717a240022df6d9d7b 100755 --- a/inst/doc/plot_timeseries.R +++ b/inst/doc/plot_timeseries.R @@ -59,9 +59,14 @@ for (expid in lstexpid ) { savename <- paste(savename, '_', expid, sep = '') } if (file.exists(paste(savename, '.sav', sep = ''))) { + cat(paste0("Loading existing data from backup file ", savename, "...\n")) load(paste(savename, '.sav', sep = '')) + if (is.null(toto1$mod) || is.null(toto1$obs)) { + stop("Missing experimental or observational data in backup file. Remove the backup to try retrieving again.") + } } else { if (var == 'prlr' | var == 'tos' ) { + cat("Retrieving mask files...\n") fnc <- nc_open(paste('/esnas/exp/ecearth/constant/land_sea_mask_', grid, '.nc', sep = '')) mask <- ncvar_get(fnc, 'LSM') @@ -116,10 +121,16 @@ if (file.exists(paste(savename, '.sav', sep = ''))) { latmax = latbnd[2], nleadtime = nltimemax, leadtimemax = nltimeout, maskmod = lstmask, maskobs = lstmaskobs) + if (is.null(toto1$mod) || is.null(toto1$obs)) { + stop("Failed retrieving data for all the experiments or observations.") + } if (is.na(match('b02p', lstexpid)) == FALSE) { toto1bis <- Load(varname, 'b02p', obs = NULL, '19501101', latmin = latbnd[1], latmax = latbnd[2], maskmod = lstmask, maskobs = lstmaskobs) + if (is.null(toto1bis$mod)) { + stop("Failed retrieving data for b02p.") + } toto1ter <- Histo2Hindcast(toto1bis$mod, '19501101', sdates, nleadtimesout = nltimeout) toto1beta <- array(dim = c(dim(toto1$mod)[1] + dim(toto1ter)[1],