R/download_jra55_minmax_surf.R

In rijaf-iri/CDTDownload: Download gridded data used by Climate Data Tools (CDT)

#' 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()
}