Patch formatting function

R/fdk_format_drivers.R

@@ -119,69 +119,6 @@ fdk_format_drivers <- function(
         data = purrr::map(data, ~fill_netrad(.))
       )
 
-    #--- merge in missing QC flags which are tossed by ingestr ---
-    # file <- list.files(
-    #   path,
-    #   glob2rx(sprintf("*%s*DD*",site)),
-    #   full.names = TRUE
-    # )
-    #
-    # daily_fluxes <- read.table(
-    #   file,
-    #   header = TRUE,
-    #   sep = ","
-    # )
-    #
-    # # keep long list of variables for further
-    # # notice - might include more variables later
-    # qc_fluxes <- daily_fluxes |>
-    #   rename(
-    #     date = "TIMESTAMP",
-    #     gpp = "GPP_DT_VUT_REF",
-    #     gpp_unc = "GPP_DT_VUT_SE",
-    #     gpp_qc = "GPP_DT_VUT_REF_QC",
-    #     temp = "TA_F_MDS",
-    #     prec = "P_F",
-    #     vpd = "VPD_F_MDS",
-    #     patm = "PA_F",
-    #     ppfd = "SW_IN_F_MDS",
-    #     netrad = "NETRAD",
-    #     wind = "WS_F",
-    #     co2 = "CO2_F_MDS",
-    #     lai = "LAI",
-    #     fapar = "FPAR",
-    #     le = "LE_F_MDS",
-    #     le_qc = "LE_F_MDS_QC",
-    #     le_cor = "LE_CORR",
-    #     le_cor_qc = "LE_CORR_QC",
-    #     gpp_qc = "GPP_DT_VUT_REF_QC",
-    #     lw_down = "LW_IN_F_MDS",
-    #     h = "H_F_MDS",
-    #     h_cor = "H_CORR"
-    #   ) |>
-    #   select(
-    #     date,
-    #     gpp_qc,
-    #     le_cor,
-    #     le_qc,
-    #     le_cor_qc
-    #   ) |>
-    #   mutate(
-    #     date = as.Date(date)
-    #   )
-    #
-    # qc_fluxes <- tibble(
-    #   sitename = site,
-    #   data = list(qc_fluxes)
-    # )
-
-      ## no qc information in forcing data frame
-      # left_join(
-      #   qc_fluxes |>
-      #     tidyr::unnest(data),
-      #   by = c("sitename", "date")
-      # )
-
     #---- Processing CRU data (for cloud cover CCOV) ----
     if (geco_system){
 
@@ -245,6 +182,9 @@ fdk_format_drivers <- function(
         ccov,
         gpp
       ) |>
+      dplyr::mutate(
+        patm = ifelse(patm <= 300, NA, patm)
+      ) |>
       dplyr::group_by(sitename) |>
       tidyr::nest()
 
@@ -315,3 +255,67 @@ fdk_format_drivers <- function(
 
   return(df_drivers)
 }
+
+
+#--- merge in missing QC flags which are tossed by ingestr ---
+# file <- list.files(
+#   path,
+#   glob2rx(sprintf("*%s*DD*",site)),
+#   full.names = TRUE
+# )
+#
+# daily_fluxes <- read.table(
+#   file,
+#   header = TRUE,
+#   sep = ","
+# )
+#
+# # keep long list of variables for further
+# # notice - might include more variables later
+# qc_fluxes <- daily_fluxes |>
+#   rename(
+#     date = "TIMESTAMP",
+#     gpp = "GPP_DT_VUT_REF",
+#     gpp_unc = "GPP_DT_VUT_SE",
+#     gpp_qc = "GPP_DT_VUT_REF_QC",
+#     temp = "TA_F_MDS",
+#     prec = "P_F",
+#     vpd = "VPD_F_MDS",
+#     patm = "PA_F",
+#     ppfd = "SW_IN_F_MDS",
+#     netrad = "NETRAD",
+#     wind = "WS_F",
+#     co2 = "CO2_F_MDS",
+#     lai = "LAI",
+#     fapar = "FPAR",
+#     le = "LE_F_MDS",
+#     le_qc = "LE_F_MDS_QC",
+#     le_cor = "LE_CORR",
+#     le_cor_qc = "LE_CORR_QC",
+#     gpp_qc = "GPP_DT_VUT_REF_QC",
+#     lw_down = "LW_IN_F_MDS",
+#     h = "H_F_MDS",
+#     h_cor = "H_CORR"
+#   ) |>
+#   select(
+#     date,
+#     gpp_qc,
+#     le_cor,
+#     le_qc,
+#     le_cor_qc
+#   ) |>
+#   mutate(
+#     date = as.Date(date)
+#   )
+#
+# qc_fluxes <- tibble(
+#   sitename = site,
+#   data = list(qc_fluxes)
+# )
+
+## no qc information in forcing data frame
+# left_join(
+#   qc_fluxes |>
+#     tidyr::unnest(data),
+#   by = c("sitename", "date")
+# )

analysis/04_batch_format_rsofun_drivers.R

@@ -13,7 +13,7 @@ input_path <- "/data/scratch/beta-v3/fluxnet/"
 # read in sites to process
 sites <- FluxDataKit::fdk_site_info
 
-site <- c("FR-Pue", "CH-Lae")
+site <- c("FR-Pue", "CH-Lae", "CH-Dav")
 
 # subset sites
 sites <- sites |>

analysis/05_screen_rsofun_data.R

@@ -0,0 +1,122 @@
+library(tidyverse)
+
+df <- readRDS("data/rsofun_driver_data.rds")
+
+# screen for missing gpp data
+screening <- df |>
+  group_by(sitename) |>
+  unnest(forcing) |>
+  summarize(
+    keep = ifelse(all(is.na(gpp)), FALSE, TRUE)
+  )
+
+df <- left_join(df, screening)
+df <- df |>
+  filter(
+    keep
+  )
+
+# screen manually, drop funky sites
+
+screen <- readODS::read_ods("data/rsofun_sites.ods") |>
+  filter(
+    drop
+  )
+
+df <- df |>
+  filter(
+    !(tolower(sitename) %in% tolower(screen$sitename))
+  ) |>
+  select(
+    -keep
+  )
+
+# screen manually, drop funky years
+screen <- readODS::read_ods("data/rsofun_sites.ods") |>
+  filter(
+    is.na(drop)
+  )
+
+data_fix_years <- df |>
+  filter(tolower(sitename) %in% tolower(screen$sitename)) |>
+  group_by(sitename) |>
+  unnest(forcing) |>
+  left_join(screen) |>
+  mutate(
+    year = as.numeric(format(date, "%Y"))
+  ) |>
+  filter(
+    (year >= start & year <= end)
+  ) |>
+  select(
+    -params_siml,
+    -site_info,
+    -year,
+    -end,
+    -start,
+    -drop,
+    -notes
+  ) |>
+  nest() |>
+  rename(
+    forcing = data
+  )
+
+df1 <- df |>
+  filter(tolower(sitename) %in% tolower(screen$sitename)) |>
+  select(
+    -forcing
+  ) |>
+  left_join(data_fix_years)
+
+df2 <- df |>
+  filter(!(tolower(sitename) %in% tolower(screen$sitename)))
+
+data <- bind_rows(df1, df2) #|>
+#   filter(
+#     sitename == "AR-SLu"
+#   )
+
+data |>
+  group_by(sitename) |>
+  do({
+
+    tmp <- .$forcing[[1]] |>
+      tidyr::pivot_longer(
+        col = !contains("date"),
+        names_to = "measurement",
+        values_to = "value"
+      )
+
+    sitename <- .$sitename[1]
+
+    l <- seq(as.Date("1990/1/1"), as.Date("2023/1/1"), "years")
+
+    p <- ggplot(data = tmp) +
+      geom_line(
+        aes(
+          date,
+          value
+        ),
+        colour = "red"
+      ) +
+      geom_vline(xintercept = l) +
+      labs(
+        title = sitename
+      ) +
+      theme_bw() +
+      theme(panel.grid.minor = element_line()
+      ) +
+      facet_grid(
+        measurement ~ .,
+        scales = "free"
+        )
+
+    ggsave(
+      paste0("manuscript/",sitename,".png"),
+      width = 12,
+      height = 14,
+      dpi = 175
+    )
+
+  })