R/fParseAmeriFlux.R
In ksmiff33/FluxSynthU: Suite of functions to analyze eddy covariance data
Defines functions
fParseAmeriFlux
Documented in
fParseAmeriFlux
#' Reads (half-)hourly datafiles from AmeriFlux and prepares an export dataframe to be used by REddyProc.
#'
#' @export
#' @title Prepare AmeriFlux data for REddyProc
#' @param site 6-char AmeriFlux site of interest, e.g. "US-Ho1"
#' @param dat a dataframe containing raw (half-)hourly data from the AmeriFlux 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
# fParseAmeriFlux
# v6.2 KS - bug fixes for parsing date strings and dealing with timezones (applied to fParseFLX2015, fParseNEONKS, and fParseAmeriFluxKS)
# v6.0 DB - parses AmeriFlux files - every site must be treated individually as they all have different column names
# these files do not have qc flags
# this code was based on fParseFLX2015() in QAQCfunv4.1.R
# arguments:
# site: AmeriFlux site of interest, e.g. "US-Ho1"
# 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
fParseAmeriFlux <- function(site, dat, tz_name, UTC_offset) {
# Convert datetime to be read by REddyProc
# parse *end* time of averaging interval - this is required by REddyProc
# Convert serial date to vectors for each datetime format (YY, MM, DD, HH, MIN)
tmp <- dat[,"TIMESTAMP_END"]
YY <- floor(tmp/1e8)
tmp <- tmp - YY*1e8
MM <- floor(tmp/1e6)
tmp <- tmp - MM*1e6
DD <- floor(tmp/1e4)
tmp <- tmp - DD*1e4
HH <- floor(tmp/1e2)
MIN <- tmp - HH*100
## The fDatenum function below is equivalent to the 'datenum' function in MatLab.
# calculates serial dates using the same origin (0000-01-01) as MatLab. This may be trivial, but it works.
k_datenum <- fDatenum(YY, MM, DD, HH, MIN, 0)
# 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(YY, MM, DD, HH, MIN, sep = "-"), format = "%Y-%m-%d-%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.
k_week <- lubridate::week(k_POSIXdate_local)
# Note: k_POSIXdate_plotting is not actually a datetime string
k_POSIXdate_plotting <- as.Date(lubridate::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
# Variables for REddyProc
k_YY <- YY
k_HH <- HH + MIN/60
k_doy <- floor(k_dd) # day of year
rm(YY,MM,DD,HH,MIN, k_week, k_POSIXdate_null, k_POSIXdate_UTC)
# Parse flux and PPFD data
# Function below looks for the appropriate response variable column and extracts it to a new object.
# If the column cannot be found, it assigns a value of zero to the new object and gives a warning.
# NOTE! AmeriFlux columns and headings are not consistent so every site must be dealt with separately
if (site == 'US-NR1'){
k_NEE <- fCheckFLXCols(dat, "FC_PI_F_1_1_1") + fCheckFLXCols(dat, "SC_PI_F_1_1_1")
k_LE <- fCheckFLXCols(dat, "LE_PI_F_1_1_1")
k_H <- fCheckFLXCols(dat, "H_PI_F_1_1_1")
k_SW_in <- fCheckFLXCols(dat, "SW_IN_PI_F_1_1_1")
k_SW_out <- fCheckFLXCols(dat, "SW_OUT_PI_F_1_1_1")
k_LW_in <- fCheckFLXCols(dat, "LW_IN_PI_F_1_1_1")
k_LW_out <- fCheckFLXCols(dat, "LW_OUT_PI_F_1_1_1")
k_Tair <- fCheckFLXCols(dat, "TA_PI_F_1_1_1")
k_Tsoil <- fCheckFLXCols(dat, "TS_PI_F_1_1_1")
k_SWC <- fCheckFLXCols(dat, "SWC_PI_F_1_1_1")
k_RH <- fCheckFLXCols(dat, "RH_PI_F_1_1_1")
k_VPD <- fCheckFLXCols(dat, "VPD_PI_F_1_1_1")
k_ustar <- fCheckFLXCols(dat, "USTAR_PI_F_1_1_1")
k_PPFD <- fCheckFLXCols(dat, "PPFD_IN_PI_F_1_1_1")
}
else if (site == 'US-Ho1'){
k_NEE <- fCheckFLXCols(dat, "NEE_PI_1_1_1")
k_LE <- fCheckFLXCols(dat, "LE_1_1_1")
k_H <- fCheckFLXCols(dat, "H_1_1_1")
k_SW_in <- fCheckFLXCols(dat, "SW_IN_2_1_1")
k_SW_out <- fCheckFLXCols(dat, "SW_OUT_2_1_1")
k_LW_in <- fCheckFLXCols(dat, "LW_IN_2_1_1")
k_LW_out <- fCheckFLXCols(dat, "LW_OUT_2_1_1")
k_Tair <- fCheckFLXCols(dat, "TA_PI_1_1_A")
k_Tsoil <- fCheckFLXCols(dat, "TS_1_2_1")
k_SWC <- as.numeric(rep(NA, times=length(k_fracyr))) # no data
k_RH <- fCheckFLXCols(dat, "RH_1_1_1")
k_VPD <- fCheckFLXCols(dat, "VPD_PI_1_1_1")
k_ustar <- fCheckFLXCols(dat, "USTAR_1_1_1")
k_PPFD <- fCheckFLXCols(dat, "PPFD_IN_1_1_1")
}
else if (site == 'CA-Obs') {
k_NEE <- fCheckFLXCols(dat, "NEE_PI")
k_LE <- fCheckFLXCols(dat, "LE")
k_H <- fCheckFLXCols(dat, "H")
k_SW_in <- fCheckFLXCols(dat, "SW_IN")
k_SW_out <- fCheckFLXCols(dat, "SW_OUT")
k_LW_in <- fCheckFLXCols(dat, "LW_IN")
k_LW_out <- fCheckFLXCols(dat, "LW_OUT")
k_Tair <- fCheckFLXCols(dat, "TA")
k_Tsoil <- fCheckFLXCols(dat, "TS_1")
k_SWC <- fCheckFLXCols(dat, "SWC_1")
k_RH <- fCheckFLXCols(dat, "RH")
k_VPD <- fCheckFLXCols(dat, "VPD_PI")
k_ustar <- fCheckFLXCols(dat, "USTAR")
k_PPFD <- fCheckFLXCols(dat, "PPFD_IN")
}
else if (site == 'CA-TP1' | site == 'CA-TP3') {
k_NEE <- fCheckFLXCols(dat, "NEE_PI")
k_LE <- fCheckFLXCols(dat, "LE")
k_H <- fCheckFLXCols(dat, "H")
k_SW_in <- fCheckFLXCols(dat, "SW_IN_PI_F")
k_SW_out <- as.numeric(rep(NA, times=length(k_fracyr))) # no data
k_LW_in <- as.numeric(rep(NA, times=length(k_fracyr))) # no data
k_LW_out <- as.numeric(rep(NA, times=length(k_fracyr))) # no data
k_Tair <- fCheckFLXCols(dat, "TA")
k_Tsoil <- fCheckFLXCols(dat, "TS_1_1_1")
k_SWC <- fCheckFLXCols(dat, "SWC_1_1_1")
k_RH <- fCheckFLXCols(dat, "RH")
k_VPD <- fCheckFLXCols(dat, "VPD_PI_F")
k_ustar <- fCheckFLXCols(dat, "USTAR")
k_PPFD <- fCheckFLXCols(dat, "PPFD_IN")
}
else if (site == 'CA-TP4') {
k_NEE <- fCheckFLXCols(dat, "NEE_PI")
k_LE <- fCheckFLXCols(dat, "LE")
k_H <- fCheckFLXCols(dat, "H")
k_SW_in <- fCheckFLXCols(dat, "SW_IN")
k_SW_out <- fCheckFLXCols(dat, "SW_OUT")
k_LW_in <- fCheckFLXCols(dat, "LW_IN")
k_LW_out <- fCheckFLXCols(dat, "LW_OUT")
k_Tair <- fCheckFLXCols(dat, "TA_1_1_1")
k_Tsoil <- fCheckFLXCols(dat, "TS_1_1_1")
k_SWC <- fCheckFLXCols(dat, "SWC_1_1_1")
k_RH <- fCheckFLXCols(dat, "RH_1_1_1")
k_VPD <- fCheckFLXCols(dat, "VPD_PI_F")
k_ustar <- fCheckFLXCols(dat, "USTAR")
k_PPFD <- fCheckFLXCols(dat, "PPFD_IN")
}
else if (site == 'CA-TPD') {
k_NEE <- fCheckFLXCols(dat, "NEE_PI")
k_LE <- fCheckFLXCols(dat, "LE")
k_H <- fCheckFLXCols(dat, "H")
k_SW_in <- fCheckFLXCols(dat, "SW_IN")
k_SW_out <- fCheckFLXCols(dat, "SW_OUT")
k_LW_in <- fCheckFLXCols(dat, "LW_IN")
k_LW_out <- fCheckFLXCols(dat, "LW_OUT")
k_Tair <- fCheckFLXCols(dat, "TA")
k_Tsoil <- fCheckFLXCols(dat, "TS_1_1_1")
k_SWC <- fCheckFLXCols(dat, "SWC_1_1_1")
k_RH <- fCheckFLXCols(dat, "RH")
k_VPD <- fCheckFLXCols(dat, "VPD_PI_F")
k_ustar <- fCheckFLXCols(dat, "USTAR")
k_PPFD <- fCheckFLXCols(dat, "PPFD_IN")
}
else if (site == 'US-Bar') {
k_NEE <- fCheckFLXCols(dat, "FC_1_1_1")
k_LE <- fCheckFLXCols(dat, "LE_1_1_1")
k_H <- fCheckFLXCols(dat, "H_1_1_1")
k_SW_in <- fCheckFLXCols(dat, "SW_IN_1_1_1")
k_SW_out <- fCheckFLXCols(dat, "SW_OUT_1_1_1")
k_LW_in <- as.numeric(rep(NA, times=length(k_fracyr))) # no data
k_LW_out <- as.numeric(rep(NA, times=length(k_fracyr))) # no data
k_Tair <- fCheckFLXCols(dat, "TA_PI_F_1_1_1")
k_Tsoil <- fCheckFLXCols(dat, "TS_1_1_1")
k_SWC <- fCheckFLXCols(dat, "SWC_1_1_1")
k_RH <- fCheckFLXCols(dat, "RH_PI_F_1_1_1")
k_VPD <- fCheckFLXCols(dat, "VPD_PI_1_1_1")
k_ustar <- fCheckFLXCols(dat, "USTAR_1_1_1")
k_PPFD <- fCheckFLXCols(dat, "PPFD_IN_PI_F_1_1_1")
}
else if (site == 'CA-Ca1') {
k_NEE <- fCheckFLXCols(dat, "NEE_PI")
k_LE <- fCheckFLXCols(dat, "LE")
k_H <- fCheckFLXCols(dat, "H")
k_SW_in <- fCheckFLXCols(dat, "SW_IN_1_1_1")
k_SW_out <- fCheckFLXCols(dat, "SW_OUT_1_1_1")
k_LW_in <- fCheckFLXCols(dat, "LW_IN_1_1_1")
k_LW_out <- fCheckFLXCols(dat, "LW_OUT_1_1_1")
k_Tair <- fCheckFLXCols(dat, "TA_1_1_1")
k_Tsoil <- fCheckFLXCols(dat, "TS_1_1_1")
k_SWC <- fCheckFLXCols(dat, "SWC_1_1_1")
k_RH <- fCheckFLXCols(dat, "RH_1_1_1")
# calculate VPD from air T and RH via Tetens eqn
es = 0.611*exp((17.502*k_Tair)/(k_Tair+240.97))
ea = (k_RH*es)/100
k_VPD = es - ea
k_ustar <- fCheckFLXCols(dat, "USTAR")
k_PPFD <- fCheckFLXCols(dat, "PPFD_IN_1_1_1")
}
else if (site == 'CA-Ca2') {
k_NEE <- fCheckFLXCols(dat, "NEE_PI")
k_LE <- fCheckFLXCols(dat, "LE")
k_H <- fCheckFLXCols(dat, "H")
k_SW_in <- fCheckFLXCols(dat, "SW_IN_1_1_1")
k_SW_out <- fCheckFLXCols(dat, "SW_OUT_1_1_1")
k_LW_in <- as.numeric(rep(NA, times=length(k_fracyr))) # no data
k_LW_out <- as.numeric(rep(NA, times=length(k_fracyr))) # no data
k_Tair <- fCheckFLXCols(dat, "TA_1_1_1")
k_Tsoil <- fCheckFLXCols(dat, "TS_1_1_1")
k_SWC <- fCheckFLXCols(dat, "SWC_1_1_1")
k_RH <- fCheckFLXCols(dat, "RH_1_1_1")
# calculate VPD from air T and RH via Tetens eqn
es = 0.611*exp((17.502*k_Tair)/(k_Tair+240.97))
ea = (k_RH*es)/100
k_VPD = es - ea
k_ustar <- fCheckFLXCols(dat, "USTAR")
k_PPFD <- fCheckFLXCols(dat, "PPFD_IN")
}
else if (site == 'CA-Ca3') {
k_NEE <- fCheckFLXCols(dat, "NEE_PI")
k_LE <- fCheckFLXCols(dat, "LE")
k_H <- fCheckFLXCols(dat, "H")
k_SW_in <- fCheckFLXCols(dat, "SW_IN_1_1_1")
k_SW_out <- fCheckFLXCols(dat, "SW_OUT_1_1_1")
k_LW_in <- fCheckFLXCols(dat, "LW_IN")
k_LW_out <- fCheckFLXCols(dat, "LW_OUT")
k_Tair <- fCheckFLXCols(dat, "TA_PI_F_1")
k_Tsoil <- fCheckFLXCols(dat, "TS_1_1_1")
k_SWC <- fCheckFLXCols(dat, "SWC_1_1_1")
k_RH <- fCheckFLXCols(dat, "RH_PI_F_1")
# calculate VPD from air T and RH via Tetens eqn
es = 0.611*exp((17.502*k_Tair)/(k_Tair+240.97))
ea = (k_RH*es)/100
k_VPD = es - ea
k_ustar <- fCheckFLXCols(dat, "USTAR")
k_PPFD <- fCheckFLXCols(dat, "PPFD_IN_1_1_1")
}
else if (site == 'CA-Cbo') {
k_NEE <- fCheckFLXCols(dat, "NEE_PI")
k_LE <- fCheckFLXCols(dat, "LE")
k_H <- fCheckFLXCols(dat, "H")
k_SW_in <- fCheckFLXCols(dat, "SW_IN_1_1_1")
k_SW_out <- fCheckFLXCols(dat, "SW_OUT")
k_LW_in <- fCheckFLXCols(dat, "LW_IN")
k_LW_out <- fCheckFLXCols(dat, "LW_OUT")
k_Tair <- fCheckFLXCols(dat, "TA_1_1_1")
k_Tsoil <- fCheckFLXCols(dat, "TS_1_1_1")
k_SWC <- fCheckFLXCols(dat, "SWC_1_1_1")
k_RH <- fCheckFLXCols(dat, "RH_1_1_1")
# calculate VPD from air T and RH via Tetens eqn
es = 0.611*exp((17.502*k_Tair)/(k_Tair+240.97))
ea = (k_RH*es)/100
k_VPD = es - ea
k_ustar <- fCheckFLXCols(dat, "USTAR")
k_PPFD <- fCheckFLXCols(dat, "PPFD_IN_1_1_1")
}
else if (site == 'CA-Ojp') {
k_NEE <- fCheckFLXCols(dat, "NEE_PI")
k_LE <- fCheckFLXCols(dat, "LE")
k_H <- fCheckFLXCols(dat, "H")
k_SW_in <- fCheckFLXCols(dat, "SW_IN")
k_SW_out <- fCheckFLXCols(dat, "SW_OUT")
k_LW_in <- fCheckFLXCols(dat, "LW_IN")
k_LW_out <- fCheckFLXCols(dat, "LW_OUT")
k_Tair <- fCheckFLXCols(dat, "TA_1_1_1")
k_Tsoil <- fCheckFLXCols(dat, "TS_1_1_1")
k_SWC <- fCheckFLXCols(dat, "SWC_1_2_1")
k_RH <- fCheckFLXCols(dat, "RH_1_1_1")
k_VPD <- fCheckFLXCols(dat, "VPD_PI")
k_ustar <- fCheckFLXCols(dat, "USTAR")
k_PPFD <- fCheckFLXCols(dat, "PPFD_IN_1_1_1")
}
else if (site == 'CA-Qcu') {
k_NEE <- fCheckFLXCols(dat, "NEE_PI")
k_LE <- fCheckFLXCols(dat, "LE")
k_H <- fCheckFLXCols(dat, "H")
k_SW_in <- fCheckFLXCols(dat, "SW_IN")
k_SW_out <- fCheckFLXCols(dat, "SW_OUT")
k_LW_in <- fCheckFLXCols(dat, "LW_IN")
k_LW_out <- fCheckFLXCols(dat, "LW_OUT")
k_Tair <- fCheckFLXCols(dat, "TA")
k_Tsoil <- fCheckFLXCols(dat, "TS_1")
k_SWC <- fCheckFLXCols(dat, "SWC_1")
k_RH <- fCheckFLXCols(dat, "RH")
k_VPD <- fCheckFLXCols(dat, "VPD_PI")
k_ustar <- fCheckFLXCols(dat, "USTAR")
k_PPFD <- fCheckFLXCols(dat, "PPFD_IN")
}
else if (site == 'CA-Qc2'){
k_NEE <- fCheckFLXCols(dat, "NEE_PI")
k_LE <- fCheckFLXCols(dat, "LE_1_1_1")
k_H <- fCheckFLXCols(dat, "H_1_1_1")
k_SW_in <- as.numeric(rep(NA, times=length(k_fracyr))) # no data
k_SW_out <- as.numeric(rep(NA, times=length(k_fracyr))) # no data
k_LW_in <- as.numeric(rep(NA, times=length(k_fracyr))) # no data
k_LW_out <- as.numeric(rep(NA, times=length(k_fracyr))) # no data
k_Tair <- fCheckFLXCols(dat, "TA_1_1_1")
k_Tsoil <- fCheckFLXCols(dat, "TS_1_1_1")
k_SWC <- fCheckFLXCols(dat, "SWC_1_1_1")
k_RH <- fCheckFLXCols(dat, "RH_1_1_1")
# calculate VPD from air T and RH via Tetens eqn
es = 0.611*exp((17.502*k_Tair)/(k_Tair+240.97))
ea = (k_RH*es)/100
k_VPD = es - ea
k_ustar <- fCheckFLXCols(dat, "USTAR")
k_PPFD <- fCheckFLXCols(dat, "PPFD_IN_1_1_1")
}
else if (site == 'CA-SJ1' | site == 'CA-SJ3') {
message('this site does not have enough useful data - rejected')
# k_NEE <- fCheckFLXCols(dat, "FC")
# k_LE <- fCheckFLXCols(dat, "LE")
# k_H <- fCheckFLXCols(dat, "H")
# k_SW_in <- fCheckFLXCols(dat, "SW_IN")
# k_SW_out <- fCheckFLXCols(dat, "SW_OUT")
# k_LW_in <- fCheckFLXCols(dat, "LW_IN")
# k_LW_out <- fCheckFLXCols(dat, "LW_OUT")
# k_Tair <- fCheckFLXCols(dat, "TA_1_1_1")
# k_Tsoil <- fCheckFLXCols(dat, "TS_1_1_1")
# k_SWC <- fCheckFLXCols(dat, "SWC_PI_1")
# k_RH <- fCheckFLXCols(dat, "RH_1_1_1")
# # calculate VPD from air T and RH via Tetens eqn
# es = 0.611*exp((17.502*k_Tair)/(k_Tair+240.97))
# ea = (k_RH*es)/100
# k_VPD = es - ea
# k_ustar <- fCheckFLXCols(dat, "USTAR")
# k_PPFD <- fCheckFLXCols(dat, "PPFD_IN_1_1_1")
}
else if (site == 'CA-SJ2'){
message('this site does not have enough useful data - rejected')
# k_NEE <- fCheckFLXCols(dat, "FC")
# k_LE <- fCheckFLXCols(dat, "LE")
# k_H <- fCheckFLXCols(dat, "H")
# k_SW_in <- fCheckFLXCols(dat, "SW_IN")
# k_SW_out <- fCheckFLXCols(dat, "SW_OUT")
# k_LW_in <- fCheckFLXCols(dat, "LW_IN")
# k_LW_out <- fCheckFLXCols(dat, "LW_OUT")
# k_Tair <- fCheckFLXCols(dat, "TA_1_1_1")
# k_Tsoil <- fCheckFLXCols(dat, "TS_1_1_1")
# k_SWC <- fCheckFLXCols(dat, "SWC_PI_1")
# k_RH <- fCheckFLXCols(dat, "RH_1_1_1")
# # calculate VPD from air T and RH via Tetens eqn
# es = 0.611*exp((17.502*k_Tair)/(k_Tair+240.97))
# ea = (k_RH*es)/100
# k_VPD = es - ea
# k_ustar <- fCheckFLXCols(dat, "USTAR")
# k_PPFD <- fCheckFLXCols(dat, "PPFD_IN")
}
else {
# save this bit to add new sites
# k_NEE <- fCheckFLXCols(dat, "")
# k_LE <- fCheckFLXCols(dat, "")
# k_H <- fCheckFLXCols(dat, "")
# k_SW_in <- fCheckFLXCols(dat, "")
# k_SW_out <- fCheckFLXCols(dat, "")
# k_LW_in <- fCheckFLXCols(dat, "")
# k_LW_out <- fCheckFLXCols(dat, "")
# k_Tair <- fCheckFLXCols(dat, "")
# k_Tsoil <- fCheckFLXCols(dat, "")
# k_SWC <- fCheckFLXCols(dat, "")
# k_RH <- fCheckFLXCols(dat, "")
# k_VPD <- fCheckFLXCols(dat, "")
# k_ustar <- fCheckFLXCols(dat, "")
# k_PPFD <- fCheckFLXCols(dat, "")
}
# Synthetic vars
#++++ This needs to be checked!
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)
# special case for CA-Obs: years 1997, 1998, and 2011 are problematic (no flux data) so delete them
if (site == 'CA-Obs') {
test <- k_YY != 1997 & k_YY != 1998 & k_YY != 2011
k_out <- k_out[test,]
k_POSIXdate_plotting <- k_POSIXdate_plotting[test]
k_fracyr <- k_fracyr[test]
}
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)
}
ksmiff33/FluxSynthU documentation built on Dec. 15, 2020, 10:29 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions fParseAmeriFlux
Documented in fParseAmeriFlux
#' Reads (half-)hourly datafiles from AmeriFlux and prepares an export dataframe to be used by REddyProc.
#'
#' @export
#' @title Prepare AmeriFlux data for REddyProc
#' @param site 6-char AmeriFlux site of interest, e.g. "US-Ho1"
#' @param dat a dataframe containing raw (half-)hourly data from the AmeriFlux 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
# fParseAmeriFlux
# v6.2 KS - bug fixes for parsing date strings and dealing with timezones (applied to fParseFLX2015, fParseNEONKS, and fParseAmeriFluxKS)
# v6.0 DB - parses AmeriFlux files - every site must be treated individually as they all have different column names
# these files do not have qc flags
# this code was based on fParseFLX2015() in QAQCfunv4.1.R
# arguments:
# site: AmeriFlux site of interest, e.g. "US-Ho1"
# 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
fParseAmeriFlux <- function(site, dat, tz_name, UTC_offset) {
# Convert datetime to be read by REddyProc
# parse *end* time of averaging interval - this is required by REddyProc
# Convert serial date to vectors for each datetime format (YY, MM, DD, HH, MIN)
tmp <- dat[,"TIMESTAMP_END"]
YY <- floor(tmp/1e8)
tmp <- tmp - YY*1e8
MM <- floor(tmp/1e6)
tmp <- tmp - MM*1e6
DD <- floor(tmp/1e4)
tmp <- tmp - DD*1e4
HH <- floor(tmp/1e2)
MIN <- tmp - HH*100
## The fDatenum function below is equivalent to the 'datenum' function in MatLab.
# calculates serial dates using the same origin (0000-01-01) as MatLab. This may be trivial, but it works.
k_datenum <- fDatenum(YY, MM, DD, HH, MIN, 0)
# 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(YY, MM, DD, HH, MIN, sep = "-"), format = "%Y-%m-%d-%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.
k_week <- lubridate::week(k_POSIXdate_local)
# Note: k_POSIXdate_plotting is not actually a datetime string
k_POSIXdate_plotting <- as.Date(lubridate::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
# Variables for REddyProc
k_YY <- YY
k_HH <- HH + MIN/60
k_doy <- floor(k_dd) # day of year
rm(YY,MM,DD,HH,MIN, k_week, k_POSIXdate_null, k_POSIXdate_UTC)
# Parse flux and PPFD data
# Function below looks for the appropriate response variable column and extracts it to a new object.
# If the column cannot be found, it assigns a value of zero to the new object and gives a warning.
# NOTE! AmeriFlux columns and headings are not consistent so every site must be dealt with separately
if (site == 'US-NR1'){
k_NEE <- fCheckFLXCols(dat, "FC_PI_F_1_1_1") + fCheckFLXCols(dat, "SC_PI_F_1_1_1")
k_LE <- fCheckFLXCols(dat, "LE_PI_F_1_1_1")
k_H <- fCheckFLXCols(dat, "H_PI_F_1_1_1")
k_SW_in <- fCheckFLXCols(dat, "SW_IN_PI_F_1_1_1")
k_SW_out <- fCheckFLXCols(dat, "SW_OUT_PI_F_1_1_1")
k_LW_in <- fCheckFLXCols(dat, "LW_IN_PI_F_1_1_1")
k_LW_out <- fCheckFLXCols(dat, "LW_OUT_PI_F_1_1_1")
k_Tair <- fCheckFLXCols(dat, "TA_PI_F_1_1_1")
k_Tsoil <- fCheckFLXCols(dat, "TS_PI_F_1_1_1")
k_SWC <- fCheckFLXCols(dat, "SWC_PI_F_1_1_1")
k_RH <- fCheckFLXCols(dat, "RH_PI_F_1_1_1")
k_VPD <- fCheckFLXCols(dat, "VPD_PI_F_1_1_1")
k_ustar <- fCheckFLXCols(dat, "USTAR_PI_F_1_1_1")
k_PPFD <- fCheckFLXCols(dat, "PPFD_IN_PI_F_1_1_1")
}
else if (site == 'US-Ho1'){
k_NEE <- fCheckFLXCols(dat, "NEE_PI_1_1_1")
k_LE <- fCheckFLXCols(dat, "LE_1_1_1")
k_H <- fCheckFLXCols(dat, "H_1_1_1")
k_SW_in <- fCheckFLXCols(dat, "SW_IN_2_1_1")
k_SW_out <- fCheckFLXCols(dat, "SW_OUT_2_1_1")
k_LW_in <- fCheckFLXCols(dat, "LW_IN_2_1_1")
k_LW_out <- fCheckFLXCols(dat, "LW_OUT_2_1_1")
k_Tair <- fCheckFLXCols(dat, "TA_PI_1_1_A")
k_Tsoil <- fCheckFLXCols(dat, "TS_1_2_1")
k_SWC <- as.numeric(rep(NA, times=length(k_fracyr))) # no data
k_RH <- fCheckFLXCols(dat, "RH_1_1_1")
k_VPD <- fCheckFLXCols(dat, "VPD_PI_1_1_1")
k_ustar <- fCheckFLXCols(dat, "USTAR_1_1_1")
k_PPFD <- fCheckFLXCols(dat, "PPFD_IN_1_1_1")
}
else if (site == 'CA-Obs') {
k_NEE <- fCheckFLXCols(dat, "NEE_PI")
k_LE <- fCheckFLXCols(dat, "LE")
k_H <- fCheckFLXCols(dat, "H")
k_SW_in <- fCheckFLXCols(dat, "SW_IN")
k_SW_out <- fCheckFLXCols(dat, "SW_OUT")
k_LW_in <- fCheckFLXCols(dat, "LW_IN")
k_LW_out <- fCheckFLXCols(dat, "LW_OUT")
k_Tair <- fCheckFLXCols(dat, "TA")
k_Tsoil <- fCheckFLXCols(dat, "TS_1")
k_SWC <- fCheckFLXCols(dat, "SWC_1")
k_RH <- fCheckFLXCols(dat, "RH")
k_VPD <- fCheckFLXCols(dat, "VPD_PI")
k_ustar <- fCheckFLXCols(dat, "USTAR")
k_PPFD <- fCheckFLXCols(dat, "PPFD_IN")
}
else if (site == 'CA-TP1' | site == 'CA-TP3') {
k_NEE <- fCheckFLXCols(dat, "NEE_PI")
k_LE <- fCheckFLXCols(dat, "LE")
k_H <- fCheckFLXCols(dat, "H")
k_SW_in <- fCheckFLXCols(dat, "SW_IN_PI_F")
k_SW_out <- as.numeric(rep(NA, times=length(k_fracyr))) # no data
k_LW_in <- as.numeric(rep(NA, times=length(k_fracyr))) # no data
k_LW_out <- as.numeric(rep(NA, times=length(k_fracyr))) # no data
k_Tair <- fCheckFLXCols(dat, "TA")
k_Tsoil <- fCheckFLXCols(dat, "TS_1_1_1")
k_SWC <- fCheckFLXCols(dat, "SWC_1_1_1")
k_RH <- fCheckFLXCols(dat, "RH")
k_VPD <- fCheckFLXCols(dat, "VPD_PI_F")
k_ustar <- fCheckFLXCols(dat, "USTAR")
k_PPFD <- fCheckFLXCols(dat, "PPFD_IN")
}
else if (site == 'CA-TP4') {
k_NEE <- fCheckFLXCols(dat, "NEE_PI")
k_LE <- fCheckFLXCols(dat, "LE")
k_H <- fCheckFLXCols(dat, "H")
k_SW_in <- fCheckFLXCols(dat, "SW_IN")
k_SW_out <- fCheckFLXCols(dat, "SW_OUT")
k_LW_in <- fCheckFLXCols(dat, "LW_IN")
k_LW_out <- fCheckFLXCols(dat, "LW_OUT")
k_Tair <- fCheckFLXCols(dat, "TA_1_1_1")
k_Tsoil <- fCheckFLXCols(dat, "TS_1_1_1")
k_SWC <- fCheckFLXCols(dat, "SWC_1_1_1")
k_RH <- fCheckFLXCols(dat, "RH_1_1_1")
k_VPD <- fCheckFLXCols(dat, "VPD_PI_F")
k_ustar <- fCheckFLXCols(dat, "USTAR")
k_PPFD <- fCheckFLXCols(dat, "PPFD_IN")
}
else if (site == 'CA-TPD') {
k_NEE <- fCheckFLXCols(dat, "NEE_PI")
k_LE <- fCheckFLXCols(dat, "LE")
k_H <- fCheckFLXCols(dat, "H")
k_SW_in <- fCheckFLXCols(dat, "SW_IN")
k_SW_out <- fCheckFLXCols(dat, "SW_OUT")
k_LW_in <- fCheckFLXCols(dat, "LW_IN")
k_LW_out <- fCheckFLXCols(dat, "LW_OUT")
k_Tair <- fCheckFLXCols(dat, "TA")
k_Tsoil <- fCheckFLXCols(dat, "TS_1_1_1")
k_SWC <- fCheckFLXCols(dat, "SWC_1_1_1")
k_RH <- fCheckFLXCols(dat, "RH")
k_VPD <- fCheckFLXCols(dat, "VPD_PI_F")
k_ustar <- fCheckFLXCols(dat, "USTAR")
k_PPFD <- fCheckFLXCols(dat, "PPFD_IN")
}
else if (site == 'US-Bar') {
k_NEE <- fCheckFLXCols(dat, "FC_1_1_1")
k_LE <- fCheckFLXCols(dat, "LE_1_1_1")
k_H <- fCheckFLXCols(dat, "H_1_1_1")
k_SW_in <- fCheckFLXCols(dat, "SW_IN_1_1_1")
k_SW_out <- fCheckFLXCols(dat, "SW_OUT_1_1_1")
k_LW_in <- as.numeric(rep(NA, times=length(k_fracyr))) # no data
k_LW_out <- as.numeric(rep(NA, times=length(k_fracyr))) # no data
k_Tair <- fCheckFLXCols(dat, "TA_PI_F_1_1_1")
k_Tsoil <- fCheckFLXCols(dat, "TS_1_1_1")
k_SWC <- fCheckFLXCols(dat, "SWC_1_1_1")
k_RH <- fCheckFLXCols(dat, "RH_PI_F_1_1_1")
k_VPD <- fCheckFLXCols(dat, "VPD_PI_1_1_1")
k_ustar <- fCheckFLXCols(dat, "USTAR_1_1_1")
k_PPFD <- fCheckFLXCols(dat, "PPFD_IN_PI_F_1_1_1")
}
else if (site == 'CA-Ca1') {
k_NEE <- fCheckFLXCols(dat, "NEE_PI")
k_LE <- fCheckFLXCols(dat, "LE")
k_H <- fCheckFLXCols(dat, "H")
k_SW_in <- fCheckFLXCols(dat, "SW_IN_1_1_1")
k_SW_out <- fCheckFLXCols(dat, "SW_OUT_1_1_1")
k_LW_in <- fCheckFLXCols(dat, "LW_IN_1_1_1")
k_LW_out <- fCheckFLXCols(dat, "LW_OUT_1_1_1")
k_Tair <- fCheckFLXCols(dat, "TA_1_1_1")
k_Tsoil <- fCheckFLXCols(dat, "TS_1_1_1")
k_SWC <- fCheckFLXCols(dat, "SWC_1_1_1")
k_RH <- fCheckFLXCols(dat, "RH_1_1_1")
# calculate VPD from air T and RH via Tetens eqn
es = 0.611*exp((17.502*k_Tair)/(k_Tair+240.97))
ea = (k_RH*es)/100
k_VPD = es - ea
k_ustar <- fCheckFLXCols(dat, "USTAR")
k_PPFD <- fCheckFLXCols(dat, "PPFD_IN_1_1_1")
}
else if (site == 'CA-Ca2') {
k_NEE <- fCheckFLXCols(dat, "NEE_PI")
k_LE <- fCheckFLXCols(dat, "LE")
k_H <- fCheckFLXCols(dat, "H")
k_SW_in <- fCheckFLXCols(dat, "SW_IN_1_1_1")
k_SW_out <- fCheckFLXCols(dat, "SW_OUT_1_1_1")
k_LW_in <- as.numeric(rep(NA, times=length(k_fracyr))) # no data
k_LW_out <- as.numeric(rep(NA, times=length(k_fracyr))) # no data
k_Tair <- fCheckFLXCols(dat, "TA_1_1_1")
k_Tsoil <- fCheckFLXCols(dat, "TS_1_1_1")
k_SWC <- fCheckFLXCols(dat, "SWC_1_1_1")
k_RH <- fCheckFLXCols(dat, "RH_1_1_1")
# calculate VPD from air T and RH via Tetens eqn
es = 0.611*exp((17.502*k_Tair)/(k_Tair+240.97))
ea = (k_RH*es)/100
k_VPD = es - ea
k_ustar <- fCheckFLXCols(dat, "USTAR")
k_PPFD <- fCheckFLXCols(dat, "PPFD_IN")
}
else if (site == 'CA-Ca3') {
k_NEE <- fCheckFLXCols(dat, "NEE_PI")
k_LE <- fCheckFLXCols(dat, "LE")
k_H <- fCheckFLXCols(dat, "H")
k_SW_in <- fCheckFLXCols(dat, "SW_IN_1_1_1")
k_SW_out <- fCheckFLXCols(dat, "SW_OUT_1_1_1")
k_LW_in <- fCheckFLXCols(dat, "LW_IN")
k_LW_out <- fCheckFLXCols(dat, "LW_OUT")
k_Tair <- fCheckFLXCols(dat, "TA_PI_F_1")
k_Tsoil <- fCheckFLXCols(dat, "TS_1_1_1")
k_SWC <- fCheckFLXCols(dat, "SWC_1_1_1")
k_RH <- fCheckFLXCols(dat, "RH_PI_F_1")
# calculate VPD from air T and RH via Tetens eqn
es = 0.611*exp((17.502*k_Tair)/(k_Tair+240.97))
ea = (k_RH*es)/100
k_VPD = es - ea
k_ustar <- fCheckFLXCols(dat, "USTAR")
k_PPFD <- fCheckFLXCols(dat, "PPFD_IN_1_1_1")
}
else if (site == 'CA-Cbo') {
k_NEE <- fCheckFLXCols(dat, "NEE_PI")
k_LE <- fCheckFLXCols(dat, "LE")
k_H <- fCheckFLXCols(dat, "H")
k_SW_in <- fCheckFLXCols(dat, "SW_IN_1_1_1")
k_SW_out <- fCheckFLXCols(dat, "SW_OUT")
k_LW_in <- fCheckFLXCols(dat, "LW_IN")
k_LW_out <- fCheckFLXCols(dat, "LW_OUT")
k_Tair <- fCheckFLXCols(dat, "TA_1_1_1")
k_Tsoil <- fCheckFLXCols(dat, "TS_1_1_1")
k_SWC <- fCheckFLXCols(dat, "SWC_1_1_1")
k_RH <- fCheckFLXCols(dat, "RH_1_1_1")
# calculate VPD from air T and RH via Tetens eqn
es = 0.611*exp((17.502*k_Tair)/(k_Tair+240.97))
ea = (k_RH*es)/100
k_VPD = es - ea
k_ustar <- fCheckFLXCols(dat, "USTAR")
k_PPFD <- fCheckFLXCols(dat, "PPFD_IN_1_1_1")
}
else if (site == 'CA-Ojp') {
k_NEE <- fCheckFLXCols(dat, "NEE_PI")
k_LE <- fCheckFLXCols(dat, "LE")
k_H <- fCheckFLXCols(dat, "H")
k_SW_in <- fCheckFLXCols(dat, "SW_IN")
k_SW_out <- fCheckFLXCols(dat, "SW_OUT")
k_LW_in <- fCheckFLXCols(dat, "LW_IN")
k_LW_out <- fCheckFLXCols(dat, "LW_OUT")
k_Tair <- fCheckFLXCols(dat, "TA_1_1_1")
k_Tsoil <- fCheckFLXCols(dat, "TS_1_1_1")
k_SWC <- fCheckFLXCols(dat, "SWC_1_2_1")
k_RH <- fCheckFLXCols(dat, "RH_1_1_1")
k_VPD <- fCheckFLXCols(dat, "VPD_PI")
k_ustar <- fCheckFLXCols(dat, "USTAR")
k_PPFD <- fCheckFLXCols(dat, "PPFD_IN_1_1_1")
}
else if (site == 'CA-Qcu') {
k_NEE <- fCheckFLXCols(dat, "NEE_PI")
k_LE <- fCheckFLXCols(dat, "LE")
k_H <- fCheckFLXCols(dat, "H")
k_SW_in <- fCheckFLXCols(dat, "SW_IN")
k_SW_out <- fCheckFLXCols(dat, "SW_OUT")
k_LW_in <- fCheckFLXCols(dat, "LW_IN")
k_LW_out <- fCheckFLXCols(dat, "LW_OUT")
k_Tair <- fCheckFLXCols(dat, "TA")
k_Tsoil <- fCheckFLXCols(dat, "TS_1")
k_SWC <- fCheckFLXCols(dat, "SWC_1")
k_RH <- fCheckFLXCols(dat, "RH")
k_VPD <- fCheckFLXCols(dat, "VPD_PI")
k_ustar <- fCheckFLXCols(dat, "USTAR")
k_PPFD <- fCheckFLXCols(dat, "PPFD_IN")
}
else if (site == 'CA-Qc2'){
k_NEE <- fCheckFLXCols(dat, "NEE_PI")
k_LE <- fCheckFLXCols(dat, "LE_1_1_1")
k_H <- fCheckFLXCols(dat, "H_1_1_1")
k_SW_in <- as.numeric(rep(NA, times=length(k_fracyr))) # no data
k_SW_out <- as.numeric(rep(NA, times=length(k_fracyr))) # no data
k_LW_in <- as.numeric(rep(NA, times=length(k_fracyr))) # no data
k_LW_out <- as.numeric(rep(NA, times=length(k_fracyr))) # no data
k_Tair <- fCheckFLXCols(dat, "TA_1_1_1")
k_Tsoil <- fCheckFLXCols(dat, "TS_1_1_1")
k_SWC <- fCheckFLXCols(dat, "SWC_1_1_1")
k_RH <- fCheckFLXCols(dat, "RH_1_1_1")
# calculate VPD from air T and RH via Tetens eqn
es = 0.611*exp((17.502*k_Tair)/(k_Tair+240.97))
ea = (k_RH*es)/100
k_VPD = es - ea
k_ustar <- fCheckFLXCols(dat, "USTAR")
k_PPFD <- fCheckFLXCols(dat, "PPFD_IN_1_1_1")
}
else if (site == 'CA-SJ1' | site == 'CA-SJ3') {
message('this site does not have enough useful data - rejected')
# k_NEE <- fCheckFLXCols(dat, "FC")
# k_LE <- fCheckFLXCols(dat, "LE")
# k_H <- fCheckFLXCols(dat, "H")
# k_SW_in <- fCheckFLXCols(dat, "SW_IN")
# k_SW_out <- fCheckFLXCols(dat, "SW_OUT")
# k_LW_in <- fCheckFLXCols(dat, "LW_IN")
# k_LW_out <- fCheckFLXCols(dat, "LW_OUT")
# k_Tair <- fCheckFLXCols(dat, "TA_1_1_1")
# k_Tsoil <- fCheckFLXCols(dat, "TS_1_1_1")
# k_SWC <- fCheckFLXCols(dat, "SWC_PI_1")
# k_RH <- fCheckFLXCols(dat, "RH_1_1_1")
# # calculate VPD from air T and RH via Tetens eqn
# es = 0.611*exp((17.502*k_Tair)/(k_Tair+240.97))
# ea = (k_RH*es)/100
# k_VPD = es - ea
# k_ustar <- fCheckFLXCols(dat, "USTAR")
# k_PPFD <- fCheckFLXCols(dat, "PPFD_IN_1_1_1")
}
else if (site == 'CA-SJ2'){
message('this site does not have enough useful data - rejected')
# k_NEE <- fCheckFLXCols(dat, "FC")
# k_LE <- fCheckFLXCols(dat, "LE")
# k_H <- fCheckFLXCols(dat, "H")
# k_SW_in <- fCheckFLXCols(dat, "SW_IN")
# k_SW_out <- fCheckFLXCols(dat, "SW_OUT")
# k_LW_in <- fCheckFLXCols(dat, "LW_IN")
# k_LW_out <- fCheckFLXCols(dat, "LW_OUT")
# k_Tair <- fCheckFLXCols(dat, "TA_1_1_1")
# k_Tsoil <- fCheckFLXCols(dat, "TS_1_1_1")
# k_SWC <- fCheckFLXCols(dat, "SWC_PI_1")
# k_RH <- fCheckFLXCols(dat, "RH_1_1_1")
# # calculate VPD from air T and RH via Tetens eqn
# es = 0.611*exp((17.502*k_Tair)/(k_Tair+240.97))
# ea = (k_RH*es)/100
# k_VPD = es - ea
# k_ustar <- fCheckFLXCols(dat, "USTAR")
# k_PPFD <- fCheckFLXCols(dat, "PPFD_IN")
}
else {
# save this bit to add new sites
# k_NEE <- fCheckFLXCols(dat, "")
# k_LE <- fCheckFLXCols(dat, "")
# k_H <- fCheckFLXCols(dat, "")
# k_SW_in <- fCheckFLXCols(dat, "")
# k_SW_out <- fCheckFLXCols(dat, "")
# k_LW_in <- fCheckFLXCols(dat, "")
# k_LW_out <- fCheckFLXCols(dat, "")
# k_Tair <- fCheckFLXCols(dat, "")
# k_Tsoil <- fCheckFLXCols(dat, "")
# k_SWC <- fCheckFLXCols(dat, "")
# k_RH <- fCheckFLXCols(dat, "")
# k_VPD <- fCheckFLXCols(dat, "")
# k_ustar <- fCheckFLXCols(dat, "")
# k_PPFD <- fCheckFLXCols(dat, "")
}
# Synthetic vars
#++++ This needs to be checked!
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)
# special case for CA-Obs: years 1997, 1998, and 2011 are problematic (no flux data) so delete them
if (site == 'CA-Obs') {
test <- k_YY != 1997 & k_YY != 1998 & k_YY != 2011
k_out <- k_out[test,]
k_POSIXdate_plotting <- k_POSIXdate_plotting[test]
k_fracyr <- k_fracyr[test]
}
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)
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.