R/fParseNEON.R

In ksmiff33/FluxSynthU: Suite of functions to analyze eddy covariance data

#' Reads (half-)hourly datafiles from NEON and prepares an export dataframe to be used by REddyProc.
#'
#' @export
#' @title Prepare NEON data for REddyProc
#' @param dat a dataframe containing raw (half-)hourly data from the NEON Network.
#' @param tz_name specify the timezone NAME (not abbrev) (e.g. "America/Winnipeg")
#' @param UTC_offset numeric, indicate the current timezone's number of hours offset from UTC




# fParseNEON
# this code was based on fParseFLX2015() in QAQCfunv4.1.R

# arguments:
#   dat: dataframe with data
#   tz_name: the timezone name (can be gathered from site.info)
#   UTC_offset: the offset in hours from UTC time

# returns:
#   newlist, a list containing:
#       k_out: data frame with data for REddyProc
#       k_plots: same data frame with useful plotting time stamps added
fParseNEON <- function(dat, tz_name, UTC_offset) {

  # original time variables
  k_YY <- dat[,'Year']
  k_doy <- dat[,'DoY']
  k_HH <- dat[,'Hour']


  ## This is a temporary change

  # new variables (convert decimal hours to hours and minutes)
  HH <- k_HH%/%1
  MIN <- (dat[,'Hour'] - dat[,'Hour']%/%1)*60

  # Write a POSIX datetime object using the variables above.

  # First, take the supplied 'Year', 'DoY', and 'Hour' columns from the processed NEON data set (note: these are local time for each site)
  # Next, create a datetime object, using 'UTC' as the default timezone (we'll change this later).
  # We now a vector of datetime values that match the original data, but are in the wrong timezone.
  k_POSIXdate_null <- strptime(paste(k_YY, k_doy, HH,
                                     MIN, sep = "-"), format = "%Y-%j-%H-%M", tz = "UTC")


  # Using a lookup table, determine the number of hours to offset from UTC
  # NOTE: '+' means behind UTC, '-' means ahead of UTC, so we need a negative sign to ensure these are in the correct zone.
  k_POSIXdate_UTC <- k_POSIXdate_null - (UTC_offset*60*60)

  # Finally, we format the UTC offset corrected time to be back in local time, using 'tz_name' from a lookup table.
  k_POSIXdate_local <- format(k_POSIXdate_UTC, tz=tz_name, usetz=TRUE) # character class

  # You'll notice that the time strings match the original data, and are now set to the appropriate timezone (by coordinates).
  # NOTE: As of 4/29/2020, this routine does NOT account for daylight savings time.


  YY <- k_YY
  MM <- lubridate::month(k_POSIXdate_local)
  DD <- lubridate::day(k_POSIXdate_local)
  k_week <- lubridate::week(k_POSIXdate_local)

  k_POSIXdate_plotting <- as.Date(make_datetime(YY,MM,DD,HH,MIN,0))

  k_datenum <- fDatenum(YY, MM, DD, HH, MIN, 0)
  k_dd <- k_datenum - fDatenum(YY, 1, 1, 0, 0, 0) + 1    # equates to 1 for the 1st day of the year, 2 for the 2nd and so on
  k_fracyr <- lubridate::decimal_date(k_POSIXdate_plotting)
  years_of_record <- as.numeric(unique(as.character(YY), 'rows'))   # one representation of each year in the record

  # What to keep?
  # For REddyProc we need: k_YY, k_doy, and k_HH
  # For plotting, we should keep:  k_YY, k_doy, k_HH, k_POSIXdate_plotting, k_fracyr, k_dd
  # Other: years_of_record

  rm(YY,MM,DD,HH,MIN, k_week, k_POSIXdate_null, k_POSIXdate_UTC)

  k_NEE <- as.numeric(dat[,'NEE'])
  k_LE <- as.numeric(dat[,'LH'])
  k_H <- as.numeric(dat[,'H'])
  k_SW_in <- as.numeric(dat[,'SWdown'])
  k_SW_out <- as.numeric(dat[,'SWup'])
  k_LW_in <- as.numeric(dat[,'LWdown'])
  k_LW_out <- as.numeric(dat[,'LWup'])
  k_Tair <- as.numeric(dat[,'Tair'])
  k_Tsoil <- as.numeric(dat[,'Tsoil_501'])
  k_SWC <- as.numeric(dat[,'SWC_501'])
  k_RH <- as.numeric(dat[,'rH'])
  k_VPD <- as.numeric(dat[,'VPD'])
  k_ustar <- as.numeric(dat[,'Ustar'])
  k_PPFD <- as.numeric(dat[,'PAR'])

  # Synthetic vars
  if (!all(is.na(k_SW_in)) & !all(is.na(k_SW_out)) & !all(is.na(k_LW_in)) & !all(is.na(k_LW_out))) {
    k_Rnet <- (k_SW_in - k_SW_out) - (k_LW_in - k_LW_out)
  } else {
    k_Rnet <- NA
  }

  if (!all(is.na(k_SW_in)) & !all(is.na(k_SW_out))) {
    k_albedo <- k_SW_out/k_SW_in
  } else {
    k_albedo <- NA
  }

  # Build output matrix for all years
  # columns needed for REddyProc
  #     k_YY
  #     k_doy
  #     k_HH
  #     k_NEE# including storage
  #     k_LE
  #     k_H
  #     k_SW_in
  #     k_Tair
  #     k_Tsoil
  #     k_RH
  #     k_VPD
  #     k_ustar
  #     k_PPFD  # not needed for original REddyProc


  # Build output matrix for REddyProc for all years
  k_full <- data.frame(k_YY, k_doy, k_HH, k_POSIXdate_local, k_POSIXdate_plotting, k_datenum, k_dd, k_fracyr,
                       k_NEE, k_LE, k_H, k_SW_in, k_SW_out, k_LW_in, k_LW_out, k_Rnet, k_albedo,
                       k_Tair, k_Tsoil, k_SWC, k_RH, k_VPD, k_ustar, k_PPFD)

  # Convert any logical columns to numeric
  k_full <- fLogic2Numeric(k_full)


  k_plots <- k_full

  k_out <- k_full %>%
    select(k_YY, k_doy, k_HH,
           k_NEE, k_LE, k_H, k_SW_in, k_SW_out,
           k_LW_in, k_LW_out, k_Rnet, k_albedo,
           k_Tair, k_Tsoil, k_SWC, k_RH, k_VPD, k_ustar, k_PPFD)


  newlist <- list(a=years_of_record, b=k_out, c=k_plots)
  names(newlist) <- c("years_of_record", "k_out", "k_plots")
  return(newlist)

  rm(k_YY, k_doy, k_HH, k_POSIXdate_plotting, k_datenum, k_fracyr, k_dd, k_NEE, k_LE, k_H, k_SW_in, k_SW_out, k_LW_in,
     k_LW_out, k_Rnet, k_albedo, k_Tair, k_Tsoil, k_SWC, k_RH, k_VPD, k_ustar, k_PPFD, k_out, k_plots, years_of_record)
}