#' Download the Japanese Re-Analysis 55 Years (JRA-55) minimum and maximum temperature at 2 meters
#'
#' This function download JRA-55 minimum and maximum temperature at 2 meters above ground.
#'
#' @param start_date Start date to be downloaded, a character in the form "YYYY-MM-DD".
#' @param end_date End date to be downloaded, a character in the form "YYYY-MM-DD".
#' @param output.dir Full path to the directory where the downloaded files will be saved.
#' @param username Your user ID for JMA Data Dissemination System (JDDS).
#' @param password Your password for JDDS.
#' @param progress If \code{TRUE}, display the download progress on the console.
#'
#' @return The downloaded data are saved under the directory "GRIB".
#'
#' @examples
#'
#' \dontrun{
#' download_jra55_minmax_surf(
#' start_date = "2019-05-26",
#' end_date = "2019-05-26",
#' output.dir = "~/Desktop/DATA/JRA55",
#' username = "my.UID",
#' password = "my.PWD"
#' )
#' }
#'
#' @export
download_jra55_minmax_surf <- function(
start_date, end_date, output.dir,
username, password, progress = TRUE
)
{
on.exit({
rm(curl); gc()
curl::handle_reset(handle)
})
ftpserver <- "ds.data.jma.go.jp"
ftpdir <- "JRA-55/Hist/Daily/minmax_surf"
ftplink <- paste0("ftp://", ftpserver, "/", ftpdir, "/")
if(missing(username))
stop("Japanese 55-year Reanalysis username is missing")
if(is.na(username))
stop("Japanese 55-year Reanalysis username is missing")
if(missing(password))
stop("Japanese 55-year Reanalysis password is missing")
if(is.na(password))
stop("Japanese 55-year Reanalysis password is missing")
login <- paste0(username, ":", password)
curl <- RCurl::getCurlHandle(userpwd = login, ftp.use.epsv = FALSE, dirlistonly = TRUE)
handle <- curl::new_handle()
curl::handle_setopt(handle, userpwd = login)
hours <- time_step_3hour(start_date, end_date)
dir.month <- format(hours, "%Y%m")
file.3hour <- format(hours, "%Y%m%d%H")
listDir <- try(RCurl::getURL(ftplink, curl = curl), silent = TRUE)
if(inherits(listDir, "try-error"))
stop(paste("Unable to connect to", ftplink))
listDir <- unlist(strsplit(listDir, "\r?\n"))
im <- dir.month %in% listDir
if(!any(im)) stop("No data available")
if(any(!im)){
cat(paste("Data for these months",
paste0(unique(dir.month[!im]), collapse = ","),
"are not available"), "\n")
}
dir.month <- dir.month[im]
file.3hour <- file.3hour[im]
ret <- lapply(unique(dir.month), function(mo){
ftpmon <- paste0(ftplink, mo, "/")
listDir <- try(RCurl::getURL(ftpmon, curl = curl), silent = TRUE)
if(inherits(listDir, "try-error")){
cat(paste("Unable to connect to", ftpmon), '\n')
return(NULL)
}
listDir <- unlist(strsplit(listDir, "\r?\n"))
gradsF <- c("TL319.pdef", "minmax_surf.ctl", "minmax_surf.idx")
listDir <- listDir[!listDir %in% gradsF]
ftpfiles <- paste0("minmax_surf.", file.3hour)
ftpfiles <- ftpfiles[ftpfiles %in% listDir]
if(length(ftpfiles) == 0){
cat(paste("Data for", mo, "are not available"), "\n")
return(NULL)
}
dir.out <- file.path(output.dir, "GRIB", mo)
dir.create(dir.out, showWarnings = FALSE, recursive = TRUE)
tl139 <- file.path(file.path(dir.out, "TL319.pdef"))
ftptl139 <- paste0(ftpmon, "TL319.pdef")
if(!file.exists(tl139)){
cat(basename(tl139), '\n')
dc <- curl::curl_download(ftptl139, destfile = tl139, quiet = !progress, handle = handle)
if(inherits(dc, "try-error"))
cat(paste("unable to download", ftptl139), "\n")
}
ctl <- file.path(file.path(dir.out, "minmax_surf.ctl"))
ftpctl <- paste0(ftpmon, "minmax_surf.ctl")
cat(basename(ctl), '\n')
dc <- curl::curl_download(ftpctl, destfile = ctl, quiet = !progress, handle = handle)
if(inherits(dc, "try-error"))
cat(paste("unable to download", ftpctl), "\n")
idx <- file.path(file.path(dir.out, "minmax_surf.idx"))
ftpidx <- paste0(ftpmon, "minmax_surf.idx")
cat(basename(idx), '\n')
dc <- curl::curl_download(ftpidx, destfile = idx, quiet = !progress, handle = handle)
if(inherits(dc, "try-error"))
cat(paste("unable to download", ftpidx), "\n")
rt <- lapply(ftpfiles, function(ff){
loc.f <- file.path(file.path(dir.out, ff))
ftp.f <- paste0(ftpmon, ff)
if(!file.exists(loc.f)){
cat(basename(loc.f), '\n')
dc <- curl::curl_download(ftp.f, destfile = loc.f, quiet = !progress, handle = handle)
if(inherits(dc, "try-error"))
cat(paste("unable to download", ftp.f), "\n")
}
})
return(0)
})
invisible()
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.