├── deprecated ├── ValidationDataframe.R ├── t.test.fromsumm.R ├── flow.neon.data.extract.sh ├── AOP_hexbin.R ├── Validation.R ├── diffusivityAE.R ├── flow.sampling.coverage.R ├── time_format.R ├── flow.Sparkle_Order.R ├── aop_heatmap.R ├── FG_diffusivityAE.R ├── flow.googledrivedownload.R ├── AOP_site_scatterplot.R ├── SiteDF.R ├── flow.lidar.R ├── downloadUnzip9min.R ├── flow.MDS.R ├── FluxDespike.R ├── AOP_pca.R ├── SiteAttributes.R ├── flow.attr.map.R ├── FUNCTION_SITELIST_FORMATTING.R ├── FG_AE.WP_v2.R ├── FG_AE.WP.R ├── MO_Length.R ├── flow.evaluation_SITELIST.R ├── downloadUnzipNEON.R ├── plot.ustar.NEE.site.R ├── Comp_Function.R ├── calc_bhatt_coefficient.R ├── flow.neon.site.squarebuffers.R ├── computeFG.AE.WP.R ├── flow.evaluation.One2One.CCC.R ├── testAEWP.R ├── dirty_plot_code.R ├── flow.evaluation.One2One.R ├── checkTimeDiff.R ├── FG_diffusivityWP.R ├── Sparkle_README.md ├── aop │ ├── flow.neon.site.simplefeatures.R │ └── flow.StructuralDiversity.R ├── plotting_9mindiff_data.R ├── FG_singleSite.R ├── grabDesiredData.R ├── wrap.concatAndFilterH5.R ├── flow.temporalCoverage.R ├── FG_singleSite_AH.R ├── def.concat_from_h5.R ├── flow.evaluation.R └── Flux_Gradient_MBR.R ├── exploratory ├── jdg │ ├── run_ridgeplot.R │ ├── stacked_arrows.R │ └── fihhy_parsing.R ├── scripts │ ├── BuildFGFiles.R │ ├── Validation_HARV.R │ ├── Validation_KONZ.R │ ├── FG_singleSite_SLM.R │ └── flow.aop.mosaic.R ├── flow.calc_US-Uaf.R ├── flow.calc_SE-Svb.R ├── flow.calc_SE-Sto.R ├── flow.clean.googledrive.R ├── SBAD_Workflow.R ├── flow.Download.GoogleDriveData.R ├── surfProp_LogWindProfile.R ├── flow.plot.raw.concentrations.R ├── flow.AmeriFlux__UstarThresholdR.R ├── aggregate_data_SE-Deg.R └── AddStabilityCols.R ├── functions ├── compile.data.availability.AOP.R ├── plot.all.sites.bar.R ├── compile.neon.data.R ├── calc.iqr.R ├── calc.rmse.R ├── temp.response.curve.R ├── light.response.curve.R ├── plot.single.site.1to1.R ├── plot.all.sites.diurnal.R ├── plot.temp.response.R ├── plot.light.response.R ├── calc.MO.length.R ├── compile.neon.data.9min.6min.R ├── add.hour.col.R ├── calc.all.sites.diurnal.avg.R ├── calc.cross.gradient.R ├── compile.neon.site.attr.R ├── interp.flux.R ├── all.sites.light.response.curve.R ├── unzip.neon.R ├── flag.iqr.R ├── plot.all.sites.1to1.R ├── calc.gas.aero.windprof.flux.R ├── calc.gas.aero.windprof.flux.WP.R ├── all.sites.temp.response.curve.R ├── compile.neon.data.1min.R ├── flag.calc.flux.diff.R ├── calc.aerodynamic.canopy.height.R ├── calc.bad.eddy.R ├── flag.all.gas.stability.R ├── compile.quality.flags.add.cols.fluxes.R └── calc.eddydiff.windprof.R ├── .gitignore ├── CONTRIBUTING.md ├── workflows ├── flow.neon.data.unzip.R ├── flow.calc.flag.windprof.batch.R ├── flow.calc.flux.batch.R ├── flow.calc.flag.mbr.batch.R ├── flow.non.neon.attribute.tables.R ├── flow.download.aligned.conc.flux.R └── flow.flag.flux.stats.R └── flow.flux.final.R /deprecated/ValidationDataframe.R: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /deprecated/t.test.fromsumm.R: -------------------------------------------------------------------------------- 1 | # calculate t test from summary stats 2 | 3 | t.test.fromsumm = function(mu,n,s) { 4 | -diff(mu) / sqrt( sum( s^2/n ) ) 5 | } 6 | -------------------------------------------------------------------------------- /deprecated/flow.neon.data.extract.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash -l 2 | 3 | module load R/4.1.1 4 | Rscript 'flow.siteDf.R' 5 | # Notify with a beep sound when the script is done 6 | printf '\a' -------------------------------------------------------------------------------- /deprecated/AOP_hexbin.R: -------------------------------------------------------------------------------- 1 | library(ggthemes) 2 | 3 | ggplot(Sites.Summary, aes(x = CHM.mean, y = LAI.mean)) + 4 | geom_hex(bins = 10) + 5 | scale_fill_viridis_c() + 6 | labs(x = "Canopy Height", y = "LAI")+ 7 | theme_minimal() -------------------------------------------------------------------------------- /deprecated/Validation.R: -------------------------------------------------------------------------------- 1 | # Filtering: 2 | KONZ.MBR$FCO2_MBR_H2Otrace[ KONZ.MBR$ustar_interp_CO2 > 0.3] 3 | 4 | # Time series plots: 5 | 6 | # Linear comparisons and r2 values: 7 | 8 | # Difference: 9 | 10 | # Optimization: 11 | -------------------------------------------------------------------------------- /deprecated/diffusivityAE.R: -------------------------------------------------------------------------------- 1 | diffusivityAE <- function(){ 2 | #calculate obukhov stability param 3 | gamma <- as.numeric(z)/as.numeric(L) 4 | #calculate AE eddy diffusivity: 0.4 = Von Karman constant 5 | ae.K <- (0.4*as.numeric(cont.df$uStar)*as.numeric(zG))/as.numeric(gamma) 6 | } -------------------------------------------------------------------------------- /deprecated/flow.sampling.coverage.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | sample.month %>% filter( gas == "CO2") %>% ggplot() + geom_point( aes(x= Month, y = Percent.Coverage.Month, col = approach, size = approach), alpha=0.3) + facet_wrap(~dLevelsAminusB ) 5 | 6 | sample.diel %>% filter( gas == "CO2") %>% ggplot() + geom_point( aes(x= hour.local, y = Percent.Coverage.Diel, col = approach, size = approach), alpha=0.3) + facet_wrap(~dLevelsAminusB ) 7 | 8 | -------------------------------------------------------------------------------- /deprecated/time_format.R: -------------------------------------------------------------------------------- 1 | #' time.format 2 | #' 3 | #' @param timeEnd 4 | #' 5 | #' @return rounded timeEnd up to 30min 6 | #' 7 | time.format <- function(x){ 8 | time <-as.data.frame(t(as.data.frame(strsplit(x, split = "T")))) 9 | time$time <- substr(time$V2 ,1, 8) 10 | time$timeEnd <- as.POSIXct(paste(time$V1, time$time, sep=" " ), tz='EST') 11 | time$timeEnd <- round_date(time$timeEnd, "30 minutes") 12 | 13 | return(time$timeEnd) 14 | } -------------------------------------------------------------------------------- /deprecated/flow.Sparkle_Order.R: -------------------------------------------------------------------------------- 1 | 2 | # Step 01: 3 | 4 | ## flow.Download.GoodgleDriveData: This script downloads the NEON data from google drive. 5 | 6 | ## flow.cal.flux.batch: This script loads the data from flow.Download.GoodgleDriveData, does the flux calculations, organizes the site data and puts it on google drive. 7 | 8 | ## flow.evaluation.CO2: Performs the CO2 workflow... 9 | 10 | # flow.evaluation.H2O : performs the ... workflow ... 11 | 12 | # flow.evaluation.Homo : performs the ... workflow 13 | 14 | 15 | -------------------------------------------------------------------------------- /exploratory/jdg/run_ridgeplot.R: -------------------------------------------------------------------------------- 1 | ridgeplot( 2 | data_file= min9.FG.WP.list, 3 | gas = 'CO2', 4 | EC_0_bin = 2, 5 | EC_flux_bins = 3, 6 | sd_scalar = 1, 7 | facet_heights = TRUE 8 | ) 9 | 10 | ggplot(min9.FG.WP.list, aes(x = CO2)) + 11 | geom_density_ridges(scale = 1, rel_min_height = 0.01) + 12 | theme_ridges() + 13 | scale_x_continuous(limits = c(0, 1000), breaks = seq(0, 1000, 100)) + 14 | labs(title = "CO2 Emissions from Min9.FG.WP.list", 15 | subtitle = "EC_0_bin = 2, EC_flux_bins = 3, sd_scalar = 1", 16 | caption = "Data from min9.FG.WP.list") -------------------------------------------------------------------------------- /deprecated/aop_heatmap.R: -------------------------------------------------------------------------------- 1 | # Select relevant columns for heatmap 2 | aop_matrix <- Sites.Summary %>% 3 | select(site, NDVI.mean, CHM.mean, EVI.mean, LAI.mean, PRI.mean, SAVI.mean) %>% 4 | column_to_rownames("site") %>% 5 | scale() # z-score 6 | 7 | # Convert to long for ggplot heatmap 8 | aop_long <- as.data.frame(aop_matrix) %>% 9 | rownames_to_column("site") %>% 10 | pivot_longer(-site, names_to = "metric", values_to = "value") 11 | 12 | ggplot(aop_long, aes(x = metric, y = site, fill = value)) + 13 | geom_tile() + 14 | scale_fill_viridis_c() + 15 | labs(title = "AOP Site Summary Heatmap", x = "Metric", y = "Site") -------------------------------------------------------------------------------- /deprecated/FG_diffusivityAE.R: -------------------------------------------------------------------------------- 1 | library(dplyr) 2 | source(file.path("R/MO_Length.R")) 3 | source(file.path("R/eddydiffAE.R")) 4 | #function arguments 5 | #desired concentration 6 | cont.desired <- "CH4" 7 | #add code later that pulls zip files off of g drive 8 | sitecode <- 'KONZ' 9 | #load in interpolated 9 min data 10 | load(file.path("data", sitecode, "KONZ_min9Diff.Rdata")) 11 | load(file.path("data", sitecode, "KONZ_attr.Rdata")) 12 | #call function to calculate eddy diffusivity using AE method 13 | min9EddyDiff.list <- eddydiffAE(cont.desired = cont.desired, sitecode = sitecode, min9 = min9Diff.list, attr = attr.df) 14 | ae.check <- min9EddyDiff.list$CH4 15 | -------------------------------------------------------------------------------- /deprecated/flow.googledrivedownload.R: -------------------------------------------------------------------------------- 1 | # Download Data from google Drive: 2 | 3 | email <- 'sparklelmalone@gmail.com' 4 | googledrive::drive_auth(email = TRUE) 5 | 6 | drive_url <- googledrive::as_id("https://drive.google.com/drive/folders/1Q99CT77DnqMl2mrUtuikcY47BFpckKw3") # The Data 7 | 8 | data_folder <- googledrive::drive_ls(path = drive_url) 9 | localdir <- "~/data" 10 | focal_file <- "FilterReport_MS1Sites.Rdata" 11 | pathDnld <- fs::path(localdir,focal_file) 12 | 13 | googledrive::drive_download(file = data_folder$id[data_folder$name == focal_file], 14 | path = pathDnld, 15 | overwrite = T) 16 | 17 | load( file=pathDnld) 18 | -------------------------------------------------------------------------------- /exploratory/scripts/BuildFGFiles.R: -------------------------------------------------------------------------------- 1 | # Build site flux files from the .Rdata objects: 2 | 3 | rm(list=ls()) 4 | library(dplyr) 5 | 6 | ggplot(data=KNOZ.AE) + geom_point(aes(x=timeEnd_A , y=FG),cex=0.3) + ylim(-100, 100) + geom_point(aes(x=timeEnd_A, y=FC_interp, ), col="red", cex=0.25) 7 | 8 | ggplot(data=KNOZ.WP) + geom_point(aes(x=timeEnd_A , y=FG),cex=0.3) + ylim(-100, 100) + geom_point(aes(x=timeEnd_A, y=FC_interp, ), col="red", cex=0.25) 9 | 10 | 11 | ggplot(data=KNOZ.MBR) + geom_point(aes(x=timeEnd_A_CO2 , y=FCO2_MBR_H2Otrace),cex=0.3) + ylim(-100, 100) + geom_point(aes(x=timeEnd_A_CO2, y=FC_interp_CO2, ), col="red", cex=0.25) 12 | 13 | rm( MBRflux_align, min9.FG.AE.list, min9.FG.WP.list) 14 | 15 | 16 | -------------------------------------------------------------------------------- /deprecated/AOP_site_scatterplot.R: -------------------------------------------------------------------------------- 1 | library(tidyverse) 2 | 3 | Sites.Summary$LAI.se <- Sites.Summary$LAI.sd / sqrt(Sites.Summary$LAI.years) 4 | Sites.Summary$CHM.se <- Sites.Summary$CHM.sd / sqrt(Sites.Summary$CHM.years) 5 | 6 | 7 | library(ggrepel) 8 | 9 | # Plot 10 | ggplot(Sites.Summary, aes(x = LAI.mean, y = CHM.mean, color = NDVI.mean)) + 11 | geom_point() + 12 | geom_errorbar(aes(ymin = CHM.mean - CHM.se, ymax = CHM.mean + CHM.se), width = 0.01, alpha=0.5) + 13 | geom_errorbarh(aes(xmin = LAI.mean - LAI.se, xmax = LAI.mean + LAI.se), height = 0.01, alpha=0.5) + 14 | geom_text_repel(aes(label = site), size = 3) + 15 | theme_classic() + 16 | labs( 17 | x = "LAI Mean", 18 | y = "CHM Mean", 19 | color = "NDVI Mean" 20 | ) -------------------------------------------------------------------------------- /exploratory/flow.calc_US-Uaf.R: -------------------------------------------------------------------------------- 1 | library(tidyverse) 2 | 3 | load( 'data/US-Uaf/US-Uaf_aligned_conc_flux_9min.RData') 4 | 5 | sitecode <- 'US-Uaf' 6 | site <- 'US-Uaf' 7 | 8 | localdir <- '/Users/sm3466/YSE Dropbox/Sparkle Malone/Research/FluxGradient/lterwg-flux-gradient' 9 | setwd(localdir) 10 | 11 | dirTmp <- paste(localdir,"data", sitecode,sep="/") 12 | 13 | drive_url <- googledrive::as_id("https://drive.google.com/drive/folders/1Q99CT77DnqMl2mrUtuikcY47BFpckKw3") 14 | data_folder <- googledrive::drive_ls(path = drive_url) 15 | 16 | source(file.path("exploratory/flow.calc.flag.mbr.batch.R")) 17 | source(file.path("exploratory/flow.calc.flag.aero.batch.R")) 18 | source(file.path("exploratory/flow.calc.flag.windprof.batch.R")) 19 | 20 | message('Next run the flow.validation.dataframe.batch.R') -------------------------------------------------------------------------------- /functions/compile.data.availability.AOP.R: -------------------------------------------------------------------------------- 1 | 2 | Site.Data.Availability.AOP <- function(dpID ){ 3 | info <- neonUtilities::getProductInfo(dpID=dpID) 4 | 5 | availability <- info$siteCodes 6 | 7 | availabilityList <- lapply(availability$siteCode,FUN=function(siteIdx){ 8 | idxRow <- which(availability$siteCode == siteIdx) 9 | yearMnths <- unlist(availability$availableMonths[idxRow]) 10 | year <- substr(yearMnths,start=1,stop=4) 11 | mnth <- substr(yearMnths,start=6,stop=7) 12 | url <- unlist(availability$availableDataUrls[idxRow]) 13 | rpt <- data.frame(site=siteIdx,year=year,month=mnth,URL=url,stringsAsFactors = FALSE) 14 | return(rpt) 15 | }) 16 | 17 | LAI.availabilityDf <- do.call(rbind,availabilityList) 18 | 19 | return(LAI.availabilityDf [, 1:3]) 20 | } 21 | #EOF -------------------------------------------------------------------------------- /deprecated/SiteDF.R: -------------------------------------------------------------------------------- 1 | #' Site.DF 2 | #' 3 | #' @param sitecode NEON site code 4 | #' @param hd.files file type h5 containg NEON site specific data 5 | #' 6 | #' @return df containing site co2, h2o, ch4 measurements at various tower heights 7 | #' 8 | #' 9 | #' @author Alexis Helgeson 10 | 11 | Site.DF <- function(hd.files, sitecode){ 12 | 13 | ALL.data = data.frame() 14 | #looping over all h5 files and extracting data over timeseries (startdate:enddate) 15 | for(i in 1:length(hd.files)){ 16 | print(i) 17 | month.data <- hdf2df(hd.files[i], sitecode) 18 | ALL.data <-smartbind(month.data, ALL.data ) 19 | rm( month.data) 20 | } 21 | #add date/time column 22 | ALL.data$datetime <- as.POSIXct(ALL.data$timeEnd, format = "%Y-%m-%dT%H:%M:%S", tz = "UTC") 23 | 24 | return( ALL.data ) 25 | } 26 | -------------------------------------------------------------------------------- /deprecated/flow.lidar.R: -------------------------------------------------------------------------------- 1 | #CHM https://www.neonscience.org/resources/learning-hub/tutorials/create-chm-rasters-r 2 | 3 | # canopy rugosity: https://rdrr.io/github/akamoske/canopyLazR/man/toc.rugosity.html 4 | 5 | 6 | # canopy gaps: https://besjournals.onlinelibrary.wiley.com/doi/full/10.1111/2041-210X.13211 7 | library(terra) 8 | library(viridis) 9 | #install.packages("remotes") 10 | #remotes::install_github("akamoske/canopyLazR") 11 | library('canopyLazR') 12 | 13 | abby <- rast('/Volumes/MaloneLab/Research/FluxGradient/NEON_indices-veg-spectrometer-mosaic/Output/ABBY/2017_CHM_2017.tif' ) 14 | 15 | plot(abby) 16 | global(abby, fun ='mean', na.rm=T) 17 | global(abby, fun ='sd', na.rm=T) 18 | 19 | 20 | 21 | abby.rugosity <-toc.rugosity(chm.raster = abby, xy.res = 1, z.res=1) 22 | library(dplyr) 23 | abby.rugosity %>% plot 24 | 25 | 26 | -------------------------------------------------------------------------------- /deprecated/downloadUnzip9min.R: -------------------------------------------------------------------------------- 1 | library("neonUtilities") 2 | 3 | savepath <- 'C:/Users/csturtevant/Dropbox/Proposals/FluxGradient' 4 | 5 | sitecode <- 'JORN' 6 | startdate <- '2022-03-01' 7 | enddate <- '2022-04-01' 8 | Pack <- 'basic' 9 | neonUtilities::zipsByProduct(dpID="DP4.00200.001", sitecode,startdate, enddate,package=Pack, check.size=F,savepath=savepath) 10 | 11 | 12 | #run through all the files and unzip 13 | pathDnld <- fs::path(savepath,'filesToStack00200') 14 | files <- list.files(path=pathDnld) 15 | for(file in files){ 16 | # Is the file zipped? 17 | if(grepl(pattern='.zip',file)){ 18 | utils::unzip(fs::path(pathDnld,file),exdir=fs::path(savepath,'unzippedFiles')) 19 | } 20 | } 21 | # Run through all the unzipped files and concatenate 22 | pathUnzipped <- fs::path(savepath,'unzippedFiles') 23 | print(paste0('Unzipped data in ',pathUnzipped)) 24 | -------------------------------------------------------------------------------- /exploratory/flow.calc_SE-Svb.R: -------------------------------------------------------------------------------- 1 | library(tidyverse) 2 | rm(list = ls()) 3 | 4 | localdir <- '/Users/sm3466/YSE Dropbox/Sparkle Malone/Research/FluxGradient/lterwg-flux-gradient' 5 | setwd(localdir) 6 | 7 | load( 'data/SE-Svb/SE-Svb_aligned_conc_flux_9min.RData') 8 | 9 | sitecode <- 'SE-Svb' 10 | site <- 'SE-Svb' 11 | 12 | dirTmp <- paste(localdir,"data", sitecode,sep="/") 13 | 14 | drive_url <- googledrive::as_id("https://drive.google.com/drive/folders/1Q99CT77DnqMl2mrUtuikcY47BFpckKw3") 15 | data_folder <- googledrive::drive_ls(path = drive_url) 16 | 17 | setwd(localdir) 18 | source(file.path("exploratory/flow.calc.flag.mbr.batch.R")) 19 | setwd(localdir) 20 | source(file.path("exploratory/flow.calc.flag.aero.batch.R")) 21 | setwd(localdir) 22 | source(file.path("exploratory/flow.calc.flag.windprof.batch.R")) 23 | 24 | message('Next run the flow.validation.dataframe.batch.R') -------------------------------------------------------------------------------- /exploratory/flow.calc_SE-Sto.R: -------------------------------------------------------------------------------- 1 | library(tidyverse) 2 | rm(list = ls()) 3 | 4 | localdir <- '/Users/sm3466/YSE Dropbox/Sparkle Malone/Research/FluxGradient/lterwg-flux-gradient' 5 | setwd(localdir) 6 | 7 | load( 'data/SE-Sto/SE-Sto_aligned_conc_flux_9min.RData') 8 | 9 | sitecode <- 'SE-Sto' 10 | site <- 'SE-Sto' 11 | 12 | 13 | dirTmp <- paste(localdir,"data", sitecode,sep="/") 14 | 15 | drive_url <- googledrive::as_id("https://drive.google.com/drive/folders/1Q99CT77DnqMl2mrUtuikcY47BFpckKw3") 16 | data_folder <- googledrive::drive_ls(path = drive_url) 17 | 18 | setwd(localdir) 19 | source(file.path("exploratory/flow.calc.flag.mbr.batch.R")) 20 | setwd(localdir) 21 | source(file.path("exploratory/flow.calc.flag.aero.batch.R")) 22 | setwd(localdir) 23 | source(file.path("exploratory/flow.calc.flag.windprof.batch.R")) 24 | 25 | message('Next run the flow.validation.dataframe.batch.R') -------------------------------------------------------------------------------- /functions/plot.all.sites.bar.R: -------------------------------------------------------------------------------- 1 | #' plot.all.sites.bar 2 | #' 3 | #' @param all.sites dataframe of all sites 4 | #' @param desired.var which variable to feature in the bar plot 5 | #' @param x.lab x axis label 6 | #' @param plot.title should reflect which method is used to calculate FG i.e. AE or WP or MBR 7 | #' 8 | #' @return bar plot of variable across all sites 9 | #' 10 | #' 11 | #' @author Alexis Helgeson 12 | plot.all.sites.bar <- function(all.sites, desired.var, x.lab, plot.title){ 13 | #bar plot of desired variable 14 | ggplot(all.sites, aes(x = !! sym(desired.var))) + 15 | geom_bar() + 16 | facet_wrap(~ site, scales = "free")+ 17 | xlab(paste0(x.lab))+ 18 | ylab("Frequency")+ 19 | ggtitle(paste0(plot.title))+ 20 | theme_minimal()+ 21 | theme(text = element_text(size = 20), axis.title=element_text(size=24), plot.title = element_text(hjust = 0.5)) 22 | } -------------------------------------------------------------------------------- /deprecated/flow.MDS.R: -------------------------------------------------------------------------------- 1 | # Import the data: 2 | rm(list=ls()) 3 | 4 | library(tidyverse) 5 | 6 | 7 | # Do I need other calculations? I need the stability in this file for the analysis.... 8 | load( "/Users/sm3466/YSE Dropbox/Sparkle Malone/Research/FluxGradient/Data/HARV/HARV_WP_9min.RDATA") 9 | min9.FG.WP.list$CO2 %>% names() 10 | 11 | # Canopy heights 6 - 3: 12 | 13 | min9.FG.WP.list$CO2$dLevelsAminusB %>% unique 14 | min9.FG.WP.list$CO2$dConc %>% summary() 15 | min9.FG.WP.list$CO2$dConc_sd %>% summary() 16 | 17 | min9.FG.WP.list$CO2 %>% filter( dConc_sd < 2 ) %>% ggplot() + geom_point( aes(x=FC_nee_interp , y=FG_mean)) + ylim(-100,100) 18 | 19 | 20 | lm(FG_mean ~ FC_nee_interp, data = min9.FG.WP.list$CO2 %>% filter( dConc_sd < 2, dLevelsAminusB == "6_5" | dLevelsAminusB == "6_4"| dLevelsAminusB == "6_3") ) %>% summary 21 | 22 | 23 | # Stability filter .... 24 | 25 | # ustar filter.... 26 | 27 | -------------------------------------------------------------------------------- /deprecated/FluxDespike.R: -------------------------------------------------------------------------------- 1 | 2 | ###########################FLUX SMOOTHING FUNCTION############################## 3 | 4 | # data is vector of GF data 5 | # k is running median length 6 | # z is average height of measurement 7 | # L is MO length 8 | 9 | FluxDespike <- function(flux,k,L,z,zeta,IQR){ 10 | 11 | data <- data.frame(flux) 12 | 13 | 14 | # 1.5 IQR FILTER 15 | 16 | q1 <- quantile(data$flux,prob=c(.25), type = 1 , na.rm =TRUE) 17 | q3 <- quantile(data$flux, prob=c(.75), type=1, na.rm=TRUE) 18 | 19 | outliers = (q3-q1)*IQR 20 | floor = q1 - outliers 21 | ceiling = q3 + outliers 22 | 23 | data$flux <- replace(data$flux, data$flux < floor , NA) 24 | data$flux <- replace(data$flux, data$flux > ceiling , NA) 25 | 26 | #STABILITY FILTER 27 | data$zeta <- z/L 28 | data$flux <- replace(data$flux, abs(data$zeta) > zeta, NA) 29 | 30 | 31 | #MEDIAN FILTER 32 | 33 | data$flux <- runmed(data$flux ,k=k) 34 | 35 | 36 | 37 | return(data$flux) 38 | } 39 | -------------------------------------------------------------------------------- /functions/compile.neon.data.R: -------------------------------------------------------------------------------- 1 | #' compile.neon.data 2 | #' 3 | #' @param sitecode NEON site code 4 | #' @param h5files list of h5 filepaths 5 | #' @param frequency high (9m or 2m) low (30m) 6 | #' 7 | #' @return df containing site co2, h2o, ch4 measurements at various tower heights 8 | #' 9 | #' 10 | #' @author Alexis Helgeson, Sam Jurado, David Reed, and Sparkle Malone 11 | compile.neon.data <- function(h5files, sitecode, frequency){ 12 | 13 | #pulls 30m concentration, flux, and met data 14 | if(frequency == "30min"){ 15 | DATA <- compile.neon.data.30min(h5files = h5files, sitecode = sitecode) 16 | } 17 | 18 | 19 | #pulls 9m CH4, CO2, H2O gas concentrations 20 | if(frequency == "9min"){ 21 | DATA <- compile.neon.data.9min.6min(h5files = h5files, sitecode = sitecode) 22 | } 23 | 24 | #pulls 9m CH4, CO2, H2O gas concentrations 25 | if(frequency == "1min"){ 26 | DATA <- compile.neon.data.1min(h5files = h5files, sitecode = sitecode) 27 | } 28 | 29 | return(DATA) 30 | } 31 | -------------------------------------------------------------------------------- /deprecated/AOP_pca.R: -------------------------------------------------------------------------------- 1 | library(tidyverse) 2 | library(factoextra) # for PCA + clustering viz 3 | library(ggplot2) 4 | 5 | # Select structure variables 6 | structure_vars <- Sites.Summary %>% 7 | select(site, CHM.mean, CHM.sd, LAI.mean, LAI.sd) %>% 8 | drop_na() 9 | 10 | # Scale and run PCA 11 | structure_scaled <- structure_vars %>% 12 | column_to_rownames("site") %>% 13 | scale() 14 | 15 | pca_result <- prcomp(structure_scaled, center = TRUE, scale. = TRUE) 16 | 17 | # Choose # clusters (elbow method) 18 | fviz_nbclust(structure_scaled, kmeans, method = "wss") 19 | 20 | # Run clustering (e.g., k = 3) 21 | set.seed(123) 22 | km_res <- kmeans(structure_scaled, centers = 3, nstart = 25) 23 | 24 | # Visualize PCA with clusters 25 | fviz_pca_ind(pca_result, 26 | geom.ind = "point", 27 | col.ind = factor(km_res$cluster), 28 | palette = "jco", 29 | addEllipses = TRUE, 30 | legend.title = "Cluster") + 31 | labs(title = "PCA of Canopy Structure with K-means Clustering") -------------------------------------------------------------------------------- /deprecated/SiteAttributes.R: -------------------------------------------------------------------------------- 1 | #' SiteAttributes 2 | #' 3 | #' @param sitecode NEON site code 4 | #' @param hd.files file type h5 containg NEON site specific data 5 | #' 6 | #' @return df containing site attributes 7 | #' 8 | #' @author Alexis Helgeson 9 | SiteAttributes <- function(hd.files, sitecode){ 10 | #all attributes grabbed are: "DistZaxsCnpy""DistZaxsDisp""DistZaxsGrndOfst""DistZaxsLvlMeasTow""DistZaxsTow""ElevRefeTow""LatTow""LonTow""LvlMeasTow""Pf.AngEnuXaxs""Pf.AngEnuYaxs""Pf.Ofst""TimeDiffUtcLt""TimeTube""TypeEco""ZoneTime""ZoneUtm" 11 | #we are only using "DistZaxsLvlMeasTow" (i.e. the measurement heights) in the MBR calculation 12 | #this fcn only uses 1st file in the list which corresponds to specific month, we are assuming all of these attributes are consistent across all months 13 | attr <- data.frame(rhdf5::h5readAttributes(hd.files[1], name = paste0("/", sitecode))) 14 | attr <- dplyr::select(attr, DistZaxsLvlMeasTow) 15 | #add NEON sitecide as column 16 | attr$Site <- sitecode 17 | 18 | return(attr) 19 | 20 | } 21 | -------------------------------------------------------------------------------- /functions/calc.iqr.R: -------------------------------------------------------------------------------- 1 | #' calc.iqr 2 | #' 3 | #' @param gas.df data frame of specific gas CO2, CH4, H2O with FG column 4 | #' 5 | #' @return data frame with IQR.flag column 6 | #' 7 | #' 8 | #' @author Alexis Helgeson 9 | calc.iqr <- function(gas.df){ 10 | #calculate IQR range based on specified upper and lower bounds 11 | #remember the FG column is the calculated flux 12 | Q3 <- quantile(gas.df$FG, c(0.75))[[1]] 13 | Q1 <- quantile(gas.df$FG, c(0.25))[[1]] 14 | IQR <- (as.numeric(Q3) - as.numeric(Q1))*3 #filter for outliers use 1.5; for extreme outliers use 3 15 | upper.threshold <- as.numeric(Q3) + as.numeric(IQR) 16 | lower.threshold <- as.numeric(Q1) - as.numeric(IQR) 17 | #add flag for values that fall outside of IQR range; use NEON convention 1 = bad data, 0 = good data 18 | gas.df[which(gas.df$FG < lower.threshold),"IQR.flag"] <- "1" 19 | gas.df[which(gas.df$FG > upper.threshold),"IQR.flag"] <- "1" 20 | gas.df[which(gas.df$FG >= lower.threshold & gas.df$FG <= upper.threshold),"IQR.flag"] <- "0" 21 | 22 | return(gas.df) 23 | } -------------------------------------------------------------------------------- /deprecated/flow.attr.map.R: -------------------------------------------------------------------------------- 1 | # View site attributes and create a site visualization: 2 | library(tidyverse) 3 | library(sf) 4 | library(AOI) 5 | 6 | setwd('/Users/sm3466/YSE Dropbox/Sparkle Malone/Research/FluxGradient/Data') 7 | 8 | dir <- c('HARV/data/HARV/HARV_attr.Rdata', 9 | 'GUAN/data/GUAN/GUAN_attr.Rdata', 10 | 'JORN/data/JORN/JORN_attr.Rdata', 11 | 'KONZ/data/KONZ/KONZ_attr.Rdata') 12 | 13 | site.att <- data.frame() 14 | 15 | for( i in 1:length(dir)){ 16 | print(i) 17 | load(dir[i]) 18 | site.att <- site.att %>% rbind(attr.df ) 19 | rm(attr.df) 20 | } 21 | 22 | site.att %>% names 23 | site.att.sf <- st_as_sf(x = site.att, 24 | coords = c("LonTow", "LatTow"), 25 | crs = 4326) 26 | 27 | site.att.sf$geometry %>% plot 28 | 29 | aoi.usa <- aoi_get(country = c('PR'), 30 | state = 'conus') 31 | 32 | ggplot() + geom_sf(data = aoi.usa, fill='white', color="navy", lwd=1.5) + geom_sf(data = site.att.sf, size=2, color = 'goldenrod') + theme_bw() 33 | -------------------------------------------------------------------------------- /deprecated/FUNCTION_SITELIST_FORMATTING.R: -------------------------------------------------------------------------------- 1 | library(tidyverse) 2 | 3 | 4 | Tair_at_TowerTop <- function(df){ 5 | levels <- df %>% select( starts_with( 'Tair')) %>% names %>% str_split_fixed( 'Tair',2) 6 | max.levels <- levels[,2] %>% max 7 | Tair <- paste('Tair',max.levels, sep="") 8 | return( Tair) 9 | } 10 | 11 | TIME_TOWER_LEVEL_FORMAT <- function(df.list, time.col, dLevelsAminusB.colname ){ 12 | 13 | for( i in 1:length( df.list )){ 14 | print(i) 15 | 16 | df <- df.list[[i]] %>% as.data.frame 17 | 18 | timestamp <- df %>% select( all_of(time.col), all_of(dLevelsAminusB.colname)) 19 | df$timestamp <- timestamp[,1] 20 | df$TowerH <- timestamp[,2] 21 | Tair <- Tair_at_TowerTop(df) 22 | airT <- df %>% select( all_of(Tair)) 23 | df$Tair <- airT[,1] 24 | 25 | df.list[[i]] <- df %>% mutate( Hour = timestamp %>% format( '%H') %>% as.numeric, 26 | Month = timestamp %>% format( '%m'), 27 | YearMon = timestamp %>% format( '%Y-%m')) 28 | 29 | 30 | } 31 | 32 | return(df.list) 33 | } -------------------------------------------------------------------------------- /exploratory/scripts/Validation_HARV.R: -------------------------------------------------------------------------------- 1 | # Build site flux files from the .Rdata objects: 2 | 3 | rm(list=ls()) 4 | library(dplyr) 5 | library(ggplot2) 6 | 7 | load( "/Users/sm3466/Dropbox (YSE)/Research/FluxGradient/Data/HARV_AE_AH_2023-12-05.RDATA" ) 8 | 9 | HARV.AE <- min9.FG.AE.list$CO2 10 | 11 | load( "/Users/sm3466/Dropbox (YSE)/Research/FluxGradient/Data/HARV_WP_AH_2023-12-05.RDATA" ) 12 | 13 | HARV.WP <- min9.FG.WP.list$CO2 14 | 15 | load( "/Users/sm3466/Dropbox (YSE)/Research/FluxGradient/Data/HARV_MBRflux.RDATA" ) 16 | 17 | HARV.MBR <- min9.FG.WP.list$CO2 18 | 19 | rm( MBRflux_align, min9.FG.AE.list, min9.FG.WP.list) 20 | 21 | 22 | ggplot(data=HARV.AE) + geom_point(aes(x=timeEnd_A , y=FG),cex=0.3) + ylim(-100, 100) + geom_point(aes(x=timeEnd_A, y=FC_interp, ), col="red", cex=0.25) 23 | 24 | ggplot(data=HARV.WP) + geom_point(aes(x=timeEnd_A , y=FG),cex=0.3) + ylim(-100, 100) + geom_point(aes(x=timeEnd_A, y=FC_interp, ), col="red", cex=0.25) 25 | 26 | ggplot(data=HARV.MBR) + geom_point(aes(x=timeEnd_A , y=FG),cex=0.3) + ylim(-100, 100) + geom_point(aes(x=timeEnd_A, y=FC_interp, ), col="red", cex=0.25) 27 | 28 | 29 | 30 | -------------------------------------------------------------------------------- /functions/calc.rmse.R: -------------------------------------------------------------------------------- 1 | #' calc.rmse 2 | #' 3 | #' @param site df of calculated flux from specific site taken from Validation df 4 | #' 5 | #' @return df with RMSE and residual columns 6 | #' 7 | #' 8 | #' @author Alexis Helgeson 9 | #' 10 | calc.rmse <- function(site){ 11 | #calculate RMSE for CO2 12 | site.CO2 <- site %>% filter(gas == "CO2") 13 | site.CO2$residual <- site.CO2$FC_turb_interp - site.CO2$FG 14 | site.CO2$RMSE <- sqrt(mean((site.CO2$residual)^2, na.rm = T)) 15 | 16 | #calculate RMSE for H2O 17 | site.H2O <- site %>% filter(gas == "H2O") 18 | site.H2O$residual <- site.H2O$FH2O_interp - site.H2O$FG 19 | site.H2O$RMSE <- sqrt(mean((site.H2O$residual)^2, na.rm = T)) 20 | 21 | #calculate RMSE for CH4 22 | site.CH4 <- site %>% filter(gas == "CH4") 23 | site.CH4$residual <- NA #set NA for now 24 | site.CH4$RMSE <- NA 25 | print("NO VALIDATION DATA AVAILABLE FOR CH4, SETTING RESIDUAL AND RMSE COLUMNS TO NA") 26 | # site.CH4$residual <- site.CH4$ - site.CH4$FG 27 | # site.CH4$RMSE <- sqrt(mean((site.CH4$residual)^2, na.rm = T)) 28 | 29 | site.residual <- rbind(site.CO2, site.H2O, site.CH4) 30 | 31 | return(site.residual) 32 | 33 | } -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # History files 2 | .Rhistory 3 | .Rapp.history 4 | # Session Data files 5 | .RData 6 | # User-specific files 7 | .Ruserdata 8 | # Example code in package build process 9 | *-Ex.R 10 | # Output files from R CMD build 11 | /*.tar.gz 12 | # Output files from R CMD check 13 | /*.Rcheck/ 14 | # RStudio files 15 | .Rproj.user/ 16 | # produced vignettes 17 | vignettes/*.html 18 | vignettes/*.pdf 19 | # OAuth2 token, see https://github.com/hadley/httr/releases/tag/v0.3 20 | .httr-oauth 21 | # knitr and R markdown default cache directories 22 | *_cache/ 23 | /cache/ 24 | # Temporary files created by R markdown 25 | *.utf8.md 26 | *.knit.md 27 | # R Environment Variables 28 | .Renviron 29 | # R project file(s) 30 | *.Rproj 31 | # DS_Store (for Mac users) 32 | .DS_Store 33 | test_download.R 34 | Harvard_Forest 35 | Konza 36 | # Data 37 | data/ 38 | Data/ 39 | ### Ignore testing folder for scripts. Roisin added 40 | testing/ 41 | .RDataTmp1 42 | .RDataTmp2 43 | .RDataTmp3 44 | .Rdata 45 | .Rhistory 46 | # Ignore certain file types 47 | *.gz 48 | *.xml 49 | *.Rdata 50 | .RDataTmp 51 | *.jpeg 52 | *.jpg 53 | *.png 54 | 55 | # Ignore certain folders 56 | methane/ 57 | data/ 58 | Data/ 59 | testing/ 60 | -------------------------------------------------------------------------------- /deprecated/FG_AE.WP_v2.R: -------------------------------------------------------------------------------- 1 | #' FG_AE.WP 2 | #' 3 | #' @param min9 gas concentration data frame, passed from computeFG.AE.WP.R 4 | #' @param eddy.diff.name name of which eddy diffusivity to use, passed from computeFG.AE.WP.R 5 | #' 6 | #' @author Samuel Jurado and Alexis Helgeson 7 | #' v2: Modified by Camilo Rey, Roisin Commane March 12 2024 8 | #' 9 | #' Code inputs molar mixing ratio: # CO2 umol mol-1, CH4 nmol mol-1, H2O mmol mol-1 10 | #' Code outputs molar flux: # CO2 umol m-2 s-1, CH4 nmol m-2 s-1, H2O mmol m-2 s-1 11 | #' min9$dConc is a mixing ratio not a concetration 12 | #' 13 | FG_AE.WP <- function(min9, eddy.diff.name){ 14 | 15 | data.cols <- c("dConc", "rhoa_kgm3", "dHeight") 16 | min9 <- min9[complete.cases(min9[,data.cols]),] 17 | diff.conc <- as.numeric(min9$dConc) # CO2 umol mol-1, CH4 nmol mol-1, H2O mmol mol-1 18 | diff.heights <- as.numeric(min9$dHeight) # m 19 | 20 | k <- as.numeric(min9[,paste0(eddy.diff.name)])# m2 s-1 21 | rho <- as.numeric(min9$rhoa_kgm3) #kg m-3 22 | rho_mol <- rho*.0289 # mol m-3 23 | 24 | min9$FGmol <- rho_mol*(-k)*(diff.conc)/(diff.heights)# CO2 umol m-2 s-1, CH4 nmol m-2 s-1, H2O mmol m-2 s-1 25 | 26 | 27 | return(min9) 28 | } 29 | -------------------------------------------------------------------------------- /functions/temp.response.curve.R: -------------------------------------------------------------------------------- 1 | #' temp.response.curve 2 | #' 3 | #' @param site df filtered to site nighttime CO2 and Air Temperature 4 | #' @param TA.name name of Ait Temperature column 5 | #' @param rho initial value of amplitude parameter 6 | #' @param psi initial value of growth/decay parameter 7 | #' @param flux.name name of flux column to use as CO2 flux 8 | #' 9 | #' @return model object with estimated temperature response curve parameters from nighttime CO2 flux and Air Temperature 10 | #' 11 | #' 12 | #' @author Alexis Helgeson 13 | temp.response.curve <- function(site, TA.name, rho, psi, flux.name){ 14 | #using exponential model 15 | temp.model <- R ~ rho*exp(psi*TA) 16 | #set initial parameter values 17 | initial.param <- c(rho = rho, psi = psi) 18 | #select for only model predictor and response data 19 | temp.flux.vars <- data.frame(TA=site[,paste0(TA.name)], R = site[,paste0(flux.name)]) 20 | #fit model 21 | temp.response.model <- gsl_nls(fn=temp.model, data=temp.flux.vars, start=initial.param) 22 | #print(light.response.model) 23 | #make predictions 24 | #df_pred <- predict(temp.response.model, newdata=temp.flux.vars) 25 | 26 | return(temp.response.model) 27 | } -------------------------------------------------------------------------------- /functions/light.response.curve.R: -------------------------------------------------------------------------------- 1 | #' light.response.curve 2 | #' 3 | #' @param site df of selected site filtered to only daytime measurements 4 | #' @param alpha initial value of slope parameter 5 | #' @param beta initial value of plateau parameter 6 | #' @param gama initial value of respiration term 7 | #' @param flux.name name of flux column to use as CO2 flux 8 | #' 9 | #' @return model object with estimated light response curve parameters from daytime CO2 flux and PAR 10 | #' 11 | #' 12 | #' @author Alexis Helgeson 13 | light.response.curve <- function(site, alpha, beta, gama, flux.name){ 14 | #using rectangular hyperbolic model 15 | light.model <- P ~ ((alpha*beta*Q)/((alpha*Q) + beta)) - gama 16 | #set initial parameter values 17 | inital.param <- c(alpha = alpha, beta = beta, gama = gama) 18 | #select for only model predictor and response data 19 | light.flux.vars <- data.frame(Q=site$PAR, P = site[,paste0(flux.name)]) 20 | #fit model 21 | light.response.model <- gsl_nls(fn=light.model, data=light.flux.vars, start=inital.param) 22 | #print(light.response.model) 23 | #make predictions 24 | #df_pred <- predict(light.response.model, newdata=light.flux.vars) 25 | 26 | return(light.response.model) 27 | } 28 | 29 | -------------------------------------------------------------------------------- /functions/plot.single.site.1to1.R: -------------------------------------------------------------------------------- 1 | #' plot.single.site.1to1 2 | #' 3 | #' @param site single site dataframe filtered to desired gas: CO2, H2O 4 | #' @param desired.var which NEON EC to use as comparison against FG 5 | #' @param x.lab x axis label 6 | #' @param y.lab y axis label 7 | #' @param plot.title should reflect which method is used to calculate FG i.e. AE or WP or MBR 8 | #' 9 | #' @return single site linear 1to1 plot 10 | #' 11 | #' 12 | #' @author Alexis Helgeson 13 | plot.single.site.1to1 <- function(site, x.flux, y.flux, x.lab, y.lab, plot.title){ 14 | #add na filter for desired.var 15 | site <- site[complete.cases(site[,c(x.flux, y.flux)]),] 16 | #set range for x/y axis based on y.flux 17 | range.x.y <- range(site[,y.flux]) 18 | #plot linear 1:1 facet by site 19 | ggplot(site, aes(x = !! sym(x.flux), y = !! sym(y.flux))) + 20 | geom_point() + 21 | geom_abline(intercept = 0, slope = 1, color = "red") + 22 | scale_x_continuous(limits = range.x.y)+ 23 | scale_y_continuous(limits = range.x.y)+ 24 | xlab(x.lab)+ 25 | ylab(y.lab)+ 26 | ggtitle(paste0(plot.title))+ 27 | theme_minimal()+ 28 | theme(text = element_text(size = 20), axis.title=element_text(size=24), plot.title = element_text(hjust = 0.5)) 29 | } -------------------------------------------------------------------------------- /functions/plot.all.sites.diurnal.R: -------------------------------------------------------------------------------- 1 | #' plot.all.sites.diurnal 2 | #' 3 | #' @param all.sites dataframe of site hourly flux averages along wih std error 4 | #' @param flux.name column name of desired flux to plot 5 | #' @param flux.ymin.name column name of ymin of desired flux for lower bound of error bar 6 | #' @param flux.ymax.name column name of ymax of desired flux for upper bound of error bar 7 | #' 8 | #' @return plot of diurnal cycle of flux across all sites 9 | #' 10 | #' 11 | #' @author Alexis Helgeson and Sam Jurado 12 | plot.all.sites.diurnal <- function(all.sites, plot.title){ 13 | #plot diurnal cycle of all sites 14 | ggplot(all.sites, aes(x = hour, y = mean_flux, colour = flux.name)) + 15 | geom_point() + 16 | geom_errorbar(aes(ymin = all.sites$ymin, ymax = all.sites$ymax, width = 0.2)) + 17 | facet_wrap(~ site, scales = "free")+ 18 | scale_x_discrete(breaks = c("00", "06", "12", "18", "23"))+ 19 | xlab("Hour of Day")+ 20 | ylab(expression(paste("CO"[2], " Flux (umol CO"[2], " m"^-2," s"^-1,")")))+ 21 | guides(colour=guide_legend(title=""))+ 22 | theme_minimal()+ 23 | ggtitle(paste0(plot.title))+ 24 | theme(text = element_text(size = 20), axis.title=element_text(size=24), legend.position = "top", plot.title = element_text(hjust = 0.5)) 25 | } -------------------------------------------------------------------------------- /exploratory/jdg/stacked_arrows.R: -------------------------------------------------------------------------------- 1 | # Load the necessary library 2 | library(ggplot2) 3 | 4 | # Example data: flux between levels, with multiple fluxes from the same source 5 | flux_data <- data.frame( 6 | from = c(1, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 4, 4, 5), 7 | to = c(2, 3, 4, 5, 6, 3, 4, 5, 6, 4, 5, 6, 5, 6, 6), 8 | flux = c(5, 10, 8, 12, 15, 8, 6, 12, 7, 12, 7, 13, 9, 13, 10) 9 | ) 10 | 11 | # Set the stack positions based on the source level 12 | flux_data$stack_position <- flux_data$from 13 | 14 | # Plot with stacked vertical arrows 15 | ggplot(flux_data) + 16 | geom_segment(aes(x = stack_position, xend = stack_position, 17 | y = from, yend = to, 18 | size = flux), 19 | arrow = arrow(type = "closed", length = unit(0.2, "inches")), 20 | lineend = "round", linejoin = "round") + 21 | scale_size_continuous(range = c(0.5, 3)) + # Arrow size proportional to flux 22 | theme_minimal() + 23 | labs(x = "Source Levels", y = "Tower Levels", 24 | title = "Carbon Flux Between Tower Levels", 25 | size = "Flux") + 26 | theme(legend.position = "right") + 27 | scale_y_continuous(breaks = 1:6, limits = c(1, 6)) + # Ensure proper y-axis breaks 28 | scale_x_continuous(breaks = 1:5, limits = c(1, 5)) # X-axis based on source levels 29 | -------------------------------------------------------------------------------- /deprecated/FG_AE.WP.R: -------------------------------------------------------------------------------- 1 | #' FG_AE.WP 2 | #' 3 | #' @param min9 gas concentration data frame, passed from computeFG.AE.WP.R 4 | #' @param eddy.diff.name name of which eddy diffusivity to use, passed from computeFG.AE.WP.R 5 | #' 6 | #' Code inputs molar mixing ratio: # CO2 umol mol-1, CH4 nmol mol-1, H2O mmol mol-1 7 | #' Code outputs molar flux: # CO2 umol m-2 s-1, CH4 nmol m-2 s-1, H2O mmol m-2 s-1 8 | #' min9$dConc is a mixing ratio not a concetration 9 | #' 10 | #' @author Samuel Jurado, Alexis Helgeson, Camilo Rey, and Roisin Commane 11 | #' 12 | FG_AE.WP <- function(min9, eddy.diff.name){ 13 | #remove NAs 14 | data.cols <- c("dConc", "rhoa_kgm3", "dHeight") 15 | min9 <- min9[complete.cases(min9[,data.cols]),] 16 | diff.conc <- as.numeric(min9$dConc) # CO2 umol mol-1, CH4 nmol mol-1, H2O mmol mol-1 17 | diff.heights <- as.numeric(min9$dHeight) # m 18 | #does this eddy diffisivity need a direction correction? 19 | #DEPRECIATED CODE 20 | # k <- as.numeric(min9$EddyDiff) #m-2 s-1 21 | #select for desired eddy diffusivity using eddy.diff.name 22 | k <- as.numeric(min9[,paste0(eddy.diff.name)]) 23 | rho <- as.numeric(min9$rhoa_kgm3) #kg m-3 24 | rho_mol <- rho*.0289 # mol m-3 25 | 26 | min9$FG <- rho_mol*(-k)*(diff.conc)/(diff.heights) # CO2 umol m-2 s-1, CH4 nmol m-2 s-1, H2O mmol m-2 s-1 27 | 28 | return(min9) 29 | } 30 | -------------------------------------------------------------------------------- /deprecated/MO_Length.R: -------------------------------------------------------------------------------- 1 | ###########################MONIN OBUKHOV LENGTH################################ 2 | #' @param press atmospheric pressure in Kpa 3 | #' @param temp temperature in C 4 | #' @param H sensible heat flux 5 | #' @param LE latent heat flux 6 | #' @param velofric velocity friction (u*) 7 | #' 8 | #' @return Vector of monin obuhkov length 9 | #' 10 | #' @author Samuel Jurado and Alexis Helgeson 11 | #' 12 | 13 | 14 | MOlength <- function(press,temp,H,LE,velofric){ 15 | #######ATMOSPHERIC COMPUTATION###### 16 | 17 | #Constants 18 | l = 2.26*10**6 #Latent Heat of Vaporization 19 | k = .41 # Von Karmaan Constant 20 | g = 9.81 # Gravity 21 | cp = 1005 # Specific Heat of Air 22 | 23 | #Air Density# 24 | 25 | for(x in list(1:length(press))){ 26 | rho = (press[x]*1000)/((temp[x]+273.15)*287) 27 | #print(rho) 28 | } 29 | 30 | 31 | #Surface Flux Virtual Temperature # 32 | 33 | for(x in list(1:length(H))){ 34 | vpotflux <- (H[x]/(rho[x]*cp))+.61*(temp[x]+273.15)*(LE[x]/(rho[x]*l)) 35 | vpotflux <- vpotflux 36 | #print(vpotflux) 37 | } 38 | 39 | #Monin-Obukhov Length# 40 | 41 | for(x in list(1:length(vpotflux))){ 42 | L <- -((velofric[x]**3)*(temp[x]+273.15))/(k*g*(vpotflux[x])) 43 | #print(L) 44 | } 45 | 46 | DATA <- list(rho = rho, vpotflux = vpotflux, L = L) 47 | return(DATA) 48 | 49 | } 50 | -------------------------------------------------------------------------------- /functions/plot.temp.response.R: -------------------------------------------------------------------------------- 1 | #' plot.temp.response 2 | #' 3 | #' @param model model object returned by light.response.curve 4 | #' @param site df filtered to site nighttime CO2 and Air Temperature 5 | #' @param TA.name name of air temperature column 6 | #' @param flux.name name of flux column to use as CO2 flux 7 | #' @param plot.title should reflect which method is used to calculate FG i.e. AE or WP or MBR 8 | #' 9 | #' @return temperature response curve 10 | #' 11 | #' 12 | #' @author Alexis Helgeson 13 | plot.temp.response <- function(model, site, TA.name, flux.name, plot.title){ 14 | #remove NAs from dataframe for plotting 15 | site <- site[complete.cases(site[,c(paste0(TA.name), paste0(flux.name))]),] 16 | #grab model coefficients 17 | model.coeff <- coefficients(model) 18 | rho <- model.coeff[["rho"]] 19 | psi <- model.coeff[["psi"]] 20 | #plot light response curve 21 | ggplot(site, aes(x = !! sym(TA.name), y = !! sym(flux.name))) + 22 | geom_point() + 23 | geom_function(fun = function(x) rho*exp(psi*x), colour = "blue")+ 24 | #facet_wrap(~ site, scales = "free")+ 25 | xlab("Air Temperature (deg C)")+ 26 | ylab(expression(paste("CO"[2], " Flux (umol CO"[2], " m"^-2," s"^-1,")")))+ 27 | ggtitle(paste0(plot.title))+ 28 | theme_minimal()+ 29 | theme(text = element_text(size = 20), axis.title=element_text(size=24), plot.title = element_text(hjust = 0.5)) 30 | } -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # Contributing Guidelines 2 | 3 | I would love to have you contribute to `PACKAGE NAME` if that is of interest! I would divide contributions into two categories: (1) function ideas that aren't coded and (2) functions that are written in scripts. Once you've decided which of these categories you fall into, follow the instructions under the relevant subheading. 4 | 5 | ## Function Ideas 6 | 7 | If you have an idea for a function submit your idea to sparkle.malone@yale.edu, and jmatthes@wellesley.edu to add a discussion of your function to the flux gradient working group meeting. 8 | 9 | ## Function Scripts 10 | 11 | If you've already written up an R function in a script you have two options for getting it added to `PACKAGE`: 12 | 13 | **Scripts Option A** 14 | 15 | - [Open a GitHub issue](https://github.com/lter/lterwg-flux-gradient/tree/main/R) and paste your function into it 16 | 17 | 18 | ## Contribution Credit 19 | 20 | In return for your generous contribution to `PACKAGE` you can consider the following modes of credit: 21 | 22 | - Add you as a contributor in the `DESCRIPTION` of the package with a link to a professional website of your choosing 23 | 24 | - Put your name in the README of the repository next to the description of your function 25 | 26 | Note that I make no distinction between contributing a function idea and contributing written code in terms of credit received. 27 | -------------------------------------------------------------------------------- /functions/plot.light.response.R: -------------------------------------------------------------------------------- 1 | #' plot.light.response 2 | #' 3 | #' @param model model object returned by light.response.curve 4 | #' @param site dataframe filtered to daytime CO2 and PAr for given site 5 | #' @param flux.name name of flux column to use as CO2 flux 6 | #' @param plot.title should reflect which method is used to calculate FG i.e. AE or WP or MBR 7 | #' 8 | #' @return light response curve plot 9 | #' 10 | #' 11 | #' @author Alexis Helgeson 12 | plot.light.response <- function(model, site, flux.name, plot.title){ 13 | #remove NAs from dataframe for plotting 14 | site <- site[complete.cases(site[,c("PAR", paste0(flux.name))]),] 15 | #grab model coefficients 16 | model.coeff <- coefficients(model) 17 | alpha <- model.coeff[["alpha"]] 18 | beta <- model.coeff[["beta"]] 19 | gama <- model.coeff[["gama"]] 20 | #plot light response curve 21 | ggplot(site, aes(x = PAR, y = !! sym(flux.name))) + 22 | geom_point() + 23 | geom_function(fun = function(x) ((alpha*beta*x)/((alpha*x) + beta)) - gama, colour = "blue")+ 24 | #facet_wrap(~ site, scales = "free")+ 25 | xlab(expression(paste("PAR (umol m"^-2, " s"^-1, ")")))+ 26 | ylab(expression(paste("CO"[2], " Flux (umol CO"[2], " m"^-2," s"^-1,")")))+ 27 | ggtitle(paste0(plot.title))+ 28 | theme_minimal()+ 29 | theme(text = element_text(size = 20), axis.title=element_text(size=24), plot.title = element_text(hjust = 0.5)) 30 | } -------------------------------------------------------------------------------- /deprecated/flow.evaluation_SITELIST.R: -------------------------------------------------------------------------------- 1 | # Creates the list of dataframes used by One2One, Diel, and Cparms. This also compiles the filter reports for all sites. 2 | 3 | SITES_MBR_9min_FILTER <- list() 4 | SITES_AE_9min_FILTER <- list() 5 | SITES_WP_9min_FILTER <- list() 6 | filter.report <- data.frame() 7 | filter.report.stability <- data.frame() 8 | # Site List DF and filter report 9 | for( site in site.list){ 10 | 11 | print( site) 12 | 13 | # Load the files: 14 | localdir.site <- paste(localdir,"/", site, sep = "") 15 | 16 | files <- paste(site, "_FILTER.Rdata", sep = "") 17 | 18 | load(paste(localdir.site, "/", files, sep="")) 19 | 20 | 21 | SITES_MBR_9min_FILTER[[site]] <- MBR_9min_FILTER 22 | SITES_AE_9min_FILTER[[site]] <- AE_9min_FILTER 23 | SITES_WP_9min_FILTER[[site]] <- WP_9min_FILTER 24 | 25 | files <- paste(site, "_9min.report.csv", sep = "") 26 | 27 | report <- read.csv( paste( localdir.site,"/", files, sep="" )) 28 | filter.report <- rbind(filter.report, report ) 29 | 30 | message("Done with ", site) 31 | } 32 | 33 | for( site in site.list){ 34 | 35 | print( site) 36 | 37 | # Load the files: 38 | localdir.site <- paste(localdir,"/", site, sep = "") 39 | 40 | files <- paste(site, "_9min.report.stability.csv", sep = "") 41 | 42 | report <- read.csv( paste( localdir.site,"/", files, sep="" )) 43 | filter.report.stability <- rbind(filter.report.stability, report ) 44 | 45 | message("Done with ", site) 46 | } -------------------------------------------------------------------------------- /deprecated/downloadUnzipNEON.R: -------------------------------------------------------------------------------- 1 | #' downloadUnzipNEON 2 | #' 3 | #' @param zip.dir filepath location of NEON zip folder 4 | #' @param sitecode NEON site code 5 | #' @param startdate startdate for download 6 | #' @param enddate enddate for download 7 | #' 8 | #' @return print message identifying where unzipped files can be found 9 | #' 10 | #' @author Alexis Helgeson 11 | downloadUnzipNEON <- function(sitecode, zip.dir, startdate, enddate){ 12 | #downloaded NEON eddy-co data as zip file 13 | #this fcn is a rate limiter, downloads can be lengthy, quicker to download off website? 14 | zipsByProduct(dpID="DP4.00200.001", sitecode,startdate, enddate,package="basic", check.size=F) 15 | 16 | #unzip files 17 | #I think the stackEddy fcn can be used here but currently does not list CH4 concentrations as an option 18 | #test <- stackEddy(filepath = paste0(site.dir, "/filesToStack00200/"), level="dp04") 19 | #setwd(zip.dir) 20 | setwd(paste0(zip.dir, "/filesToStack00200")) 21 | 22 | zip.files <-list.files(pattern=".zip") 23 | for(j in 1:length(zip.files)){ 24 | print(j) 25 | unzip(zip.files[j]) 26 | } 27 | folders <- list.files(pattern = "KONZ.DP4.00200.001") 28 | 29 | for(j in 3:length(folders)){ 30 | gz.files <-list.files(path = file.path(folders[j]), pattern=".gz", full.names = TRUE) 31 | print(j) 32 | gunzip(gz.files, remove=FALSE) 33 | } 34 | 35 | return(print(paste0("NEON files for ", sitecode, " are downloaded and unzipped h5 files can be found at ", zip.dir))) 36 | } 37 | -------------------------------------------------------------------------------- /deprecated/plot.ustar.NEE.site.R: -------------------------------------------------------------------------------- 1 | #' plot.ustar.NEE.site 2 | #' 3 | #' @param NEE dataframe of nighttime NEE and ustar values 4 | #' 5 | #' @return plot of NEE vs ustar with threshold marked in red 6 | #' 7 | #' 8 | #' @author Alexis Helgeson 9 | plot.ustar.NEE.site <- function(NEE){ 10 | ustar.0NEE <- NEE[which(NEE$FC_nee_interp >= -1 & NEE$FC_nee_interp <= 1), "ustar_interp"] 11 | # Fitting a nonlinear quadratic curve using nls 12 | fit <- nls(y ~ a * x^2 + b * x + c, start = list(a = 1, b = 1, c = 1), data = list(y = NEE$FC_nee_interp, x = NEE$ustar_interp)) 13 | #grab model coefficients 14 | model.coeff <- coefficients(fit) 15 | a <- model.coeff[["a"]] 16 | b <- model.coeff[["b"]] 17 | c <- model.coeff[["c"]] 18 | #remove NAs before plotting 19 | NEE <- NEE[complete.cases(NEE[,c("ustar_interp", "FC_nee_interp")]),] 20 | #plot light response curve 21 | ggplot(NEE, aes(x = ustar_interp, y = FC_nee_interp)) + 22 | xlim(0, max(NEE$ustar_interp))+ 23 | ylim(0, max(NEE$FC_nee_interp))+ 24 | geom_point(size = 3) + 25 | geom_function(fun = function(x) a * x^2 + b * x + c, colour = "blue", size = 2)+ 26 | geom_vline(xintercept = median(ustar.0NEE), colour = "red", size = 2)+ 27 | geom_text(x = 0.2, y = max(NEE$FC_nee_interp), label = paste("Ustar threshold \n", round(median(ustar.0NEE), 3)), size = 8) + 28 | xlab(expression(paste("Nighttime U star (m/s)")))+ 29 | ylab(expression(paste("Nighttime NEE Flux (umol CO"[2], " m"^-2," s"^-1,")")))+ 30 | theme_minimal()+ 31 | theme(text = element_text(size = 20), axis.title=element_text(size=24)) 32 | } -------------------------------------------------------------------------------- /functions/calc.MO.length.R: -------------------------------------------------------------------------------- 1 | ###########################MONIN OBUKHOV LENGTH################################ 2 | #' @param press atmospheric pressure in Kpa 3 | #' @param temp temperature in C 4 | #' @param H sensible heat flux 5 | #' @param LE latent heat flux 6 | #' @param velofric velocity friction (u*) 7 | #' 8 | #' @return Vector of monin obuhkov length 9 | #' 10 | #' @author Samuel Jurado and Alexis Helgeson 11 | #' Modified by Camilo Rey Sanchez March 14 2024 12 | 13 | 14 | calc.MO.length <- function(press,temp,H,LE,velofric){ 15 | #######ATMOSPHERIC COMPUTATION###### 16 | 17 | #Constants 18 | lambda = 2.26*10**3 # Latent Heat of Vaporization (J g-1) 19 | k = .41 # Von Karmaan Constant (unitless) 20 | g = 9.81 # Gravity (m s-2) 21 | cp = 1.005 # Specific Heat of Air J K-1 g-1 22 | R= 8.314462 # Universal gas constant m3 Pa K-1 mol-1 23 | Md= 29 # Molecular mass of dry air g mol-1 24 | 25 | #Dry Air Density# 26 | 27 | for(x in list(1:length(press))){ 28 | rho = (press[x]*1000)/((temp[x]+273.15)*R)*Md # g m-3 29 | #print(rho) 30 | } 31 | 32 | 33 | #Virtual Potential Temperature Flux # 34 | 35 | for(x in list(1:length(H))){ 36 | vpotflux <- (H[x]/(rho[x]*cp))+.61*(temp[x]+273.15)*(LE[x]/(rho[x]*lambda)) 37 | vpotflux <- vpotflux 38 | #print(vpotflux) 39 | } 40 | 41 | #Monin-Obukhov Length# 42 | 43 | for(x in list(1:length(vpotflux))){ 44 | L <- -((velofric[x]**3)*(temp[x]+273.15))/(k*g*(vpotflux[x])) 45 | #print(L) 46 | } 47 | 48 | DATA <- list(rho = rho, vpotflux = vpotflux, L = L) 49 | return(DATA) 50 | 51 | } 52 | -------------------------------------------------------------------------------- /exploratory/flow.clean.googledrive.R: -------------------------------------------------------------------------------- 1 | # Clean up google drive: 2 | library(tidyverse) 3 | library( googledrive) 4 | 5 | 6 | # We no longer need the 30min flux data for the MBR, AE, and WP: 7 | 8 | email <- 'sparklelmalone@gmail.com' 9 | googledrive::drive_auth(email = TRUE) 10 | drive_url <- googledrive::as_id("https://drive.google.com/drive/folders/1Q99CT77DnqMl2mrUtuikcY47BFpckKw3") # The Data 11 | 12 | metadata <- read.csv('/Volumes/MaloneLab/Research/FluxGradient/Ameriflux_NEON field-sites.csv') # has a list of all the sites 13 | all.site.list <- metadata$Site_Id.NEON %>% unique 14 | 15 | for( site in site.list){ 16 | print(site) 17 | data_folder_main <- googledrive::drive_ls(path =drive_url ) # need to go into the folder of each site: 18 | 19 | data_folder_site <- googledrive::drive_ls(path = data_folder_main$id[data_folder_main$name == site] ) # need to go into the folder of each site: 20 | 21 | focal_file_AE.rdata <- paste(site,"_AE_30min.Rdata", sep="") 22 | focal_file_AE <- paste(site,"_AE_30min.zip", sep="") 23 | focal_file_WP <- paste(site,"_WP_30min.zip", sep="") 24 | focal_file_MBR <- paste(site,"_MBR_30min.zip", sep="") 25 | 26 | googledrive::drive_trash(file = data_folder_site$id[data_folder_site$name == focal_file_AE.rdata]) 27 | googledrive::drive_trash(file = data_folder_site$id[data_folder_site$name == focal_file_AE]) 28 | googledrive::drive_trash(file = data_folder_site$id[data_folder_site$name == focal_file_WP]) 29 | googledrive::drive_trash(file = data_folder_site$id[data_folder_site$name == focal_file_MBR]) 30 | 31 | rm(focal_file_AE.rdata,focal_file_AE, focal_file_WP, focal_file_MBR ) 32 | print("Done") 33 | } 34 | -------------------------------------------------------------------------------- /functions/compile.neon.data.9min.6min.R: -------------------------------------------------------------------------------- 1 | #' compile.neon.data.9min.6min 2 | #' 3 | #' @param h5files list containing monthly h5 files 4 | #' @param sitecode NEON site code 5 | #' 6 | #' @return list of dataframes containing CH4, CO2, H2O gas concentration at 9 min resolution 7 | #' 8 | #' @author Alexis Helgeson 9 | compile.neon.data.9min.6min <- function(h5files, sitecode){ 10 | #create empty list to store monthly data 11 | ALL.data = list() 12 | 13 | #looping over all h5 files and extracting data over timeseries (startdate:enddate) 14 | for(i in 1:length(h5files)){ 15 | hd.file <- h5files[i] 16 | print(i) 17 | month.data <- grab.neon.gas.9min.6min(hd.file = hd.file, sitecode = sitecode) 18 | 19 | ALL.data[[i]] <- month.data 20 | 21 | } 22 | #remove looping variable 23 | rm(month.data) 24 | 25 | #rbind similar df FOR 9M GAS 26 | CH4.all <- data.frame() 27 | CO2.all <- data.frame() 28 | H2O.all <- data.frame() 29 | 30 | for (k in 1:length(ALL.data)) { 31 | grabMonth <- ALL.data[[k]] 32 | #grab ch4 for all months and combine into one df 33 | grabCH4 <- grabMonth[[which(names(grabMonth) == "CH4")]] 34 | CH4.all <- bind_rows(CH4.all, grabCH4) 35 | #grab co2 for all months and combine into one df 36 | grabCO2 <- grabMonth[[which(names(grabMonth) == "CO2")]] 37 | CO2.all <- bind_rows(CO2.all, grabCO2) 38 | #grab h2o for all months and combine into one df 39 | grabH2O <- grabMonth[[which(names(grabMonth) == "H2O")]] 40 | H2O.all <- bind_rows(H2O.all, grabH2O) 41 | 42 | } 43 | 44 | #FOR 9M GAS 45 | DATA <- list(CH4 = CH4.all, CO2 = CO2.all, H2O = H2O.all) 46 | 47 | return(DATA) 48 | } -------------------------------------------------------------------------------- /deprecated/Comp_Function.R: -------------------------------------------------------------------------------- 1 | #' Comp_Function 2 | #' 3 | #' @param obs_data Observational Data (vector) 4 | #' @param derv_data Derived Data (vector) 5 | #' @param IQR Inter-Quartile Range, numeric 1.5 for outlier removal, 3 for extreme outliers 6 | #' 7 | #' @return df containing site co2, h2o, ch4 measurements at various tower heights 8 | #' 9 | #' 10 | #' @author Sam Jurado 11 | 12 | 13 | Flux_Comparison <- function(obs_data,derv_data,IQR){ 14 | 15 | diff <- as.numeric(obs_data) - as.numeric(derv_data) 16 | 17 | diff_df <- data.frame(diff) 18 | #number of points that fall outside of x number of standard deviations 19 | 20 | 21 | #makes this an IQR test instead 22 | q1 <- quantile(diff_df$diff,prob=c(.25), type = 1 , na.rm =TRUE) 23 | q3 <- quantile(diff_df$diff, prob=c(.75), type=1, na.rm=TRUE) 24 | 25 | outliers = (q3-q1)*IQR 26 | floor = q1 - outliers 27 | ceiling = q3 + outliers 28 | 29 | diff_df$diff <- replace(diff_df$diff, diff_df$diff < floor , NA) 30 | diff_df$diff <- replace(diff_df$diff, diff_df$diff > ceiling , NA) 31 | 32 | percent_diff <- (diff_df$diff)/as.numeric(df$obs_data) *100 33 | 34 | 35 | diff_df$percent_diff <- percent_diff 36 | 37 | 38 | q1 <- quantile(diff_df$percent_diff,prob=c(.25), type = 1 , na.rm =TRUE) 39 | q3 <- quantile(diff_df$percent_diff, prob=c(.75), type=1, na.rm=TRUE) 40 | 41 | outliers = (q3-q1)*IQR 42 | floor = q1 - outliers 43 | ceiling = q3 + outliers 44 | 45 | diff_df$percent_diff <- replace(diff_df$percent_diff, diff_df$percent_diff < floor , NA) 46 | diff_df$percent_diff <- replace(diff_df$percent_diff, diff_df$percent_diff > ceiling , NA) 47 | 48 | return(data.frame(diff_df)) 49 | } 50 | -------------------------------------------------------------------------------- /functions/add.hour.col.R: -------------------------------------------------------------------------------- 1 | #' add.hour.col 2 | #' 3 | #' @param site individual site data frame 4 | #' @param site.name NEON site code 5 | #' 6 | #' @return data frame with hour column and timeMid set to local time to site location 7 | #' 8 | #' 9 | #' @author Alexis Helgeson and Sam Jurado 10 | add.hour.col <- function(site, site.name){ 11 | #fix timezone and adjust for daylight savings 12 | #these sites are all in MT 13 | if(site.name == "NIWO" | site.name == "BONA" | site.name == "CPER" | site.name == "JORN"){ 14 | site$timeMid <- as.POSIXct(site$timeMid, tz ="MST7MDT,M3.2.0/2:00:00,M11.1.0/2:00:00") 15 | site$hour <- substr(as.character(site$timeMid), start = 12, stop = 13) 16 | } 17 | #this site is in EST 18 | if(site.name == "HARV"){ 19 | site$timeMid <- as.POSIXct(site$timeMid, tz ="EST5EDT,M3.2.0/2:00:00,M11.1.0/2:00:00") 20 | site$hour <- substr(as.character(site$timeMid), start = 12, stop = 13) 21 | } 22 | #this site is in AKT 23 | if(site.name == "TOOL"){ 24 | site$timeMid <- as.POSIXct(site$timeMid, tz ="ASKT9AKDT,M3.2.0/2:00:00,M11.1.0/2:00:00") 25 | site$hour <- substr(as.character(site$timeMid), start = 12, stop = 13) 26 | } 27 | #this site is in CT 28 | if(site.name == "KONZ"){ 29 | site$timeMid <- as.POSIXct(site$timeMid, tz ="CST6CDT,M3.2.0/2:00:00,M11.1.0/2:00:00") 30 | site$hour <- substr(as.character(site$timeMid), start = 12, stop = 13) 31 | } 32 | #this site is in AST 33 | if(site.name == "GUAN"){ 34 | site$timeMid <- as.POSIXct(site$timeMid, tz ="EST5EDT,M3.2.0/2:00:00,M11.1.0/2:00:00") #NEED TO FIND PROPER TZ CORRECTION CODE 35 | site$hour <- substr(as.character(site$timeMid), start = 12, stop = 13) 36 | } 37 | 38 | return(site) 39 | } -------------------------------------------------------------------------------- /functions/calc.all.sites.diurnal.avg.R: -------------------------------------------------------------------------------- 1 | #' calc.all.sites.diurnal.avg 2 | #' 3 | #' @param all.sites data frame of fluxes across all sites 4 | #' @param gas.name name of desired gas CO2, H2O, CH4 5 | #' 6 | #' @return data frame of hourly flux avg across all sites 7 | #' 8 | #' 9 | #' @author Alexis Helgeson and Sam Jurado 10 | calc.all.sites.diurnal.avg <- function(all.sites, FG.name = "FG", EC.name = "FC_turb_interp"){ 11 | #calculate diurnal averages by site for each flux type 12 | all.sites.diurnal.FG <- all.sites %>% group_by(hour, site) %>% summarise(mean_flux = mean(!! sym(FG.name), na.rm=TRUE), sd_flux = sd(!! sym(FG.name), na.rm=TRUE), n =n()) 13 | all.sites.diurnal.EC <- all.sites %>% group_by(hour, site) %>% summarise(mean_flux = mean(!! sym(EC.name), na.rm =TRUE), sd_flux = sd(!! sym(EC.name), na.rm =TRUE), n =n()) 14 | #add standard error column 15 | all.sites.diurnal.FG$std_err <- all.sites.diurnal.FG$sd_flux/sqrt(all.sites.diurnal.FG$n) 16 | all.sites.diurnal.EC$std_err <- all.sites.diurnal.EC$sd_flux/sqrt(all.sites.diurnal.EC$n) 17 | #add min/max column for plotting error bars 18 | all.sites.diurnal.FG$ymin <- all.sites.diurnal.FG$mean_flux - all.sites.diurnal.FG$std_err 19 | all.sites.diurnal.FG$ymax <- all.sites.diurnal.FG$mean_flux + all.sites.diurnal.FG$std_err 20 | all.sites.diurnal.EC$ymin <- all.sites.diurnal.EC$mean_flux - all.sites.diurnal.EC$std_err 21 | all.sites.diurnal.EC$ymax <- all.sites.diurnal.EC$mean_flux + all.sites.diurnal.EC$std_err 22 | #add column to distinguish flux type 23 | all.sites.diurnal.FG$flux.name <- "FG" 24 | all.sites.diurnal.EC$flux.name <- "EC" 25 | #combine into one data frame 26 | all.sites.diurnal <- bind_rows(all.sites.diurnal.FG, all.sites.diurnal.EC) 27 | 28 | return(all.sites.diurnal) 29 | } -------------------------------------------------------------------------------- /workflows/flow.neon.data.unzip.R: -------------------------------------------------------------------------------- 1 | ## --------------------------------------------- ## 2 | # Housekeeping ----- 3 | ## --------------------------------------------- ## 4 | # Purpose: 5 | # Unzips downloaded NEON data files 6 | 7 | # NOTE IMPORTANT INFORMATION: 8 | # all of the flow scripts are written assuming the end user has connected their R studio project to the lterwg-flux-gradient GitHub repo 9 | # AND that they have created a data folder 10 | # AND that within that data folder there are site folders named with the NEON sitecode 11 | 12 | # Set local dir 13 | #setwd('/Users/sm3466/YSE Dropbox/Sparkle Malone/Research/FluxGradient/lterwg-flux-gradient') 14 | 15 | # Source unzip.neon fcn 16 | source(file.path("functions", "unzip.neon.R")) 17 | 18 | # Add all sites here: 19 | site.list <- c("ABBY", "BARR", "BART", "BLAN", 20 | "BONA", "CLBJ", "CPER", "DCFS", 21 | "DEJU", "DELA", "DSNY", "GRSM", 22 | "GUAN", "HARV", "HEAL", "JERC", 23 | "JORN", "KONA", "KONZ", "LAJA", 24 | "LENO", "MLBS", "MOAB", "NIWO", 25 | "NOGP", "OAES", "ONAQ", "ORNL", 26 | "OSBS", "PUUM", "RMNP", "SCBI", 27 | "SERC", "SJER", "SOAP", "SRER", 28 | "STEI", "STER", "TALL", "TEAK", 29 | "TOOL", "TREE", "UKFS", "UNDE", 30 | "WOOD", "WREF", "YELL") 31 | 32 | ## --------------------------------------------- ## 33 | # Unzipping ----- 34 | ## --------------------------------------------- ## 35 | 36 | for(sitecode in site.list){ 37 | 38 | print(sitecode) 39 | 40 | # Unzip eddy-co bundled files 41 | unzip.neon(in_path = file.path("data", sitecode, "filesToStack00200"), 42 | out_path = file.path("data", sitecode), 43 | quiet = FALSE) 44 | 45 | } 46 | 47 | # EOF 48 | 49 | 50 | -------------------------------------------------------------------------------- /functions/calc.cross.gradient.R: -------------------------------------------------------------------------------- 1 | # ------ Prerequisites! Make sure these packages are installed ---- 2 | # Also requires packages: googledrive 3 | library(dplyr) 4 | library(lubridate) 5 | library(ggplot2) 6 | library(gslnls) 7 | library(ggh4x) 8 | library(googledrive) 9 | 10 | 11 | #Real Eddy Diff. converter - Sam J. 12 | 13 | "This code is intended to take the EC fluxes and concetration observations from NEON 14 | towers and convert them into an eddy diffusivity for comparison between H2O and CO2 K's 15 | and cross-gradient analysis" 16 | 17 | ### EC Eddy Diffusivity ### 18 | "input site file is a list of 3 data frames, CO2,H2O,and CH4. Back calculates 19 | CO2 and H2O and returns original frames with added columns KCO2 and KH2O" 20 | 21 | eddy_diff_real <- function(site) { 22 | 23 | 24 | site.2 <- site %>% mutate( 25 | rho = rhoa_kgm3, 26 | dz1 = TowerHeight_A, 27 | dz2 = TowerHeight_B, 28 | dx = dConc, 29 | dz = as.numeric(dz1)-as.numeric(dz2), 30 | cp = 1005 ,#J/kgK 31 | mol_air = rho*34.53, 32 | 33 | # H2O 34 | flux = case_when( gas == 'H2O' ~ ((LE_turb_interp/(2.25*10**6))/(.01801))*1000, gas == 'CO2'~ FC_turb_interp), 35 | Kgas = -(flux*dz)/(dx*mol_air) #m2/s 36 | ) 37 | 38 | return(site.2) 39 | } 40 | 41 | ####Cross Gradient Flux Flagger### 42 | "Flags all instances of a cross gradient flux" 43 | #' K is eddy diffusivity of gas H2O or CO2 44 | #' df is the dataframe of interest 45 | 46 | cross_grad_flag <- function(df,K){ 47 | 48 | df <- cbind(df, cross_grad_flag = NA) 49 | df$cross_grad_flag <- ifelse(df$K < 0,1,0 ) 50 | return(df) 51 | } 52 | 53 | crossGradientDF <- function( DATA ){ 54 | 55 | for (i in 1:length(DATA)) { 56 | DATA[[i]] <- eddy_diff_real(DATA[[i]]) #calculates Kgas 57 | DATA[[i]] <- cross_grad_flag(DATA[[i]], Kgas) 58 | } 59 | 60 | return(DATA) 61 | 62 | } 63 | -------------------------------------------------------------------------------- /deprecated/calc_bhatt_coefficient.R: -------------------------------------------------------------------------------- 1 | bhatt.coeff.df <- function(df , df.filter){ 2 | 3 | VPD.1 = df %>% select(VPD) %>% na.omit 4 | VPD.2 = df.filter %>% select(VPD) %>% na.omit 5 | 6 | Tair_K.1 = df %>% select(Tair_K) %>% na.omit 7 | Tair_K.2 = df.filter %>% select(Tair_K) %>% na.omit 8 | 9 | PAR.1 = df %>% select(PAR) %>% na.omit 10 | PAR.2 = df.filter %>% select(PAR) %>% na.omit 11 | 12 | summary <- data.frame( 13 | Bhatt.coe.PAR = bhatt.coeff(x = PAR.1[,1], y = PAR.2[,1]), 14 | Bhatt.coe.Tair_K = bhatt.coeff(x = Tair_K.1[,1], y = Tair_K.2[,1]), 15 | Bhatt.coe.VPD = bhatt.coeff(x = VPD.1[,1], y = VPD.2[,1]), 16 | Hellinger.PAR = statip::hellinger(x = PAR.1[,1], y = PAR.2[,1], -Inf, Inf), 17 | Hellinger.Tair_K = statip::hellinger(x = Tair_K.1[,1], y = Tair_K.2[,1], -Inf, Inf), 18 | Hellinger.VPD = statip::hellinger(x = VPD.1[,1], y = VPD.2[,1], -Inf, Inf), 19 | KS.PAR = stats::ks.test(x = PAR.1[,1], y = PAR.2[,1], alternative = c("two.sided"))$statistic, 20 | KS.Tair_K = stats::ks.test(x = Tair_K.1[,1], y = Tair_K.2[,1], alternative = c("two.sided"))$statistic, 21 | KS.VPD = stats::ks.test(x = VPD.1[,1], y = VPD.2[,1],alternative = c("two.sided"))$statistic, 22 | KS.P.PAR = stats::ks.test(x = PAR.1[,1], y = PAR.2[,1], alternative = c("two.sided"))$p.value, 23 | KS.P.Tair_K = stats::ks.test(x = Tair_K.1[,1], y = Tair_K.2[,1], alternative = c("two.sided"))$p.value, 24 | KS.P.VPD = stats::ks.test(x = VPD.1[,1], y = VPD.2[,1],alternative = c("two.sided"))$p.value) 25 | 26 | summary.final <- summary %>% mutate( bhatt.PAR = -log(Bhatt.coe.PAR), 27 | Bhatt.Tair_K = -log(Bhatt.coe.Tair_K), 28 | Bhatt.VPD = -log(Bhatt.coe.VPD ) ) %>% na.omit 29 | 30 | return( summary.final) 31 | } -------------------------------------------------------------------------------- /exploratory/SBAD_Workflow.R: -------------------------------------------------------------------------------- 1 | 2 | # Authenticate with Google Drive 3 | email <- 'sam.jurado@yale.edu' 4 | googledrive::drive_auth(email = email) 5 | 6 | # Define Google Drive file IDs for required data files 7 | file_ids <- list( 8 | "SITES_AE_9min.Rdata" = "12nE75Zh-tQ8oXOXARj2_3J2HjA6Lf1wl", 9 | "SITES_WP_9min.Rdata"= "17Y-QYKSof3nMOAz6L8QsCxtLSoqObvn-", 10 | "FilteredData_ALLSites_BH.Rdata" = "1bZw9bXN6YmvvtRvG4FGXZ2Zwbsj30ObR" 11 | ) 12 | 13 | # Define local directory for downloads 14 | localdir <- "/Users/jurado/flux_group_git/lterwg-flux-gradient/data" 15 | 16 | # Create local directory if it doesn't exist 17 | if (!dir.exists(localdir)) { 18 | dir.create(localdir, recursive = TRUE) 19 | } 20 | 21 | # Function to download files from Google Drive 22 | download_googledrive_file <- function(file_name, file_id, localdir) { 23 | message(paste0("Downloading ", file_name, " from Google Drive...")) 24 | 25 | # Define local path 26 | local_path <- file.path(localdir, file_name) 27 | 28 | # Download the file 29 | googledrive::drive_download( 30 | googledrive::as_id(file_id), # Explicitly call as_id from googledrive 31 | path = local_path, 32 | overwrite = TRUE 33 | ) 34 | 35 | 36 | message(paste0(file_name, " downloaded successfully to ", local_path)) 37 | } 38 | 39 | # Loop through the files and download them 40 | for (file_name in names(file_ids)) { 41 | download_googledrive_file(file_name, file_ids[[file_name]], localdir) 42 | } 43 | 44 | # Load the downloaded RData files 45 | for (file_name in names(file_ids)) { 46 | local_path <- file.path(localdir, file_name) 47 | if (file.exists(local_path)) { 48 | message(paste0("Loading ", file_name, "...")) 49 | load(local_path) 50 | } else { 51 | warning(paste0("File ", file_name, " not found after download.")) 52 | } 53 | } 54 | 55 | message("All files processed successfully.") 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | -------------------------------------------------------------------------------- /functions/compile.neon.site.attr.R: -------------------------------------------------------------------------------- 1 | #' compile.neon.site.attr 2 | #' 3 | #' @param sitecode NEON site code 4 | #' @param hd.files file type h5 containg NEON site specific data 5 | #' 6 | #' @return df containing site attributes 7 | #' 8 | #' @author Alexis Helgeson, Sam Jurado, David Reed, and Sparkle Malone 9 | compile.neon.site.attr <- function(hd.files, sitecode){ 10 | #all attributes grabbed are: "DistZaxsCnpy""DistZaxsDisp""DistZaxsGrndOfst""DistZaxsLvlMeasTow""DistZaxsTow""ElevRefeTow""LatTow""LonTow""LvlMeasTow""Pf.AngEnuXaxs""Pf.AngEnuYaxs""Pf.Ofst""TimeDiffUtcLt""TimeTube""TypeEco""ZoneTime""ZoneUtm" 11 | #we are only using "DistZaxsLvlMeasTow" (i.e. the measurement heights) in the MBR calculation 12 | #this fcn only uses 1st file in the list which corresponds to specific month, we are assuming all of these attributes are consistent across all months 13 | attr.list <- rhdf5::h5readAttributes(hd.files[1], name = paste0("/", sitecode)) 14 | #removing TypeEco from the list because this returns an error from data.frame when run at GUAN this site 15 | attr.list <- attr.list[-which(names(attr.list) == "TypeEco")] 16 | #if site is UKFS, do this workaround to fix the typo in TimeTube 17 | if (sitecode == "UKFS"){ 18 | third_element <- attr.list$TimeTube[3] 19 | fourth_element <- attr.list$TimeTube[4] 20 | fifth_element <- attr.list$TimeTube[5] 21 | if (nchar(attr.list$TimeTube[3]) == 10){ 22 | attr.list$TimeTube[3] <- stringr::str_extract_all(third_element, "[:digit:]+\\.[:digit:]+")[[1]][1] 23 | attr.list$TimeTube[4] <- stringr::str_extract_all(third_element, "[:digit:]+\\.[:digit:]+")[[1]][2] 24 | attr.list$TimeTube[5] <- fourth_element 25 | attr.list$TimeTube[6] <- fifth_element 26 | } 27 | } 28 | attr.df <- data.frame(attr.list) 29 | attr.df$TowerPosition <- seq(1,dim(attr.df)[1], 1) 30 | #add NEON sitecide as column 31 | attr.df$Site <- sitecode 32 | 33 | return(attr.df) 34 | 35 | } 36 | -------------------------------------------------------------------------------- /deprecated/flow.neon.site.squarebuffers.R: -------------------------------------------------------------------------------- 1 | 2 | # Create Square Buffers for LTER-NEON co located sites using this file from google drive: 3 | 4 | # Load libraries: 5 | library( sf) 6 | library(ggplot2) 7 | 8 | # Import the csv of sites and their locations. 9 | Sites <- read.csv('/Volumes/MaloneLab/Research/FluxGradient/Ameriflux_NEON field-sites.csv') 10 | 11 | # Make dataframe a shapfile: 12 | Sites.shp <- st_as_sf(x = Sites, 13 | coords = c("Longitude..degrees.", "Latitude..degrees."), 14 | crs = "epsg:4326") 15 | 16 | # Create a USA AOI: 17 | aoi.usa <- AOI::aoi_get(country= c("USA", "PR") ) 18 | 19 | # Visualize the point locations within the USA: 20 | ggplot( ) + geom_sf(data=aoi.usa) + geom_sf(data=Sites.shp) 21 | 22 | # Add projection to the shape file crs: 23 | Sites.shp.proj <- sf::st_transform(Sites.shp ,crs = "epsg:4087" ) 24 | 25 | # Create square buffers: 26 | Sites.shp.30 <-sf::st_buffer(x=Sites.shp.proj, dist= 30, endCapStyle = "SQUARE") 27 | Sites.shp.30$dist_m <- 30 28 | Sites.shp.90 <-sf::st_buffer(x=Sites.shp.proj, dist= 90, endCapStyle = "SQUARE") 29 | Sites.shp.90$dist_m <- 90 30 | Sites.shp.450 <-sf::st_buffer(x=Sites.shp.proj, dist= 450, endCapStyle = "SQUARE") 31 | Sites.shp.450$dist_m <- 450 32 | Sites.shp.900 <-sf::st_buffer(x=Sites.shp.proj, dist= 900, endCapStyle = "SQUARE") 33 | Sites.shp.900$dist_m <- 900 34 | Sites.shp.1800 <-sf::st_buffer(x=Sites.shp.proj, dist= 1800, endCapStyle = "SQUARE") 35 | Sites.shp.1800$dist_m <- 1800 36 | 37 | # merge all buffer sizes into a single shapefile: 38 | Site.Buffers <- rbind( Sites.shp.30, Sites.shp.90, Sites.shp.450, Sites.shp.900, Sites.shp.1800) 39 | 40 | Site.Buffers$site <- Site.Buffers$Site_Id.NEON 41 | 42 | # Write shapefiles for use in Site.Spatial.Homo 43 | save(Site.Buffers, file='/Volumes/MaloneLab/Research/FluxGradient/NEONLTERsiteBuffers.Rdata') 44 | 45 | 46 | message("Next run flow.neon.site.simplefeatures.R") 47 | -------------------------------------------------------------------------------- /functions/interp.flux.R: -------------------------------------------------------------------------------- 1 | ############################################################################################## 2 | #' @title Interpolate flux data 3 | 4 | #' @author 5 | #' Cove Sturtevant \email{csturtevant@battelleecology.org} 6 | 7 | #' @description 8 | #' Linearly interpolate window-average flux data (or any other data expressed as a 9 | #' window-average measurement). Time points for the flux data are assumed to be the 10 | #' mid-point of the averaging window. 11 | 12 | #' @param timeBgn Required. POSIXct Vector. Start time for flux measurement 13 | #' @param timeEnd Required. POSIXct Vector. End time for flux measurement 14 | #' @param flux Required. Numeric vector. Flux measurement (or any other data expressed as a 15 | #' window-average measurement) 16 | #' @param timePred Required. POSIXct Vector. Time at which to interpolate flux measurement at 17 | #' 18 | #' @return Numeric vector. Interpolated fluxes 19 | #' 20 | #' @export 21 | #' 22 | #' @examples 23 | #' timeBgn <- as.POSIXct(c('2024-03-10 00:00','2024-03-10 00:30','2024-03-10 01:00'),tz='GMT') 24 | #' timeEnd <- as.POSIXct(c('2024-03-10 00:30','2024-03-10 01:00','2024-03-10 01:30'),tz='GMT') 25 | #' flux <- c(10,20,30) 26 | #' timePred <- as.POSIXct(c('2024-03-10 00:20','2024-03-10 00:40'),tz='GMT') 27 | #' fluxPred <- interp.flux(timeBgn,timeEnd,flux,timePred) 28 | 29 | # changelog and author contributions / copyrights 30 | # Cove Sturtevant (2023-10-20) 31 | # original creation 32 | ############################################################################################## 33 | interp.flux <- function(timeBgn, 34 | timeEnd, 35 | flux, 36 | timePred) 37 | { 38 | 39 | timeMid <- timeBgn + (timeEnd-timeBgn)/2 # midpoint of flux computation window 40 | 41 | fluxPred <- approx(x = timeMid, y = flux, xout = timePred, method="linear", 42 | rule = 1, f = 0.5, ties = mean, na.rm = FALSE) 43 | 44 | return(fluxPred$y) 45 | 46 | } 47 | 48 | -------------------------------------------------------------------------------- /exploratory/scripts/Validation_KONZ.R: -------------------------------------------------------------------------------- 1 | 2 | rm(list=ls()) 3 | library(dplyr) 4 | 5 | load( "/Users/sm3466/Dropbox (YSE)/Research/FluxGradient/Data/KONZ_AE_AH_2023-12-05.RDATA" ) 6 | 7 | KONZ.AE <- min9.FG.AE.list$CO2$gas 8 | 9 | load( "/Users/sm3466/Dropbox (YSE)/Research/FluxGradient/Data/KONZ_WP_AH_2023-12-05.RDATA" ) 10 | 11 | KONZ.WP <- min9.FG.WP.list$CO2$gas 12 | 13 | load( "/Users/sm3466/Dropbox (YSE)/Research/FluxGradient/Data/KONZ_MBRflux.RDATA" ) 14 | 15 | KONZ.MBR <- MBRflux_align 16 | 17 | rm( MBRflux_align, min9.FG.AE.list, min9.FG.WP.list) 18 | 19 | # Time series plots: 20 | ggplot(data=KONZ.AE) + geom_point(aes(x=timeEnd_A , y=FG),cex=0.3) + ylim(-100, 100) + geom_point(aes(x=timeEnd_A, y=FC_interp, ), col="red", cex=0.25) 21 | 22 | ggplot(data=KONZ.WP) + geom_point(aes(x=timeEnd_A , y=FG),cex=0.3) + ylim(-100, 100) + geom_point(aes(x=timeEnd_A, y=FC_interp, ), col="red", cex=0.25) 23 | 24 | ggplot(data=KONZ.MBR) + geom_point(aes(x=timeEnd_A_CO2 , y=FCO2_MBR_H2Otrace),cex=0.3) + ylim(-100, 100) + geom_point(aes(x=timeEnd_A_CO2, y=FC_interp_CO2, ), col="red", cex=0.25) 25 | 26 | 27 | # Filtering: 28 | KONZ.AE$FG[KONZ.AE$FG > 100 | KONZ.AE$FG < -100] <-NA 29 | KONZ.WP$FG[KONZ.WP$FG > 100 | KONZ.WP$FG < -100] <-NA 30 | # Linear comparisons and r2 values: 31 | 32 | ggplot(data=KONZ.AE) + geom_point(aes(x=FG, y=FC_interp), col="red", cex=0.25) + ylim(-100, 100) 33 | summary(lm( data=KONZ.AE, FG ~ FC_interp)) 34 | 35 | ggplot(data=KONZ.WP) + geom_point(aes(x=FG, y=FC_interp), col="red", cex=0.25) + ylim(-100, 100) 36 | 37 | summary(lm( data=KONZ.WP, FG ~ FC_interp)) 38 | 39 | # Diurnal pattern 40 | 41 | KONZ.WP$Hour <- format(KONZ.WP$timeEnd_A, format = "%H") 42 | KONZ.WP$Month <- format(KONZ.WP$timeEnd_A, format = "%m") 43 | 44 | 45 | ggplot( data= KONZ.WP, aes(x= Hour, y= FG)) + 46 | geom_point() + geom_smooth(method="auto", se=TRUE, fullrange=TRUE, level=0.95) 47 | 48 | ggplot( data= KONZ.WP, aes(x= Hour, y= FG)) + 49 | geom_boxplot() + facet_grid(. ~ Month) 50 | 51 | ggplot( data= KONZ.WP[which( KONZ.WP$Month == '05'),], aes(x= Hour, y= FG)) + geom_violin() 52 | 53 | -------------------------------------------------------------------------------- /deprecated/computeFG.AE.WP.R: -------------------------------------------------------------------------------- 1 | #' compute.gasflux.FG.aerowindprof 2 | #' 3 | #' @param min9.K list of data frames output of eddydiffAE or eddydiffWP 4 | #' @param eddy.diff.name name of which eddy diffusivity to use 5 | #' 6 | #' @return list of data frame containing fluxes calculate using AE and WP methods 7 | #' 8 | #' @author Alexis Helgeson 9 | #' 10 | calc.gas.aero.windprof.flux <- function(min9.K, eddy.diff.name = "EddyDiff", 11 | bootstrap){ 12 | 13 | # Calculate H2O fluxes 14 | # Select only H2O conc data 15 | H2O <- min9.K[[which(names(min9.K) == "H2O")]] 16 | 17 | #calculate difference in tower heights 18 | H2O$dHeight <- as.numeric(H2O$TowerHeight_A) - as.numeric(H2O$TowerHeight_B) 19 | 20 | #set tower height difference = 0 to NA so it will be removed 21 | H2O[which(H2O$dHeight==0.00),"dHeight"] <- NA 22 | H2O.FG <- calc.eqn.aero.windprof.flux(min9 = H2O, eddy.diff.name = eddy.diff.name, 23 | bootstrap=1, nsamp=1000) 24 | 25 | #calculate CO2 fluxes 26 | CO2 <- min9.K[[which(names(min9.K) == "CO2")]] 27 | #calculate difference in tower heights 28 | CO2$dHeight <- as.numeric(CO2$TowerHeight_A) - as.numeric(CO2$TowerHeight_B) 29 | #set tower height difference = 0 to NA so it will be removed 30 | CO2[which(CO2$dHeight==0.00),"dHeight"] <- NA 31 | CO2.FG <- calc.eqn.aero.windprof.flux(min9 = CO2, eddy.diff.name = eddy.diff.name, 32 | bootstrap=1, nsamp=1000) 33 | 34 | #calculate CO2 fluxes 35 | CH4 <- min9.K[[which(names(min9.K) == "CH4")]] 36 | #calculate difference in tower heights 37 | CH4$dHeight <- as.numeric(CH4$TowerHeight_A) - as.numeric(CH4$TowerHeight_B) 38 | #set tower height difference = 0 to NA so it will be removed 39 | CH4[which(CH4$dHeight==0.00),"dHeight"] <- NA 40 | CH4.FG <- calc.eqn.aero.windprof.flux(min9 = CH4, eddy.diff.name = eddy.diff.name, 41 | bootstrap=1, nsamp=1000) 42 | 43 | #add to list 44 | min9.FG.list <- list(H2O = H2O.FG, CO2 = CO2.FG, CH4 = CH4.FG) 45 | return(min9.FG.list) 46 | } -------------------------------------------------------------------------------- /deprecated/flow.evaluation.One2One.CCC.R: -------------------------------------------------------------------------------- 1 | # DirRepo <- "." # Relative or absolute path to lterwg-flux-gradient git repo on your local machine. Make sure you've pulled the latest from main! 2 | # localdir <- tempdir() 3 | 4 | source(fs::path(DirRepo, 'exploratory/FUNCTION_One2One.CCC_testing.R')) 5 | # Calculate CCC parameters for CO2 6 | SITES_CCC_CO2 <- ccc.parms.site(MBR.tibble = SITES_MBR_9min_FILTER, 7 | AE.tibble = SITES_AE_9min_FILTER, 8 | WP.tibble = SITES_WP_9min_FILTER, 9 | gas = "CO2") 10 | 11 | # Calculate CCC parameters for H2O 12 | SITES_CCC_H2O <- ccc.parms.site(MBR.tibble = SITES_MBR_9min_FILTER, 13 | AE.tibble = SITES_AE_9min_FILTER, 14 | WP.tibble = SITES_WP_9min_FILTER, 15 | gas = "H2O") 16 | 17 | # Combine all CCC data with gas indicator 18 | SITES_One2One <- SITES_CCC_CO2 %>% 19 | mutate(gas = "CO2") %>% 20 | rbind( 21 | SITES_CCC_H2O %>% 22 | mutate(gas = "H2O")) 23 | 24 | # plots: 25 | setwd(dir.one2one) 26 | library(rstatix) 27 | library(ggplot2) 28 | library(ggpubr) 29 | library(ggstatsplot) 30 | 31 | for(site in site.list){ 32 | 33 | print(site) 34 | 35 | mbr <- SITES_MBR_9min_FILTER[[site]] %>% filter(TowerPosition_A == max(TowerPosition_A)) 36 | 37 | ae <- SITES_AE_9min_FILTER[[site]] %>% filter(TowerPosition_A == max(TowerPosition_A)) 38 | 39 | wp <- SITES_WP_9min_FILTER[[site]] %>% filter(TowerPosition_A == max(TowerPosition_A)) 40 | 41 | png(paste(site,"_One2One_CO2.png", sep=""), 42 | height= 1000, width = 1000) 43 | print(ccc.plots(MBR.DF = mbr, 44 | AE.DF = ae , 45 | WP.DF = wp, 46 | gas= "CO2")) 47 | dev.off() 48 | 49 | png(paste(site,"_One2One_H2O.png", sep=""), 50 | height= 1000, width = 1000) 51 | print(ccc.plots(MBR.DF = mbr, 52 | AE.DF = ae , 53 | WP.DF = wp, 54 | gas= "H2O")) 55 | dev.off() 56 | 57 | rm( mbr, ae, wp) 58 | 59 | } 60 | -------------------------------------------------------------------------------- /functions/all.sites.light.response.curve.R: -------------------------------------------------------------------------------- 1 | #' all.sites.light.response.curve 2 | #' 3 | #' @param all.sites df of all sites for a given method 4 | #' @param flux.name name of flux column to use as CO2 flux 5 | #' @param alpha initial value of slope parameter 6 | #' @param beta initial value of plateau parameter 7 | #' @param gama initial value of respiration term 8 | #' @param method which method was used for flux calculation: AE, WP, or MBR 9 | #' 10 | #' @return list containing dataframe of parameters and list of model objects 11 | #' 12 | #' 13 | #' @author Alexis Helgeson 14 | all.sites.light.response.curve <- function(all.sites, flux.name, alpha, beta, gama, method){ 15 | #get list of sites 16 | site.names <- unique(all.sites.ae$site) 17 | #create dataframe to store light response curve parameters for all sites 18 | light.response.df <- data.frame(site = site.names, flux.name = flux.name, method = method, alpha = NA, beta = NA, gama = NA) 19 | #create list to store model object 20 | all.sites.model.LRC <- list() 21 | #loop over sites and add estimated parameters to df 22 | for(s in 1:length(site.names)){ 23 | #filter to daytime flux and PAR for single site 24 | site <- all.sites %>% filter(gas == "CO2" & day_night == "day" & site == site.names[s]) 25 | #fit curve 26 | model.LRC <- light.response.curve(site = site, alpha = alpha, beta = beta, gama = gama, flux.name = flux.name) 27 | #grab model coefficients 28 | model.coeff <- coefficients(model.LRC) 29 | #add to dataframe for given site 30 | light.response.df[which(light.response.df$site == site.names[s]),"alpha"] <- model.coeff[["alpha"]] 31 | light.response.df[which(light.response.df$site == site.names[s]),"beta"] <- model.coeff[["beta"]] 32 | light.response.df[which(light.response.df$site == site.names[s]),"gama"] <- model.coeff[["gama"]] 33 | #save model object to list 34 | all.sites.model.LRC[[s]] <- model.LRC 35 | } 36 | #set names for model object list as site names 37 | names(all.sites.model.LRC) <- site.names 38 | 39 | return(list(param.df = light.response.df, model.objects = all.sites.model.LRC)) 40 | 41 | } -------------------------------------------------------------------------------- /functions/unzip.neon.R: -------------------------------------------------------------------------------- 1 | #' @title Un-ZIP NEON Data Products 2 | #' 3 | #' 4 | #' @param in_path location of download zip file 5 | #' @param out_path location to store h5 files 6 | #' @param quiet update function messages on/off 7 | #' 8 | #' @description NEON data products are downloaded as ZIP files which unzip to .gz files. This function accepts the path to those 9 | #' 10 | #' @return print message identifying where unzipped files can be found 11 | #' 12 | #' @author Alexis Helgeson, Nick Lyon, Sparkle Malone 13 | #' 14 | #' 15 | unzip.neon <- function(in_path = NULL, out_path = NULL, quiet = FALSE){ 16 | 17 | # Identify names of downloaded ZIP files 18 | zip.files <- dir(path = in_path, pattern = ".zip") 19 | 20 | # Error out for no ZIP files found 21 | if(length(zip.files) == 0) 22 | stop("No ZIP files found at specified `in_path`") 23 | 24 | # Message ZIP success if `quiet` argument doesn't specify the opposite 25 | if(quiet != TRUE){ 26 | message("Found ", length(zip.files), " ZIP files") 27 | } 28 | 29 | # Unzip those files! 30 | for(j in 1:length(zip.files)){ 31 | unzip(file.path(in_path, zip.files[j]), exdir = in_path) 32 | } 33 | 34 | # Identify the .gz files created by unzipping 35 | gz.files <- dir(path = in_path, pattern = ".gz") 36 | 37 | # Error out if no .gz files are found 38 | if(length(gz.files) == 0) 39 | message("No .gz files found in specified ZIP files") 40 | 41 | # Message ZIP success if `quiet` argument doesn't specify the opposite 42 | if(quiet != TRUE & length(gz.files) > 0){ 43 | message("Found ", length(gz.files), " .gz files") 44 | 45 | # Process those as well! 46 | for(k in 1:length(gz.files)){ 47 | 48 | R.utils::gunzip(file.path(in_path, gz.files[k]), 49 | destname = file.path(out_path, 50 | gsub(pattern = ".gz", replacement = "", 51 | x = gz.files[k])), 52 | remove = F, overwrite = T) } 53 | } 54 | 55 | 56 | } 57 | 58 | 59 | 60 | # Process those as well! 61 | 62 | -------------------------------------------------------------------------------- /exploratory/flow.Download.GoogleDriveData.R: -------------------------------------------------------------------------------- 1 | # Download data from google drive: 2 | 3 | # Pull data from google drive 4 | email <- 'sparklelmalone@gmail.com' 5 | # ------ Prerequisites! Make sure these packages are installed ---- 6 | library(ggplot2) 7 | library(fs) 8 | library(googledrive) 9 | # ------------------------------------------------------- 10 | 11 | # Authenticate with Google Drive 12 | googledrive::drive_auth(email = TRUE) 13 | drive_url <- googledrive::as_id("https://drive.google.com/drive/folders/1Q99CT77DnqMl2mrUtuikcY47BFpckKw3") 14 | data_folder <- googledrive::drive_ls(path = drive_url) 15 | localdir <- '/Users/sm3466/YSE Dropbox/Sparkle Malone/Research/FluxGradient/data' 16 | site.list <- c('HARV', 'KONZ', 'JORN', 'GUAN') 17 | 18 | download.googledrive <- function( drive_url,data_folder, localdir, site ) { 19 | 20 | site_folder <- googledrive::drive_ls(path = data_folder$id[data_folder$name==site]) 21 | # Download data 22 | 23 | dirTmp <- fs::path(localdir,site) 24 | dir.create(dirTmp) 25 | 26 | # Uncomment the next line and comment the following line if you want all the files 27 | fileDnld <- site_folder$name 28 | #fileDnld <- paste0(site,'_aligned_conc_flux_9min.zip') 29 | 30 | message(paste0('Downloading aligned concentration & flux data for ',site)) 31 | 32 | for(focal_file in fileDnld){ 33 | 34 | # Find the file identifier for that file 35 | file_id <- subset(site_folder, name == focal_file) 36 | 37 | # Download that file 38 | pathDnld <- fs::path(dirTmp,focal_file) 39 | googledrive::drive_download(file = file_id$id, 40 | path = pathDnld, 41 | overwrite = T) 42 | # Unzip 43 | if(grepl(pattern='.zip',focal_file)){ 44 | utils::unzip(pathDnld,exdir=dirTmp) 45 | } 46 | 47 | } 48 | 49 | # Load the data 50 | fileIn <- fs::path(dirTmp,paste0(site,'_aligned_conc_flux_9min.RData')) 51 | load(fileIn) 52 | 53 | } 54 | 55 | for (i in site.list){ 56 | 57 | download.googledrive(drive_url = drive_url ,data_folder = data_folder , localdir = localdir , site = i ) 58 | } 59 | -------------------------------------------------------------------------------- /workflows/flow.calc.flag.windprof.batch.R: -------------------------------------------------------------------------------- 1 | 2 | # Load functions for the wind profile flux gradient calculation 3 | source(file.path("functions", "calc.MO.length.R")) 4 | source(file.path("functions", "calc.eddydiff.windprof.R")) 5 | source(file.path("functions", "calc.gas.aero.windprof.flux.R")) 6 | source(file.path("functions", "calc.eqn.aero.windprof.flux.R")) 7 | source(file.path("functions", "calc.stability.correction.R")) 8 | source(file.path("functions", "calc.aerodynamic.canopy.height.R")) 9 | 10 | # Calculate eddy diffusivity with the wind profile method 11 | min9.K.WP.list <- calc.eddydiff.windprof(site = site, min9 = min9Diff.list) 12 | #min30.K.WP.list <- calc.eddydiff.windprof(site = site, min9 = min30Diff.list) 13 | 14 | # Compute wind profile flux gradient fluxes for all gases. 15 | # Optional bootstrap (1) or skip bootstrap (0) for gas conc uncertainty 16 | # function contains option to manual set name of eddy diffusivity column default is "EddyDiff" 17 | 18 | min9.FG.WP.list <- calc.gas.aero.windprof.flux(min9.K = min9.K.WP.list, 19 | bootstrap = 1, 20 | nsamp = 1000) 21 | #min30.FG.WP.list <- calc.gas.aero.windprof.flux(min9.K = min30.K.WP.list, 22 | # bootstrap = 1, nsamp=1000) 23 | 24 | # #Upload to Google Drive 25 | # Save 9-minute 26 | fileSave <- fs::path(dirTmp, paste0(site, "_WP_9min.Rdata")) 27 | fileZip <- fs::path(dirTmp, paste0(site, "_WP_9min.zip")) 28 | save(min9.FG.WP.list, file = fileSave) 29 | wdPrev <- getwd() 30 | setwd(dirTmp) 31 | utils::zip(zipfile = fileZip, files = paste0(site, "_WP_9min.Rdata")) 32 | setwd(wdPrev) 33 | googledrive::drive_upload(media = fileZip, 34 | overwrite = T, 35 | path = data_folder$id[data_folder$name==site]) 36 | 37 | # Save 30-minute 38 | #fileSave <- fs::path(dirTmp,paste0(site,"_WP_30min.Rdata")) 39 | #fileZip <- fs::path(dirTmp,paste0(site,"_WP_30min.zip")) 40 | #save(min30.FG.WP.list,file=fileSave) 41 | #wdPrev <- getwd() 42 | #setwd(dirTmp) 43 | #utils::zip(zipfile=fileZip,files=paste0(site,"_WP_30min.Rdata")) 44 | #setwd(wdPrev) 45 | #googledrive::drive_upload(media = fileZip, overwrite = T, path = data_folder$id[data_folder$name==site]) # path might need work 46 | 47 | -------------------------------------------------------------------------------- /deprecated/testAEWP.R: -------------------------------------------------------------------------------- 1 | library(dplyr) 2 | source(file.path("R/MO_Length.R")) 3 | source(file.path("R/eddydiffAE.R")) 4 | source(file.path("R/eddydiffWP.R")) 5 | source(file.path("R/FG_AE.WP.R")) 6 | #add code to pull data off of google drive 7 | #add code later that pulls zip files off of g drive 8 | sitecode <- 'KONZ' 9 | #load in interpolated 9 min data 10 | load(file.path("data", sitecode, "KONZ_min9Diff.Rdata")) 11 | load(file.path("data", sitecode, "KONZ_attr.Rdata")) 12 | #desired concentration 13 | #add in loop to include all gas concentrations? 14 | cont.desired <- "H2O" 15 | #call function to calculate eddy diffusivity using AE method 16 | #add in calculation for all gas concentrations 17 | min9EddyDiffAE.list <- eddydiffAE(cont.desired = cont.desired, sitecode = sitecode, min9 = min9Diff.list, attr = attr.df) 18 | #call function to calculate eddy diffusivity using WP method 19 | min9EddyDiffWP.list <- eddydiffWP(cont.desired = cont.desired, sitecode = sitecode, min9 = min9Diff.list, attr = attr.df) 20 | #calculate fluxes using AE method 21 | gas.conc.AE <- min9EddyDiffAE.list[[1]] 22 | gas.conc.AE$dHeight <- as.numeric(gas.conc.AE$TowerHeight_A) - as.numeric(gas.conc.AE$TowerHeight_B) 23 | min9FGAE.list <- FG_AE.WP(min9 = gas.conc.AE) 24 | #calculate fluxes using WP method 25 | gas.conc.WP <- min9EddyDiffWP.list[[1]] 26 | gas.conc.WP$dHeight <- as.numeric(gas.conc.WP$TowerHeight_A) - as.numeric(gas.conc.WP$TowerHeight_B) 27 | min9FGWP.list <- FG_AE.WP(min9 = gas.conc.WP) 28 | #filter for top two tower positions 29 | CO2.FG <- list() 30 | CO2.AE <- min9FGAE.list$gas 31 | CO2.WP <- min9FGWP.list$gas 32 | CO2.AE <- CO2.AE %>% filter(TowerPosition_A == 4 & TowerPosition_B == 3) 33 | CO2.WP <- CO2.WP %>% filter(TowerPosition_A == 4 & TowerPosition_B == 3) 34 | CO2.FG <- list(AE = CO2.AE, WP = CO2.WP) 35 | 36 | H2O.FG <- list() 37 | H2O.AE <- min9FGAE.list$gas 38 | H2O.WP <- min9FGWP.list$gas 39 | H2O.AE <- H2O.AE %>% filter(TowerPosition_A == 4 & TowerPosition_B == 3) 40 | H2O.WP <- H2O.WP %>% filter(TowerPosition_A == 4 & TowerPosition_B == 3) 41 | H2O.FG <- list(AE = H2O.AE, WP = H2O.WP) 42 | 43 | load(file.path("data", sitecode, "KONZ_AE_WP_Helgeson_1252023.Rdata")) 44 | Flux.gradient.AE.WP <- list(CO2.AE = CO2.FG$AE, CO2.WP = CO2.FG$WP, H2O.AE = H2O.AE, H2O.WP = H2O.WP) 45 | save(Flux.gradient.AE.WP, file = file.path("data", sitecode, "KONZ_AE_WP_Helgeson_1252023.Rdata")) 46 | -------------------------------------------------------------------------------- /functions/flag.iqr.R: -------------------------------------------------------------------------------- 1 | #' flag.iqr 2 | #' 3 | #' @param site df of calculated flux from specific site taken from Validation df 4 | #' 5 | #' @return df with outliers removed 6 | #' 7 | #' @author Alexis Helgeson 8 | #' 9 | flag.iqr <- function(site){ 10 | #IQR Filtering for CO2 11 | #filter df for desired gas 12 | site.CO2 <- site %>% filter(gas == "CO2") 13 | #add IQR.flag to data frame 14 | site.CO2 <- calc.iqr(gas.df = site.CO2) 15 | #calculate how much data would be remain after IQR 16 | percent.good.data <- round(length(site.CO2[which(site.CO2$IQR.flag=="0"),"FG"])/length(site.CO2[,"FG"]),3)*100 #good data/total data 17 | print(paste0("After filtering for extreme outliers there is ~", percent.good.data, "% good data remaining for CO2")) 18 | #duplicate FG column and set values IQR.flag == 1 to NA 19 | #site.CO2$FG_IQR <- site.CO2$FG 20 | #site.CO2[which(site.CO2$IQR.flag=="1"), "FG_IQR"] <- NA 21 | 22 | #IQR Filtering for H20 23 | #filter df for desired gas 24 | site.H20 <- site %>% filter(gas == "H2O") 25 | #add IQR.flag to data frame 26 | site.H20 <- calc.iqr(gas.df = site.H20) 27 | #calculate how much data would be remain after IQR 28 | percent.good.data <- round(length(site.H20[which(site.H20$IQR.flag=="0"),"FG"])/length(site.H20[,"FG"]),3)*100 #good data/total data 29 | print(paste0("After filtering for extreme outliers there is ~", percent.good.data, "% good data remaining for H20")) 30 | #duplicate FG column and set values IQR.flag == 1 to NA 31 | # site.H20$FG_IQR <- site.H20$FG 32 | # site.H20[which(site.H20$IQR.flag=="1"), "FG_IQR"] <- NA 33 | 34 | #IQR Filtering for CH4 35 | #filter df for desired gas 36 | site.CH4 <- site %>% filter(gas == "CH4") 37 | #add IQR.flag to data frame 38 | site.CH4 <- calc.iqr(gas.df = site.CH4) 39 | #calculate how much data would be remain after IQR 40 | percent.good.data <- round(length(site.CH4[which(site.CH4$IQR.flag=="0"),"FG"])/length(site.CH4[,"FG"]),3)*100 #good data/total data 41 | print(paste0("After filtering for extreme outliers there is ~", percent.good.data, "% good data remaining for CH4")) 42 | #duplicate FG column and set values IQR.flag == 1 to NA 43 | # site.CH4$FG_IQR <- site.CH4$FG 44 | # site.CH4[which(site.CH4$IQR.flag=="1"), "FG_IQR"] <- NA 45 | 46 | site.outlier <- bind_rows(site.CO2, site.H20, site.CH4) 47 | 48 | return(site.outlier) 49 | } -------------------------------------------------------------------------------- /deprecated/dirty_plot_code.R: -------------------------------------------------------------------------------- 1 | # Pull the 30-min fluxes 2 | FC <- m30.list$F_co2 3 | FC$timeBgn <- as.POSIXct(strptime(x=FC$timeBgn,format='%Y-%m-%dT%H:%M:%OSZ',tz='GMT')) 4 | FC$timeEnd <- as.POSIXct(strptime(x=FC$timeEnd,format='%Y-%m-%dT%H:%M:%OSZ',tz='GMT')) 5 | FC$turbFilt <- FC$turb 6 | FC$turbFilt[FC$turb.qfFinl==1] <- NA 7 | library(plotly) 8 | plot <- plotly::plot_ly(data=FC, x=~timeBgn, y=~turbFilt, type='scatter', mode='lines') %>% 9 | plotly::layout(margin = list(b = 50, t = 50, r=50), 10 | title = 'FC', 11 | xaxis = list(title = base::paste0(c(rep("\n ", 3), 12 | rep(" ", 20), 13 | paste0("Date-time"), 14 | rep(" ", 20)), 15 | collapse = ""), 16 | nticks=6, 17 | #range = c(1,48), 18 | zeroline=TRUE 19 | ), 20 | yaxis = list(title = 'FC'), 21 | showlegend=TRUE) 22 | 23 | print(plot) 24 | 25 | F <- m30.list$F_H 26 | F$turb <- F$turb/10 # Divide H by 10 to put in same ballpark as FC 27 | F$turbFilt <- F$turb 28 | F$turbFilt[F$turb.qfFinl==1] <- NA 29 | F$type <- 'H' 30 | F$timeBgn <- as.POSIXct(strptime(x=F$timeBgn,format='%Y-%m-%dT%H:%M:%OSZ',tz='GMT')) 31 | F$timeEnd <- as.POSIXct(strptime(x=F$timeEnd,format='%Y-%m-%dT%H:%M:%OSZ',tz='GMT')) 32 | FC$type <- 'FC' 33 | F <- rbind(F,FC) 34 | 35 | plot <- plotly::plot_ly(data=F, x=~timeBgn, y=~turbFilt, split = ~type, type='scatter', mode='lines') %>% 36 | plotly::layout(margin = list(b = 50, t = 50, r=50), 37 | title = 'Fluxes', 38 | xaxis = list(title = base::paste0(c(rep("\n ", 3), 39 | rep(" ", 20), 40 | paste0("Date-time"), 41 | rep(" ", 20)), 42 | collapse = ""), 43 | nticks=6, 44 | #range = c(1,48), 45 | zeroline=TRUE 46 | ), 47 | yaxis = list(title = ''), 48 | showlegend=TRUE) 49 | 50 | print(plot) -------------------------------------------------------------------------------- /deprecated/flow.evaluation.One2One.R: -------------------------------------------------------------------------------- 1 | 2 | source(fs::path(DirRepo,'exploratory/FUNCTION_One2One.R' )) 3 | 4 | 5 | sites <- names(SITES_WP_9min_FILTER ) 6 | 7 | 8 | SITES_One2One_CO2 <- one2one.parms.site(MBR.tibble = SITES_MBR_9min_FILTER, 9 | AE.tibble = SITES_AE_9min_FILTER, 10 | WP.tibble = SITES_WP_9min_FILTER, 11 | gas="CO2") 12 | 13 | SITES_One2One_H2O <- one2one.parms.site(MBR.tibble = SITES_MBR_9min_FILTER, 14 | AE.tibble = SITES_AE_9min_FILTER, 15 | WP.tibble = SITES_WP_9min_FILTER, 16 | gas="H2O") 17 | 18 | # Need to add the gas to this table. The point is to get the r2 associated with the max level 19 | Best_Level_CO2 <- SITES_One2One_CO2 %>% 20 | reframe(.by =c(Site, Approach ), maxR2 = max(R2)) %>% mutate(gas = "CO2") %>% rbind( 21 | SITES_One2One_H2O %>% 22 | reframe(.by =c(Site, Approach ), maxR2 = max(R2)) %>% mutate(gas = "H2O")) 23 | 24 | SITES_One2One <- SITES_One2One_CO2 %>% mutate(gas = "CO2") %>% rbind( 25 | SITES_One2One_H2O %>% mutate(gas = "H2O")) 26 | 27 | 28 | Best_Level <- SITES_One2One %>% left_join( Best_Level_CO2, by =c( 'Site', 'Approach', 'gas')) %>% filter( R2 == maxR2 ) %>% mutate( BestHeight = dLevelsAminusB) %>% select(Site, Approach, gas, BestHeight) 29 | 30 | 31 | SITES_MBR_9min_FILTER_BH <- list() 32 | SITES_AE_9min_FILTER_BH <- list() 33 | SITES_WP_9min_FILTER_BH <- list() 34 | 35 | for( site in unique(SITES_One2One$Site) ){ 36 | print(site) 37 | 38 | BH.MBR <- Best_Level %>% filter(Site == site, Approach=='MBR') %>% mutate(site = Site) 39 | SITES_MBR_9min_FILTER_BH[[site]] <- SITES_MBR_9min_FILTER[[site]] %>% full_join( BH.MBR, by= c( 'site','gas') ) %>% filter(dLevelsAminusB == BestHeight) 40 | 41 | 42 | BH.AE <- Best_Level %>% filter(Site == site, Approach=='AE') %>% mutate(site = Site) 43 | SITES_AE_9min_FILTER_BH[[site]] <- SITES_AE_9min_FILTER[[site]] %>% full_join( BH.AE, by= c( 'site','gas') ) %>% filter(dLevelsAminusB == BestHeight) 44 | 45 | BH.WP <- Best_Level %>% filter(Site == site, Approach=='WP') %>% mutate(site = Site) 46 | 47 | SITES_WP_9min_FILTER_BH[[site]] <- SITES_WP_9min_FILTER[[site]] %>% full_join( BH.WP, by= c( 'site','gas') ) %>% filter(dLevelsAminusB == BestHeight) 48 | } 49 | -------------------------------------------------------------------------------- /deprecated/checkTimeDiff.R: -------------------------------------------------------------------------------- 1 | 2 | SITES_AE$KONZ$site <- "KONZ" 3 | SITES_AE$BONA$site <- "BONA" 4 | SITES_AE$CPER$site <- "CPER" 5 | SITES_AE$GUAN$site <- "GUAN" 6 | SITES_AE$HARV$site <- "HARV" 7 | SITES_AE$JORN$site <- "JORN" 8 | SITES_AE$NIWO$site <- "NIWO" 9 | SITES_AE$TOOL$site <- "TOOL" 10 | 11 | all.sites <- bind_rows(SITES_AE) 12 | 13 | 14 | co2 <- all.sites %>% filter(gas == "CO2") 15 | #head(difftime(co2$timeEnd_A, co2$timeBgn_A, units = "min")) 16 | co2$diffTime <- round(difftime(co2$timeEnd_A, co2$timeBgn_A, units = "min")) 17 | unique(co2$diffTime) 18 | unique(co2[which(co2$diffTime==6),"site"]) 19 | unique(co2[which(co2$diffTime==2),"timeBgn_A"]) 20 | unique(co2[which(co2$diffTime==1),"timeBgn_A"]) 21 | unique(co2[which(co2$diffTime==5),"timeBgn_A"]) 22 | unique(co2[which(co2$diffTime==4),"timeBgn_A"]) 23 | unique(co2[which(co2$diffTime==3),"timeBgn_A"]) 24 | unique(co2[which(co2$diffTime==0),"timeBgn_A"]) 25 | unique(co2[which(co2$diffTime==9),"timeBgn_A"]) 26 | hist(as.numeric(co2$diffTime), main = "Histogram CO2 Time Difference", xlab = "timeEnd-timeBgn") 27 | 28 | h2o <- all.sites %>% filter(gas == "H2O") 29 | h2o$diffTime <- round(difftime(h2o$timeEnd_A, h2o$timeBgn_A, units = "min")) 30 | unique(h2o$diffTime) 31 | unique(h2o[which(h2o$diffTime==6),"site"]) 32 | unique(h2o[which(h2o$diffTime==2),"timeBgn_A"]) 33 | unique(h2o[which(h2o$diffTime==1),"timeBgn_A"]) 34 | unique(h2o[which(h2o$diffTime==5),"timeBgn_A"]) 35 | unique(h2o[which(h2o$diffTime==4),"timeBgn_A"]) 36 | unique(h2o[which(h2o$diffTime==3),"timeBgn_A"]) 37 | unique(h2o[which(h2o$diffTime==0),"timeBgn_A"]) 38 | unique(h2o[which(h2o$diffTime==9),"timeBgn_A"]) 39 | hist(as.numeric(h2o$diffTime), main = "Histogram H2O Time Difference", xlab = "timeEnd-timeBgn") 40 | 41 | 42 | ch4 <- all.sites %>% filter(gas == "CH4") 43 | ch4$diffTime <- round(difftime(ch4$timeEnd_A, ch4$timeBgn_A, units = "min")) 44 | unique(ch4$diffTime) 45 | unique(ch4[which(ch4$diffTime==6),"timeBgn_A"]) 46 | unique(ch4[which(ch4$diffTime==2),"timeBgn_A"]) 47 | unique(ch4[which(ch4$diffTime==1),"timeBgn_A"]) 48 | unique(ch4[which(ch4$diffTime==5),"timeBgn_A"]) 49 | unique(ch4[which(ch4$diffTime==4),"timeBgn_A"]) 50 | unique(ch4[which(ch4$diffTime==3),"timeBgn_A"]) 51 | unique(ch4[which(ch4$diffTime==0),"timeBgn_A"]) 52 | unique(ch4[which(ch4$diffTime==9),"site"]) 53 | unique(ch4[which(ch4$diffTime==7),"timeBgn_A"]) 54 | unique(ch4[which(ch4$diffTime==8),"timeBgn_A"]) 55 | hist(as.numeric(ch4$diffTime), main = "Histogram CH4 Time Difference", xlab = "timeEnd-timeBgn") 56 | 57 | 58 | -------------------------------------------------------------------------------- /deprecated/FG_diffusivityWP.R: -------------------------------------------------------------------------------- 1 | library(dplyr) 2 | source(file.path("R/MO_Length.R")) 3 | source(file.path("R/eddydiffWP.R")) 4 | #function arguments 5 | #desired concentration 6 | cont.desired <- "CH4" 7 | #add code later that pulls zip files off of g drive 8 | sitecode <- 'KONZ' 9 | #load in interpolated 9 min data 10 | load(file.path("data", sitecode, "KONZ_min9Diff.Rdata")) 11 | load(file.path("data", sitecode, "KONZ_attr.Rdata")) 12 | #call function to calculate eddy diffusivity using AE method 13 | min9EddyDiffWP.list <- eddydiffWP(cont.desired = cont.desired, sitecode = sitecode, min9 = min9Diff.list, attr = attr.df) 14 | wp.check <- min9EddyDiff.list$CH4 15 | 16 | 17 | 18 | # #grab desired concentration 19 | # cont.9minInter <- min9Diff.list[[which(names(min9Diff.list) == cont.desired)]] 20 | # #grab required data columns 21 | # data.eddydiff <- cont.9minInter %>% select(timeEnd_A, timeBgn_A, TowerPosition_A, timeEnd_B, timeBgn_B, TowerPosition_B, timeMid, match_time, ubar4, ubar1, ubar2, ubar3, roughLength_interp) 22 | # #grab only tower heights and positions for matching 23 | # tower.heights <- attr.df %>% select(DistZaxsLvlMeasTow, TowerPosition) 24 | # #adding place holder identifier to create tower height columns 25 | # data.eddydiff$TowerHeight_A <- "hold" 26 | # data.eddydiff$TowerHeight_B <- "hold" 27 | # for(i in 1:dim(attr.df)[1]){ 28 | # #loop over position A 29 | # data.eddydiff[which(data.eddydiff$TowerPosition_A == i),"TowerHeight_A"] <- tower.heights[which(tower.heights$TowerPosition == i),1] 30 | # #loop over position B 31 | # data.eddydiff[which(data.eddydiff$TowerPosition_B == i),"TowerHeight_B"] <- tower.heights[which(tower.heights$TowerPosition == i),1] 32 | # } 33 | # #calculate eddy diffusivty using WP 34 | # #assuming von karman constant is 0.4 35 | # k = 0.4 36 | # #why are we using geometric mean instead of regular mean? 37 | # data.eddydiff$GeometricMean_AB <- sqrt(as.numeric(data.eddydiff$TowerHeight_A)*as.numeric(data.eddydiff$TowerHeight_B)) 38 | # 39 | # #create column for store wind profile eddy diffusivity 40 | # data.eddydiff$eddyDiff_wp <- "hold" 41 | # for(j in 1:dim(data.eddydiff)[1]){ 42 | # ubar = as.numeric(data.eddydiff[j,grep(as.character(data.eddydiff[j,"TowerPosition_A"]), names(data.eddydiff))]) 43 | # z = as.numeric(data.eddydiff[j,"TowerHeight_A"]) 44 | # 45 | # data.eddydiff[j,"eddyDiff_wp"] <- ((k^2)*ubar*as.numeric(data.eddydiff[j,"GeometricMean_AB"])/log(z/as.numeric(data.eddydiff[j,"roughLength_interp"]))) 46 | # } 47 | # data.eddydiff.na <- na.omit(data.eddydiff) 48 | -------------------------------------------------------------------------------- /functions/plot.all.sites.1to1.R: -------------------------------------------------------------------------------- 1 | #' plot.all.sites.1to1 2 | #' 3 | #' @param all.sites dataframe of all sites filtered to desired gas: CO2, H2O 4 | #' @param desired.var which NEON EC to use as comparison against FG 5 | #' @param x.lab x axis label 6 | #' @param y.lab y axis label 7 | #' @param plot.title should reflect which method is used to calculate FG i.e. AE or WP or MBR 8 | #' 9 | #' @return linear 1 to 1 plot across all sites 10 | #' 11 | #' 12 | #' @author Alexis Helgeson 13 | plot.all.sites.1to1 <- function(all.sites, x.flux, y.flux, x.lab, y.lab, plot.title){ 14 | #add na filter for desired.var 15 | all.sites <- all.sites[complete.cases(all.sites[,c(x.flux, y.flux)]),] 16 | #set scale for each facet so x and y are even: NOTE THESE LIST ENTRIES NEED TO BE IN THE SAME ORDER AS THE FACETTED PLOTS 17 | x.limits <- list(scale_x_continuous(limits = range(all.sites[which(all.sites$site=="BONA"), y.flux])), scale_x_continuous(limits = range(all.sites[which(all.sites$site=="CPER"), y.flux])), scale_x_continuous(limits = range(all.sites[which(all.sites$site=="GUAN"), y.flux])), scale_x_continuous(limits = range(all.sites[which(all.sites$site=="HARV"), y.flux])), scale_x_continuous(limits = range(all.sites[which(all.sites$site=="JORN"), y.flux])), scale_x_continuous(limits = range(all.sites[which(all.sites$site=="KONZ"), y.flux])), scale_x_continuous(limits = range(all.sites[which(all.sites$site=="NIWO"), y.flux])), scale_x_continuous(limits = range(all.sites[which(all.sites$site=="TOOL"), y.flux]))) 18 | y.limits <- list(scale_y_continuous(limits = range(all.sites[which(all.sites$site=="BONA"), y.flux])), scale_y_continuous(limits = range(all.sites[which(all.sites$site=="CPER"), y.flux])), scale_y_continuous(limits = range(all.sites[which(all.sites$site=="GUAN"), y.flux])), scale_y_continuous(limits = range(all.sites[which(all.sites$site=="HARV"), y.flux])), scale_y_continuous(limits = range(all.sites[which(all.sites$site=="JORN"), y.flux])), scale_y_continuous(limits = range(all.sites[which(all.sites$site=="KONZ"), y.flux])), scale_y_continuous(limits = range(all.sites[which(all.sites$site=="NIWO"), y.flux])), scale_y_continuous(limits = range(all.sites[which(all.sites$site=="TOOL"), y.flux]))) 19 | #plot linear 1:1 facet by site 20 | ggplot(all.sites, aes(x = !! sym(x.flux), y = !! sym(y.flux))) + 21 | geom_point() + 22 | geom_abline(intercept = 0, slope = 1, color = "red") + 23 | facet_wrap(~ site, scales = "free")+ 24 | facetted_pos_scales(x = x.limits, y = y.limits)+ 25 | xlab(x.lab)+ 26 | ylab(y.lab)+ 27 | ggtitle(paste0(plot.title))+ 28 | theme_minimal()+ 29 | theme(text = element_text(size = 20), axis.title=element_text(size=24), plot.title = element_text(hjust = 0.5)) 30 | } -------------------------------------------------------------------------------- /exploratory/scripts/FG_singleSite_SLM.R: -------------------------------------------------------------------------------- 1 | # Load Libraries and Set Environment Vars --------------------------------- 2 | #load libaries 3 | library(neonUtilities) 4 | library(readr) 5 | library(BiocManager) 6 | library(rhdf5) 7 | library(dplyr) 8 | library(oce) 9 | library(tidyr) 10 | library(lubridate) 11 | library(naniar) 12 | library(ggplot2) 13 | library(R.utils) 14 | library(gtools) 15 | 16 | 17 | #load in FG specific functions 18 | source("R/SiteAttributes.R") 19 | source("R/SiteDF.R") 20 | source("R/SiteDF_RCv2.R") 21 | source("R/met1m.R") 22 | source("R/Flux_Gradient_MBR.R") 23 | source("R/Flux_Gradient_AE.R") 24 | source("R/time_format.R") 25 | source("R/cont9m.R") 26 | source("R/Comp_Function.R") 27 | source("R/metCont30m.R") 28 | source("R/Comp_Function.R") 29 | source("R/MO_Length.R") 30 | source("R/surfProp_LogWindProfile.R") 31 | source("R/unzip.neon.R") 32 | 33 | 34 | 35 | #set up dir to store data 36 | Main.Directory <- c(file.path( paste("Data", sitecode,"filesToStack00200", sep="/"))) 37 | #set desired site name and NEON code 38 | sitename <- 'Konza Praire' 39 | sitecode <- 'KONZ' 40 | #set start and end date for obs 41 | startdate <- "2021-01" 42 | enddate <- "2023-09" 43 | 44 | 45 | 46 | # Call Fcns to Calculate CH4 fluxes --------------------------------------- 47 | #grab h5 files to be passed to SiteAttributes and SiteDF 48 | hd.files <-list.files(path = Main.Directory, pattern="\\.h5$", full.names = TRUE) 49 | #grab attribute data 50 | attr.df <- SiteAttributes(hd.files, sitecode) 51 | cont.df <- Site.DF(hd.files, sitecode, frequency = "high") 52 | 53 | #filter for good data 54 | h2o.qfqm.df <- cont.df %>% filter(h2o_qfqm.000_040_30m == "0") %>% filter(h2o_qfqm.000_060_30m == "0") %>% filter(F_co2_qfqm == "0") 55 | 56 | co2.qfqm.df <- cont.df %>% filter(co2_qfqm.000_040_30m == "0") %>% filter(co2_qfqm.000_060_30m == "0") %>% filter(F_LE_qfqm == "0") 57 | #save df as csv 58 | # write.csv(cont.df, paste0(sitecode, "_", startdate, "_", enddate, "_cont.csv")) 59 | #calculate flux gradient 60 | #select lower twoer height 61 | z1_height <- attr.df$DistZaxsLvlMeasTow[4] 62 | #select upper tower height 63 | z2_height <- attr.df$DistZaxsLvlMeasTow[6] 64 | #select tallest height for sonic anemometer 65 | z_height <- attr.df$DistZaxsLvlMeasTow[6] 66 | #calculate fluxes using Modified Bowan Ratio 67 | mbr.df <- Flux_Gradient_MBR(cont.df = co2.qfqm.df, attr.df, z1_height, z2_height) 68 | 69 | #save df as csv 70 | # write.csv(mbr.df, paste0(sitecode, "_", startdate, "_", enddate, "_mbr.csv")) 71 | #calculate fluxes using aerodynamic profile and wind profile 72 | ae.df <- Flux_Gradient_AE(cont.df = co2.qfqm.df, attr.df, z1_height, z2_height, z_height) 73 | #save df as csv 74 | write.csv(ae.df, paste0(sitecode, "_", startdate, "_", enddate, "_ae.csv")) 75 | -------------------------------------------------------------------------------- /functions/calc.gas.aero.windprof.flux.R: -------------------------------------------------------------------------------- 1 | #' calc.gas.aero.windprof.flux.R 2 | #' 3 | #' Use the dataframe that includes k (diffisivity from the aerodynamic or wind profile) 4 | #' with the gas concentration difference between two tower heights (dConc) 5 | #' to calculate the gas flux by the flux gradient method. 6 | #' 7 | #' Option to create bootstrapped uncertainty for the calculated fluxes 8 | #' by sampling from the mean & variance of gas concentrations 9 | #' and concentration differences. 10 | #' 11 | #' @param min9.K list of data frames output of eddydiffAE or eddydiffWP 12 | #' @param eddy.diff.name name of which eddy diffusivity to use 13 | #' @param bootstrap: 1 to run bootstrap iterations for conc mean & sd or 0 to use provided mean dConc 14 | #' @param nsamp: number of bootstrap iterations to run - default 1000 15 | #' 16 | #' @return list of data frames (one df per gas) containing fluxes calculate using AE and WP methods 17 | #' @return 18 | #' 19 | #' @author Alexis Helgeson, Jackie Matthes 20 | #' 21 | calc.gas.aero.windprof.flux <- function(min9.K, eddy.diff.name = "EddyDiff", 22 | bootstrap, nsamp){ 23 | 24 | # Calculate H2O fluxes 25 | # Select only H2O conc data 26 | H2O <- min9.K[[which(names(min9.K) == "H2O")]] 27 | 28 | #calculate difference in tower heights 29 | H2O$dHeight <- as.numeric(H2O$TowerHeight_A) - as.numeric(H2O$TowerHeight_B) 30 | 31 | #set tower height difference = 0 to NA so it will be removed 32 | H2O[which(H2O$dHeight==0.00),"dHeight"] <- NA 33 | H2O.FG <- calc.eqn.aero.windprof.flux(min9 = H2O, eddy.diff.name = eddy.diff.name, 34 | bootstrap, nsamp) 35 | 36 | #calculate CO2 fluxes 37 | CO2 <- min9.K[[which(names(min9.K) == "CO2")]] 38 | #calculate difference in tower heights 39 | CO2$dHeight <- as.numeric(CO2$TowerHeight_A) - as.numeric(CO2$TowerHeight_B) 40 | #set tower height difference = 0 to NA so it will be removed 41 | CO2[which(CO2$dHeight==0.00),"dHeight"] <- NA 42 | CO2.FG <- calc.eqn.aero.windprof.flux(min9 = CO2, eddy.diff.name = eddy.diff.name, 43 | bootstrap, nsamp) 44 | 45 | #calculate CO2 fluxes 46 | CH4 <- min9.K[[which(names(min9.K) == "CH4")]] 47 | #calculate difference in tower heights 48 | CH4$dHeight <- as.numeric(CH4$TowerHeight_A) - as.numeric(CH4$TowerHeight_B) 49 | #set tower height difference = 0 to NA so it will be removed 50 | CH4[which(CH4$dHeight==0.00),"dHeight"] <- NA 51 | CH4.FG <- calc.eqn.aero.windprof.flux(min9 = CH4, eddy.diff.name = eddy.diff.name, 52 | bootstrap, nsamp) 53 | 54 | #add to list 55 | min9.FG.list <- list(H2O = H2O.FG, CO2 = CO2.FG, CH4 = CH4.FG) 56 | return(min9.FG.list) 57 | } 58 | -------------------------------------------------------------------------------- /functions/calc.gas.aero.windprof.flux.WP.R: -------------------------------------------------------------------------------- 1 | #' calc.gas.aero.windprof.flux.R 2 | #' 3 | #' Use the dataframe that includes k (diffisivity from the aerodynamic or wind profile) 4 | #' with the gas concentration difference between two tower heights (dConc) 5 | #' to calculate the gas flux by the flux gradient method. 6 | #' 7 | #' Option to create bootstrapped uncertainty for the calculated fluxes 8 | #' by sampling from the mean & variance of gas concentrations 9 | #' and concentration differences. 10 | #' 11 | #' @param min9.K list of data frames output of eddydiffAE or eddydiffWP 12 | #' @param eddy.diff.name name of which eddy diffusivity to use 13 | #' @param bootstrap: 1 to run bootstrap iterations for conc mean & sd or 0 to use provided mean dConc 14 | #' @param nsamp: number of bootstrap iterations to run - default 1000 15 | #' 16 | #' @return list of data frames (one df per gas) containing fluxes calculate using AE and WP methods 17 | #' @return 18 | #' 19 | #' @author Alexis Helgeson, Jackie Matthes 20 | #' 21 | calc.gas.aero.windprof.flux.WP <- function(min9.K, eddy.diff.name = "EddyDiff_WP", 22 | bootstrap, nsamp){ 23 | 24 | # Calculate H2O fluxes. 25 | # Select only H2O conc data 26 | H2O <- min9.K[[which(names(min9.K) == "H2O")]] 27 | 28 | #calculate difference in tower heights 29 | H2O$dHeight <- as.numeric(H2O$TowerHeight_A) - as.numeric(H2O$TowerHeight_B) 30 | 31 | #set tower height difference = 0 to NA so it will be removed 32 | H2O[which(H2O$dHeight==0.00),"dHeight"] <- NA 33 | H2O.FG <- calc.eqn.aero.windprof.flux(min9 = H2O, eddy.diff.name = eddy.diff.name, 34 | bootstrap, nsamp) 35 | 36 | #calculate CO2 fluxes 37 | CO2 <- min9.K[[which(names(min9.K) == "CO2")]] 38 | #calculate difference in tower heights 39 | CO2$dHeight <- as.numeric(CO2$TowerHeight_A) - as.numeric(CO2$TowerHeight_B) 40 | #set tower height difference = 0 to NA so it will be removed 41 | CO2[which(CO2$dHeight==0.00),"dHeight"] <- NA 42 | CO2.FG <- calc.eqn.aero.windprof.flux(min9 = CO2, eddy.diff.name = eddy.diff.name, 43 | bootstrap, nsamp) 44 | 45 | #calculate CO2 fluxes 46 | CH4 <- min9.K[[which(names(min9.K) == "CH4")]] 47 | #calculate difference in tower heights 48 | CH4$dHeight <- as.numeric(CH4$TowerHeight_A) - as.numeric(CH4$TowerHeight_B) 49 | #set tower height difference = 0 to NA so it will be removed 50 | CH4[which(CH4$dHeight==0.00),"dHeight"] <- NA 51 | CH4.FG <- calc.eqn.aero.windprof.flux(min9 = CH4, eddy.diff.name = eddy.diff.name, 52 | bootstrap, nsamp) 53 | 54 | #add to list 55 | min9.FG.list <- list(H2O = H2O.FG, CO2 = CO2.FG, CH4 = CH4.FG) 56 | return(min9.FG.list) 57 | } -------------------------------------------------------------------------------- /exploratory/surfProp_LogWindProfile.R: -------------------------------------------------------------------------------- 1 | #' Usage: SurfProp_LogWindProfile(z,U) 2 | #' 3 | #' Description: Determine zero-plane displacement and roughness length from the log-wind profile. 4 | #' The zero-plane displacement is the vertical displacement of the wind profile as a result of 5 | #' closely-spaced surface elements, approx. 2/3 the height of surface elements 6 | #' The roughness length is a length-scale of surface roughness, and is the height above the zero-plane 7 | #' displacement at which the wind speed theoretically becomes zero, approx. 1/10 height of 8 | #' surface roughness elements 9 | #' Notes: Three measurement levels at or above the zero-plane displacement are required. 10 | #' Estimates are valid only for neutral atmospheric stability conditions. 11 | #' NA will be output for values not converging to a solution 12 | #' 13 | #' ----- Inputs ------ 14 | #' z: vector of three measurement heights, ex. z <- c(0.5,2,4) 15 | #' U: A n x 3 matrix of average (ex. 30-minute) wind speeds corresponding to the measurement heights in z, 16 | #' where n is the sample size 17 | #' 18 | #' ----- Outputs ------ 19 | #' result is a data frame of n observations and 3 variables: 20 | #' d: the zero-plane displacement 21 | #' z0: the roughness length 22 | #' ustar: the friction velocity, a velocity scale of turbulence 23 | #' -------------------- 24 | #' 25 | #' Cove Sturtevant 26 | #' 19 November 2015 27 | #' 28 | surfProp_LogWindProfile <- function(z,U) { 29 | 30 | # Do some error checking 31 | if(length(z) != 3 | !is.vector(z)) {stop("z must be a vector of length 3")} 32 | sz <- dim(U) 33 | if(sz[2] != 3) {stop("U must be a matrix with 3 columns")} 34 | 35 | # Reassign data for easy processing 36 | z1 <- z[1] 37 | z2 <- z[2] 38 | z3 <- z[3] 39 | U1 <- U[,1] 40 | U2 <- U[,2] 41 | U3 <- U[,3] 42 | 43 | # Iteratively solve for d 44 | dout <- matrix(data=NA,nrow=sz[1]) 45 | for(i in 1:sz[1]) { 46 | 47 | fun <- function(d) { abs((U2[i]-U1[i])/(U3[i]-U1[i])*log((z3-d)/(z1-d))-log((z2-d)/(z1-d)))} 48 | 49 | b <- optimize(f=fun,interval=c(-1,1),maximum = FALSE) # Minimize residual 50 | 51 | # If we found a good solution, record it 52 | if(1-abs(b$minimum) < 0.02) {dout[i]=NA} else {dout[i] <- b$minimum} 53 | 54 | } 55 | 56 | # Compute roughness length 57 | z0=exp((U2*log(z3-dout)-U3*log(z2-dout))/(U2-U3)) 58 | 59 | # Compute ustar 60 | k <- 0.4 # von Karman constant 61 | ustar <- U*k/log((t(matrix(data=z,nrow=3,ncol=sz[1]))-matrix(dout,nrow=sz[1],ncol=3))/matrix(z0,nrow=sz[1],ncol=3)) 62 | ustar <- ustar[,1] 63 | 64 | # Make a list of the result 65 | result <- data.frame(d=dout,z0=z0,ustar=ustar) 66 | 67 | return(result) 68 | } -------------------------------------------------------------------------------- /functions/all.sites.temp.response.curve.R: -------------------------------------------------------------------------------- 1 | #' all.sites.temp.response.curve 2 | #' 3 | #' @param all.sites df of all sites for a given method 4 | #' @param flux.name name of flux column to use as CO2 flux 5 | #' @param method which method was used for flux calculation: AE, WP, or MBR 6 | #' @param rho initial value of amplitude parameter 7 | #' @param psi initial value of growth/decay parameter 8 | #' 9 | #' @return list containing dataframe of parameters and list of model objects 10 | #' 11 | #' 12 | #' @author Alexis Helgeson 13 | all.sites.temp.response.curve <- function(all.sites, flux.name, rho, psi, method){ 14 | #get list of sites 15 | site.names <- unique(all.sites.ae$site) 16 | #create dataframe to store light response curve parameters for all sites 17 | temp.response.df <- data.frame(site = site.names, flux.name = flux.name, method = method, rho = NA, psi = NA) 18 | #create list to store model object 19 | all.sites.model.TRC <- list() 20 | #loop over sites and add estimated parameters to df 21 | for(s in 1:length(site.names)){ 22 | #filter to daytime flux and PAR for single site 23 | site <- all.sites %>% filter(gas == "CO2" & day_night == "night" & site == site.names[s]) 24 | #select for only temperature columns 25 | TA.cols <- c(names(site)[grep("Tair", names(site))]) 26 | ta.check <- c() 27 | for(t in 1:length(TA.cols)){ 28 | ta.nas <- length(is.na(site[,TA.cols[t]])[is.na(site[,TA.cols[t]]) == TRUE]) 29 | if(ta.nas == length(site[,TA.cols[t]])){ 30 | ta.check[t] <- NA 31 | }else{ 32 | ta.check[t] <- 1 33 | } 34 | } 35 | #check which columns are NA and remove from options to pass to temp.response.curve 36 | if(TRUE %in% is.na(ta.check)){ 37 | TA.cols <- TA.cols[-which(is.na(ta.check))] 38 | }else{ 39 | TA.cols <- TA.cols 40 | } 41 | #select for top of tower air temperature 42 | TA.levels <- as.numeric(substr(TA.cols, 5,5)) 43 | TA.top <- max(TA.levels, na.rm = T) 44 | TA.name <- paste0("Tair",TA.top) 45 | #fit curve 46 | model.TRC <- temp.response.curve(site = site, rho = rho, psi = psi, flux.name = flux.name, TA.name = TA.name) 47 | #grab model coefficients 48 | model.coeff <- coefficients(model.TRC) 49 | #add to dataframe for given site 50 | temp.response.df[which(temp.response.df$site == site.names[s]),"rho"] <- model.coeff[["rho"]] 51 | temp.response.df[which(temp.response.df$site == site.names[s]),"psi"] <- model.coeff[["psi"]] 52 | #save model object to list 53 | all.sites.model.TRC[[s]] <- model.TRC 54 | } 55 | #set names for model object list as site names 56 | names(all.sites.model.TRC) <- site.names 57 | 58 | return(list(param.df = temp.response.df, model.objects = all.sites.model.TRC)) 59 | 60 | } -------------------------------------------------------------------------------- /deprecated/Sparkle_README.md: -------------------------------------------------------------------------------- 1 | The purpose of this file is to remind Sparkle what the hell is going on. Don't judge me, I am old. 2 | 3 | 1.**flow.NEON.data.download.R** Workflow script that download and unzip NEON HDF5 (eddy covariance files) files for all sites and time periods of interest. ALSO downloads all required MET data products that are not in the bundled HDF5 file. 4 | 5 | 2. **flow.NEON.data.unzip.R** Workflow. Unzips all downloaded NEON data files. 6 | 7 | 3. **flow.NEON.data.extract.R** Extract and stack downloaded and unzipped data into R objects for each data averaging interval, saved in their own RData file. These are currently min9.list (9-min/6-min concentrations), min30.list (30-min met and flux data), and min1.list (1-min met data), WS2D (2D wind speed data). Also extracts and saves site attributes from the HDF5 files into an R object called attr.df. Zips and saves objects to Google Drive. For example, `googledrive::drive_upload(media = path to the local file to upload, overwrite = T, path = googledrive::as_id("url to Drive folder"))`. 8 | 9 | 4. **flow.NEON.data.format.conc.diffs.R** Grabs output from flow.NEON.data.extract.R from Google Drive. Align the 9-min concentration data among adjacent tower levels (and also the bottom-top levels). Interpolates 30-min eddy flux and MET data to the 9-min/6-min concentrations, including but not limited to u*, ubar (profile), roughness length. Also derives kinematic water flux (LE -> w'q'), heat flux (w'T'), aerodynamic canopy height, displacement height, that are needed for the various methods. Differences the concentrations for CH4, CO2, and H2O for adjacent tower levels (and bottom-top). Saves output as SITE_aligned_conc_flux_9min.RData, where SITE is the NEON site code. Zips and uploads to Google Drive. 10 | 11 | 5. **flow.Download.GoogleDriveData.R** Downloads the SITE_aligned_conc_flux data from google drive. 12 | 13 | 6. **flow.calc.flux.batch.R** Calculates the gradient fluxes and aggregates datasetsby method and site. 14 | Files are saved locally and on google drive. 15 | 16 | 7. **flow.evaluations.R** Workflow to evaluate CO2 flues. This flow pulls in **FUNCTION_Filter.R**, **FUNCTION_One2One.R**, and **FUNCTION_DIURNAL.R**. 17 | 18 | 8. **flow.evaluations_H2O.R** .... 19 | 20 | 9. **flow.Heterogeneity_H2O.R** .... 21 | 22 | 23 | # AOP Workflow: 24 | 25 | 1. **flow.NEONAOP.EVI.Download.R** - creates a list of available data at each site and download LAI, vegetation indices, and canopy height data 26 | 27 | 2. **flow.neon.site.squarebuffers.R** - Creates a sites simple feature and generates spatialbuffers. 28 | 29 | 3. **flow_AOP_FormatLayers.R** - Make site level raster tifs for AOP data of interest to be used in **Site.Spatial.Homo.R** . 30 | 31 | 4. **Site.Spatial.Homo.R** - Summarizes spectral and structural diversity of site foot prints. 32 | 33 | 34 | 35 | -------------------------------------------------------------------------------- /deprecated/aop/flow.neon.site.simplefeatures.R: -------------------------------------------------------------------------------- 1 | 2 | # Load libraries: 3 | library( sf) 4 | library(ggplot2) 5 | library(dplyr) 6 | 7 | 8 | # Import the csv of sites and their locations. 9 | Sites <- read.csv('/Volumes/MaloneLab/Research/FluxGradient/Ameriflux_NEON field-sites.csv') 10 | 11 | # Make dataframe a shapfile: 12 | Sites.shp <- st_as_sf(x = Sites, 13 | coords = c("Longitude..degrees.", "Latitude..degrees."), 14 | crs = "epsg:4326") 15 | 16 | # Create a USA AOI: 17 | aoi.usa <- AOI::aoi_get(country= c("USA", "PR") ) 18 | 19 | # Visualize the point locations within the USA: 20 | ggplot( ) + geom_sf(data=aoi.usa) + geom_sf(data=Sites.shp) 21 | 22 | # Add projection to the shape file crs: 23 | #Sites.shp.proj <- sf::st_transform(Sites.shp ,crs = "epsg:4087" ) 24 | 25 | st_wedge <- function(x,y,r,start,width,n=20){ 26 | theta = seq(start, start+width, length=n) 27 | xarc = x + r*sin(theta) 28 | yarc = y + r*cos(theta) 29 | xc = c(x, xarc, x) 30 | yc = c(y, yarc, y) 31 | st_polygon(list(cbind(xc,yc))) 32 | } 33 | 34 | st_wedges <- function(x, y, r, nsegs){ 35 | width = (2*pi)/nsegs 36 | starts = (1:nsegs)*width 37 | polys = lapply(starts, function(s){st_wedge(x,y,r,s,width)}) 38 | mpoly = st_cast(do.call(st_sfc, polys), "MULTIPOLYGON") 39 | mpoly 40 | } 41 | 42 | n_wedges <- 8 43 | 44 | Sites.shp$X <- Sites.shp %>% st_coordinates() %>% as.data.frame %>% select(X) 45 | Sites.shp$Y <- Sites.shp %>% st_coordinates() %>% as.data.frame %>% select(Y) 46 | 47 | 48 | assign.wedge <- function(shp, r, n_wedges) { 49 | wedges <- st_wedges(shp$X[1,], shp$Y[1,], r, n_wedges) %>% 50 | st_as_sf() %>% 51 | st_set_crs(4326) %>% 52 | st_transform(3488) 53 | 54 | wedges$wedge <- seq(1,8, 1) 55 | 56 | return(wedges ) 57 | } 58 | 59 | length(Sites.shp$Name) 60 | 61 | sites.wedges <-c() 62 | 63 | for( i in 1:length(Sites.shp$Name)){ 64 | print(i) 65 | sf <- assign.wedge(shp=Sites.shp[i,], r=4, n_wedges=8) %>% st_as_sf 66 | sf$site <- Sites.shp$Site_Id.NEON[i] 67 | sites.wedges <-rbind( sites.wedges, sf) 68 | } 69 | 70 | 71 | # Load shapefile created in flow.neon.site.squarebuffers.R: 72 | load('/Volumes/MaloneLab/Research/FluxGradient/NEONLTERsiteBuffers.Rdata') 73 | 74 | sites.wedges <- sites.wedges %>% st_transform( st_crs(Sites.shp)) 75 | site.Buffers <- Site.Buffers %>% st_transform( st_crs(Sites.shp)) 76 | 77 | # Take the intersection of the site files and the wedges: 78 | site.buffers.wedges <- site.Buffers %>% st_intersection(sites.wedges) %>% filter( site == site.1) 79 | 80 | save(site.Buffers,site.buffers.wedges, 81 | file='/Volumes/MaloneLab/Research/FluxGradient/FG_Site_Wdges.RDATA') 82 | 83 | message("Next run flow_AOP_FormatLayers") 84 | 85 | message('After you prepare the AOP layers now you can use the products of this script to summarize information at the site level') -------------------------------------------------------------------------------- /functions/compile.neon.data.1min.R: -------------------------------------------------------------------------------- 1 | #' compile.neon.data.1min 2 | #' 3 | #' @param sitecode NEON site code 4 | #' @param h5files list of h5 files 5 | #' 6 | #' @return list of data frames containing Tair, Press, WS3D, SWin, Swout, LWin, LWout, SoilHF at 1 min resolution 7 | #' 8 | #' @author Alexis Helgeson 9 | compile.neon.data.1min <- function(h5files, sitecode){ 10 | #create empty list to store monthly data 11 | ALL.data = list() 12 | 13 | #looping over all h5 files and extracting data over timeseries (startdate:enddate) 14 | for(i in 1:length(h5files)){ 15 | hd.file <- h5files[i] 16 | print(i) 17 | month.data <- grab.neon.met.1min(hd.file = hd.file, sitecode = sitecode, startdate = startdate, enddate = enddate) 18 | 19 | ALL.data[[i]] <- month.data 20 | 21 | } 22 | #remove looping variable 23 | rm(month.data) 24 | 25 | #rbind similar df FOR 1M MET 26 | Tair.all <- data.frame() 27 | Press.all <- data.frame() 28 | WS3D.all <- data.frame() 29 | SWin.all <- data.frame() 30 | SWout.all <- data.frame() 31 | LWin.all <- data.frame() 32 | LWout.all <- data.frame() 33 | SoilHF.all <- data.frame() 34 | 35 | for (k in 1:length(ALL.data)) { 36 | grabMonth <- ALL.data[[k]] 37 | #grab air temp for all months and combine into one df 38 | grabTair <- grabMonth[[which(names(grabMonth) == "TAir")]] 39 | Tair.all <- bind_rows(Tair.all, grabTair) 40 | #grab air pressure for all months and combine into one df 41 | grabPress <- grabMonth[[which(names(grabMonth) == "Press")]] 42 | Press.all <- bind_rows(Press.all, grabPress) 43 | #grab 3D wind speed for all months and combine into one df 44 | grabWS3D <- grabMonth[[which(names(grabMonth) == "WS3D")]] 45 | WS3D.all <- bind_rows(WS3D.all, grabWS3D) 46 | #grab shortwave in for all months and combine into one df 47 | grabSWin <- grabMonth[[which(names(grabMonth) == "SWin")]] 48 | SWin.all <- bind_rows(SWin.all, grabSWin) 49 | #grab shortwave out for all months and combine into one df 50 | grabSWout <- grabMonth[[which(names(grabMonth) == "SWout")]] 51 | SWout.all <- bind_rows(SWout.all, grabSWout) 52 | #grab longwave in for all months and combine into one df 53 | grabLWin <- grabMonth[[which(names(grabMonth) == "LWin")]] 54 | LWin.all <- bind_rows(LWin.all, grabLWin) 55 | #grab longwave out for all months and combine into one df 56 | grabLWout <- grabMonth[[which(names(grabMonth) == "LWout")]] 57 | LWout.all <- bind_rows(LWout.all, grabLWout) 58 | #grab soil heat flux for all months and combine into one df 59 | grabSoilHF <- grabMonth[[which(names(grabMonth) == "SoilHF")]] 60 | SoilHF.all <- bind_rows(SoilHF.all, grabSoilHF) 61 | 62 | } 63 | 64 | #FOR 1M MET 65 | DATA <- list(SWin = SWin.all, SWout = SWout.all, LWin = LWin.all, LWout = LWout.all, Tair = Tair.all, Press = Press.all, WS3D = WS3D.all, SoilHF = SoilHF.all) 66 | 67 | return(DATA) 68 | } -------------------------------------------------------------------------------- /deprecated/plotting_9mindiff_data.R: -------------------------------------------------------------------------------- 1 | # Pull stacked data from GoogleDrive, spot-check data 2 | 3 | email <- 'kyle.delwiche@gmail.com' 4 | site <- 'GUAN' 5 | 6 | # ------ Prerequisites! Make sure these packages are installed ---- 7 | 8 | library(foreach) 9 | library(doParallel) 10 | library(stringr) 11 | library(plotly) 12 | library(ggplot2) 13 | library(gridExtra) 14 | 15 | # ------------------------------------------------------- 16 | sites <- c('BONA','CPER') 17 | for (site in sites){ 18 | print(site) 19 | 20 | # Authenticate with Google Drive and get site data 21 | googledrive::drive_auth(email = email) # Likely will not work on RStudio Server. If you get an error, try email=TRUE to open an interactive auth session. 22 | drive_url <- googledrive::as_id("https://drive.google.com/drive/folders/1Q99CT77DnqMl2mrUtuikcY47BFpckKw3") 23 | data_folder <- googledrive::drive_ls(path = drive_url) 24 | site_folder <- googledrive::drive_ls(path = data_folder$id[data_folder$name==site]) 25 | dirTmp <- fs::path(tempdir(),site) 26 | dir.create(dirTmp) 27 | files <- site_folder$name 28 | 29 | 30 | file_idx <- match(1, str_detect(files, "aligned")) #get the file name containing "aligned" 31 | focal_file <- files[file_idx] 32 | pathDnld <- fs::path(dirTmp,focal_file) 33 | file_id <- subset(site_folder, name == focal_file) 34 | googledrive::drive_download(file = file_id$id, 35 | path = pathDnld, 36 | overwrite = T) 37 | 38 | if(grepl(pattern='.zip',focal_file)){ 39 | utils::unzip(pathDnld,exdir=dirTmp) 40 | } 41 | 42 | #load data 43 | fileIn <- fs::path(dirTmp,paste0(site,'_aligned_conc_flux_9min.Rdata')) 44 | load(fileIn) 45 | 46 | #separate into dataframes 47 | ch4 <- data.frame(min9Diff.list$CH4) 48 | co2 <- data.frame(min9Diff.list$CO2) 49 | h2o <- data.frame(min9Diff.list$H2O) 50 | 51 | # create histogram of dConc values for plotting in log-y format 52 | temp <- hist(ch4$dConc, breaks = 400) 53 | hist_df <- data.frame(temp$mids, temp$counts) 54 | hist_df$log_counts = log10(temp$counts) 55 | hist_df[sapply(hist_df, is.infinite)] <- 0 56 | 57 | # Plot times series of dConc values 58 | p1 <- ggplot(ch4, aes(x = timeMid, y = dConc)) + 59 | geom_point() + 60 | theme_minimal()+ 61 | labs(x = '', y = 'ch4_dConc') 62 | 63 | 64 | # plot log-y histogram of dConc values 65 | p2 <- ggplot(hist_df, aes(x = temp.mids, y = log_counts)) + 66 | geom_line() + 67 | theme_minimal() + 68 | labs(x = 'ch4_dConc', y = 'Log(Counts)')+ 69 | xlim(-0.3, 0.3) 70 | 71 | #combine plots into one figure 72 | grid.arrange(p1, p2, top = textGrob(site,gp=gpar(fontsize=20,font=3))) 73 | g <- arrangeGrob(p1, p2, nrow=3) #generates g which can be saved with ggsave 74 | 75 | # Save the subplot as an image 76 | ggsave(paste("Figures/",site,"_ch4_dConc.png", sep = ""), g, width = 10, height = 5, dpi = 300) 77 | } -------------------------------------------------------------------------------- /functions/flag.calc.flux.diff.R: -------------------------------------------------------------------------------- 1 | #' flag.calc.flux.diff 2 | #' 3 | #' @param day.night.df gas concentration data frame filtered to either day or night 4 | #' 5 | #' @return dataframe with spike.flag column where 1 = spike and 0 = no spike 6 | #' 7 | #' 8 | #' @author Alexis Helgeson 9 | flag.calc.flux.diff <- function(day.night.df){ 10 | #add a looping column where the numbers are all consecutive: cut() does not return consecutive numbers if there is missing data, which there is because our fluxes are not gapfilled 11 | num.groups <- unique(day.night.df$spike.bin) 12 | loop.num <- seq(1, length(num.groups),1) 13 | #add loop.num as column to dataframe for indexing within the loop 14 | for(l in 1:length(unique(day.night.df$date))){ 15 | day.night.df[which(day.night.df$spike.bin==num.groups[l]),"loop.num"] <- loop.num[l] 16 | } 17 | #calculate median of differences (Md)/MAD for day/night fluxes for each spike.bin 18 | #daytime 19 | for(d in 1:length(num.groups)){ 20 | group.bin <- day.night.df %>% filter(spike.bin==num.groups[d]) 21 | #for last group need to pull in 1 day from previous bin to calculate differences 22 | #we don't want to grab 1st entry in previous bin because that will be over 13 days from current date, so we want to take the last entry in the previous bin and add it to the beginning 23 | if(d == length(num.groups)){ 24 | group.bin.minus1 <- rbind(day.night.df[which(day.night.df$loop.num==(d-1))[length(which(day.night.df$loop.num==(d-1)))],], group.bin) 25 | #calculate difference of FG 26 | group.bin$day.d <- diff(group.bin.minus1$FG) 27 | }else{ 28 | #add 1 obs from next bin to end of the dataframe to calculate differences 29 | group.bin.plus1 <- rbind(group.bin, day.night.df[which(day.night.df$loop.num==(d+1))[1],]) 30 | #calculate difference of FG 31 | group.bin$day.d <- diff(group.bin.plus1$FG) 32 | } 33 | #TO DO: add error message here if there are NAs in group.bin$day.d, there should not be and this is an indication something went wrong with the group selection/matching 34 | #calculate median of differences 35 | day.Md <- median(group.bin$day.d) 36 | #calculate MAD 37 | day.MAD <- mad(group.bin$FG) 38 | #set upper/lower threshold for difference using z=5.5 39 | lower.threshold <- day.Md - ((5.5*day.MAD)/0.6745) 40 | upper.threshold <- day.Md + ((5.5*day.MAD)/0.6745) 41 | #flag which day.d fall outside of range, use NEON convention 1 = bad data, 0 = good data 42 | group.bin[which(group.bin$day.d < lower.threshold),"spike.flag"] <- "1" 43 | group.bin[which(group.bin$day.d > upper.threshold), "spike.flag"] <- "1" 44 | group.bin[which(group.bin$day.d >= lower.threshold & group.bin$day.d <= upper.threshold),"spike.flag"] <- "0" 45 | #add flag to larger df to save 46 | day.night.df[which(day.night.df$spike.bin==num.groups[d]),"spike.flag"] <- group.bin$spike.flag 47 | } 48 | 49 | return(day.night.df) 50 | } -------------------------------------------------------------------------------- /workflows/flow.calc.flux.batch.R: -------------------------------------------------------------------------------- 1 | ## --------------------------------------------- ## 2 | # Housekeeping ----- 3 | ## --------------------------------------------- ## 4 | # Purpose: 5 | # Uses the aligned concentration file combined with the 30min and 9min data files to calculates fluxes and saves locally. 6 | # You must download the aligned concentration data using flow.download.aligned.conc.flux.R. 7 | 8 | # Output(s): 9 | # SITE_AE_9min.Rdata (local & Google Drive) 10 | # SITE_AE_9min.zip (local) 11 | # SITE_MBR_9min.RData (local) 12 | # SITE_MBR_9min.zip (local & Google Drive) 13 | # SITE_WP_9min.Rdata (local) 14 | # SITE_WP_9min.zip (local & Google Drive) 15 | 16 | # Load packages 17 | library(fs) 18 | library(googledrive) 19 | library(dplyr) 20 | library(stringr) 21 | library(tidyverse) 22 | 23 | # Add all sites here: 24 | metadata <- read.csv('/Volumes/MaloneLab/Research/FluxGradient/Site_Attributes.csv') # has a list of all the sites 25 | 26 | # Get unique sites 27 | site.list <- metadata$Site %>% unique() 28 | 29 | # Add local directory for downloaded data here: 30 | localdir1 <- '/Volumes/MaloneLab/Research/FluxGradient/FluxData' # MaloneLab Server 31 | 32 | # Add local directory for your Flux repo here: 33 | localdir2 <- "/Users/sm3466/YSE Dropbox/Sparkle Malone/Research/FluxGradient/lterwg-flux-gradient" 34 | setwd(localdir2) 35 | 36 | ## --------------------------------------------- ## 37 | # Authenticate ----- 38 | ## --------------------------------------------- ## 39 | 40 | email <- 'sparklelmalone@gmail.com' 41 | googledrive::drive_auth(email = TRUE) 42 | 43 | # Authenticate with Google Drive 44 | drive_url <- googledrive::as_id("https://drive.google.com/drive/folders/1Q99CT77DnqMl2mrUtuikcY47BFpckKw3") # The Data 45 | 46 | # Data on google drive 47 | data_folder <- googledrive::drive_ls(path = drive_url) 48 | 49 | ## --------------------------------------------- ## 50 | # Gradient Flux Calculations ----- 51 | ## --------------------------------------------- ## 52 | 53 | for(site in site.list){ 54 | 55 | setwd(localdir2) 56 | 57 | sitecode <- site 58 | print(sitecode) 59 | 60 | # Load Data: 61 | load(fs::path(localdir1, site, paste0(site, '_aligned_conc_flux_30min.RData'))) 62 | load(fs::path(localdir1, site, paste0(site, '_aligned_conc_flux_9min.RData'))) 63 | 64 | dirTmp <- file.path(localdir1, site) 65 | 66 | print('Data Loaded') 67 | 68 | print('Running MBR') 69 | source(file.path("workflows", "flow.calc.flag.mbr.batch.R")) 70 | print('MBR Done') 71 | 72 | setwd(localdir2) 73 | print('Running AE') 74 | source(file.path("workflows", "flow.calc.flag.aero.batch.R")) 75 | print('AE Done') 76 | 77 | setwd(localdir2) 78 | print('Running WP') 79 | source(file.path("workflows", "flow.calc.flag.windprof.batch.R")) 80 | print('WP Done') 81 | 82 | print('done') 83 | rm(min9) 84 | } 85 | 86 | message('Next run the flow.evaluation.dataframe.R') 87 | -------------------------------------------------------------------------------- /deprecated/FG_singleSite.R: -------------------------------------------------------------------------------- 1 | # Load Libraries and Set Environment Vars --------------------------------- 2 | #load libaries 3 | library(neonUtilities) 4 | library(readr) 5 | library(BiocManager) 6 | library(rhdf5) 7 | library(dplyr) 8 | library(oce) 9 | library(tidyr) 10 | library(lubridate) 11 | library(naniar) 12 | library(ggplot2) 13 | library(R.utils) 14 | library(gtools) 15 | #load in FG specific functions 16 | source("R/SiteAttributes.R") 17 | source("R/SiteDF.R") 18 | source("R/hdf2df.R") 19 | source("R/Flux_Gradient_MBR.R") 20 | source("R/Flux_Gradient_AE.R") 21 | source("R/time_format.R") 22 | source("R/cont.HF.R") 23 | #set up dir to store data 24 | Main.Directory <- file.path("Konza") 25 | #set up dir to store data 26 | Main.Directory <- c(file.path("data/")) 27 | #set desired site name and NEON code 28 | sitename <- 'Konza Praire' 29 | sitecode <- 'KONZ' 30 | #set start and end date for obs 31 | startdate <- "2021-01" 32 | enddate <- "2023-09" 33 | #create site folders and setwd 34 | #site.dir <- paste(Main.Directory,"/",sitename, sep="") 35 | #if(!exists(site.dir)){dir.create(site.dir)} 36 | #setwd(paste0(site.dir, "/filesToStack00200/")) 37 | 38 | # Call Fcns to Calculate CH4 fluxes --------------------------------------- 39 | #grab h5 files to be passed to SiteAttributes and SiteDF 40 | hd.files <-list.files(path = Main.Directory, pattern="\\.h5$", full.names = TRUE) 41 | #grab attribute data 42 | attr.df <- SiteAttributes(hd.files, sitecode) 43 | #save df as csv 44 | # write.csv(attr.df, paste0(sitecode, "_", startdate, "_", enddate, "_attr.csv")) 45 | #grab co2, h20, ch4 level 1 data at all 30min resolution tower heights along with level 4 co2, sensible heat, latent heat fluxes, uStar, uBar, air temp, z0 46 | cont.df <- Site.DF(hd.files, sitecode, frequency = "high") 47 | 48 | #filter for good data 49 | h2o.qfqm.df <- cont.df %>% filter(h2o_qfqm.000_040_30m == "0") %>% filter(h2o_qfqm.000_060_30m == "0") %>% filter(F_co2_qfqm == "0") 50 | 51 | co2.qfqm.df <- cont.df %>% filter(co2_qfqm.000_040_30m == "0") %>% filter(co2_qfqm.000_060_30m == "0") %>% filter(F_LE_qfqm == "0") 52 | #save df as csv 53 | # write.csv(cont.df, paste0(sitecode, "_", startdate, "_", enddate, "_cont.csv")) 54 | #calculate flux gradient 55 | #select lower twoer height 56 | z1_height <- attr.df$DistZaxsLvlMeasTow[4] 57 | #select upper tower height 58 | z2_height <- attr.df$DistZaxsLvlMeasTow[6] 59 | #select tallest height for sonic anemometer 60 | z_height <- attr.df$DistZaxsLvlMeasTow[6] 61 | #calculate fluxes using Modified Bowan Ratio 62 | mbr.df <- Flux_Gradient_MBR(cont.df = co2.qfqm.df, attr.df, z1_height, z2_height) 63 | 64 | #save df as csv 65 | # write.csv(mbr.df, paste0(sitecode, "_", startdate, "_", enddate, "_mbr.csv")) 66 | #calculate fluxes using aerodynamic profile and wind profile 67 | ae.df <- Flux_Gradient_AE(cont.df = co2.qfqm.df, attr.df, z1_height, z2_height, z_height) 68 | #save df as csv 69 | write.csv(ae.df, paste0(sitecode, "_", startdate, "_", enddate, "_ae.csv")) 70 | -------------------------------------------------------------------------------- /deprecated/grabDesiredData.R: -------------------------------------------------------------------------------- 1 | # Load Libraries and Set Environment Vars --------------------------------- 2 | #load libaries 3 | library(neonUtilities) 4 | library(readr) 5 | library(BiocManager) 6 | library(rhdf5) 7 | library(dplyr) 8 | library(oce) 9 | library(tidyr) 10 | library(lubridate) 11 | library(naniar) 12 | library(ggplot2) 13 | library(R.utils) 14 | library(gtools) 15 | #load in FG specific functions 16 | source(file.path("R/SiteDF.R")) 17 | source(file.path("R/SiteAttributes.R")) 18 | source(file.path("R/cont9m.R")) 19 | source(file.path("R/metCont30m.R")) 20 | source(file.path("R/met1m.R")) 21 | #set up dir to store data 22 | Main.Directory <- c(file.path("data/KONZ")) 23 | #set desired site name and NEON code 24 | sitename <- 'Konza Praire' 25 | sitecode <- 'KONZ' 26 | #set start and end date for obs 27 | startdate <- "2021-08" 28 | enddate <- "2021-10" 29 | # Call Fcns to Calculate CH4 fluxes --------------------------------------- 30 | #grab h5 files to be passed to SiteAttributes and SiteDF 31 | folders <- list.files(path = file.path("data","Konza", "NEON_eddy-flux"), pattern = "KONZ.DP4.00200.001", full.names = T) 32 | 33 | folders <- folders[8:10] 34 | hd.files <-list.files(path = file.path(folders[1]), pattern="\\.h5$", full.names = T) 35 | 36 | #select for 2021 july forward 37 | #grab attribute data 38 | attr.df <- SiteAttributes(hd.files, sitecode) 39 | #save df as csv 40 | # write.csv(attr.df, paste0(sitecode, "_", startdate, "_", enddate, "_attr.csv")) 41 | #grab co2, h20, ch4 level 1 data at all 30min resolution tower heights along with level 4 co2, sensible heat, latent heat fluxes, uStar, uBar, air temp, z0 42 | min9.list <- Site.DF(folder = folders, sitecode = sitecode, frequency = "9min") 43 | 44 | # WS2D <- m30.list$WS2D 45 | # WS2D <- WS2D %>% 46 | # mutate(TowerPosition = as.numeric(verticalPosition)/10) %>% 47 | # select(TowerPosition, startDateTime, endDateTime, windSpeedMean, windSpeedFinalQF) 48 | # 49 | # m30.list$WS2D <- WS2D 50 | 51 | # m30.list <- met.cont.30m(hd.file = hd.files, sitecode = sitecode, startdate = startdate, enddate = enddate) 52 | # m9.list <- cont.9m(hd.file = hd.files, sitecode = sitecode) 53 | # m1.list <- met.1m(hd.file = hd.files, sitecode = sitecode, startdate = startdate, enddate = enddate) 54 | 55 | #grab 2D horizontal wind speed 56 | # WS2D <- loadByProduct("DP1.00001.001", site="KONZ", 57 | # timeIndex=2, package="basic", 58 | # startdate=startdate, enddate=enddate, 59 | # check.size=F) 60 | # WS2D_2min <- WS2D$twoDWSD_2min %>% 61 | # select(verticalPosition, startDateTime, endDateTime, windSpeedMean, windSpeedFinalQF) 62 | 63 | # save(attr.df, m30.list, m9.list, m1.list, WS2D_2min, file = paste0("data/", sitecode,"_vars.Rdata")) 64 | # load(paste0("data/", sitecode,"_vars.Rdata")) 65 | # save(attr.df, m30.list, m9.list, WS2D_2min, m1.list, file = paste0("data/", sitecode,"_vars.Rdata")) 66 | save(m1.list, file = paste0("data/", sitecode,"_1m.Rdata")) 67 | 68 | 69 | -------------------------------------------------------------------------------- /exploratory/flow.plot.raw.concentrations.R: -------------------------------------------------------------------------------- 1 | rm(list=ls()) 2 | 3 | # This script requires download of the IP0 data from the NEON GCS bucket: 4 | # https://console.cloud.google.com/storage/browser/neon-sae-files/ods/dataproducts/IP0;tab=objects 5 | 6 | #fileDnld <- 'F:/FluxGradientProject/IP0/KONZ/NEON.D06.KONZ.IP0.00200.001.ecse.2021-08-01.l0p.h5.gz' 7 | fileDnld <- 'F:/FluxGradientProject/IP0/TOOL/NEON.D18.TOOL.IP0.00200.001.ecse.2021-08-25.l0p.h5.gz' 8 | var <- 'tempWbox' 9 | lvl <- c('000_040','000_030','000_020','000_010') 10 | dirHdf5pre <- '/TOOL/dp0p/data/crdCo2' 11 | 12 | # Is the file zipped? 13 | if(grepl(pattern='.gz',fileDnld)){ 14 | system(paste0('gzip -d ',fileDnld)) 15 | fileDnld <- base::substr(fileDnld,1,nchar(fileDnld)-3) 16 | } 17 | 18 | # Grab the file structure 19 | listObj <- base::try(rhdf5::h5ls(fileDnld, datasetinfo = FALSE),silent=TRUE) 20 | 21 | if (base::class(listObj) == "try-error"){ 22 | base::stop('Cannot open file. Aborting...') 23 | } 24 | 25 | # Combine path and name 26 | listObjName <- base::paste(listObj$group, listObj$name, sep = "/") # combined path and name 27 | 28 | # Read in the data 29 | numDir <- base::length(lvl) 30 | data <- vector(mode='list',length=numDir) 31 | base::names(data) <- lvl 32 | for(idxLvl in lvl){ 33 | dirHdf <- paste0(dirHdf5pre,'/',idxLvl,'/',var) 34 | dataIdx <- base::try(rhdf5::h5read(file=fileDnld,name=dirHdf),silent=TRUE) 35 | 36 | # Error-check 37 | if(base::class(dataIdx) == 'try-error'){ 38 | # Close the file 39 | rhdf5::h5closeAll() 40 | 41 | # Remove downloaded file if selected 42 | # if(Rm){ 43 | # base::unlink(fileDnld) 44 | # } 45 | 46 | # Did we want the whole file? 47 | if(dirHdf == '/'){ 48 | base::stop('File is unreadable. Aborting...') 49 | } else { 50 | base::stop(base::paste0('Could not retrieve ',dirHdf,' from file ',fileDnld,'. Aborting...')) 51 | } 52 | } 53 | 54 | dataIdx <- data.frame(idx=1:length(dataIdx),conc=dataIdx,lvl=idxLvl) 55 | data[[idxLvl]] <- dataIdx 56 | 57 | } 58 | 59 | dataAll <- do.call('rbind',data) 60 | 61 | # Close the file 62 | rhdf5::h5closeAll() 63 | 64 | library(plotly) 65 | plot <- plotly::plot_ly(data=dataAll, x=~idx, y=~conc, split=~lvl,type='scatter', mode='markers') %>% 66 | plotly::layout(margin = list(b = 50, t = 50, r=50), 67 | title = 'Concentration trace', 68 | xaxis = list(title = base::paste0(c(rep("\n ", 3), 69 | rep(" ", 20), 70 | paste0("Seconds"), 71 | rep(" ", 20)), 72 | collapse = ""), 73 | #range = c(1,48), 74 | zeroline=TRUE 75 | ), 76 | yaxis = list(title = paste0(var,' Concentration')), 77 | showlegend=TRUE) 78 | 79 | print(plot) -------------------------------------------------------------------------------- /exploratory/scripts/flow.aop.mosaic.R: -------------------------------------------------------------------------------- 1 | # Import and Prcess NEON AOP Data t Produce EVI tifs. 2 | 3 | #https://www.neonscience.org/resources/learning-hub/tutorials/merge-aop-raster-data 4 | 5 | library('neonUtilities') 6 | library('raster') 7 | library('data.table') 8 | library('docstring') 9 | library('gdalUtilities') 10 | 11 | source("~/Dropbox (YSE)/Research/FluxGradient/lterwg-flux-gradient/functions/compile.data.availability.AOP.R") 12 | 13 | VegetationIndice <- 'DP3.30026.001' 14 | LAI <- 'DP3.30012.001' 15 | Canopy_Height <- 'DP3.30015.001' 16 | #'DP3.30024.001' - give the componenets to get chm? 17 | 18 | VI.availabilityDf <- Site.Data.Availability.AOP(VegetationIndice) 19 | LAI.availabilityDf <- Site.Data.Availability.AOP(LAI) 20 | CH.availabilityDf <- Site.Data.Availability.AOP(Canopy_Height) 21 | 22 | source("~/Dropbox (YSE)/Research/FluxGradient/lterwg-flux-gradient/exploratory/aop_merge_raster_functions.R") 23 | 24 | NEON_TOKEN <-'eyJ0eXAiOiJKV1QiLCJhbGciOiJFUzI1NiJ9.eyJhdWQiOiJodHRwczovL2RhdGEubmVvbnNjaWVuY2Uub3JnL2FwaS92MC8iLCJzdWIiOiJzcGFya2xlbG1hbG9uZUBnbWFpbC5jb20iLCJzY29wZSI6InJhdGU6cHVibGljIiwiaXNzIjoiaHR0cHM6Ly9kYXRhLm5lb25zY2llbmNlLm9yZy8iLCJleHAiOjE4NjgxNTUzODQsImlhdCI6MTcxMDQ3NTM4NCwiZW1haWwiOiJzcGFya2xlbG1hbG9uZUBnbWFpbC5jb20ifQ.A9PxSOT-3FxbAbxV7xqkM1Ps3OqMnzZcTe14PK3Vi16BaCdz_ClmPGqzLRxD8K61Mv-6XouIf8ToaqnP-NXxnQ' 25 | 26 | setwd('/Volumes/MaloneLab/Research/FluxGradient/NEON_indices-veg-spectrometer-mosaic') 27 | 28 | # Where to download data to: 29 | download_folder <-'/Volumes/MaloneLab/Research/FluxGradient/NEON_indices-veg-spectrometer-mosaic' 30 | 31 | # LAI Data 32 | 33 | for( i in 1:length(LAI.availabilityDf$site )){ 34 | print(i) 35 | site <- LAI.availabilityDf$site[i] 36 | year <- LAI.availabilityDf$year[i] 37 | 38 | message(paste('Working on', site, "-", year)) 39 | 40 | chm_output_folder <- paste("Output/",site, sep="") 41 | 42 | makeFullSiteMosaics('DP3.30012.001',year,site,download_folder,chm_output_folder,NEON_TOKEN) 43 | 44 | message(paste('Done with', site, "-", year)) 45 | } 46 | 47 | # 20, 32, 40,47 48 | for( i in 47:length(CH.availabilityDf$site )){ 49 | print(i) 50 | site <- CH.availabilityDf$site[i] 51 | year <- CH.availabilityDf$year[i] 52 | 53 | message(paste('Working on', site, "-", year)) 54 | 55 | chm_output_folder <- paste("Output/",site, sep="") 56 | 57 | try( makeFullSiteMosaics(Canopy_Height,year,site,download_folder,chm_output_folder,NEON_TOKEN), silent =T) 58 | 59 | message(paste('Done with', site, "-", year)) 60 | } 61 | 62 | #40 63 | for( i in 65:length(VI.availabilityDf$site )){ 64 | print(i) 65 | site <- VI.availabilityDf$site[i] 66 | year <- VI.availabilityDf$year[i] 67 | 68 | message(paste('Working on', site, "-", year)) 69 | 70 | chm_output_folder <- paste("Output/",site, sep="") 71 | 72 | try(makeFullSiteMosaics(VegetationIndice,year,site,download_folder,chm_output_folder,NEON_TOKEN), silent =T) 73 | 74 | message(paste('Done with', site, "-", year)) 75 | } 76 | 77 | 78 | dpID =VegetationIndice 79 | year = VI.availabilityDf$year[64] 80 | siteCode = VI.availabilityDf$site[64] 81 | dataRootDir = download_folder 82 | outFileDir = chm_output_folder 83 | apiToken=NEON_TOKEN 84 | 85 | 86 | 87 | -------------------------------------------------------------------------------- /functions/calc.aerodynamic.canopy.height.R: -------------------------------------------------------------------------------- 1 | # Estimate Aerodynamic Canopy Height (h) based on Pennypacker and Baldocchi (2015) 2 | # By Camilo Rey_sanchez. May 2024 3 | 4 | #Returns: 5 | # zh final= Gap filled series of aerodynamic canopy height (m) 6 | # h_dsk= Smoothed series of aerodynamic canopy height (m, non-gapfilled) 7 | 8 | 9 | calc.aerodynamic.canopy.height <- function(Mdate, ustar, z, L, u, daysAVG, plotYN) { 10 | k <- 0.4 11 | d_h <- 0.6 # Default from paper 12 | z0_h <- 0.1 # Default from paper 13 | print("Calculating Aerodynamic Canopy Height") 14 | 15 | # Define criteria for calculating h 16 | ind <- which(ustar > 0.35 & ustar < 0.5 & abs(z / L) < 0.1 & u>1) 17 | # ind <- which(ustar > 0.25 & ustar < 0.35 & abs(z / L) 18 | 19 | h <- rep(NA, length(ustar)) 20 | h[ind] <- z / (d_h + z0_h * exp(k * u[ind] / ustar[ind])) 21 | # Calculate daily mean height using smoothing and despike one last time 22 | Days <- as.numeric(format(Mdate, "%j")) 23 | h_despike <- h[ind]# You might need to implement or find a despike function in R. Not implemented for now. 24 | navg <- daysAVG # number of windows to use for average 25 | 26 | if( length(h_despike) < length(rep(1/navg, navg)) ){ # Added this case for TEAK 27 | cat("Too little data, z_veg will be equal to the average\n") 28 | h_dsk <- rep(NA, length(ustar)) # Is this ok? 29 | zh_final <- rep(mean(h_despike, na.rm=TRUE), length(h)) 30 | 31 | } else if ((length(h_despike) >= length(rep(1/navg, navg))) & (length(unique(Days)) > 30)) { # higher than 30 days of data 32 | #navg <- daysAVG # number of windows to use for average 33 | hsmooth_dsk <- stats::filter(h_despike, rep(1/navg, navg), sides=2) # smoothing 34 | h_dsk <- rep(NA, length(ustar)) 35 | h_dsk[ind] <- hsmooth_dsk 36 | if (length(h_dsk[!is.na(h_dsk)]) < 2){ # Added this case for WREF 37 | cat("Too little data, z_veg will be equal to the average\n") 38 | h_dsk <- rep(NA, length(ustar)) 39 | zh_final <- rep(mean(h_despike, na.rm=TRUE), length(h)) 40 | } else { 41 | # Interpolate daily measurements back to 30 (9) min values 42 | zh_final <- approx(Mdate[!is.na(h_dsk)], h_dsk[!is.na(h_dsk)], 43 | Mdate, method="linear", rule=2)$y 44 | # Fix the interpolation at the end 45 | fff <- which(!is.na(h_dsk)) 46 | zh_final[1:fff[1]] <- zh_final[fff[1]] 47 | zh_final[fff[length(fff)]:length(zh_final)] <- zh_final[fff[length(fff)]] 48 | } 49 | 50 | } else { 51 | cat("Too little data, z_veg will be equal to the average\n") 52 | h_dsk <- rep(NA, length(ustar)) # Added this for TOOL 53 | zh_final <- rep(mean(h_despike, na.rm=TRUE), length(h)) 54 | } 55 | 56 | if (plotYN == 1 && length(unique(Days)) > 4) { # higher than 4 days of data 57 | plot(Mdate, h, pch=19, col="black", cex=1, main=paste("Smoothing based on a", daysAVG, "-day window average"), 58 | xlab="Date", ylab="Aerodynamic canopy height (m)") 59 | points(Mdate, h_dsk, pch=19, col="blue", cex=1) 60 | lines(Mdate, zh_final, col="blue") 61 | legend("topleft", legend=c("initial", "Smoothed", "Gap filled"), col=c("black", "blue", "blue"), pch=c(19, 19, NA), lty=c(NA, NA, 1)) 62 | } 63 | 64 | DATA <- list(h_dsk=h_dsk, zh_final=zh_final) 65 | return(DATA) 66 | } 67 | 68 | -------------------------------------------------------------------------------- /deprecated/aop/flow.StructuralDiversity.R: -------------------------------------------------------------------------------- 1 | # Canopy Diversity Indices: 2 | ## https://www.nature.com/articles/s41597-024-04018-0#Sec7 3 | 4 | library(terra) 5 | library(sf) 6 | library(tidyverse) 7 | library(gtools) 8 | 9 | load(file='/Volumes/MaloneLab/Research/FluxGradient/FG_Site_Wdges.RDATA') 10 | 11 | st_crs(site.Buffers) 12 | 13 | # 14 | diversity.dir <- "/Volumes/MaloneLab/Research/FluxGradient/StructuralDiversity_rasters" 15 | 16 | folders <- list.files(diversity.dir ) 17 | 18 | # Files to save information: 19 | Structural.Diversity.mean <- data.frame() 20 | Structural.Diversity.sd <- data.frame() 21 | 22 | for( i in folders){ 23 | 24 | print(paste("Working in folder: ",i)) 25 | 26 | site.year.dir <- paste(diversity.dir,"/", i , sep="") 27 | files.site <- list.files(site.year.dir, patter=".tif$") 28 | 29 | site.rasters <- terra::rast(paste(site.year.dir, "/",files.site , sep="")) %>% terra::project('epsg:4326') 30 | 31 | names.raster <- names(site.rasters) 32 | site.names <- names.raster %>% substr(start = 10, stop = 13) %>% unique 33 | site.year <- names.raster %>% substr(start = 5, stop =8 ) %>% unique 34 | names(site.rasters) <- names.raster %>% substr(start = 17, stop =40 ) 35 | 36 | site.Buffers.sub <- site.buffers.wedges %>% dplyr::filter(site == site.names) %>% distinct 37 | 38 | if( length(site.Buffers.sub$geometry) > 0 ) { 39 | # Loop through the shapefiles for the site to extract the mean and SD. 40 | for( a in 1:length( site.Buffers.sub$geometry )){ 41 | 42 | Sites.wedges.sub <- site.Buffers.sub[a,] 43 | 44 | print(paste("Working in folder: ",i, "buffer =",a)) 45 | 46 | raster.sub <- terra::extract(site.rasters, site.Buffers.sub[a,], 47 | touches=TRUE) 48 | 49 | summary.mean <- summarise_all(raster.sub , .funs= "mean", na.rm=T) 50 | summary.sd <-summarise_all(raster.sub , .funs= "sd", na.rm=T) 51 | 52 | 53 | summary.sd$Site <-summary.mean$Site <- Sites.wedges.sub$site 54 | summary.sd$dist.m <-summary.mean$dist.m <- Sites.wedges.sub$dist_m 55 | summary.sd$wedge <-summary.mean$wedge <- Sites.wedges.sub$wedge 56 | summary.sd$Year <-summary.mean$Year <-site.year 57 | 58 | Structural.Diversity.mean <- smartbind(Structural.Diversity.mean, summary.mean) 59 | Structural.Diversity.sd <- smartbind(Structural.Diversity.sd, summary.sd) 60 | rm( summary.sd) 61 | } 62 | } else{ print("There are no buffers for the site")} 63 | 64 | } 65 | 66 | 67 | Structural.Diversity.mean <- Structural.Diversity.mean %>% distinct 68 | Structural.Diversity.sd <- Structural.Diversity.sd %>% distinct 69 | 70 | 71 | # Summarise the data before writing it outL 72 | 73 | Structural.Diversity.mean.summary <- Structural.Diversity.mean %>% filter (wedge == 8) %>% 74 | group_by(Site) %>% summarise_all('mean', na.rm = T) 75 | 76 | Structural.Diversity.mean.summary.sd <- Structural.Diversity.mean %>% filter (wedge == 8) %>% 77 | group_by(Site) %>% summarise_all('sd', na.rm = T) 78 | 79 | save( Structural.Diversity.mean, Structural.Diversity.sd, Structural.Diversity.mean.summary,Structural.Diversity.mean.summary.sd, 80 | file='/Volumes/MaloneLab/Research/FluxGradient/Structral_Diversity.Rdata' ) 81 | 82 | message("Next run flow.canopy to bring attribute, AOP, and structural diversity data together.") -------------------------------------------------------------------------------- /deprecated/wrap.concatAndFilterH5.R: -------------------------------------------------------------------------------- 1 | # pathUnzipped <- 'C:/Users/csturtevant/Dropbox/Proposals/FluxGradient/unzippedFiles' 2 | 3 | # dirHdf5Data <- c(paste0('/',sitecode,'/dp01/data/ch4Conc/000_040_09m/rtioMoleDryCh4'), 4 | # paste0('/',sitecode,'/dp01/data/ch4Conc/000_030_09m/rtioMoleDryCh4'), 5 | # paste0('/',sitecode,'/dp01/data/ch4Conc/000_020_09m/rtioMoleDryCh4'), 6 | # paste0('/',sitecode,'/dp01/data/ch4Conc/000_010_09m/rtioMoleDryCh4'), 7 | # paste0('/',sitecode,'/dp01/data/isoCo2/000_040_09m/rtioMoleDryCo2'), 8 | # paste0('/',sitecode,'/dp01/data/isoCo2/000_030_09m/rtioMoleDryCo2'), 9 | # paste0('/',sitecode,'/dp01/data/isoCo2/000_020_09m/rtioMoleDryCo2'), 10 | # paste0('/',sitecode,'/dp01/data/isoCo2/000_010_09m/rtioMoleDryCo2'), 11 | # paste0('/',sitecode,'/dp01/data/isoCo2/000_040_09m/rtioMoleDryH2o'), 12 | # paste0('/',sitecode,'/dp01/data/isoCo2/000_030_09m/rtioMoleDryH2o'), 13 | # paste0('/',sitecode,'/dp01/data/isoCo2/000_020_09m/rtioMoleDryH2o'), 14 | # paste0('/',sitecode,'/dp01/data/isoCo2/000_010_09m/rtioMoleDryH2o') 15 | # )# array of paths 16 | 17 | # # H5 paths to extract with the final flags for the above variables (note - the tables must all have the same columns, and should correspond to the data listed above) 18 | # dirHdf5Qf <- c(paste0('/',sitecode,'/dp01/qfqm/ch4Conc/000_040_09m/rtioMoleDryCh4'), 19 | # paste0('/',sitecode,'/dp01/qfqm/ch4Conc/000_030_09m/rtioMoleDryCh4'), 20 | # paste0('/',sitecode,'/dp01/qfqm/ch4Conc/000_020_09m/rtioMoleDryCh4'), 21 | # paste0('/',sitecode,'/dp01/qfqm/ch4Conc/000_010_09m/rtioMoleDryCh4'), 22 | # paste0('/',sitecode,'/dp01/qfqm/isoCo2/000_040_09m/rtioMoleDryCo2'), 23 | # paste0('/',sitecode,'/dp01/qfqm/isoCo2/000_030_09m/rtioMoleDryCo2'), 24 | # paste0('/',sitecode,'/dp01/qfqm/isoCo2/000_020_09m/rtioMoleDryCo2'), 25 | # paste0('/',sitecode,'/dp01/qfqm/isoCo2/000_010_09m/rtioMoleDryCo2'), 26 | # paste0('/',sitecode,'/dp01/qfqm/isoCo2/000_040_09m/rtioMoleDryH2o'), 27 | # paste0('/',sitecode,'/dp01/qfqm/isoCo2/000_030_09m/rtioMoleDryH2o'), 28 | # paste0('/',sitecode,'/dp01/qfqm/isoCo2/000_020_09m/rtioMoleDryH2o'), 29 | # paste0('/',sitecode,'/dp01/qfqm/isoCo2/000_010_09m/rtioMoleDryH2o') 30 | # )# array of paths 31 | 32 | wrap.concatAndFilterH5 <- function(pathUnzipped,dirHdf5Data,dirHdf5Qf){ 33 | 34 | # Grab the data 35 | data <- def.concat_from_h5(pathUnzipped,dirHdf5Data) 36 | 37 | # Grab the quality flags 38 | qf <- def.concat_from_h5(pathUnzipped,dirHdf5Qf) 39 | 40 | # If nrow data and qf are the same, assume timestamps align 41 | if(nrow(data) == nrow(qf)){ 42 | dataFilt <- data 43 | dataFilt[qf$qfFinl == 1,'min'] <- NA 44 | dataFilt[qf$qfFinl == 1,'max'] <- NA 45 | dataFilt[qf$qfFinl == 1,'mean'] <- NA 46 | dataFilt[qf$qfFinl == 1,'vari'] <- NA 47 | } else { 48 | stop('Cannot produce filtered data. Data and flags data frames do not have the same number of rows') 49 | } 50 | 51 | # Convert ver to tower level 52 | dataFilt$level <- as.numeric(dataFilt$ver)/10 53 | 54 | return(dataFilt) 55 | 56 | } 57 | 58 | -------------------------------------------------------------------------------- /flow.flux.final.R: -------------------------------------------------------------------------------- 1 | 2 | # summarize fluxes at the site level: 3 | 4 | 5 | for( site in site.list){ 6 | 7 | print(site) 8 | message( paste("Importing the data for ", site)) 9 | localdir.site <- paste(localdir,"/", site, sep = "") 10 | load(paste(localdir.site, "/", site, "_FILTER.Rdata", sep="")) 11 | 12 | SITES_One2One_ID_sub <- SITES_One2One_ID %>% filter(Site == site) 13 | 14 | if( sum( SITES_One2One_ID_sub$Good.CCC) > 0){ 15 | 16 | MBR_9min_FILTER_CCC <- SITES_One2One_ID_sub %>% filter( Approach == "MBR") %>% full_join( MBR_9min_FILTER , by = c('dLevelsAminusB'), relationship = "many-to-many") %>% filter( Good.CCC == 1) 17 | 18 | WP_9min_FILTER_CCC <- SITES_One2One_ID_sub %>% filter( Approach == "WP") %>% full_join( WP_9min_FILTER , by = c('dLevelsAminusB'), relationship = "many-to-many")%>% filter( Good.CCC == 1) 19 | 20 | AE_9min_FILTER_CCC <- SITES_One2One_ID_sub %>% filter( Approach == "AE") %>% full_join( AE_9min_FILTER , by = c('dLevelsAminusB'), relationship = "many-to-many")%>% filter( Good.CCC == 1) 21 | 22 | DF.FILTER_CCC <- rbind(MBR_9min_FILTER_CCC, WP_9min_FILTER_CCC, AE_9min_FILTER_CCC ) %>% filter( Canopy_L1 != "WW") %>% mutate( timeEndA.local.round = lubridate::round_date(lubridate::ymd_hms(timeEndA.local), unit = "30 minutes")) # Create a half fourly timestamp: 23 | 24 | 25 | 26 | # aggregate fluxes by the half hour 27 | DF.FILTER_CCC %>% names() 28 | DF.FILTER_CCC_30 <- DF.FILTER_CCC %>% reframe( .by =timeEndA.local.round, 29 | FC_nee_interp = mean( FC_nee_interp, na.rm=T), 30 | FG_mean= mean( FG_mean, na.rm=T), 31 | FG_sd= mean( FG_sd, na.rm=T), 32 | CanopyHeight= mean(CanopyHeight, na.rm=T), 33 | Cutoff05.SDH= mean( Cutoff05.SDH, na.rm=T), 34 | EVI.mean= mean( EVI.mean, na.rm=T), 35 | NDVI.mean= mean( NDVI.mean, na.rm=T), 36 | LAI.mean= mean( LAI.mean, na.rm=T), 37 | RH= mean( RH, na.rm=T), 38 | PAR= mean( PAR, na.rm=T), 39 | VPD= mean( VPD, na.rm=T), 40 | Tair_K= mean( Tair_K, na.rm=T) ) 41 | 42 | 43 | 44 | DF.FILTER_CCC_30 %>% filter( PAR >=1500) %>% ggplot() + geom_boxplot(aes( x= FC_nee_interp), outlier.colour="black", outlier.shape=16, 45 | outlier.size=2, notch=FALSE)+ 46 | geom_boxplot(aes( x= FG_mean),colour="orange", outlier.colour="orange", outlier.shape=16, outlier.size=2, notch=FALSE, alpha= 0.4) 47 | 48 | 49 | DF.FILTER_CCC_30 %>% ggplot() + geom_point(aes( x=PAR, y= FG_mean)) + geom_smooth( aes( x=PAR, y= FC_nee_interp)) 50 | 51 | 52 | # Mean Flux when PAR == 0 and >= 1500 53 | # canculate the diel and scale it to the daily rate. 54 | # Q10 55 | # Do everything for the EC and FG 56 | 57 | 58 | } 59 | print('done') 60 | 61 | } 62 | -------------------------------------------------------------------------------- /deprecated/flow.temporalCoverage.R: -------------------------------------------------------------------------------- 1 | library(lubridate) 2 | 3 | count.samples.month <- function(df, gas){ 4 | 5 | df.sub.gas <- df %>% filter( gas == gas) %>% select("FG_mean", "hour.local", "timeEndA.local") %>% 6 | reframe(.by= timeEndA.local, FG_mean = mean(FG_mean, na.rm=T)) %>% 7 | mutate( count = 1, timeEndA.local = as.POSIXct(timeEndA.local), Month = format(timeEndA.local, "%m"), hour.local = format(timeEndA.local, "%H")) %>% 8 | select("FG_mean", "count", "Month", "hour.local", "timeEndA.local") %>% 9 | mutate( Days.in.Month = days_in_month(month(timeEndA.local)), 10 | Years.count = length(unique(format(timeEndA.local, "%Y")))) 11 | 12 | df.sub.gas.month <- df.sub.gas %>% reframe( .by= c(Month), Month.sample = sum(count), 13 | Days.in.Month = mean(Days.in.Month), 14 | Years.count = mean(Years.count )) %>% 15 | mutate( space = Years.count * Days.in.Month*48, 16 | Percent.Coverage.Month = (Month.sample / space) *100) %>% select(Month, Percent.Coverage.Month) 17 | 18 | 19 | } 20 | 21 | count.samples.diel <- function(df, gas){ 22 | 23 | 24 | df.sub.gas <- df %>% filter( gas == gas) %>% select("FG_mean","timeEndA.local") %>% 25 | reframe(.by= timeEndA.local, FG_mean = mean(FG_mean, na.rm=T)) %>% 26 | mutate( count = 1, timeEndA.local = as.POSIXct(timeEndA.local), 27 | Month = format(timeEndA.local, "%m"), 28 | hour.local = format(timeEndA.local, "%H")) %>% 29 | select("FG_mean", "count", "Month", "hour.local", "timeEndA.local") %>% 30 | mutate( Days.in.Month = days_in_month(month(timeEndA.local)), 31 | Years.count = length(unique(format(timeEndA.local, "%Y")))) 32 | 33 | df.sub.gas.diel <- df.sub.gas %>% reframe( .by= c(hour.local), Diel.sample = sum(count), 34 | Years.count = mean(Years.count )) %>% 35 | mutate( space = 17520, 36 | Percent.Coverage.Diel = (Diel.sample/ space) *100) %>% select(hour.local, Percent.Coverage.Diel) 37 | 38 | return( df.sub.gas.diel) 39 | } 40 | 41 | 42 | MBR_9min_FILTER_CCC <- SITES_One2One_ID_sub %>% filter( Approach == "MBR") %>% full_join( MBR_9min_FILTER , by = c('dLevelsAminusB'), relationship = "many-to-many") %>% filter( Good.CCC == 1) 43 | 44 | WP_9min_FILTER_CCC <- SITES_One2One_ID_sub %>% filter( Approach == "WP") %>% full_join( WP_9min_FILTER , by = c('dLevelsAminusB'), relationship = "many-to-many")%>% filter( Good.CCC == 1) 45 | 46 | AE_9min_FILTER_CCC <- SITES_One2One_ID_sub %>% filter( Approach == "AE") %>% full_join( AE_9min_FILTER , by = c('dLevelsAminusB'), relationship = "many-to-many")%>% filter( Good.CCC == 1) 47 | 48 | 49 | DF.FILTER_CCC <- gtools::smartbind(MBR_9min_FILTER_CCC, WP_9min_FILTER_CCC, AE_9min_FILTER_CCC ) %>% filter( Canopy_L1 != "WW") 50 | 51 | month.CO2 <- count.samples.month(df= DF.FILTER_CCC, gas = "CO2") %>% mutate( gas="CO2") 52 | month.H2O <- count.samples.month(df= DF.FILTER_CCC, gas = "H2O") %>% mutate( gas="H2O") 53 | 54 | sample.month <- rbind(month.CO2, month.H2O) %>% mutate(site = site) 55 | 56 | diel.CO2 <- count.samples.diel(df= DF.FILTER_CCC, gas = "CO2") %>% mutate( gas="CO2") 57 | diel.H2O <- count.samples.diel(df= DF.FILTER_CCC, gas = "H2O") %>% mutate( gas="H2O") 58 | 59 | sample.diel <- rbind( diel.CO2, diel.H2O) %>% mutate(site = site) 60 | -------------------------------------------------------------------------------- /functions/calc.bad.eddy.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | Bad_Eddy <- function(df, method) { 4 | # Access the data based on the site and method 5 | site_data <- df 6 | 7 | # Check if the specified method is valid 8 | if (!(method %in% c("EddyDiff", "EddyDiff_WP"))) { 9 | stop("Invalid method. Please choose either 'EddyDiff' or 'EddyDiff_WP'.") 10 | } 11 | 12 | # Select the column based on the method 13 | method_column <- site_data[[method]] 14 | kgas <- site_data$Kgas 15 | 16 | # Calculate Q1, Q3, and IQR 17 | Q1 <- quantile(method_column, 0.25, na.rm=TRUE) 18 | Q3 <- quantile(method_column, 0.75, na.rm=TRUE) 19 | IQR_value <- IQR(method_column, na.rm=TRUE) 20 | 21 | # Calculate the lower and upper bounds for outliers 22 | lower_bound <- 0 # Since you're checking for values >= 0 (for EddyDiff) 23 | upper_bound <- Q3 + 1.5 * IQR_value 24 | 25 | # Create the Eddy_outlier column based on the outlier condition 26 | site_data$Eddy_outlier <- ifelse(kgas < lower_bound | kgas > upper_bound, 1, 0) 27 | 28 | # Calculate the percentage of data flagged as outliers 29 | percent_flagged <- mean(site_data$Eddy_outlier, na.rm=TRUE) * 100 30 | 31 | # Print the message on how much data was lost 32 | cat("Percentage of data flagged as outliers:", percent_flagged, "%\n") 33 | 34 | # Return the updated dataframe with the new 'Eddy_outlier' column 35 | return(site_data) 36 | } 37 | 38 | 39 | ######Super Bad Eddy###### 40 | """Super_Bad_eddy takes a dataframe (df), an eddy diffusivity (method) to analyze (calculated from either AE or WP method) and specified bound (x). We then compare the K 41 | calculated by the AE or WP method against the eddy diffusivity back calculated from the eddy covariance method (kgas). If kgas is different from the 42 | eddy diffusivity calcuated from AE and WP, we flag it as an outlier with the assumption that the difference was caused by conditions unsuitable for the 43 | gradient method. The argument x determines what the boundaries of what is interpreted as unsuitable are. Argument x could possibly be defined as +- a 44 | certain percentage of a each EC kgas observation, or in the case of the Bad_Eddy function, if kgas is within 1.5IQR of the range calculated by AE and WP 45 | for each site.""" 46 | 47 | 48 | 49 | Super_Bad_Eddy <- function(df, method, x) { 50 | # Access the data 51 | site_data <- df 52 | 53 | # Check if the specified method is valid 54 | if (!(method %in% c("EddyDiff", "EddyDiff_WP"))) { 55 | stop("Invalid method. Please choose either 'EddyDiff' or 'EddyDiff_WP'.") 56 | } 57 | 58 | # Select the column based on the method 59 | method_column <- site_data[[method]] 60 | kgas <- site_data$Kgas 61 | 62 | # Calculate the lower and upper bounds for outliers based on x 63 | lower_bound <- method_column - x 64 | upper_bound <- method_column + x 65 | 66 | # Create the s_eddy_outliers column based on the outlier condition 67 | site_data$s_eddy_outliers <- ifelse(kgas < lower_bound | kgas > upper_bound, 1, 0) 68 | 69 | # Calculate the percentage of data flagged as outliers 70 | percent_flagged <- mean(site_data$s_eddy_outliers, na.rm=TRUE) * 100 71 | 72 | # Print the message on how much data was flagged 73 | cat("Percentage of data flagged as s_eddy_outliers:", percent_flagged, "%\n") 74 | 75 | # Return the updated dataframe with the new 's_eddy_outliers' column 76 | return(site_data) 77 | } 78 | 79 | 80 | 81 | -------------------------------------------------------------------------------- /functions/flag.all.gas.stability.R: -------------------------------------------------------------------------------- 1 | #' flag.all.gas.stability 2 | #' 3 | #' @param flux.df dataframe of calculated fluxes and L is the name of the column with obukov length 4 | #' @param z canopy height as computed from ustar and wind speed at tower top, per Eqn. 9.7.1b in Stull 5 | #' @param d zero plane displacement height, calculated as 2/3 of z_veg_aero 6 | #' @param L Obukov length 7 | #' @return df with new column for stability conditions 8 | #' 9 | #' 10 | #' @author Sparkle Malone 11 | #' 12 | #' 13 | flag.all.gas.stability <- function(flux.df, L, z, d){ 14 | 15 | L = flux.df %>% select(all_of(L)) 16 | z = flux.df %>% select(all_of(z)) 17 | d = flux.df %>% select(all_of(d)) 18 | 19 | flux.df$zeta = (z-d)/L 20 | 21 | #use obukov length to filter for stable, neutral, unstable atmospheric conditions 22 | #use 100m and 500m as threshold for comparison 23 | flux.df <- flux.df %>% mutate( Stability_100 = case_when( abs(L) > 100 ~ "neutral", 24 | L < 100 & L > 0 ~ "stable", 25 | L > -100 & L < 0 ~ "unstable"), 26 | Stability_500 = case_when( abs(L) > 500 ~ "neutral", 27 | L < 500 & L > 0 ~ "stable", 28 | L > -500 & L < 0 ~ "unstable"), 29 | Stability_Exteme = case_when( abs(zeta) > 1 ~ "extreme", 30 | abs(zeta) <= 1 ~ "stable")) 31 | 32 | flux.df$Stability_Exteme 33 | #calculate amount of data in each condition 34 | percent.neutral100 <- round(length(flux.df[which(flux.df$Stability_100=="neutral"), 1])/length(flux.df[,1]), 3)*100 35 | percent.stable100 <- round(length(flux.df[which(flux.df$Stability_100=="stable"),1])/length(flux.df[,1]), 3)*100 36 | percent.unstable100 <- round(length(flux.df[which(flux.df$Stability_100=="unstable"), 1])/length(flux.df[,1]), 3)*100 37 | 38 | percent.Stability_Exteme <- round(length(flux.df[which(flux.df$Stability_Exteme=="stable"), 1])/length(flux.df[,1]), 3)*100 39 | 40 | print(paste0("Amount of data under neutral conditions is ~", percent.neutral100, "% using 100m threshold")) 41 | print(paste0("Amount of data under stable conditions is ~", percent.stable100, "% using 100m threshold")) 42 | print(paste0("Amount of data under unstable conditions is ~", percent.unstable100, "% using 100m threshold")) 43 | 44 | percent.neutral500 <- round(length(flux.df[which(flux.df$Stability_500=="neutral"),1])/length(flux.df[,1]), 3)*100 45 | percent.stable500 <- round(length(flux.df[which(flux.df$Stability_500=="stable"),1])/length(flux.df[,1]), 3)*100 46 | percent.unstable500 <- round(length(flux.df[which(flux.df$Stability_500=="unstable"),1])/length(flux.df[,1]), 3)*100 47 | print(paste0("Amount of data under neutral conditions is ~", percent.neutral100, "% using 500m threshold")) 48 | print(paste0("Amount of data under stable conditions is ~", percent.stable100, "% using 500m threshold")) 49 | print(paste0("Amount of data under unstable conditions is ~", percent.unstable100, "% using 500m threshold")) 50 | 51 | print(paste0("Amount of data under stable conditions is ~", percent.Stability_Exteme , "% using extreme zeta cutoffs from cantero et al., 2022")) 52 | return(flux.df) 53 | 54 | } -------------------------------------------------------------------------------- /deprecated/FG_singleSite_AH.R: -------------------------------------------------------------------------------- 1 | # Load Libraries and Set Environment Vars --------------------------------- 2 | #load libaries 3 | library(neonUtilities) 4 | library(readr) 5 | library(BiocManager) 6 | library(rhdf5) 7 | library(dplyr) 8 | library(oce) 9 | library(tidyr) 10 | library(lubridate) 11 | library(naniar) 12 | library(ggplot2) 13 | library(R.utils) 14 | library(gtools) 15 | #load in FG specific functions 16 | source(file.path("R/SiteAttributes.R")) 17 | source(file.path("R/SiteDF.R")) 18 | source(file.path("R/Flux_Gradient_MBR.R")) 19 | source(file.path("R/Flux_Gradient_AE.R")) 20 | source(file.path("R/time_format.R")) 21 | source(file.path("R/cont9m.R")) 22 | source(file.path("R/metCont30m.R")) 23 | source(file.path("R/met1m.R")) 24 | #set up dir to store data 25 | Main.Directory <- c(file.path("data/Konza")) 26 | #set desired site name and NEON code 27 | sitename <- 'Konza Praire' 28 | sitecode <- 'KONZ' 29 | #set start and end date for obs 30 | startdate <- "2021-08" 31 | enddate <- "2021-09" 32 | #create site folders and setwd 33 | #site.dir <- paste(Main.Directory,"/",sitename, sep="") 34 | #if(!exists(site.dir)){dir.create(site.dir)} 35 | #setwd(paste0(site.dir, "/filesToStack00200/")) 36 | 37 | # Call Fcns to Calculate CH4 fluxes --------------------------------------- 38 | #grab h5 files to be passed to SiteAttributes and SiteDF 39 | folders <- list.files(path = file.path("data","Konza", "NEON_eddy-flux"), pattern = "KONZ.DP4.00200.001", full.names = T) 40 | folders <- folders[8:33] 41 | hd.files <-list.files(path = file.path(folders[1]), pattern="\\.h5$", full.names = T) 42 | #select for 2021 july forward 43 | #grab attribute data 44 | attr.df <- SiteAttributes(hd.files, sitecode) 45 | #save df as csv 46 | # write.csv(attr.df, paste0(sitecode, "_", startdate, "_", enddate, "_attr.csv")) 47 | #grab co2, h20, ch4 level 1 data at all 30min resolution tower heights along with level 4 co2, sensible heat, latent heat fluxes, uStar, uBar, air temp, z0 48 | #cont.df <- Site.DF(hd.files, sitecode, frequency = "high") 49 | m30.list <- met.cont.30m(hd.file = hd.files, sitecode = sitecode, startdate = startdate, enddate = enddate) 50 | m9.list <- cont.9m(hd.file = hd.files, sitecode = sitecode) 51 | m1.list <- met1m(hd.file = hd.files, sitecode = sitecode) 52 | #filter for good data 53 | # h2o.qfqm.df <- cont.df %>% filter(h2o_qfqm.000_040_30m == "0") %>% filter(h2o_qfqm.000_060_30m == "0") %>% filter(F_co2_qfqm == "0") 54 | # 55 | # co2.qfqm.df <- cont.df %>% filter(co2_qfqm.000_040_30m == "0") %>% filter(co2_qfqm.000_060_30m == "0") %>% filter(F_LE_qfqm == "0") 56 | #save df as csv 57 | # write.csv(cont.df, paste0(sitecode, "_", startdate, "_", enddate, "_cont.csv")) 58 | #calculate flux gradient 59 | #select lower twoer height 60 | z1_height <- attr.df$DistZaxsLvlMeasTow[4] 61 | #select upper tower height 62 | z2_height <- attr.df$DistZaxsLvlMeasTow[6] 63 | #select tallest height for sonic anemometer 64 | z_height <- attr.df$DistZaxsLvlMeasTow[6] 65 | #calculate fluxes using Modified Bowan Ratio 66 | mbr.df <- Flux_Gradient_MBR(cont.df = co2.qfqm.df, attr.df, z1_height, z2_height) 67 | 68 | #save df as csv 69 | # write.csv(mbr.df, paste0(sitecode, "_", startdate, "_", enddate, "_mbr.csv")) 70 | #calculate fluxes using aerodynamic profile and wind profile 71 | ae.df <- Flux_Gradient_AE(cont.df = co2.qfqm.df, attr.df, z1_height, z2_height, z_height) 72 | #save df as csv 73 | write.csv(ae.df, paste0(sitecode, "_", startdate, "_", enddate, "_ae.csv")) -------------------------------------------------------------------------------- /exploratory/flow.AmeriFlux__UstarThresholdR.R: -------------------------------------------------------------------------------- 1 | #install.packages("amerifluxr") 2 | library("amerifluxr") 3 | library(dplyr) 4 | library(stringr) 5 | #if(!require(devtools)){install.packages("devtools")} 6 | #devtools::install_github("chuhousen/amerifluxr") 7 | 8 | 9 | ########################################################### 10 | 11 | #download ameriflux data directly in your folder 12 | site <- amf_site_info() 13 | 14 | neon.sites <- read.csv('/Volumes/MaloneLab/Research/FluxGradient/Ameriflux_NEON field-sites.csv') 15 | 16 | download <- neon.sites %>% filter(check == FALSE) 17 | 18 | # if code does not run for all sites, you can select fewer sites 19 | 20 | amf_download_fluxnet(user_id = "smalone", # add your user id 21 | user_email = "sparkle.malone@yale.edu", # add your email 22 | site_id = download$Site.Id.AF, 23 | data_product = "FLUXNET", 24 | data_policy = "CCBY4.0", 25 | agree_policy = TRUE, 26 | intended_use = "model", 27 | intended_use_text = "GradientFlux calculation at NEON sites", 28 | verbose = TRUE, 29 | out_dir = "/Volumes/MaloneLab/Research/FluxGradient/AmeriFlux") 30 | 31 | ########################################################### 32 | 33 | # Extract information from zipped files: 34 | setwd( '/Volumes/MaloneLab/Research/FluxGradient/AmeriFlux/') 35 | td <- "/Volumes/MaloneLab/Research/FluxGradient/AmeriFlux/Files" 36 | 37 | file_to_unzip <- list.files("/Volumes/MaloneLab/Research/FluxGradient/AmeriFlux", pattern =".zip*", full.names = T) 38 | 39 | for( i in 1:length(file_to_unzip)){ 40 | unzip(file_to_unzip[i], ex = td) 41 | } 42 | 43 | setwd( td) 44 | 45 | AUXNEE.files <- list.files(td, pattern ="AUXNEE", full.names = T) 46 | AUXNEE.file.names <- list.files(td, pattern ="AUXNEE", full.names = F) 47 | 48 | UThreshold <- data.frame() 49 | 50 | for( i in 1:length(AUXNEE.files)){ 51 | print(i) 52 | 53 | Site <- stringr::str_sub( AUXNEE.file.names[i],5,10) # Get the site 54 | 55 | import <- read.csv( AUXNEE.files[i]) 56 | 57 | # Get the mean threshold and add to UThreshold: 58 | ustar <- import %>% filter(PARAMETER == "USTAR_THRESHOLD") %>% 59 | reframe(.by = TIMESTAMP, VALUE = mean(VALUE, na.rm=T)) %>% 60 | mutate(max = max(TIMESTAMP)) %>% filter(TIMESTAMP == max ) 61 | new.data <- data.frame(Site.Id.AF = Site, Threshold=ustar$VALUE) 62 | UThreshold <- rbind( UThreshold , new.data) 63 | 64 | } 65 | 66 | neon.sites$check <- neon.sites$Site.Id.AF %in% UThreshold$Site.Id.AF 67 | 68 | neon.sites <- neon.sites %>% left_join(UThreshold , by= 'Site.Id.AF') 69 | 70 | summary <-neon.sites %>% reframe( .by= Vegetation.Abbreviation..IGBP., Threshold.mean= mean(Threshold , na.rm=T) ) 71 | 72 | mean(summary$Threshold.mean, na.rm=T ) 73 | 74 | neon.sites <- neon.sites %>% left_join(summary, by= 'Vegetation.Abbreviation..IGBP.') %>% 75 | mutate( Threshold.final = case_when(is.na(Threshold) == TRUE ~ mean(summary$Threshold.mean, na.rm=T ), 76 | is.na(Threshold) == FALSE ~ Threshold)) 77 | neon.sites$Threshold.final 78 | 79 | neon.sites$Site_Id.NEON 80 | 81 | #* We used the threshold when present, if ot we used the mean threshod for an IGBP class and resorted to the mean across classes for two locations. 82 | write.csv(neon.sites, "/Volumes/MaloneLab/Research/FluxGradient/UstarNeonSites.csv" ) 83 | -------------------------------------------------------------------------------- /functions/compile.quality.flags.add.cols.fluxes.R: -------------------------------------------------------------------------------- 1 | #' compile.quality.flags.add.cols.fluxes 2 | #' 3 | #' @param list.sites list of sites with computed FG fluxes 4 | #' @param method FG method either MBR, AE, WP 5 | #' 6 | #' @return list of data frames for each site containing additional columns for quality filtering and residuals 7 | #' 8 | #' 9 | #' @author Alexis Helgeson 10 | compile.quality.flags.add.cols.fluxes <- function(list.sites, method){ 11 | #loop over sites 12 | list.sites.quality <- list() 13 | #list.sites.ustar <- list() 14 | for(s in 1:length(list.sites)){ 15 | #select one site, all quality metrics are site specific 16 | site <- list.sites[[s]] 17 | #First step before validation figures can be made is to filter the data for stability conditions and remove extreme values 18 | #Additional filtering for AE and WP methods for top two tower heights 19 | if(method == "AE" | method == "WP"){ 20 | #make TowerHeight numeric 21 | site$TowerHeight_A <- as.numeric(site$TowerHeight_A) 22 | site$TowerHeight_B <- as.numeric(site$TowerHeight_B) 23 | site.upper.height <- sort(unique(site$TowerHeight_A), decreasing = TRUE)[[1]] #tallest height 24 | site.lower.height <- sort(unique(site$TowerHeight_A), decreasing = TRUE)[[2]] #2nd tallest height 25 | #filter to top of tower and next level down 26 | site <- site %>% filter(TowerHeight_A == site.upper.height & TowerHeight_B == site.lower.height) 27 | } 28 | #flag outliers, create new column IQR_flag that flags outliers 29 | site.outlier <- flag.iqr(site = site) 30 | #flag spikes in fluxes, create new columns spike.bin which is the bin assigned for comparison of differences, spike.flag that flags spikes, date, and day_night 31 | site.spike <- flag.flux.spikes(site = site.outlier) 32 | #flag atmospheric stability conditions, create new columns Stability_100 and Stability_500 that indicates neutral, stable, unstable conditions 33 | #only for AE which uses L 34 | if(method == "AE"){ 35 | site.stability <- flag.all.gas.stability(site = site.spike) 36 | site.residuals <- calc.rmse(site = site.stability) 37 | }else{ 38 | #Next calculate RMSE and residuals 39 | site.residuals <- calc.rmse(site = site.spike) 40 | } 41 | #Add in month column for grouping/visualizations 42 | site.residuals$month <- month(site.residuals$timeBgn_A) 43 | #flag ustar -> this function must be called after the month column is added, we need the month column for ustar threshold calculation 44 | #still needs work -> REddy Proc function only works with dataframe where rows are exactly 30 min apart 45 | #Decided to use "plotting" method for determining ustar threshold: selecting for ustar values when -1 >= nighttime NEE <= 1 and take median, grouping data by month, growing/nongrowing, all data 46 | #the ustar_threshold column is a dataframe 47 | site.ustar <- calc.flag.ustar.thres(site = site.residuals) 48 | #list.sites.ustar[[s]] <- site.ustar 49 | #Add in hour column for grouping/visualizations: the timezone will be local for that site and corrected for daylight savings 50 | #TO DO: ADD PROPER TZ CORRECTION CODE FOR GUAN 51 | site.hour <- add.hour.col(site = site.ustar, site.name = unique(site$site)) 52 | 53 | list.sites.quality[[s]] <- site.hour 54 | } 55 | #only includes top two tower levels 56 | names(list.sites.quality) <- names(list.sites) 57 | #names(list.sites.ustar) <- names(list.sites) 58 | 59 | return(list.sites.quality) 60 | } 61 | -------------------------------------------------------------------------------- /deprecated/def.concat_from_h5.R: -------------------------------------------------------------------------------- 1 | def.concat_from_h5 <- function(pathUnzipped,dirHdf5){ 2 | files <- list.files(path=pathUnzipped,pattern='h5') 3 | 4 | numDir <- base::length(dirHdf5) 5 | data <- vector(mode='list',length=numDir) 6 | names(data) <- dirHdf5 7 | data <- lapply(data,FUN=function(l){list()}) 8 | for (file in files){ 9 | # Is the file zipped? 10 | if(grepl(pattern='.gz',file)){ 11 | system(paste0('gzip -d ',fs::path(pathUnzipped,file))) 12 | file <- base::substr(file,1,nchar(file)-3) 13 | } 14 | 15 | # Grab the file structure 16 | listObj <- base::try(rhdf5::h5ls(fs::path(pathUnzipped,file), datasetinfo = FALSE),silent=TRUE) 17 | 18 | if (base::class(listObj) == "try-error"){ 19 | base::stop('Cannot open file. Aborting...') 20 | } 21 | 22 | # Combine path and name 23 | listObjName <- base::paste(listObj$group, listObj$name, sep = "/") # combined path and name 24 | 25 | # Read in the data 26 | for(idxDir in base::seq_len(numDir)){ 27 | dataIdx <- base::try(rhdf5::h5read(file=fs::path(pathUnzipped,file),name=dirHdf5[idxDir]),silent=FALSE) 28 | 29 | # Error-check 30 | if(base::class(dataIdx) == 'try-error'){ 31 | # Close the file 32 | rhdf5::h5closeAll() 33 | 34 | # # Remove downloaded file if selected 35 | # if(Rm){ 36 | # base::unlink(file) 37 | # } 38 | 39 | # Did we want the whole file? 40 | if(dirHdf5[idxDir] == '/'){ 41 | base::stop('File is unreadable. Aborting...') 42 | } else { 43 | base::stop(base::paste0('Could not retrieve ',dirHdf5[idxDir],' from file ',file$name[idxFile],'. Aborting...')) 44 | } 45 | } else if (base::any(base::class(dataIdx) != 'data.frame') && Pack == 'expanded'){ 46 | # Close the file 47 | rhdf5::h5closeAll() 48 | 49 | # Remove downloaded file if selected 50 | if(Rm){ 51 | base::unlink(file) 52 | } 53 | 54 | stop(base::paste0('Cannot return results from the expanded package when dirHdf5 (',dirHdf5[idxDir],') does not end in a dataset.')) 55 | } 56 | 57 | data[[dirHdf5[idxDir]]][[file]] <- dataIdx 58 | 59 | } 60 | 61 | # Close the file 62 | rhdf5::h5closeAll() 63 | 64 | # Remove downloaded file if selected 65 | # if(Rm){ 66 | # base::unlink(file) 67 | # } 68 | } 69 | 70 | # Stack the files 71 | dataStacked <- lapply(data,FUN=function(idxData){do.call(rbind,idxData)}) 72 | 73 | # Extract and populate the site, HOR & VER, and quantity (e.g. rtioMoleDryCh4) within the data frame 74 | for (idxDf in seq_len(length(dataStacked))){ 75 | pathSplt <- strsplit(dirHdf5[idxDf],'/')[[1]] 76 | site <- pathSplt[2] 77 | hor_ver_tmi <- pathSplt[6] 78 | var <- pathSplt[7] 79 | HVTSplt <- strsplit(hor_ver_tmi,'_')[[1]] 80 | ver <- HVTSplt[2] 81 | tmi <- HVTSplt[3] 82 | 83 | df <- dataStacked[[idxDf]] 84 | df[['site']] <- site 85 | df[['var']] <- var 86 | df[['ver']] <- ver 87 | df[['tmi']] <- tmi 88 | 89 | #Reassign 90 | dataStacked[[idxDf]] <- df 91 | } 92 | 93 | # STACK THEM ALL 94 | dataAll <- do.call('rbind',dataStacked) 95 | 96 | # Convert the timestamps 97 | dataAll$timeBgn <- strptime(dataAll$timeBgn,format='%Y-%m-%dT%H:%M:%OSZ',tz='GMT') 98 | dataAll$timeEnd <- strptime(dataAll$timeEnd,format='%Y-%m-%dT%H:%M:%OSZ',tz='GMT') 99 | return(dataAll) 100 | } -------------------------------------------------------------------------------- /workflows/flow.calc.flag.mbr.batch.R: -------------------------------------------------------------------------------- 1 | source(file.path("functions", "calc.mbr.R")) 2 | 3 | # Calculate MBR flux combos 9 min (CO2 with H2O trace, CH4 with H2O trace, etc) 4 | MBRflux_align = calc.mbr(min9 = min9Diff.list, 5 | bootstrap = 1, 6 | nsamp = 1000) 7 | 8 | # Calculate MBR flux combos 30 min (e.g. CO2 with H2O tracer ...) 9 | #MBRflux_align_30min = calc.mbr(min9=min30Diff.list, bootstrap=1, 10 | # nsamp=1000) 11 | 12 | # # FC with H2O as tracer 13 | # data <- MBRflux_align[c("FC_turb_interp_CO2","FCO2_MBR_H2Otrace_mean")] 14 | # dataComp <- data[complete.cases(data),] 15 | # RFCO2 <- cor.test(data$FC_turb_interp_CO2,data$FCO2_MBR_H2Otrace_mean) 16 | # print(paste0('RFCO2 R-squared = ',round(RFCO2$estimate^2,2)*100,' %')) 17 | 18 | # ggplot(data=dplyr::filter(MBRflux_align, dConc_H2O_bin==0)) + 19 | # geom_point(aes(x=FC_turb_interp_CO2, y=FCO2_MBR_H2Otrace_mean)) + 20 | # geom_abline(aes(intercept=0,slope=1),lty=2) + 21 | # ylim(c(-15,15)) + 22 | # xlim(c(-15,15)) + 23 | # labs(title=paste0(site, ' MBR method (levels 4-3); R-squared = ',round(RFCO2$estimate^2,2)*100,'%')) + 24 | # theme_minimal() 25 | # 26 | # ggplot(data=dplyr::filter(MBRflux_align, dConc_CO2_bin==0)) + 27 | # geom_point(aes(x=FH2O_interp_H2O, y=FH2O_MBR_CO2trace_mean)) + 28 | # geom_abline(aes(intercept=0,slope=1),lty=2) + 29 | # ylim(c(-1,5)) + 30 | # xlim(c(-1,5)) + 31 | # labs(title = site) + 32 | # theme_minimal() 33 | # 34 | # ggplot(data=dplyr::filter(MBRflux_align, dConc_CO2_bin==0)) + 35 | # geom_point(aes(x=FCH4_turb_interp_CH4, y=FCH4_MBR_H2Otrace_mean)) + 36 | # geom_abline(aes(intercept=0,slope=1),lty=2) + 37 | # ylim(c(-50,50)) + 38 | # xlim(c(-50,50)) + 39 | # labs(title=site) + 40 | # theme_minimal() 41 | 42 | # #data <- dplyr::filter(MBRflux_align, dLevelsAminusB_CH4=="4_1")[c("FCH4_turb_interp_CH4","FCH4_MBR_CO2trace_mean")] 43 | # data <- MBRflux_align[c("FCH4_turb_interp_CH4","FCH4_MBR_CO2trace_mean")] 44 | # dataComp <- data[complete.cases(data),] 45 | # RFCH4 <- cor.test(data$FCH4_turb_interp_CH4,data$FCH4_MBR_CO2trace_mean) 46 | # print(paste0('FCH4 R-squared = ',round(RFCH4$estimate^2,2)*100,' %')) 47 | 48 | # ggplot(data=dplyr::filter(MBRflux_align, dConc_CO2_bin==0)) + 49 | # geom_point(aes(x=FCH4_turb_interp_CH4, y=FCH4_MBR_CO2trace_mean)) + 50 | # geom_abline(aes(intercept=0,slope=1),lty=2) + 51 | # ylim(c(-100,100)) + 52 | # xlim(c(-100,100)) + 53 | # labs(title=paste0(site, ' MBR method (levels 4-3); R-squared = ',round(RFCH4$estimate^2,2)*100,'%')) + 54 | # theme_minimal() 55 | 56 | # -------- Save and zip the file to the temp directory. Upload to google drive. ------- 57 | setwd(dirTmp) 58 | fileSave <- fs::path(dirTmp, paste0(site, '_MBR_9min.RData')) 59 | fileZip <- fs::path(dirTmp, paste0(site, '_MBR_9min.zip')) 60 | save(MBRflux_align, file = fileSave) 61 | wdPrev <- getwd() 62 | utils::zip(zipfile = fileZip, files = paste0(site, '_MBR_9min.RData')) 63 | setwd(wdPrev) 64 | googledrive::drive_upload(media = fileZip, 65 | overwrite = T, 66 | path = data_folder$id[data_folder$name==site]) 67 | 68 | #fileSave <- fs::path(dirTmp,paste0(site,'_MBR_30min.RData')) 69 | #fileZip <- fs::path(dirTmp,paste0(site,'_MBR_30min.zip')) 70 | #save(MBRflux_align_30min,file=fileSave) 71 | #wdPrev <- getwd() 72 | #setwd(dirTmp) 73 | #utils::zip(zipfile=fileZip,files=paste0(site,'_MBR_30min.RData')) 74 | #setwd(wdPrev) 75 | #googledrive::drive_upload(media = fileZip, overwrite = T, 76 | # path = data_folder$id[data_folder$name==site]) # path might need work 77 | -------------------------------------------------------------------------------- /workflows/flow.non.neon.attribute.tables.R: -------------------------------------------------------------------------------- 1 | ## ------------------------------------------------- ## 2 | # Make Non-NEON Attribute Tables 3 | ## ------------------------------------------------- ## 4 | # Script author(s): Nick Lyon, Kyle Delwiche 5 | 6 | # Purpose: 7 | ## Make attribute tables for non-NEON sites that are consistent with those of NEON sites 8 | 9 | ## ---------------------------- ## 10 | # Housekeeping ---- 11 | ## ---------------------------- ## 12 | 13 | # Load libraries 14 | # install.packages("librarian") 15 | librarian::shelf(tidyverse, googledrive, readxl) 16 | 17 | # Authorize Google Drive 18 | googledrive::drive_auth() 19 | ## You'll need to select a pre-authorized email via the Console 20 | 21 | # Make sure a 'data' folder exists locally 22 | dir.create(path = file.path("data"), showWarnings = F) 23 | 24 | # Clear environment 25 | rm(list = ls()) 26 | 27 | ## ---------------------------- ## 28 | # Wrangling ---- 29 | ## ---------------------------- ## 30 | 31 | ## Done elsewhere (talk to Kyle) 32 | 33 | ## ---------------------------- ## 34 | # CSV to RData ---- 35 | ## ---------------------------- ## 36 | 37 | # Identify all Drive URLs with attributes files 38 | attr_urls <- c( 39 | "https://drive.google.com/drive/u/0/folders/1MznM0IT_MYNkFQihpeI0o1JtHFXIFLGV", # Fl-Hyy 40 | "https://drive.google.com/drive/u/0/folders/1MzyDvXudL-A3ZGlzukbhil19fsx3s7Mk", # SE-Deg 41 | "https://drive.google.com/drive/u/0/folders/1F1qZkAZywNUq_fyS1OmlG3C9AkGo6fdc", # SE-Sto 42 | "https://drive.google.com/drive/u/0/folders/1qPrBaZxX7XBBKq77eEmVXALSoDmUB2_I", # SE-Svb 43 | "https://drive.google.com/drive/u/0/folders/1AOct-UbwpzkuLMT9EnEspRX_QnX07T4G" # US-Uaf 44 | ) 45 | 46 | # Loop across these folders 47 | for(focal_url in attr_urls){ 48 | 49 | # Identify Drive folder 50 | drive_url <- googledrive::as_id(focal_url) 51 | 52 | # Identify attributes table CSV 53 | attr_csv <- googledrive::drive_ls(path = drive_url) %>% 54 | dplyr::filter(stringr::str_detect(string = name, pattern = "_attr.csv")) 55 | 56 | # Skip if there isn't an attributes file (or if there's more than 1) 57 | if(nrow(attr_csv) != 1){ 58 | message("More/fewer than 1 attribute file found. This script may not be appropriate") 59 | 60 | # Otherwise, do the workflow 61 | } else { 62 | 63 | # Processing message 64 | message("Processing ", attr_csv$name, " into equivalent RData and ZIP files") 65 | 66 | # Download from Google Drive into 'data/' folder 67 | purrr::walk2(.x = attr_csv$id, .y = attr_csv$name, 68 | .f = ~ googledrive::drive_download(file = .x, overwrite = T, 69 | path = file.path("data", .y))) 70 | 71 | # Read in that CSV 72 | attr.df <- read.csv(file = file.path("data", attr_csv$name)) 73 | 74 | # Pare down the CSV file name a bit 75 | file_slug <- gsub(pattern = "_attr.csv", replacement = "", x = attr_csv$name) 76 | 77 | # Save the table as an RData object 78 | save(attr.df, file = file.path("data", paste0(file_slug, "_attr.RData"))) 79 | 80 | # Zip it too 81 | zip(zipfile = file.path("data", paste0(file_slug, "_attr.zip")), 82 | files = file.path("data", paste0(file_slug, "_attr.RData"))) 83 | 84 | # Upload both back to the same Drive folder the CSV came from 85 | ## RData 86 | googledrive::drive_upload(media = file.path("data", paste0(file_slug, "_attr.RData")), 87 | path = drive_url, overwrite = T) 88 | ## Zip 89 | googledrive::drive_upload(media = file.path("data", paste0(file_slug, "_attr.zip")), 90 | path = drive_url, overwrite = T) 91 | 92 | } # Close `else` conditional 93 | } # Close loop 94 | 95 | # End ---- 96 | -------------------------------------------------------------------------------- /deprecated/flow.evaluation.R: -------------------------------------------------------------------------------- 1 | # flow.evaluation: Makes the dataframes needed for gradient flux evaluation 2 | 3 | rm(list=ls()) 4 | 5 | library(tidyverse) 6 | library(ggplot2) 7 | library(ggpubr) 8 | 9 | localdir <- '/Volumes/MaloneLab/Research/FluxGradient/FluxData' 10 | drive_url <- googledrive::as_id("https://drive.google.com/drive/folders/1Q99CT77DnqMl2mrUtuikcY47BFpckKw3") 11 | 12 | 13 | setwd(localdir) 14 | 15 | load( "SITES_WP_9min.Rdata") 16 | load( "SITES_AE_9min.Rdata") 17 | load( "SITES_MBR_9min.Rdata") 18 | 19 | # Subset list to only include sites of interest: 20 | sites <- c("KONZ", "HARV", "JORN", "GUAN") 21 | 22 | SITES_MBR_9min <- SITES_MBR_9min[ sites] 23 | SITES_AE_9min <- SITES_AE_9min[ sites] 24 | SITES_WP_9min <- SITES_WP_9min[ sites] 25 | 26 | # Application of Filter Functions: #### 27 | source('/Users/sm3466/YSE Dropbox/Sparkle Malone/Research/FluxGradient/lterwg-flux-gradient/exploratory/flow.evaluation.filter.R') 28 | 29 | save( SITES_WP_9min_FILTER,SITES_AE_9min_FILTER, SITES_MBR_9min_FILTER , 30 | file="/Volumes/MaloneLab/Research/FluxGradient/FilteredData_MS1Sites.Rdata") 31 | 32 | fileSave <- file.path("/Volumes/MaloneLab/Research/FluxGradient/FilteredData_MS1Sites.Rdata") 33 | googledrive::drive_upload(media = fileSave, overwrite = T, path = drive_url) 34 | 35 | save( SITES_WP_9min.report,SITES_AE_9min.report, SITES_MBR_9min.report , 36 | file="/Volumes/MaloneLab/Research/FluxGradient/FilterReport_MS1Sites.Rdata") 37 | 38 | fileSave <- file.path("/Volumes/MaloneLab/Research/FluxGradient/FilterReport_MS1Sites.Rdata") 39 | googledrive::drive_upload(media = fileSave, overwrite = T, path = drive_url) 40 | 41 | 42 | # Application of the One2One Analysis #### 43 | 44 | source('/Users/sm3466/YSE Dropbox/Sparkle Malone/Research/FluxGradient/lterwg-flux-gradient/exploratory/flow.evaluation.One2One.R') 45 | 46 | save( SITES_One2One, 47 | file="/Volumes/MaloneLab/Research/FluxGradient/One2One_MS1Sites.Rdata") 48 | 49 | fileSave <- file.path("/Volumes/MaloneLab/Research/FluxGradient/One2One_MS1Sites.Rdata") 50 | googledrive::drive_upload(media = fileSave, overwrite = T, path = drive_url) 51 | 52 | save( SITES_WP_9min_FILTER_BH,SITES_AE_9min_FILTER_BH, SITES_MBR_9min_FILTER_BH , 53 | file="/Volumes/MaloneLab/Research/FluxGradient/FilteredData_MS1Sites_BH.Rdata") 54 | 55 | fileSave <- file.path("/Volumes/MaloneLab/Research/FluxGradient/FilteredData_MS1Sites_BH.Rdata") 56 | googledrive::drive_upload(media = fileSave, overwrite = T, path = drive_url) 57 | 58 | # Fit Diurnal for that month: 59 | 60 | source('/Users/sm3466/YSE Dropbox/Sparkle Malone/Research/FluxGradient/lterwg-flux-gradient/exploratory/flow.evaluation.diurnal.R') 61 | 62 | save( diurnal.summary.H2O ,diurnal.summary.CO2, 63 | file="/Volumes/MaloneLab/Research/FluxGradient/DiurnalSummary_MS1Sites_BH.Rdata") 64 | 65 | fileSave <- file.path("/Volumes/MaloneLab/Research/FluxGradient/DiurnalSummary_MS1Sites_BH.Rdata") 66 | googledrive::drive_upload(media = fileSave, overwrite = T, path = drive_url) 67 | 68 | # Carbon Exchange PARMS: #### 69 | 70 | source('/Users/sm3466/YSE Dropbox/Sparkle Malone/Research/FluxGradient/lterwg-flux-gradient/exploratory/flow.evaluation.cparms.R') 71 | 72 | save( SITES_MBR_9min_CPARMS_FG , 73 | SITES_MBR_9min_CPARMS_EC , 74 | SITES_AE_9min_CPARMS_FG, 75 | SITES_AE_9min_CPARMS_EC, 76 | SITES_WP_9min_CPARMS_EC, 77 | SITES_WP_9min_CPARMS_FG , 78 | MBR.CPARMS, 79 | AE.CPARMS , 80 | WP.CPARMS, 81 | file= '/Volumes/MaloneLab/Research/FluxGradient/CarbonParms_MS1Sites.Rdata') 82 | 83 | fileSave <- file.path('/Volumes/MaloneLab/Research/FluxGradient/CarbonParms_MS1Sites.Rdata') 84 | googledrive::drive_upload(media = fileSave, overwrite = T, path = drive_url) 85 | 86 | message("Next run flow.evaluation.figures_MS1.R ") 87 | -------------------------------------------------------------------------------- /workflows/flow.download.aligned.conc.flux.R: -------------------------------------------------------------------------------- 1 | ## --------------------------------------------- ## 2 | # Housekeeping ----- 3 | ## --------------------------------------------- ## 4 | # Purpose: 5 | # Downloads aligned concentration data and site attribute data from Google Drive 6 | 7 | # Load packages 8 | library(tidyverse) 9 | 10 | # Has a list of all the sites 11 | metadata <- read.csv('/Volumes/MaloneLab/Research/FluxGradient/Ameriflux_NEON field-sites.csv') 12 | 13 | # Get unique sites 14 | site.list <- metadata$Site_Id.NEON %>% unique() 15 | 16 | # Flux Data Download: 17 | # Local Directory: 18 | localdir1 <- '/Volumes/MaloneLab/Research/FluxGradient/FluxData' # MaloneLab Server 19 | 20 | # Attribute Data Download 21 | # Local Directory: 22 | localdir2 <- '/Volumes/MaloneLab/Research/FluxGradient/Attributes' # MaloneLab Server 23 | 24 | ## --------------------------------------------- ## 25 | # Authenticate ----- 26 | ## --------------------------------------------- ## 27 | 28 | # Authenticate with Google Drive 29 | drive_url <- googledrive::as_id("https://drive.google.com/drive/folders/1Q99CT77DnqMl2mrUtuikcY47BFpckKw3") 30 | 31 | # Data on google drive 32 | data_folder <- googledrive::drive_ls(path = drive_url) 33 | 34 | ## --------------------------------------------- ## 35 | # Download Aligned Concentration ----- 36 | ## --------------------------------------------- ## 37 | 38 | for(site in site.list){ 39 | 40 | print(paste("Downloading aligned concentration data from", site, sep = " ") ) 41 | 42 | # Download data 43 | dirTmp <- fs::path(localdir1, site) 44 | dir.create(dirTmp) 45 | 46 | site_folder <- googledrive::drive_ls(path = data_folder$id[data_folder$name==site]) 47 | 48 | # Uncomment the next line and comment the following line if you want all the files 49 | fileDnld <- site_folder$name 50 | fileDnld <- c(paste0(site, '_aligned_conc_flux_9min.zip'), 51 | paste0(site, '_aligned_conc_flux_30min.zip')) 52 | 53 | message(paste0('Downloading aligned concentration & flux data for ', site)) 54 | 55 | for(focal_file in fileDnld){ 56 | 57 | # Find the file identifier for that file 58 | file_id <- subset(site_folder, name == focal_file) 59 | 60 | # Download that file 61 | pathDnld <- fs::path(dirTmp, focal_file) 62 | googledrive::drive_download(file = file_id$id, 63 | path = pathDnld, 64 | overwrite = T) 65 | # Unzip 66 | if(grepl(pattern = '.zip', focal_file)){ 67 | utils::unzip(pathDnld, exdir = dirTmp) 68 | } 69 | } 70 | } 71 | 72 | ## --------------------------------------------- ## 73 | # Download Attributes ----- 74 | ## --------------------------------------------- ## 75 | 76 | for(site in site.list){ 77 | 78 | print(paste("Downloading attributes for", site, sep = " ") ) 79 | 80 | # Download data 81 | dirTmp <- localdir2 82 | 83 | site_folder <- googledrive::drive_ls(path = data_folder$id[data_folder$name==site]) 84 | 85 | # Uncomment the next line and comment the following line if you want all the files 86 | fileDnld <- site_folder$name 87 | fileDnld <- c(paste0(site, '_attr.zip')) 88 | 89 | # Find the file identifier for that file 90 | file_id <- subset(site_folder, name == fileDnld) 91 | 92 | # Download that file 93 | pathDnld <- fs::path(dirTmp, fileDnld) 94 | googledrive::drive_download(file = file_id$id, 95 | path = pathDnld, 96 | overwrite = T) 97 | # Unzip 98 | if(grepl(pattern = '.zip', fileDnld)){ 99 | utils::unzip(pathDnld, exdir = dirTmp) 100 | } 101 | } 102 | 103 | message('Next run the flow.calc.flux.batch.R') -------------------------------------------------------------------------------- /exploratory/aggregate_data_SE-Deg.R: -------------------------------------------------------------------------------- 1 | # install.packages("librarian") 2 | # librarian::shelf(data.table) 3 | library(data.table) 4 | library(dplyr) 5 | library(tictoc) 6 | # Load data more efficiently 7 | file_path <- "/global/scratch/users/kdelwiche/Flux_Gradient/concentration_2020_aa.csv" 8 | 9 | # Clear environment 10 | rm(list = ls()) 11 | Sys.setenv(tz="UTC") 12 | 13 | base.path = "/global/scratch/users/kdelwiche/Flux_Gradient/" 14 | filename1 = paste0(base.path,"concentration_2020_aa.csv") 15 | 16 | ### Read in csv file 17 | ### Terminal command to split the files up 18 | ### split -l 345600 -d concentration_2021.csv concentration_2021_ 19 | #data1.raw = read.csv("/Users/rcommane/Data_LTER/FluxGradient/data/SE-Deg_concentration_2020_first1000rows.csv",sep=",",header=T) 20 | file.1 = paste0(base.path,"concentration_2020_aa.csv") 21 | data1.raw <- fread(file.1,sep=",",header=T) 22 | ###fread(filename1, sep=",", header=TRUE)[-1, ] 23 | 24 | ### read in individual files 25 | file.list1 = list.files(path=base.path,pattern="concentration_2020_",full.names = T) 26 | 27 | ### Read in first file on list 28 | pb <- txtProgressBar(min = 1, max = length(file.list1), style = 3) 29 | 30 | for (j in 1:length(file.list1)){ 31 | #length(file.list1)){ 32 | tic() 33 | print(j) #for (i in 1:length(file.list1)){ 34 | 35 | #j=2 36 | data.rawA = fread(file.list1[j],sep=",",header=F,skip=2) 37 | colnames(data.rawA) = colnames(data1.raw) 38 | 39 | data2 <- data.rawA %>% 40 | mutate( 41 | DateTime = as.POSIXct(data.rawA$TIMESTAMP, format="%Y-%m-%d %H:%M:%S", tz="UTC"), 42 | Date = as.Date(DateTime)) 43 | 44 | # Convert all possible numeric columns 45 | data1 <- as.data.frame(data2 %>% 46 | mutate(across(where(is.character), ~ as.numeric(.))),) 47 | 48 | # Identify transition points for LEVEL changes 49 | end_time <- data1$DateTime[which(diff(data1$LEVEL) != 0)] 50 | time.avg.interval = 30 51 | #head(end_time) 52 | 53 | # Compute statistics efficiently 54 | print("mean_sum-ing") 55 | mean_sum <- lapply(end_time, function(t) { 56 | subset_data <- data1 %>% 57 | filter(DateTime > (t - time.avg.interval) & DateTime < t) 58 | 59 | if (nrow(subset_data) > 0) { 60 | subset_data %>% 61 | summarise( 62 | Date = as.POSIXct(mean(as.numeric(DateTime), na.rm=TRUE),origin="1970-01-01",tz="UTC"), 63 | Start_Time = format(as.POSIXct(min(as.numeric(DateTime), na.rm=TRUE), 64 | origin="1970-01-01",tz="UTC"), "%H:%M:%S"), 65 | End_Time = format(as.POSIXct(max(as.numeric(DateTime), na.rm=TRUE), 66 | origin="1970-01-01",tz="UTC"), "%H:%M:%S"), 67 | LEVEL = mean(LEVEL, na.rm=TRUE), 68 | CO2.mean = mean(CO2, na.rm=TRUE), 69 | CH4.mean = mean(CH4, na.rm=TRUE), 70 | H2O.mean = mean(H2O, na.rm=TRUE), 71 | CO2.sd = sd(CO2, na.rm=TRUE), 72 | CH4.sd = sd(CH4, na.rm=TRUE), 73 | H2O.sd = sd(H2O, na.rm=TRUE), 74 | CO2.n = sum(!is.na(CO2)), 75 | CH4.n = sum(!is.na(CH4)), 76 | H2O.n = sum(!is.na(H2O)) 77 | ) 78 | } 79 | }) %>% 80 | bind_rows() # Combine results into a data frame 81 | 82 | print("saving out data files") 83 | if (j < 10){use.num = sprintf("%02d", j)}else{use.num=j} 84 | file.out1 = paste0(base.path,"data_1min/conc_2020_",use.num,"_1min.csv") 85 | write.table(mean_sum,file=file.out1,sep = ",",row.names = F) 86 | 87 | #mean_sum_all = rbind(mean_sum_all,mean_sum) 88 | ### %>% bind_rows() # Combine results into a data frame 89 | #setTxtProgressBar(pb, j) 90 | rm(list=c("data.rawA","data1","data2")) 91 | toc() 92 | } 93 | close(pb) 94 | #file.out1 = paste0("/Users/rcommane/Data_LTER/FluxGradient/data/conc_2021_1min_all.csv") 95 | #write.table(mean_sum_all,file=file.out1,sep = ",",row.names = F) 96 | -------------------------------------------------------------------------------- /exploratory/AddStabilityCols.R: -------------------------------------------------------------------------------- 1 | load(file.path("data", "Validation", paste0("SITES_WP_val.Rdata"))) 2 | all.sites.wp <- bind_rows(SITES_WP_validation) 3 | load(file.path("data", "Validation", paste0("SITES_AE_val.Rdata"))) 4 | all.sites.ae <- bind_rows(SITES_AE_validation) 5 | #ADD STABILITY COLUMNS TO WP AND MBR 6 | #select just site, gas, timeMid, and stability columns 7 | stability.df <- all.sites.ae %>% select(site, gas, timeMid, Stability_100, Stability_500) 8 | #METHOD WP 9 | #add columns 10 | all.sites.wp <- all.sites.wp %>% left_join(stability.df, by = c("site", "gas", "timeMid")) 11 | 12 | #METHOD MBR 13 | #grab CO2 cols for mbr 14 | co2.cols <- grep("_CO2", names(all.sites.mbr), value = T) 15 | #select for only CO2 cols for mbr 16 | mbr.co2 <- all.sites.mbr[,c(co2.cols, "site")] 17 | #filter to gas = CO2 for stability columns 18 | stability.co2.df <- stability.df %>% filter(gas == "CO2") 19 | #remove gas column 20 | stability.co2.df$gas <- NULL 21 | #rename cols to match mbr convention 22 | names(stability.co2.df)[which(names(stability.co2.df) == "timeMid")] <- "timeMid_CO2" 23 | names(stability.co2.df)[which(names(stability.co2.df) == "Stability_500")] <- "Stability_500_CO2" 24 | names(stability.co2.df)[which(names(stability.co2.df) == "Stability_100")] <- "Stability_100_CO2" 25 | #add stability cols 26 | mbr.co2 <- mbr.co2 %>% left_join(stability.co2.df, by = c("site", "timeMid_CO2")) 27 | 28 | #grab H2O cols for mbr 29 | h2o.cols <- grep("_H2O", names(all.sites.mbr), value = T) 30 | #select for only CO2 cols for mbr 31 | mbr.h2o <- all.sites.mbr[,c(h2o.cols, "site")] 32 | #filter to gas = CO2 for stability columns 33 | stability.h2o.df <- stability.df %>% filter(gas == "H2O") 34 | #remove gas column 35 | stability.h2o.df$gas <- NULL 36 | #rename cols to match mbr convention 37 | names(stability.h2o.df)[which(names(stability.h2o.df) == "timeMid")] <- "timeMid_H2O" 38 | names(stability.h2o.df)[which(names(stability.h2o.df) == "Stability_500")] <- "Stability_500_H2O" 39 | names(stability.h2o.df)[which(names(stability.h2o.df) == "Stability_100")] <- "Stability_100_H2O" 40 | #add stability cols 41 | mbr.h2o <- mbr.h2o %>% left_join(stability.h2o.df, by = c("site", "timeMid_H2O")) 42 | #remove site col (otherwise there will be duplicates when we combine) 43 | mbr.h2o$site <- NULL 44 | 45 | #grab CH4 cols for mbr 46 | ch4.cols <- grep("_CH4", names(all.sites.mbr), value = T) 47 | #select for only CO2 cols for mbr 48 | mbr.ch4 <- all.sites.mbr[,c(ch4.cols, "site")] 49 | #filter to gas = CO2 for stability columns 50 | stability.ch4.df <- stability.df %>% filter(gas == "CH4") 51 | #remove gas column 52 | stability.ch4.df$gas <- NULL 53 | #rename cols to match mbr convention 54 | names(stability.ch4.df)[which(names(stability.ch4.df) == "timeMid")] <- "timeMid_CH4" 55 | names(stability.ch4.df)[which(names(stability.ch4.df) == "Stability_500")] <- "Stability_500_CH4" 56 | names(stability.ch4.df)[which(names(stability.ch4.df) == "Stability_100")] <- "Stability_100_CH4" 57 | #add stability cols 58 | mbr.ch4 <- mbr.ch4 %>% left_join(stability.ch4.df, by = c("site", "timeMid_CH4")) 59 | #remove site col (otherwise there will be duplicates when we combine) 60 | mbr.ch4$site <- NULL 61 | 62 | #combine all data frames 63 | all.sites.mbr <- cbind(mbr.co2, mbr.h2o, mbr.ch4) 64 | 65 | #save as .Rdata objects 66 | save(all.sites.wp, file = file.path("data", "Validation", "SITES_WP_Stability.Rdata")) 67 | save(all.sites.mbr, file = file.path("data", "Validation", "SITES_MBR_Stability.Rdata")) 68 | 69 | #upload to gdrive 70 | # Pull data from google drive 71 | email <- 'alexisrose0525@gmail.com' 72 | #copy this browser url from the site folder on the shared G drive (located at https://drive.google.com/drive/folders/1Q99CT77DnqMl2mrUtuikcY47BFpckKw3) you wish to upload your zip files to 73 | #this url should point to the NEONSITES_Validation folder 74 | drive_url <- googledrive::as_id("https://drive.google.com/drive/folders/14Ga9sLRMlQVvorZdHBiYxCbUybiGwPNp") 75 | 76 | googledrive::drive_upload(media = paste0("data/Validation/SITES_WP_Stability.Rdata"), overwrite = T, path = drive_url) 77 | googledrive::drive_upload(media = paste0("data/Validation/SITES_MBR_Stability.Rdata"), overwrite = T, path = drive_url) 78 | 79 | 80 | -------------------------------------------------------------------------------- /functions/calc.eddydiff.windprof.R: -------------------------------------------------------------------------------- 1 | #' calc.eddydiff.windprof.R 2 | #' 3 | #' @param sitecode NEON site code 4 | #' @param min9 9min interpolated data file for given site 5 | #' 6 | #' @author Alexis Helgeson, Samuel Jurado, Roisin Commane, and Camilo Rey-Sanchez 7 | #' 8 | #' @return list of gas concentration dataframes containing variables associated with wind profile eddy diffusivity calculation 9 | #' 10 | calc.eddydiff.windprof <- function(sitecode, min9){ 11 | 12 | #currently hard coded to calculate for all gas concentrations 13 | #grab H2O 14 | H2O <- min9[[which(names(min9) == "H2O")]] 15 | #remove NAs from data columns used in calculation for WP this includes: ubar1:n and roughLength_interp 16 | #select for data columns -> remember there are as many ubar cols as there are TowerPositions for a given site 17 | data.cols <- c("roughLength_interp", grep("ubar", names(H2O), value = TRUE)) 18 | #remove NAs 19 | #H2O <- H2O[complete.cases(H2O[,data.cols]),] 20 | #calculate obukhov length and stability parameters 21 | H2O <- calc.stability.correction(gas = H2O) 22 | #calculate eddy diffusivty using WP 23 | #assuming von karman constant is 0.4 24 | k = 0.4 25 | #why are we using geometric mean instead of regular mean? 26 | H2O$GeometricMean_AB <- sqrt(as.numeric(H2O$TowerHeight_A)*as.numeric(H2O$TowerHeight_B)) 27 | 28 | #create column for store wind profile eddy diffusivity 29 | H2O$EddyDiff <- "hold" 30 | #TO DO: REFORMAT ubar COLUMNS SO THAT WE CAN SELECT FOR CORRECT ubar USING TowerPosition 31 | for(j in 1:dim(H2O)[1]){ 32 | c.name <- paste0("ubar", as.character(H2O[j,"TowerPosition_A"])) 33 | ubar = as.numeric(H2O[j,grep(c.name, names(H2O))]) 34 | z = as.numeric(H2O[j,"TowerHeight_A"]) 35 | 36 | #H2O[j,"EddyDiff"] <- ((k^2)*ubar*as.numeric(H2O[j,"GeometricMean_AB"])/(log(z/as.numeric(H2O[j,"roughLength_interp"]))*H2O[j,"phih"])) 37 | 38 | H2O[j,"EddyDiff"] <- ((k^2)*ubar*as.numeric(H2O[j,"GeometricMean_AB"])/(log(z/as.numeric(H2O[j,"roughLength_interp"])))) 39 | 40 | } 41 | #set EddyDiff as numeric 42 | H2O$EddyDiff <- as.numeric(H2O$EddyDiff) 43 | #grab CO2 44 | CO2 <- min9[[which(names(min9) == "CO2")]] 45 | #remove NAs 46 | #CO2 <- CO2[complete.cases(CO2[,data.cols]),] 47 | #calculate obukhov length and stability columns 48 | CO2 <- calc.stability.correction(gas = CO2) 49 | #calculate eddy diffusivty using WP 50 | #assuming von karman constant is 0.4 51 | k = 0.4 52 | #why are we using geometric mean instead of regular mean? 53 | CO2$GeometricMean_AB <- sqrt(as.numeric(CO2$TowerHeight_A)*as.numeric(CO2$TowerHeight_B)) 54 | 55 | #create column for store wind profile eddy diffusivity 56 | CO2$EddyDiff <- "hold" 57 | for(j in 1:dim(CO2)[1]){ 58 | c.name <- paste0("ubar", as.character(CO2[j,"TowerPosition_A"])) 59 | ubar = as.numeric(CO2[j,grep(c.name, names(CO2))]) 60 | z = as.numeric(CO2[j,"TowerHeight_A"]) 61 | 62 | CO2[j,"EddyDiff"] <- ((k^2)*ubar*as.numeric(CO2[j,"GeometricMean_AB"])/(log(z/as.numeric(CO2[j,"roughLength_interp"]))*CO2[j,"phih"])) 63 | } 64 | #set EddyDiff as numeric 65 | CO2$EddyDiff <- as.numeric(CO2$EddyDiff) 66 | #grab CH4 67 | CH4 <- min9[[which(names(min9) == "CH4")]] 68 | #remove NAs 69 | #CH4 <- CH4[complete.cases(CH4[,data.cols]),] 70 | #calculate obukhov length and stability parameter 71 | CH4 <- calc.stability.correction(gas = CH4) 72 | #calculate eddy diffusivty using WP 73 | #assuming von karman constant is 0.4 74 | k = 0.4 75 | #why are we using geometric mean instead of regular mean? 76 | CH4$GeometricMean_AB <- sqrt(as.numeric(CH4$TowerHeight_A)*as.numeric(CH4$TowerHeight_B)) 77 | 78 | #create column for store wind profile eddy diffusivity 79 | CH4$EddyDiff <- "hold" 80 | for(j in 1:dim(CH4)[1]){ 81 | c.name <- paste0("ubar", as.character(CH4[j,"TowerPosition_A"])) 82 | ubar = as.numeric(CH4[j,grep(c.name, names(CH4))]) 83 | z = as.numeric(CH4[j,"TowerHeight_A"]) 84 | 85 | CH4[j,"EddyDiff"] <- ((k^2)*ubar*as.numeric(CH4[j,"GeometricMean_AB"])/(log(z/as.numeric(CH4[j,"roughLength_interp"]))*CH4[j,"phih"])) 86 | } 87 | #set EddyDiff as numeric 88 | CH4$EddyDiff <- as.numeric(CH4$EddyDiff) 89 | #add to list 90 | min9.K.WP.list <- list(H2O = H2O, CO2 = CO2, CH4 = CH4) 91 | return(min9.K.WP.list) 92 | } -------------------------------------------------------------------------------- /deprecated/Flux_Gradient_MBR.R: -------------------------------------------------------------------------------- 1 | #' Flux_Gradient_MBR 2 | #' 3 | #' @param cont.df df containing site co2, h2o, ch4 measurements at various heights 4 | #' @param z1_height lower tower height (taken from attr.df$DistZaxsLvlMeasTow) 5 | #' @param z2_height upper tower height (taken from attr.df$DistZaxsLvlMeasTow) 6 | #' @param attr.df df containing site measurment heights 7 | #' 8 | #' @return df with additional columns for MBR calculated ch4, co2, h2o fluxes 9 | #' 10 | #' @author Alexis Helgeson, Sam Jurado, David Reed, and Sparkle Malone 11 | Flux_Gradient_MBR <- function(cont.df, attr.df, z1_height, z2_height){ 12 | 13 | #set heights for grabbing cont 14 | z1 <- as.numeric(z1_height) 15 | z2 <- as.numeric(z2_height) 16 | #set col names for grabbing concentrations 17 | site_max_height <- which(attr.df$DistZaxsLvlMeasTow == z2) 18 | site_min_height <- which(attr.df$DistZaxsLvlMeasTow == z1) 19 | #cont.df has measurement height as part of column name, so we need to set the correct col name to grab co2/h2o/ch4 measurements 20 | co2_max_col <- paste("co2.000_0",site_max_height,"0_30m",sep="") 21 | ch4_max_col <- paste("ch4.000_0",site_max_height,"0_30m",sep="") 22 | h2o_max_col <- paste("h2o.000_0",site_max_height,"0_30m",sep="") 23 | co2_min_col <- paste("co2.000_0",site_min_height,"0_30m",sep="") 24 | ch4_min_col <- paste("ch4.000_0",site_min_height,"0_30m",sep="") 25 | h2o_min_col <- paste("h2o.000_0",site_min_height,"0_30m",sep="") 26 | 27 | #build df to fill with MBR estimated fluxes 28 | mbr.df <- as.data.frame(matrix(NA, nrow = dim(cont.df)[1], ncol = 5)) 29 | #we want the measurement height to be part of the calculated flux col name for matching/validation 30 | F_ch4_MBR_co2 <- paste0("F_ch4_MBR_co2_0", site_min_height, "0_0", site_max_height, "0_30m") 31 | F_ch4_MBR_LE <- paste0("F_ch4_MBR_LE_0", site_min_height, "0_0", site_max_height, "0_30m") 32 | F_co2_MBR_LE <- paste0("F_co2_MBR_LE_0", site_min_height, "0_0", site_max_height, "0_30m") 33 | F_LE_MBR_co2 <- paste0("F_LE_MBR_co2_0", site_min_height, "0_0", site_max_height, "0_30m") 34 | colnames(mbr.df) <- c("timeEnd", F_ch4_MBR_co2, F_ch4_MBR_LE, F_co2_MBR_LE, F_LE_MBR_co2) 35 | #add timeEnd for merging 36 | mbr.df$timeEnd <- cont.df$timeEnd 37 | 38 | #MBR ch4 flux using co2 39 | #grabs level 4 co2 flux 40 | Flux_co2 <- as.numeric(cont.df$F_co2) 41 | #grabs level 1 co2 stor at lowest height 42 | Conc_co2_z1<-as.numeric(cont.df[,which(names(cont.df) == co2_min_col)]) 43 | #grabs level 1 co2 stor at max height for site 44 | Conc_co2_z2<-as.numeric(cont.df[,which(names(cont.df) == co2_max_col)]) 45 | #grabs level 1 ch4 cont at lowest height 46 | Conc_CH4_z1<-as.numeric(cont.df[,which(names(cont.df) == ch4_min_col)]) 47 | #grabs level 1 ch4 cont at max height for site 48 | Conc_CH4_z2<-as.numeric(cont.df[,which(names(cont.df) == ch4_max_col)]) 49 | #calculate ch4 flux and add to df 50 | mbr.df[,which(names(mbr.df) == F_ch4_MBR_co2)] <- ((Conc_CH4_z1-Conc_CH4_z2)/(z2-z1))*(Flux_co2/((Conc_co2_z1-Conc_co2_z2)/(z2-z1))) 51 | 52 | #MBR ch4 flux using latent heat flux 53 | #grab NEON level 4 latent heat flux 54 | Flux_LE <- as.numeric(cont.df$F_LE) 55 | #grab NEON level 1 h2o stor at lowest height 56 | Conc_h2o_z1<-as.numeric(cont.df[,which(names(cont.df) == h2o_min_col)]) 57 | #grab NEON level 1 h2o stor at max height 58 | Conc_h2o_z2<-as.numeric(cont.df[,which(names(cont.df) == h2o_max_col)]) 59 | #calculate ch4 flux and add to df: need to include unit conversion for h2O to get from W/m^2 to mmmol using latent heat of vaporization (2.26e3 J/g) and molar mass (18.02 g/mol) 60 | mbr.df[,which(names(mbr.df) == F_ch4_MBR_LE)] <- ((Conc_CH4_z1-Conc_CH4_z2)/(z2-z1))*((Flux_LE/((1/2.26e3)*(1/18.02)*(1000)))*((Conc_h2o_z1-Conc_h2o_z2)/(z2-z1))) 61 | 62 | #MBR co2 flux using latent heat: need to include unit conversion for h2O to get from W/m^2 to mmmol using latent heat of vaporization (2.26e3 J/g) and molar mass (18.02 g/mol) 63 | mbr.df[,which(names(mbr.df) == F_co2_MBR_LE)] <- ((Conc_co2_z1-Conc_co2_z2)/(z2-z1))*((Flux_LE/((1/2.26e3)*(1/18.02)*(1000)))*((Conc_h2o_z1-Conc_h2o_z2)/(z2-z1))) 64 | 65 | #MBR LE flux using co2 66 | mbr.df[,which(names(mbr.df) == F_LE_MBR_co2)] <- ((Conc_h2o_z1-Conc_h2o_z2)/(z2-z1))*(Flux_co2/((Conc_co2_z1-Conc_co2_z2)/(z2-z1))) 67 | 68 | return(mbr.df) 69 | } 70 | -------------------------------------------------------------------------------- /exploratory/jdg/fihhy_parsing.R: -------------------------------------------------------------------------------- 1 | # For loading data from Google Drive 2 | library(googledrive) 3 | library(readr) 4 | library(dplyr) 5 | 6 | # Authenticate with Google Drive 7 | googledrive::drive_auth() 8 | 9 | # Define the Google Drive path for FI-Hyy data 10 | gdrive_path <- "https://drive.google.com/drive/folders/1MznM0IT_MYNkFQihpeI0o1JtHFXIFLGV" 11 | 12 | # Create a local folder for data storage 13 | dir.create(path = file.path("fihyy_data"), showWarnings = FALSE) 14 | 15 | # List files in the FI-Hyy folder 16 | fi_hyy_files <- googledrive::drive_ls(path = googledrive::as_id(gdrive_path)) 17 | print(fi_hyy_files) 18 | 19 | # Select specific files to download 20 | files_to_download <- c( 21 | "fihyy_attr.csv", # Attribute file 22 | "FI-Hyy_concentration_profile_1min.csv", # Concentration profile data 23 | "FLX_FI-Hyy_FLUXNET-CH4_HH_2016-2016_1-1.csv", # Flux data (using this instead of gasflux_30min) 24 | "FI-Hyy_met_1min.csv", # Meteorological data 25 | "FI-Hyy_variables.csv", # Variables metadata 26 | "FI-Hyy_metadata.xlsx" # Additional metadata if available 27 | ) 28 | 29 | # Filter the file list to include only the files we want 30 | files_to_download_ids <- fi_hyy_files %>% 31 | dplyr::filter(name %in% files_to_download) 32 | 33 | # Download each file 34 | for (i in 1:nrow(files_to_download_ids)) { 35 | file_id <- files_to_download_ids$id[i] 36 | file_name <- files_to_download_ids$name[i] 37 | download_path <- file.path("fihyy_data", file_name) 38 | 39 | message(paste("Downloading", file_name)) 40 | googledrive::drive_download( 41 | file = file_id, 42 | path = download_path, 43 | overwrite = TRUE 44 | ) 45 | } 46 | 47 | # Read the files into R to examine their structure 48 | # Try to read the attribute file 49 | if (file.exists(file.path("fihyy_data", "fihyy_attr.csv"))) { 50 | attr_df <- read.csv(file.path("fihyy_data", "fihyy_attr.csv")) 51 | print("Structure of attr_df:") 52 | str(attr_df) 53 | print("Column names of attr_df:") 54 | print(names(attr_df)) 55 | } else { 56 | message("Attribute file not found") 57 | } 58 | 59 | # Read concentration profile data 60 | if (file.exists(file.path("fihyy_data", "FI-Hyy_concentration_profile_1min.csv"))) { 61 | conc_data <- read.csv(file.path("fihyy_data", "FI-Hyy_concentration_profile_1min.csv")) 62 | print("Structure of concentration profile data:") 63 | str(conc_data) 64 | print("Column names of concentration profile data:") 65 | print(names(conc_data)) 66 | } else { 67 | message("Concentration profile file not found") 68 | } 69 | 70 | # Read flux data (using FLUXNET-CH4 file) 71 | flux_file <- "FLX_FI-Hyy_FLUXNET-CH4_HH_2016-2016_1-1.csv" 72 | if (file.exists(file.path("fihyy_data", flux_file))) { 73 | flux_data <- read.csv(file.path("fihyy_data", flux_file)) 74 | print("Structure of flux data:") 75 | str(flux_data) 76 | print("Column names of flux data:") 77 | print(names(flux_data)) 78 | } else { 79 | message("Flux data file not found") 80 | } 81 | 82 | # Read meteorological data 83 | if (file.exists(file.path("fihyy_data", "FI-Hyy_met_1min.csv"))) { 84 | met_data <- read.csv(file.path("fihyy_data", "FI-Hyy_met_1min.csv")) 85 | print("Structure of meteorological data:") 86 | str(met_data) 87 | print("Column names of meteorological data:") 88 | print(names(met_data)) 89 | } else { 90 | message("Meteorological data file not found") 91 | } 92 | 93 | # Read variables metadata if available 94 | if (file.exists(file.path("fihyy_data", "FI-Hyy_variables.csv"))) { 95 | var_meta <- read.csv(file.path("fihyy_data", "FI-Hyy_variables.csv")) 96 | print("Structure of variables metadata:") 97 | str(var_meta) 98 | print("Column names of variables metadata:") 99 | print(names(var_meta)) 100 | } else { 101 | message("Variables metadata file not found") 102 | } 103 | 104 | # Read metadata Excel file if available 105 | if (file.exists(file.path("fihyy_data", "FI-Hyy_metadata.xlsx"))) { 106 | library(readxl) 107 | meta_data <- readxl::read_excel(file.path("fihyy_data", "FI-Hyy_metadata.xlsx")) 108 | print("Structure of metadata:") 109 | str(meta_data) 110 | print("Column names of metadata:") 111 | print(names(meta_data)) 112 | } else { 113 | message("Metadata file not found") 114 | } 115 | -------------------------------------------------------------------------------- /workflows/flow.flag.flux.stats.R: -------------------------------------------------------------------------------- 1 | # Pull data from google drive 2 | email <- 'alexisrose0525@gmail.com' 3 | #copy this browser url from the site folder on the shared G drive (located at https://drive.google.com/drive/folders/1Q99CT77DnqMl2mrUtuikcY47BFpckKw3) you wish to upload your zip files to 4 | #this url should point to the NEONSITES_Validation folder 5 | drive_url <- googledrive::as_id("https://drive.google.com/drive/folders/14Ga9sLRMlQVvorZdHBiYxCbUybiGwPNp") 6 | #add userinfo for saving and uploading the file to G drive 7 | user <- "AH" 8 | #the R.data/zipfiles are labeled based on the method used to calculate the fluxes (i.e. AE, WP, MBR) 9 | method <- 'WP' 10 | 11 | # ------ Prerequisites! Make sure these packages are installed ---- 12 | # Also requires packages: googledrive 13 | library(dplyr) 14 | library(lubridate) 15 | library(changepoint) 16 | #library(REddyProc) 17 | 18 | # Load functions in this repo 19 | source(file.path("functions/calc.iqr.R")) 20 | source(file.path("functions/flag.all.gas.stability.R")) 21 | source(file.path("functions/calc.rmse.R")) 22 | source(file.path("functions/flag.flux.spikes.R")) 23 | source(file.path("functions/calc.flag.ustar.thres.R")) 24 | source(file.path("functions/compile.quality.flags.add.cols.fluxes.R")) 25 | source(file.path("functions/add.hour.col.R")) 26 | source(file.path("functions/flag.calc.flux.diff.R")) 27 | source(file.path("functions/flag.iqr.R")) 28 | 29 | #Pull data from gdrive 30 | # Authenticate with Google Drive and get site data 31 | googledrive::drive_auth(email = email) # Likely will not work on RStudio Server. If you get an error, try email=TRUE to open an interactive auth session. 32 | validation_folder <- googledrive::drive_ls(path = drive_url) 33 | #site_folder <- googledrive::drive_ls(path = data_folder$id[data_folder$name==sitecode]) 34 | dirTmp <- fs::path(tempdir(),method) 35 | dir.create(dirTmp) 36 | for(focal_file in validation_folder$name){ 37 | 38 | # Find the file identifier for that file 39 | file_id <- subset(validation_folder, name == focal_file) 40 | 41 | # Download that file 42 | pathDnld <- fs::path(dirTmp,focal_file) 43 | googledrive::drive_download(file = file_id$id, 44 | path = pathDnld, 45 | overwrite = T) 46 | # Unzip 47 | if(grepl(pattern='.zip',focal_file)){ 48 | utils::unzip(pathDnld,exdir=dirTmp) 49 | } 50 | 51 | } 52 | #Load validation data frames 53 | #problem loading in .Rdata objects currently being saved to 2 different directories? 54 | #TO DO: better understand how to control where files are unzipped to when downloaded off of gdrive 55 | fileIn <- fs::path(dirTmp, paste0("data/Validation/SITES_", method, ".Rdata")) 56 | load(fileIn) 57 | #if data is already downloaded and saved 58 | load(file.path("data", "Validation", paste0("SITES_", method, ".Rdata"))) 59 | 60 | #run quality flag functions and calculate residuals, note we cannot calculate residuals for CH4 yet 61 | #save list of df as .Rdata object, zip, and upload to google drive 62 | #zip 63 | #upload to g drive 64 | if(method=="WP"){ 65 | SITES_WP_validation <- compile.quality.flags.add.cols.fluxes(list.sites = SITES_WP, method = method) 66 | save(SITES_WP_validation, file = file.path("data", "Validation", "SITES_WP_val.Rdata")) 67 | #zip(zipfile = paste0("data/Validation/SITES_WP_val.zip"), files = paste0("data/Validation/SITES_WP_val.Rdata")) 68 | googledrive::drive_upload(media = paste0("data/Validation/SITES_WP_val.Rdata"), overwrite = T, path = drive_url) 69 | } 70 | if(method == "AE"){ 71 | SITES_AE_validation <- compile.quality.flags.add.cols.fluxes(list.sites = SITES_AE, method = method) 72 | save(SITES_AE_validation, file = file.path("data", "Validation", "SITES_AE_val.Rdata")) 73 | zip(zipfile = paste0("data/Validation/SITES_AE_val.zip"), files = paste0("data/Validation/SITES_AE_val.Rdata")) 74 | googledrive::drive_upload(media = paste0("data/Validation/SITES_AE_val.Rdata"), overwrite = T, path = drive_url) 75 | } 76 | if(method == "MBR"){ 77 | SITES_MBR_validation <- compile.quality.flags.add.cols.fluxes(list.sites = SITES_MBR, method = method) 78 | save(SITES_MBR, file = file.path("data", "Validation", "SITES_MBR_val.Rdata")) 79 | zip(zipfile = paste0("data/Validation/SITES_MBR_val.zip"), files = paste0("data/Validation/SITES_MBR_val.Rdata")) 80 | googledrive::drive_upload(media = paste0("data/Validation/SITES_MBR_val.zip"), overwrite = T, path = drive_url) 81 | } 82 | #TO DO ADD PROPER TZ CORRECTION FOR GUAN TO add.hour.column.R 83 | 84 | --------------------------------------------------------------------------------