# vim:textwidth=80:expandtab:shiftwidth=4:softtabstop=4
#' Read an argo File in Copernicus Format
#'
#' This function was added to read a particular file downloaded from the
#' Fleet Monitoring website (Reference 1). The format was inferred
#' through examination of the file and a brief study of a document
#' (Reference 2) that describes the format. Not all fields are read
#' by this function; see Reference 3 for a full list and note that
#' the author would be happy to add new entries (but not to spend hours
#' entering then all).
#'
#' @param file A character string giving the name of the file to load.
#'
#' @template encodingIgnoredTemplate
#'
#' @param debug A flag that turns on debugging. Set to 1 to get a moderate
#' amount of debugging information, or 0 (the default) for silent operation.
#'
#' @param processingLog ignored.
#'
#' @param ... ignored.
#'
#' @references
#' 1. `https://fleetmonitoring.euro-argo.eu/float/4902489`
#'
#' 2. Copernicus Marine In Situ Tac Data Management Team. Copernicus Marine In
#' Situ NetCDF Format Manual (version V1.43). Pdf. Copernicus in situ TAC, 2021.
#' `https://doi.org/10.13155/59938` (link checked 2022-04-11).
#'
#' 3. Variable names are provided in files at
#' `https://doi.org/10.13155/53381` (link checked 2022-04-12)
#'
#' @family things related to argo data
#'
#' @author Dan Kelley
read.argo.copernicus <- function(file, encoding = NA, debug = getOption("oceDebug"), processingLog, ...) {
oceDebug(debug, "read.argo.copernicus(file=\"", filename, "\", ...) START\n", sep = "", unindent = 1)
if (missing(file)) {
stop("must supply 'file'")
}
if (is.character(file)) {
if (!file.exists(file)) {
stop("cannot find file \"", file, "\"")
}
if (0L == file.info(file)$size) {
stop("empty file \"", file, "\"")
}
}
if (!requireNamespace("ncdf4", quietly = TRUE)) {
stop("must install.packages(\"ncdf4\") to read argo data")
}
if (missing(processingLog)) {
processingLog <- paste(deparse(match.call()), sep = "", collapse = "")
}
filename <- ""
# NOTE: need to name ncdf4 package because otherwise R checks give warnings.
if (is.character(file)) {
filename <- fullFilename(file)
file <- ncdf4::nc_open(file)
on.exit(ncdf4::nc_close(file))
} else {
if (!inherits(file, "connection")) {
stop("argument `file' must be a character string or connection")
}
if (!isOpen(file)) {
file <- ncdf4::nc_open(file)
on.exit(ncdf4::nc_close(file))
}
}
varNames <- names(file$var)
oceDebug(debug, "varNames=c(\"", paste(varNames, collapse = "\", \""), "\")\n")
res <- new("argo")
getGlobalAttribute <- function(file, attname) {
a <- ncdf4::ncatt_get(nc = file, varid = 0, attname = attname)
if (a$hasatt) a$value else NULL
}
# FIXME: look in docs to see if there are other interesting things
# that I've missed here.
res@metadata$title <- getGlobalAttribute(file, "title")
res@metadata$institution <- getGlobalAttribute(file, "institution")
res@metadata$source <- getGlobalAttribute(file, "source")
res@metadata$history <- getGlobalAttribute(file, "history")
res@metadata$references <- getGlobalAttribute(file, "references")
res@metadata$userManualVersion <- getGlobalAttribute(file, "user_manual_version")
res@metadata$conventions <- getGlobalAttribute(file, "Conventions")
res@metadata$formatVersion <- getGlobalAttribute(file, "format_version")
res@metadata$conventions <- getGlobalAttribute(file, "Conventions")
res@metadata$featureType <- getGlobalAttribute(file, "featureType")
res@metadata$citation <- getGlobalAttribute(file, "citation")
res@metadata$dateUpdate <- getGlobalAttribute(file, "date_update")
res@metadata$WMOInstType <- getGlobalAttribute(file, "wmo_inst_type")
res@metadata$DOI <- getGlobalAttribute(file, "doi")
res@metadata$PI <- getGlobalAttribute(file, "pi_name")
res@metadata$QCManual <- getGlobalAttribute(file, "qc_manual")
res@metadata$id <- getGlobalAttribute(file, "platform_code") # or "id"???
res@metadata$dataNamesOriginal <- list()
res@metadata$flags <- list()
# print(sort(varNames))
nameMap <- list(
"BBP700" = "backscatter700", # not listed in official docs
"BBP700_ADJUSTED" = "backscatterA700djusted",
"BBP700_ADJUSTED_ERROR" = "backscatterA700djustedError",
"CNDC" = "conductivity",
"CNDC_ADJUSTED" = "conductivityAdjusted",
"CNDC_ADJUSTED_ERROR" = "conductivityAdjustedError",
"CPHL" = "chlorophyll",
"CPHL_ADJUSTED" = "chlorophyllAdjusted",
"CPHL_ADJUSTED_ERROR" = "chlorophyllAdjustedError",
"DIRECTION" = "direction",
"DOX2" = "oxygen",
"DOX2_ADJUSTED" = "oxygenAdjusted",
"DOX2_ADJUSTED_ERROR" = "oxygenAdjustedError",
"DOXY" = "oxygen",
"DOXY_ADJUSTED" = "oxygenAdjusted",
"DOXY_ADJUSTED_ERROR" = "oxygenAdjustedError",
"NTAW" = "nitrate",
"NTAW_ADJUSTED" = "nitrateAdjusted",
"NTAW_ADJUSTED_ERROR" = "nitrateAdjustedError",
"PHPH" = "pH",
"PHPH_ADJUSTED" = "pHAdjusted",
"PHPH_ADJUSTED_ERROR" = "pHAdjustedError",
"PSAL" = "salinity",
"PSAL_ADJUSTED" = "salinityAdjusted",
"PSAL_ADJUSTED_ERROR" = "salinityAdjustedError",
"PRES" = "pressure",
"PRES_ADJUSTED" = "pressureAdjusted",
"PRES_ADJUSTED_ERROR" = "pressureAdjustedError",
"TEMP" = "temperature",
"TEMP_ADJUSTED" = "temperatureAdjusted",
"TEMP_ADJUSTED_ERROR" = "temperatureAdjustedError",
"VERTICAL_SAMPLING_SCHEME" = "verticalSamplingScheme"
)
varNamesKnown <- names(nameMap)
QCNamesKnown <- paste0(names(nameMap), "_QC")
res@metadata$units <- list()
for (name in varNames) {
if (name %in% varNamesKnown) {
oceName <- nameMap[[name]]
res@data[[oceName]] <- ncdf4::ncvar_get(file, name)
res@metadata$dataNamesOriginal[oceName] <- name
oceDebug(debug, "inferring ", oceName, " from ", name, "\n")
if (grepl("^BBP700", name)) {
res@metadata$units[[oceName]] <- list(unit = expression(1 / m), scale = "")
} else if (grepl("^CNDC", name)) {
res@metadata$units[[oceName]] <- list(unit = expression(S / m), scale = "")
} else if (grepl("^CPHL", name)) {
res@metadata$units[[oceName]] <- list(unit = expression(mg / m^3), scale = "")
} else if (grepl("^DOX2", name)) {
res@metadata$units[[oceName]] <- list(unit = expression(umol / kg), scale = "")
} else if (grepl("^DOXY", name)) {
res@metadata$units[[oceName]] <- list(unit = expression(mmol / m^3), scale = "")
} else if (grepl("^NTAW", name)) {
res@metadata$units[[oceName]] <- list(unit = expression(umol / kg), scale = "")
} else if (grepl("^PHPH", name)) {
res@metadata$units[[oceName]] <- list(unit = expression(), scale = "")
} else if (grepl("^PRES", name)) {
res@metadata$units[[oceName]] <- list(unit = expression(dbar), scale = "")
} else if (grepl("^PSAL", name)) {
res@metadata$units[[oceName]] <- list(unit = expression(), scale = "")
} else if (grepl("^TEMP", name)) {
res@metadata$units[[oceName]] <- list(unit = expression(degree * C), scale = "")
} else if (name %in% QCNamesKnown) {
oceName <- nameMap[[gsub("_QC", "", name)]]
res@metadata$flags[[oceName]] <- ncdf4::ncvar_get(file, name)
}
oceDebug(debug, "inferring flags[", oceName, "] from ", name, "\n")
} else if (!(name %in% c("TIME", "POSITION_QC", "TIME_QC"))) { # some special cases skipped
oceDebug(debug, "saving \"", name, "\" to data slot, without renaming\n", sep = "")
res@data[[name]] <- ncdf4::ncvar_get(file, name)
res@metadata$dataNamesOriginal[[name]] <- name
}
}
# Extract longitude, latitude and time, if they are present.
lat <- try(ncdf4::ncvar_get(file, "LATITUDE"), silent = TRUE)
if (!inherits(lat, "try-error")) {
res@data$latitude <- lat
res@metadata$dataNamesOriginal$latitude <- "LATITUDE"
}
lon <- try(ncdf4::ncvar_get(file, "LONGITUDE"), silent = TRUE)
if (!inherits(lon, "try-error")) {
res@data$longitude <- lon
res@metadata$dataNamesOriginal$longitude <- "LONGITUDE"
}
# time is measured in years since start of 1950.
time <- try(ncdf4::ncvar_get(file, "TIME"), silent = TRUE)
if (!inherits(time, "try-error")) {
time0 <- ISOdatetime(1950, 1, 1, 0.0, 0.0, 0.0, tz = "UTC")
res@data$time <- time0 + 86400.0 * time
}
timeQc <- try(ncdf4::ncvar_get(file, "TIME_QC"), silent = TRUE)
if (!inherits(timeQc, "try-error")) {
res@metadata$flags$time <- timeQc
}
positionQc <- try(ncdf4::ncvar_get(file, "POSITION_QC"), silent = TRUE)
if (!inherits(positionQc, "try-error")) {
res@metadata$flags$position <- positionQc
}
oceDebug(debug, "END read.argo.copernicus()\n", sep = "", unindent = 1)
res
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.