Nothing
#' Download and import seismic data from an FDSN service provider
#'
#' The function implements download and import of seismic data from FDSN data
#' providers via the fdsnws-dataselect service (see
#' \url{https://www.fdsn.org/webservices/}). It is basically a wrapper for
#' the query approach.
#'
#' The FDSN (International Federation of Digital Seismograph Networks)
#' provides access to a large number of seismic stations worldwide. The data
#' are organised by network, station, component and further arguments. In
#' order to use the eseis function \code{read_fdsn}, one must know at least
#' the former three criteria for the data of interest. A list of networks is
#' available here: \url{https://www.fdsn.org/networks/}. The function expects
#' the 2-digit network code, the 3- or 4-digit station code, a single seismic
#' component ID, and the URL to the data archive. Additional query arguments
#' can be added (and must be added to point at a single seismic trace to
#' download and import). A complete list of query arguments is available
#' here: \url{https://www.fdsn.org/webservices/fdsnws-dataselect-1.1.pdf}.
#'
#' For each network listed there, one can find the URL that gives access to
#' the data (if existing) under "Data Access". Note that the function only
#' requires the first URL part, e.g., \url{https://geofon.gfz-potsdam.de}.
#'
#' @param start \code{POSIXct} value, start time of the data to import. If
#' lazy users only submit a text string instead of a POSIXct object, the
#' function will try to convert that text string, assuming UTC as time zone.
#'
#' @param duration \code{Numeric} value, duration of the data to import,
#' in seconds.
#'
#' @param station \code{Character} vector, optional 3-4-digit FDSN station ID.
#'
#' @param network \code{Character} vector, optional 2-digit FDSN network ID.
#'
#' @param component \code{Character} vector, seismic component to search for.
#' If omitted, the function will look for \code{"BHZ"} by default.
#'
#' @param url \code{Chracter} vector, URL of the FDSN data provider. Should be
#' of the form \code{"http://service.iris.edu"}, i.e., without further URL
#' parts. URLs can be submitted as a vector. If omitted, the function will
#' look in the two most comprehensive providers, i.e.
#' \code{url = c("http://service.iris.edu", "http://eida-federator.ethz.ch")}.
#' See details for further information.
#'
#' @param eseis \code{Logical} value, option to read data to an \code{eseis}
#' object (recommended, see documentation of
#' \code{aux_initiateeseis}), default is \code{TRUE}
#'
#' @param \dots Additional query arguments sent to the FDSN data provider. See
#' details for available argument names and conventions.
#'
#' @return An \code{eseis} object or a \code{list} with the time
#' (\code{$time}) and \code{$signal} vectors as well as meta information.
#'
#' @author Michael Dietze
#'
#' @keywords eseis
#'
#' @examples
#'
#' \dontrun{
#'
#' ## read and plot 10 min of data from Ecuador, specifying the component
#' s <- read_fdsn(start = "2020-05-16 22:42:00",
#' duration = 360,
#' station = "IMBA",
#' network = "EC",
#' component = "HHZ")
#' plot(s)
#'
#' ## read and plot 10 min of data from Germany, specifying the URL
#' s <- read_fdsn(start = "2017-03-21 04:38:00",
#' duration = 360,
#' station = "RGN",
#' network = "GE",
#' url = "http://geofon.gfz-potsdam.de")
#' plot(s)
#'
#' }
#'
#' @export read_fdsn
read_fdsn <- function(
start,
duration,
station,
network,
component = "BHZ",
url,
eseis = TRUE,
...
){
## check start time format
if(class(start)[1] != "POSIXct") {
start <- try(as.POSIXct(start, tz = "UTC"), silent = TRUE)
if(class(start)[1] != "POSIXct") {
stop("Start date is not a POSIXct format!")
}
}
## define end time based on duration
stop <- start + duration
## extract further arguments
dots <- list(...)
## check/set location argument
if ("location" %in% names(dots)) {
location <- paste0("location=", dots$location, "&")
}
else {
location <- ""
}
## check/set quality argument
if ("quality" %in% names(dots)) {
quality <- paste0("quality=", dots$quality, "&")
}
else {
quality <- ""
}
## check/set minimumlength argument
if ("minimumlength" %in% names(dots)) {
minimumlength <- paste0("minimumlength=", dots$minimumlength, "&")
}
else {
minimumlength <- ""
}
## check/set longestonly argument
if ("longestonly" %in% names(dots)) {
longestonly <- paste0("longestonly=", dots$longestonly, "&")
}
else {
longestonly <- ""
}
## check/set urls
if(missing(url) == TRUE) {
url <- c("http://service.iris.edu", "http://eida-federator.ethz.ch")
}
## make parameter list
pars <- list(network = network,
station = station,
start = start,
stop = stop,
channel = component,
location = location,
quality = quality,
minimumlength = minimumlength,
longestonly = longestonly)
## build query url
s <- lapply(url, FUN = function(url, pars) {
## optionally remove superfluent URL parts
url_get <- gsub(x = url,
pattern = "/fdsnws/dataselect/1",
replacement = "")
## optionally remove superfluent URL parts
url_get <- gsub(x = url,
pattern = "/fdsnws",
replacement = "")
## optionally remove superfluent URL parts
url_get <- gsub(x = url,
pattern = "//",
replacement = "")
## build query URL string
url_get <- paste0(url[1], "/fdsnws/dataselect/1/query?",
"network=", network, "&",
"station=", station, "&",
location, quality, minimumlength, longestonly,
"starttime=", format(start, "%Y-%m-%dT%H:%M:%S"), "&",
"endtime=", format(stop, "%Y-%m-%dT%H:%M:%S"), "&",
"channel=", component, "&")
## create temporary file name
f_temp <- paste0(tempdir(), "/",
"temp_eseis_",
format(Sys.time(), "%Y-%m-%d-%H-%M-%S_"),
round(x = runif(n = 1, min = 1000000, max = 9999999),
digits = 0),
".mseed")
## download file
s_tmp <- try(utils::download.file(url = url_get, quiet = TRUE,
destfile = f_temp),
silent = TRUE)
## read downloaded file
s <- suppressWarnings(try(eseis::read_mseed(file = f_temp),
silent = TRUE))
## remove temporary file
try(if(file.exists(f_temp) == TRUE) {
invisible(unlink(f_temp))
}, silent = TRUE)
## return output
return(s)
}, pars)
## remove empty list elements
i_ok <- do.call(c, lapply(X = s, FUN = function(s) {
class(s)[1] == "eseis"
}))
s <- s[i_ok]
s <- s[[1]]
## optionally remove eseis object structure
if(eseis == FALSE) {
s <- list(signal = s$signal,
time = seq(from = s$meta$starttime,
by = s$meta$dt,
length.out = s$meta$n),
meta = s$meta,
header = s$header)
}
## return output
return(s)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.