R/netCDF_functions.R

In ssaxe-usgs/modelCollect:

#' List NetCDF Variables and Descriptions
#'
#' List all variables in a NetCDF and associated long names and units if available
#' @param ncPaths One or more netCDF files containing the same variable.
#' @param checkVars Check if variable information is the same in all files (slow).
#' @param verbose Should text be printed to console?
#' @return Variable names and information.
#' @export
#' @examples
#' ncdf_info(ncPaths)

ncdf_info <- function(ncPaths,
                      checkVars = F,
                      verbose = F){
  # Load libraries
  tryCatch({
    library("raster")
    library("ncdf4")
  }, warning = function(w){
    stop("Must install packages 'raster' and 'ncdf4'")
  })
  # function to apply to each layer
  nc_variables <- function(x){
    tryCatch({
      # open nc
      nc <- ncdf4::nc_open(x)
      # Get variable info
      meta_out <- do.call("rbind",
                          lapply(X = nc$var,
                                 FUN = function(y){
                                   # names of list y
                                   y_nm <- names(y)
                                   # get variable name
                                   if ("name" %in% y_nm){
                                     name_out <- y$name
                                   }else{
                                     name_out <- NA
                                   }
                                   # Get Long Name
                                   if ("longname" %in% y_nm){
                                     longname_out <- y$longname
                                   }else{
                                     longname_out <- NA
                                   }
                                   # Get units
                                   if ("units" %in% y_nm){
                                     units_out <- y$units
                                   }else{
                                     units_out <- NA
                                   }
                                   # return as data.frame
                                   data.frame(variable = name_out,
                                              long_name = longname_out,
                                              units = units_out,
                                              stringsAsFactors = F)

                                 }))
      rownames(meta_out) <- NULL
      # close connection to netcdf
      ncdf4::nc_close(nc)
      # return data.frame of variable info
      return(meta_out)
    }, error = function(e){
      ncdf4::nc_close(nc)
    })

  }
  # Get variable data from each file
  if (checkVars == T && length(ncPaths) > 1){
    if (verbose) cat("Making sure variables are the same throughout all files...\n")
    all_nc <- pbapply::pblapply(X = ncPaths,
                                FUN = nc_variables)
  }
  # Get variable info from first file
  outt <- nc_variables(ncPaths[1])
  if (verbose){
    cat("File variable information:\n")
    print(outt)
  }
  # return
  return(outt)
}


#' Extract and Save to File a Single NetCDF Variable
#'
#' Function to extract a single variable from NetCDF and save to file as a rasterStack.
#' Variable names can be found using 'ncdf_info' function.
#' @param ncPaths One or more netCDF files containing the same variable.
#' @param varname Variable name.
#' @param savePath Path to save rasterStack as.  Not written to file if not provided this arg.
#' @param r_level Variable level if required.
#' @param verbose Show progress bar and text
#' @return Names of files.
#' @export
#' @examples
#' extract_netCDF

extract_netCDF <- function(ncPaths,
                           varname,
                           savePath,
                           r_level = NULL,
                           verbose = T
                           ){
  # Load libraries
  tryCatch({
    library("raster")
    library("ncdf4")
  }, warning = function(w){
    stop("Must install packages 'raster' and 'ncdf4'")
  })

  # Raster function
  ras_var <- function(x, y, z = r_level){
    # Get raster variable
    ras_out <- tryCatch({
      if (is.null(z)){
        raster::raster(x, var = y)
      }else{
        raster::raster(x, var = y, level = z)
      }
    }, warning = function(w){
      if (grepl(pattern = '"level" set to 1',
                x = w,
                fixed = T)){
        "Level Warning"
      }else{
        w
      }
    })
    # return warning for levels
    if (class(ras_out) == "RasterLayer"){
      return(ras_out)
    }else{
      if (ras_out == "Level Warning"){
        stop(paste0(
          "Variable selected contains multiple levels.\n",
          "\nPlease see the primary source documentation and",
          "\nselect the appropriate level for argument 'r_level'."
        ))
      }else{
        stop(w)
      }
    }
  }

  # Load all rasters, extracting specified variable
  if (verbose){
    ras_stack <- raster::stack(
      pbapply::pblapply(X = ncPaths,
                        FUN = ras_var,
                        y = varname[1],
                        z = r_level)
    )
  }else{
    ras_stack <- raster::stack(
      lapply(X = ncPaths,
             FUN = ras_var,
             y = varname[1],
             z = r_level)
    )
  }

  # If savePath provided, write to file
  if (!is.null(savePath)){
    if (verbose) cat("Writing to file...\n")
    raster::writeRaster(ras_stack, filename = savePath)
  }
  # return
  return(ras_stack)
}