Fluxes

Evaluation of the TROLL version 4 simulations of daily fluxes in relation to field observations and remote sensing at two Amazonian sites.

Code
path <- "results/eval/"
rep <- "R1"
par_prefix <- paste0(path, "Paracou_", rep, "/Paracou_", rep, "_0_")
tap_prefix <- paste0(path, "Tapajos_", rep, "/Tapajos_", rep, "_0_")
trollwater <- list(
  Paracou = read_tsv(paste0(par_prefix, "water_balance.txt")) %>% 
     mutate(date = as_date("2004/01/01")+iter),
  Tapajos = read_tsv(paste0(tap_prefix, "water_balance.txt")) %>% 
     mutate(date = as_date("2002/01/01")+iter)
) %>% bind_rows(.id = "site") %>% 
  mutate(swc0 = SWC_0, swc1 = SWC_1, swc2 = SWC_2,  swc3 = SWC_3,  swc4 = SWC_4,
         et = (transpitation_0 + transpitation_1 + transpitation_2 + 
                 transpitation_3 + transpitation_4 + evaporation + 
                 (precipitation/1000-throughfall))*1000) %>% 
  select(site, date, swc0, swc1, swc2, swc3, swc4, et) %>% 
  group_by(site, year = year(date)) %>% 
  mutate(rswc10 = swc0/quantile(swc0, 0.95, na.rm = T)) %>% 
  ungroup() %>% 
  select(-year) %>% 
  gather(variable, simulated, -site, -date)
trollsum <- list(
  Paracou = read_tsv(paste0(par_prefix, "sumstats.txt")) %>% 
     mutate(date = as_date("2004/01/01")+iter),
  Tapajos = read_tsv(paste0(tap_prefix, "sumstats.txt")) %>% 
     mutate(date = as_date("2002/01/01")+iter)
) %>% bind_rows(.id = "site") %>% 
  select(-npp, -rday, -rnight, -rstem) %>% 
  mutate(litter = litterfall*10^2, gpp = gpp*10^2*365/10^3) %>% 
  select(-iter, -litterfall) %>% 
  gather(variable, simulated, -site, -date)
lai <- list(
  Paracou = read_tsv(paste0(par_prefix, "LAIdynamics.txt")) %>% 
     mutate(date = as_date("2004/01/01")+iter),
  Tapajos = read_tsv(paste0(tap_prefix, "LAIdynamics.txt")) %>% 
     mutate(date = as_date("2002/01/01")+iter)
) %>% bind_rows(.id = "site") %>% 
  mutate(variable = "lai", simulated = LAI) %>% 
  select(site, date, variable, simulated)
lai_age <- list(
  Paracou = list(
    lai_young = read_tsv(paste0(par_prefix, "LAIyoung.txt")),
    lai_mature = read_tsv(paste0(par_prefix, "LAImature.txt")) %>% 
      mutate(iter = as.numeric(iter)) %>% na.omit(),
    lai_old = read_tsv(paste0(par_prefix, "LAIold.txt")) %>% 
      mutate(iter = as.numeric(iter)) %>% na.omit()
  ) %>% bind_rows(.id = "variable"),
  Tapajos = list(
    lai_young = read_tsv(paste0(tap_prefix, "LAIyoung.txt")),
    lai_mature = read_tsv(paste0(tap_prefix, "LAImature.txt")) %>% 
      mutate(iter = as.numeric(iter)) %>% na.omit(),
    lai_old = read_tsv(paste0(tap_prefix, "LAIold.txt")) %>% 
      mutate(iter = as.numeric(iter)) %>% na.omit()
  ) %>% bind_rows(.id = "variable")
) %>% bind_rows(.id = "site") %>% 
  mutate(date = as_date("2004/01/01")+iter) %>% 
  select(-iter) %>% 
  gather(height, value, -date, -variable, -site) %>% 
  group_by(site, variable, date) %>% 
  summarise(simulated = sum(value))
bind_rows(trollwater, trollsum, lai, lai_age) %>% 
  write_tsv("outputs/evaluation_fluxes.tsv")

Gross Primary Productivity

The new version of TROLL correctly simulated the phenology of Gross Primary Productivity (GPP, kgC/m2/yr) with a lower GPP in wet season and higher values in the dry season. However, TROLL version 4 is globally overestimating GPP with daily values overlapping wet season values but significantly higher values in dry season with a pike around 5 instead of 4 kgC/m2/yr. Remotely-sensed observation from TROPOMI Solar Induced Fluorescence showed under-estimated values of GPP between 2.5 and 3.5 kgC/m2/yr monthly means but with a similar phenology. The new version of TROLL seems to be too deterministic in the relation between available light (incoming PAR mol/m2/day) and GPP with a correlation coefficient of 0.94 against an observed coefficient of 0.58. The overestimation of GPP seems to be linked to over-efficient GPP for high light availability (PAR above 5 mol/m2/day). Globally, simulated GPP showed a very good evaluation with a correlation coefficient of 0.59 in Paracou and 0.46 in Tapajos against daily observations from eddy-flux towers, and corresponding RMSEP of respectively 0.9 and 1.6 kgC/m2/yr.

Code
daily <- read_tsv("outputs/evaluation_fluxes.tsv") %>% 
  filter(variable == "gpp") %>% 
  left_join(read_tsv("outputs/fluxnet_fluxes.tsv") %>% 
              mutate(observed = value*10^2*365/10^3) %>% 
              select(-value)) %>% 
  left_join(read_tsv("outputs/fluxnet_fluxes.tsv") %>% 
              filter(variable %in% c("par", "vpd_max", "temperature", "ws")) %>% 
              rename(determinant = variable, determinant_value = value)) %>% 
  left_join(read_tsv("data/fluxes/rtsif.tsv") %>% 
              mutate(satellite = rtsif*15.343*365/10^3) %>% 
              select(-rtsif)) %>% 
  gather(type, value, -site, -date, -variable, -determinant, -determinant_value)
monthly <- daily %>% 
  group_by(site, date = floor_date(date, "month"), variable, type) %>% 
  summarise(l = quantile(value, 0.025, na.rm = TRUE), 
            value = mean(value, na.rm = TRUE), 
            h = quantile(value, 0.975, na.rm = TRUE))
Code
g <- daily %>% 
  ggplot(aes(date, value, col = type)) +
  geom_line(alpha = 0.5) +
  geom_line(data = monthly) +
  facet_wrap(~ site, nrow = 2) +
  theme_bw() +
  theme(legend.position = "bottom") +
  xlab("") +
  ylab(expression("Gross Primary Productivity ["~kgC~m^{-2}~yr^{-1}~"]")) +
  scale_color_manual("", values = as.vector(cols[c("obs", "sat", "sim")]), 
                     labels = c("Tower", "Satellite", "TROLL"))
ggsave("figures/fa07.png", g, dpi = 300, width = 10, height = 5, bg = "white")
g

Daily and monthly means of growth primary productivity for Paracou and Tapajos. Dark lines are the monthly means, semi-transparent lines are the daily means variations with the exception of satellite data for which data are available only every 8 days.
Code
g <- daily %>% 
  group_by(site, variable, type, date = floor_date(date, "15 days")) %>% 
  summarise_all(mean, na.rm = T) %>%
  mutate(week = week(date)) %>%  
  group_by(site, variable, type, week) %>% 
  summarise(l = quantile(value, 0.025, na.rm = TRUE), 
            m = mean(value, na.rm = TRUE), 
            h = quantile(value, 0.975, na.rm = TRUE)) %>% 
  ggplot(aes(week, m)) +
  geom_rect(aes(xmin = week, xmax = end), fill  = "#fff4e0",
           ymin = -Inf, ymax = Inf, alpha = 0.5,
           data = data.frame(week = week(as_date(c("2000-8-1", "2000-06-15"))),
                             m = -Inf,
                             end = week(as_date(c("2000-12-1", "2000-11-1"))),
                             site = c("Paracou", "Tapajos"))) +
  geom_ribbon(aes(ymin = l, ymax = h, fill = type), col = NA, alpha = 0.2) +
  geom_smooth(aes(col = type), se = FALSE) +
  theme_bw() +
  theme(legend.position = "bottom") +
  scale_fill_discrete("") +
  scale_color_discrete("") +
  facet_wrap(~ site, scales = "free_x") +
    scale_x_continuous(breaks = week(as_date(paste("2000-", 1:12, "-01"))),
                     labels = c("J", "F", "M", "A", "M", "J", "J", "A", "S", "O", "N", "D")) +
  ylab(expression("Gross Primary Productivity ["~kgC~m^{-~2}~yr^{-~1}~"]")) +
  xlab("") +
  scale_color_manual("", values = as.vector(cols[c("obs", "sat", "sim")]), 
                     labels = c("Tower", "Satellite", "TROLL")) +
  scale_fill_manual("", values = as.vector(cols[c("obs", "sat", "sim")]), 
                     labels = c("Tower", "Satellite", "TROLL")) +
  geom_text(aes(col = "simulated", label = lab), 
            data = data.frame(week = 8, 
                              m = 1,
                              site = c("Paracou", "Tapajos"),
                              lab = c("RMSEP=0.75",
                                      "RMSEP=1.12")))
ggsave("figures/f10.png", g, dpi = 300, width = 8, height = 5, bg = "white")
g

Mean annual cycle from fortnightly means of growth primary productivity for Paracou and Tapajos. Bands are the intervals of means across years, and rectangles in the background correspond to the site’s climatological dry season.
Code
g <- daily %>% 
  mutate(determinant_value = ifelse(determinant == "par", 
                                    determinant_value/10^2, determinant_value)) %>% 
  mutate(det_long = recode(determinant, 
                           "par" = 'Incoming~PAR~"["~mol~m^{-~2}~day^{-~1}~"]"',
                           "temperature" = 'Temperature~"["~degree~C~"]"',
                            "vpd_max" = '"Vapour Pressure Deficit ["~kPa~day^{-~1}~"]"',
                           "ws" = 'Wind~Speed~"["~m^{2}~s^{-~1}~"]"')) %>% 
  ggplot(aes(determinant_value, value, col = type)) +
  geom_point(alpha = 0.1) +
  theme_bw() +
  facet_grid(site ~ det_long, scales = "free", labeller = label_parsed) +
  theme(legend.position = "bottom") +
  geom_smooth(method = "lm", formula = "y ~ 1+log(x+10^-6)", se = FALSE) +
  ylab(expression("Gross Primary Productivity ["~kgC~m^{-~2}~yr^{-~1}~"]")) +
  xlab("") +
  scale_color_manual("", values = as.vector(cols[c("obs", "sat", "sim")]), 
                     labels = c("Tower", "Satellite", "TROLL")) +
  scale_fill_manual("", values = as.vector(cols[c("obs", "sat", "sim")]), 
                     labels = c("Tower", "Satellite", "TROLL")) +
  ylim(0, 7.5) +
  ggpubr::stat_cor(aes(label = paste(..rr.label.., ..p.label.., sep = "~`,`~")),
                   p.accuracy = 0.001)
ggsave("figures/f12.png", g, dpi = 300, width = 10, height = 7, bg = "white")
g

Daily averages of growth primary productivity as a function of vapour pressure deficit, incoming photosynthetically active radiation, temperature, and wind speed for model-, satellite- and tower-based estimates at Paracou and Tapajos.
Code
g <- daily %>% 
  pivot_wider(names_from = determinant, values_from = determinant_value) %>% 
  mutate(value = value /(12.0107 * (par/10^2*(1-exp(-0.5*6))))) %>% 
  # lue = gpp / (mass_carbon * (PPFD * fAPAR)) = gpp / (mass_carbon * (PPFD * (1-exp(k*LAI))))  = gpp / (mass_carbon * (PPFD * (1-exp(.5*6))))
  mutate(variable = "lue") %>% 
  select(-par) %>% 
  gather(determinant, determinant_value, -site, -date, -variable, -type, -value) %>% 
  mutate(det_long = recode(determinant, 
                           "temperature" = 'Temperature~"["~degree~C~"]"',
                            "vpd_max" = '"Vapour Pressure Deficit ["~kPa~day^{-~1}~"]"',
                           "ws" = 'Wind~Speed~"["~m^{2}~s^{-~1}~"]"')) %>% 
  ggplot(aes(determinant_value, value, col = type)) +
  geom_point(alpha = 0.1) +
  theme_bw() +
  facet_grid(site ~ det_long, scales = "free", labeller = label_parsed) +
  theme(legend.position = "bottom") +
  geom_smooth(method = "lm", formula = "y ~ 1+log(x+10^-6)", se = FALSE) +
  ylab(expression("Light Use Efficiency ["~molC~mol^{-~1}~"photons]")) +
  xlab("") +
  scale_color_manual("", values = as.vector(cols[c("obs", "sat", "sim")]), 
                     labels = c("Tower", "Satellite", "TROLL")) +
  scale_fill_manual("", values = as.vector(cols[c("obs", "sat", "sim")]), 
                     labels = c("Tower", "Satellite", "TROLL")) +
  ylim(0, 0.1) +
  ggpubr::stat_cor(aes(label = paste(..rr.label.., ..p.label.., sep = "~`,`~")),
                   p.accuracy = 0.001)
ggsave("figures/fa12.png", g, dpi = 300, width = 10, height = 6, bg = "white")
g

LUE determinants.
Code
daily %>% 
  pivot_wider(names_from = type, values_from = value) %>% 
  gather(type, observed, -site, -date, -variable, -determinant, -determinant_value, -simulated) %>% 
  ggplot(aes(simulated,observed, col = yday(date))) +
  facet_grid(site ~ type) +
  theme_bw() +
  geom_point() +
  scale_color_viridis_c("Day") +
  geom_abline(col = "red") +
  xlab(expression("Observed GPP ["~kgC~m^{-~2}~yr^{-~1}~"]")) +
  ylab(expression("Simulated GPP ["~kgC~m^{-~2}~yr^{-~1}~"]")) +
  scale_color_viridis_c("Day") +
  ggpubr::stat_cor()

Evaluation of simulated versus observed daily means of GPP in Paracou and Tapajos.
Code
daily %>% 
  pivot_wider(names_from = type, values_from = value) %>% 
  gather(type, observed, -site, -date, -variable, -determinant, -determinant_value, -simulated) %>% 
  na.omit() %>% 
  nest_by(site, variable, type) %>% 
  mutate(R2 = summary(lm(observed ~ 0 + simulated, data = data))$r.squared,
         CC = cor(data$simulated, data$observed),
         RMSEP = sqrt(mean((data$simulated-data$observed)^2)),
         RRMSEP = sqrt(mean((data$simulated-data$observed)^2))/mean(data$observed),
         SD =sd(data$simulated-data$observed),
         RSD =sd(data$simulated-data$observed)/mean(data$observed)) %>% 
  select(-data) %>% 
  knitr::kable(caption = "Evaluation fo daily means of GPP at Paracou and Tapajos.")
Evaluation fo daily means of GPP at Paracou and Tapajos.
site variable type R2 CC RMSEP RRMSEP SD RSD
Paracou gpp observed 0.9697223 0.6038441 0.743844 0.2078451 0.6658932 0.1860641
Paracou gpp satellite 0.9535270 0.1980375 1.169922 0.3775626 0.7935245 0.2560900
Tapajos gpp observed 0.9674821 0.4546221 1.124531 0.3486050 0.6763800 0.2096780
Tapajos gpp satellite 0.9615592 0.2199041 1.541116 0.5816081 0.7538847 0.2845117

Leaf Area Index

We had multiples data to evaluate canopy dynamics and resulting Leaf Area Index (LAI, m2/m2) that were not in agreement and unfortunately not in the same time period. LAI from MODIS shows a base value around 6 m2/m2 most of the years and a small increase below 0.2 m2/m3 in the dry season that pike in the middle of the dry season at both Paracou and Tapajos. Field measures with drone lidar showed a greater variation in Paracou with lowest values of 5.5 m2/m2 in April to June and highest values of almost 6 m2/m2 in December. Oppositely, field measures with terrestrial lidar in Tapajos showed no variation of LAI stable around 5.75 m2/m2 the whole year. This results thus question the use of MODIS LAI for TROLL evaluation. Indeed simulated LAI followed also the same phenology with an crease of LAI during the dry season but with values matching drone data in Paracou and not MODIS product. In Tapajos, the simulations showed even higher variations of LAI, that did not correspond to both MODIS and terrestrial LAD. Globally, simulated LAI showed a weak evaluation with a correlation coefficient of 0.37 in Paracou and 0.63 in Tapajos against 8-day observations from MODIS satellites, and corresponding RMSEP of respectively 0.3 and 0.1 m2/m2.

Code
daily <- read_tsv("outputs/evaluation_fluxes.tsv") %>% 
  filter(variable == "lai") %>% 
  select(-variable) %>% 
  mutate(type = "simulated") %>% 
  rename(value = simulated) %>% 
  bind_rows(read_tsv("outputs/lai.tsv") %>% 
              rename(type = variable)) %>% 
  bind_rows(readxl::read_xlsx("data/fluxes/Data_LAI_new.xlsx") %>% 
              mutate(date = as_date(paste0("2010-", month, "-15"))) %>% 
              mutate(site = "Tapajos", type = "PhenoCam", value = `Camera_LAI (m^2 m^-2)`) %>% 
              select(date, value, site, type)) %>% 
    mutate(type = recode(type, 
                       "LAD" = "TLS (Smith et al., 2019)",
                       "LAI" = "Modis",
                       "PAI" = "UAV (Barbier, Verley, Vincent, unpublished)",
                       "PhenoCam" = "PhenoCam (Wu et al. 2016)",
                       "simulated" = "TROLL"))
monthly <- daily %>% 
  group_by(site, date = floor_date(date, "month"), type) %>% 
  summarise(l = quantile(value, 0.025, na.rm = TRUE), 
            value = mean(value, na.rm = TRUE), 
            h = quantile(value, 0.975, na.rm = TRUE))
Code
daily %>% 
  ggplot(aes(date, value, col = type)) +
  geom_line(alpha = 0.5) +
  geom_line(data = monthly) +
  facet_wrap(~ site, scales = "free_x") +
  theme_bw() +
  theme(legend.position = "bottom") +
  xlab("") + 
  ylab(expression("Leaf Area Index ["~m^2~m^{-2}~"]")) +
  scale_color_discrete("") +
  guides(col = guide_legend(nrow = 2))

Daily and monthly means of leaf area index for Paracou and Tapajos. Dark lines are the monthly means, semi-transparent lines are the daily means variations with the exception of satellite data for which data are available only every 8 days.
Code
g <- daily %>% 
  group_by(site, type, date = floor_date(date, "15 days")) %>% 
  summarise_all(mean, na.rm = T) %>%
  mutate(week = week(date)) %>%  
  group_by(site, type, week) %>% 
  summarise(l = quantile(value, 0.025, na.rm = TRUE), 
            m = mean(value, na.rm = TRUE), 
            h = quantile(value, 0.975, na.rm = TRUE)) %>% 
  ggplot(aes(week, m)) +
  geom_rect(aes(xmin = week, xmax = end), fill  = "#fff4e0",
           ymin = -Inf, ymax = Inf, alpha = 0.5,
           data = data.frame(week = week(as_date(c("2000-8-1", "2000-06-15"))),
                             m = -Inf,
                             end = week(as_date(c("2000-12-1", "2000-11-1"))),
                             site = c("Paracou", "Tapajos"))) +
  geom_ribbon(aes(ymin = l, ymax = h, fill = type), col = NA, alpha = 0.2) +
  geom_smooth(aes(col = type), se = FALSE) +
  theme_bw() +
  theme(legend.position = "bottom") +
  scale_fill_manual("", values = c("#ffa006", "#fb7754", "#197b14", "#0da1f8", "#3f3f3f")) +
  scale_color_manual("", values = c("#ffa006", "#fb7754", "#197b14", "#0da1f8", "#3f3f3f")) +
  facet_wrap(~ site, scales = "free_x") +
    scale_x_continuous(breaks = week(as_date(paste("2000-", 1:12, "-01"))),
                     labels = c("J", "F", "M", "A", "M", "J", "J", "A", "S", "O", "N", "D")) +
  ylab(expression("Leaf Area Index ["~m^2~m^{-~2}~"]")) + xlab("") +
  guides(col = guide_legend(nrow = 2), fill = guide_legend(nrow = 2)) +
  geom_text(aes(col = "TROLL", label = lab), 
            data = data.frame(week = 8, 
                              m = 5.2,
                              site = c("Paracou", "Tapajos"),
                              lab = c("RMSEP=0.11",
                                      "RMSEP=0.11")))
ggsave("figures/f08.png", g, dpi = 300, width = 8, height = 5, bg = "white")
g

Mean annual cycle from fortnightly means of leaf area index for Paracou and Tapajos. Bands are the intervals of means across years, and rectangles in the background correspond to the site’s climatological dry season.
Code
daily %>% 
  group_by(site, type, date = floor_date(date, "15 days")) %>% 
  summarise_all(mean, na.rm = T) %>%
  mutate(week = week(date)) %>%  
  group_by(site, type, week) %>% 
  summarise(value = mean(value, na.rm = TRUE)) %>% 
  pivot_wider(names_from = type, values_from = value) %>% 
  rename(simulated = TROLL) %>% 
  gather(type, observed, -site, -week, -simulated) %>% 
  na.omit() %>% 
  ungroup() %>% 
  nest_by(site, type) %>% 
  mutate(R2 = summary(lm(observed ~ 0 + simulated, data = data))$r.squared,
         CC = cor(data$simulated, data$observed),
         RMSEP = sqrt(mean((data$simulated-data$observed)^2)),
         RRMSEP = sqrt(mean((data$simulated-data$observed)^2))/mean(data$observed),
         SD =sd(data$simulated-data$observed),
         RSD =sd(data$simulated-data$observed)/mean(data$observed)) %>% 
  select(-data) %>% 
  knitr::kable(caption = "Evaluation fo monthly means of LAI at Paracou and Tapajos.")
Evaluation fo monthly means of LAI at Paracou and Tapajos.
site type R2 CC RMSEP RRMSEP SD RSD
Paracou Modis 0.9993110 0.6443293 0.2995714 0.0498207 0.1528940 0.0254273
Paracou UAV (Barbier, Verley, Vincent, unpublished) 0.9996465 0.8404994 0.1378908 0.0236607 0.1121080 0.0192366
Tapajos Modis 0.9992162 0.5613419 0.3990495 0.0649692 0.1641144 0.0267195
Tapajos PhenoCam (Wu et al. 2016) 0.9998312 0.9169373 0.1124293 0.0192047 0.0790174 0.0134974
Tapajos TLS (Smith et al., 2019) 0.9990079 0.2484052 0.2014810 0.0353875 0.1859247 0.0326553

Leaf Area Index per Age

For comparisons with Yang et al. (2023), we also simulated Leaf Area Index per leaf-age class. In the figure 8 of Yang et al. (2023) Tapajos is represented by the subclass S1, characterised by an always higher values old LAI above 3 m2/m2 and lower values of young and mature LAI around 1.5 m2/m2, while Paracou is represented by the subclass S2, characterised with high values of old LAI and low value of young and mature LAI in wet season but a strong loss of old LAI, a strong increase in mature LAI, a slight increase of young LAI in dry season. Similarly, in our simulations we observed a high LAI of old leaves especially in Tapajos. It seems that old leaf area are overestimated in Tapajos, because a priori there is little interest in accumulating less efficient leaves, and therefore confirms the hypothesis that the basal flux of litter is not high enough for Tapajos. At Paracou, we simulated back the phenology of Yang et al. (2023) with increased young LAI and mature LAI in the dry season while old LAI is decreasing, but a bit later than in Yang et al. (2023) and with values of mature LAI similar to those of old LAI between 2 and 3.5 m2/m2.

Code
daily <- read_tsv("outputs/evaluation_fluxes.tsv") %>% 
  filter(variable %in% c("lai_mature", "lai_old", "lai_young")) %>% 
  separate(variable, c("variable", "age")) %>% 
  rename(value = simulated)
monthly <- daily %>% 
  group_by(site, date = floor_date(date, "month"), variable, age) %>% 
  summarise(l = quantile(value, 0.025, na.rm = TRUE), 
            value = mean(value, na.rm = TRUE), 
            h = quantile(value, 0.975, na.rm = TRUE))
cols_laid <- c("young" = "#2bd22c", "mature" = "#197b14", "old" = "#ffa006")
Code
daily %>% 
  ggplot(aes(date, value, col = age)) +
  geom_line(alpha = 0.5) +
  geom_line(data = monthly) +
  facet_wrap(~ site, scales = "free_x") +
  theme_bw() +
  theme(legend.position = "bottom") +
  xlab("") + 
  ylab(expression("Leaf Area Index ["~m^2~m^{-2}~"]")) +
  scale_color_manual("", values = as.vector(cols_laid[c("mature", "old", "young")]))

Daily and monthly means of leaf area index for Paracou and Tapajos with leaf cohorts of yound, mature and old leaves. Dark lines are the monthly means, semi-transparent lines are the daily means variations.
Code
g <- daily %>% 
  group_by(site, variable, age, date = floor_date(date, "15 days")) %>% 
  summarise_all(mean, na.rm = T) %>%
  mutate(week = week(date)) %>%  
  group_by(site, variable, age, week) %>% 
  summarise(l = quantile(value, 0.025, na.rm = TRUE), 
            m = mean(value, na.rm = TRUE), 
            h = quantile(value, 0.975, na.rm = TRUE)) %>% 
  mutate(type = "TROLL") %>% 
  bind_rows(read_tsv("data/fluxes/lai_age.tsv") %>% 
              filter(type == "time series") %>% 
              mutate(type = "Yang et al. (2023)\nReanalysis")) %>% 
  bind_rows(readxl::read_xlsx("data/fluxes/Data_LAI_new.xlsx", 2) %>% 
              rename(young = `Obs_LAIyoung (m^2 m^-2)`,
                     mature = `Obs_LAImature (m^2 m^-2)`,
                     old = `Obs_LAIold (m^2 m^-2)`) %>% 
              mutate(site = "Tapajos", type = "Wu et al. (2016)\nPhenoCam") %>% 
              mutate(date = as_date(paste0("2010-", month, "-15"))) %>% 
              mutate(week = week(date)) %>% 
              select(site, week, type, young, mature, old) %>% 
              gather(age, m, -site, -week, -type)) %>% 
  mutate(type = factor(type, levels = c("TROLL", "Wu et al. (2016)\nPhenoCam",
                                        "Yang et al. (2023)\nReanalysis"))) %>% 
  ggplot(aes(week, m)) +
  geom_rect(aes(xmin = week, xmax = end), fill  = "#fff4e0",
           ymin = -Inf, ymax = Inf, alpha = 0.5,
           data = data.frame(week = week(as_date(c("2000-8-1", "2000-06-15"))),
                             m = -Inf,
                             end = week(as_date(c("2000-12-1", "2000-11-1"))),
                             site = c("Paracou", "Tapajos"))) +
  geom_ribbon(aes(ymin = l, ymax = h, fill = age), col = NA, alpha = 0.2) +
  geom_smooth(aes(col = age), se = FALSE) +
  theme_bw() +
  scale_fill_discrete("") +
  scale_color_discrete("") +
  facet_grid(site~ type) +
  scale_x_continuous(breaks = week(as_date(paste("2000-", 1:12, "-01"))),
                     labels = c("J", "F", "M", "A", "M", "J", "J", "A", "S", "O", "N", "D")) + 
  ylab(expression("Leaf Area Index ["~m^2~m^{-~2}~"]")) + xlab("") +
  scale_color_manual("", values = as.vector(cols_laid[c("mature", "old", "young")])) +
  scale_fill_manual("", values = as.vector(cols_laid[c("mature", "old", "young")])) +
  theme(legend.position = "bottom")
ggsave("figures/fa06.png", g, dpi = 300, width = 8, height = 5, bg = "white")
g

Mean annual cycle from fortnightly means of leaf area index for Paracou and Tapajos with leaf cohorts of yound, mature and old leaves. Bands are the intervals of means across years, and rectangles in the background correspond to the site’s climatological dry season.
Code
g <- daily %>% 
  group_by(site, variable, age, date = floor_date(date, "15 days")) %>% 
  summarise_all(mean, na.rm = T) %>%
  mutate(week = week(date)) %>%  
  group_by(site, variable, age, week) %>% 
  summarise(l = quantile(value, 0.025, na.rm = TRUE), 
            m = mean(value, na.rm = TRUE), 
            h = quantile(value, 0.975, na.rm = TRUE)) %>% 
  mutate(type = "TROLL") %>% 
  bind_rows(read_tsv("data/fluxes/lai_age.tsv") %>% 
              filter(type == "time series") %>% 
              mutate(type = "Yang et al. (2023) Reanalysis")) %>% 
  bind_rows(readxl::read_xlsx("data/fluxes/Data_LAI_new.xlsx", 2) %>% 
              rename(young = `Obs_LAIyoung (m^2 m^-2)`,
                     mature = `Obs_LAImature (m^2 m^-2)`,
                     old = `Obs_LAIold (m^2 m^-2)`) %>% 
              mutate(site = "Tapajos", type = "Wu et al. (2016) PhenoCam") %>% 
              mutate(date = as_date(paste0("2010-", month, "-15"))) %>% 
              mutate(week = week(date)) %>% 
              select(site, week, type, young, mature, old) %>% 
              gather(age, m, -site, -week, -type)) %>% 
  # bind_rows(readxl::read_xlsx("data/fluxes/Data_LAI_new.xlsx", 3) %>% 
  #             mutate(site = recode(Site, "K67" = "Tapajos")) %>% 
  #             rename(young = `LAIyoung (m^2 m^-2)`,
  #                    mature = `LAImature (m^2 m^-2)`,
  #                    old = `LAIold (m^2 m^-2)`) %>% 
  #             mutate(type = "Chen et al. (in prep)") %>% 
  #             mutate(date = as_date(paste0("2010-", month, "-15"))) %>% 
  #             mutate(week = week(date)) %>% 
  #             select(site, week, type, young, mature, old) %>% 
  #             gather(age, m, -site, -week, -type)) %>% 
  mutate(type = factor(type, levels = c("TROLL", "Wu et al. (2016) PhenoCam",
                                        "Yang et al. (2023) Reanalysis"))) %>% 
  group_by(site, variable, age, type) %>% 
  # mutate(m = m / mean(m)) %>% 
  mutate(m = as.vector(scale(m))) %>% 
  mutate(age = factor(age, levels = c("old", "mature", "young"))) %>% 
  ggplot(aes(week, m)) +
  geom_rect(aes(xmin = week, xmax = end), fill  = "#fff4e0",
           ymin = -Inf, ymax = Inf, alpha = 0.5,
           data = data.frame(week = week(as_date(c("2000-8-1", "2000-06-15"))),
                             m = -Inf,
                             end = week(as_date(c("2000-12-1", "2000-11-1"))),
                             site = c("Paracou", "Tapajos"))) +
  geom_smooth(aes(col = type), se = FALSE) +
  theme_bw() +
  scale_color_manual("", values = c("#0da1f8",  "#3f3f3f", "#fb7754")) +
  facet_grid(age ~ site) +
  scale_x_continuous(breaks = week(as_date(paste("2000-", 1:12, "-01"))),
                     labels = c("J", "F", "M", "A", "M", "J", "J", "A", "S", "O", "N", "D")) + 
  ylab(expression("Normalised Leaf Area Index")) + xlab("") +
  theme(legend.position = "bottom")
ggsave("figures/f09.png", g, dpi = 300, width = 8, height = 5, bg = "white")
g

Mean annual cycle from fortnightly means of leaf area index for Paracou and Tapajos with leaf cohorts of yound, mature and old leaves. Bands are the intervals of means across years, and rectangles in the background correspond to the site’s climatological dry season.
Code
troll <- list(
    lai_young = read_tsv("results/eval/Tapajos_R1/Tapajos_R1_0_LAIyoung.txt"),
    lai_mature = read_tsv("results/eval/Tapajos_R1/Tapajos_R1_0_LAImature.txt") %>% 
      mutate(iter = as.numeric(iter)) %>% na.omit(),
    lai_old = read_tsv("results/eval/Tapajos_R1/Tapajos_R1_0_LAIold.txt") %>% 
      mutate(iter = as.numeric(iter)) %>% na.omit()
  ) %>% bind_rows(.id = "variable") %>% 
  mutate(date = as_date("2004/01/01")+iter) %>% 
  select(-iter) %>% 
  gather(height, value, -date, -variable) %>% 
  separate(height, c("h", "height"), convert = T) %>% 
  mutate(canopy = ifelse(height < 20, "lower", "upper")) %>% 
  group_by(canopy, date) %>% 
  summarise(value = sum(value)) %>% 
  mutate(site = "Tapajos", variable = "LAI") %>% 
  mutate(week = week(date), year = year(date)) %>% 
  mutate(type = "TROLL")
obs <- read_tsv("outputs/lai_tapajos_strat.tsv") %>% 
  mutate(type = "LAI (Smith et al., 2019)")
bind_rows(troll, obs) %>% 
ggplot(aes(week, value)) +
    geom_rect(aes(xmin = week, xmax = end), fill  = "#fff4e0",
            ymin = -Inf, ymax = Inf, alpha = 0.5,
            data = data.frame(week = week(as_date(c("2000-06-15"))),
                              value = -Inf,
                              end = week(as_date(c("2000-11-1"))))) +
  geom_line(aes(group = paste(year, canopy), col = canopy), alpha = 0.5) +
  geom_smooth(aes(col = canopy), se = FALSE) +
  theme_bw() +
  theme(legend.position = "bottom") +
  ylab(expression("Leaf Area Index ["~m^2~m^{-~2}~"]")) + xlab("") +
  scale_x_continuous(breaks = week(as_date(paste("2000-", 1:12, "-01"))),
                     labels = c("J", "F", "M", "A", "M", "J", "J", "A", "S", "O", "N", "D")) +
  facet_wrap(~ type)

Evapotranspiration

The new version of TROLL correctly simulated the phenology of evapotranspiration (ET, mm/day), with a lower ET in wet season and an higher evaporative demand in the dry season. Simulations are slightly underestimating the ET but globally daily values overlaps in most of the 15-days windows with a wet season flux simulated around 2 mm/day against 3 mm/day observed in Paracou and both around 3.5 mm/day in the dry season. Similarly in Tapajos, the wet season flux simulated drop to almost 1 mm/day despite being above 2 mm/day in observations and they both reach 3 mm/day in the dry season. Both simulations and observations are driven by daily maximum vapour pressure deficit with a correlation coefficient between 0.58 and 0.67 for observation, and more deterministic for simulations between 0.89 and 0.93. Globally, simulated ET showed a very good evaluation with a correlation coefficient of 0.73 in Paracou and 0.72 in Tapajos against daily observations from eddy-flux towers, and corresponding RMSEP of respectively 0.9 and 0.8 mm/day.

Code
daily <- read_tsv("outputs/evaluation_fluxes.tsv") %>% 
  filter(variable == "et") %>% 
  left_join(read_tsv("outputs/fluxnet_fluxes.tsv") %>% 
              mutate(observed = value*20) %>% 
              select(-value)) %>% 
  left_join(read_tsv("outputs/fluxnet_fluxes.tsv") %>% 
              filter(variable %in% c("par", "vpd_max", "temperature", "ws")) %>% 
              rename(determinant = variable, determinant_value = value)) %>% 
  gather(type, value, -site, -date, -variable, -determinant, -determinant_value)
monthly <- daily %>% 
  group_by(site, date = floor_date(date, "month"), variable, type) %>% 
  summarise(l = quantile(value, 0.025, na.rm = TRUE), 
            value = mean(value, na.rm = TRUE), 
            h = quantile(value, 0.975, na.rm = TRUE))
daily_etp <- read_tsv("outputs/fluxnet_climate.tsv") %>% 
  mutate(ws = ws) %>% # u10
  mutate(rgnet = snet) %>% # already rgnet
  mutate(es = 0.6108*exp((17.27*temperature)/(237.3+temperature))) %>% 
  mutate(ea = es - vpd) %>% 
  mutate(delta = 4098*es/(237.3+temperature)) %>% 
  mutate(z = 30) %>% # with 30-m canopy
  mutate(p = 101.3*((293-0.0065*z)/293)^5.26) %>% 
  mutate(gamma = 0.655*10^(-3)*p) %>% 
  mutate(etp = (0.408*delta*rgnet+gamma*(900/(temperature+273))*ws*vpd)/
           (delta+gamma*(1+0.34*ws))) %>% 
  mutate(etp = etp/1000) %>% 
  group_by(site, date = date(time)) %>% 
  summarise(value = sum(etp)) %>% 
  mutate(type = "etp") %>% 
  select(site, date, type, value)
Code
g <- daily %>% 
  ggplot(aes(date, value, col = type)) +
  geom_line(alpha = 0.5) +
  geom_line(data = monthly) +
  facet_wrap(~ site, nrow = 2) +
  theme_bw() +
  theme(legend.position = "bottom") +
  xlab("") + 
  ylab(expression("Evapotranspiration ["~mm~day^{-~1}~"]")) +
  scale_color_manual("", values = as.vector(cols[c("obs", "sim")]), 
                     labels = c("Tower", "TROLL"))
ggsave("figures/fa08.png", g, dpi = 300, width = 10, height = 5, bg = "white")
g

Daily and monthly means of evapotranpsiration for Paracou and Tapajos. Dark lines are the monthly means, semi-transparent lines are the daily means variations
Code
g <- daily %>% 
  group_by(site, variable, type, date = floor_date(date, "15 days")) %>% 
  summarise_all(mean, na.rm = T) %>%
  mutate(week = week(date)) %>%  
  group_by(site, variable, type, week) %>% 
  summarise(l = quantile(value, 0.025, na.rm = TRUE), 
            m = mean(value, na.rm = TRUE), 
            h = quantile(value, 0.975, na.rm = TRUE)) %>% 
  ggplot(aes(week, m)) +
  geom_rect(aes(xmin = week, xmax = end), fill  = "#fff4e0",
           ymin = -Inf, ymax = Inf, alpha = 0.5,
           data = data.frame(week = week(as_date(c("2000-8-1", "2000-06-15"))),
                             m = -Inf,
                             end = week(as_date(c("2000-12-1", "2000-11-1"))),
                             site = c("Paracou", "Tapajos"))) +
  geom_ribbon(aes(ymin = l, ymax = h, fill = type), col = NA, alpha = 0.2) +
  geom_smooth(aes(col = type), se = FALSE) +
  theme_bw() +
  theme(legend.position = "bottom") +
  scale_fill_discrete("") +
  scale_color_discrete("") +
  facet_wrap(~ site, scales = "free_x") +
    scale_x_continuous(breaks = week(as_date(paste("2000-", 1:12, "-01"))),
                     labels = c("J", "F", "M", "A", "M", "J", "J", "A", "S", "O", "N", "D")) + 
  ylab(expression("Evapotranspiration ["~mm~day^{-~1}~"]")) + xlab("") +
    scale_color_manual("", values = as.vector(cols[c("obs", "sim")]), 
                     labels = c("Tower", "TROLL")) +
  scale_fill_manual("", values = as.vector(cols[c("obs", "sim")]), 
                     labels = c("Tower", "TROLL")) +
  geom_text(aes(col = "simulated", label = lab), 
            data = data.frame(week = 8, 
                              m = 1,
                              site = c("Paracou", "Tapajos"),
                              lab = c("RMSEP=0.60",
                                      "RMSEP=0.75")))
ggsave("figures/f11.png", g, dpi = 300, width = 8, height = 5, bg = "white")
g

Mean annual cycle from fortnightly means of evapotranspiration for Paracou and Tapajos. Bands are the intervals of means across years, and rectangles in the background correspond to the site’s climatological dry season.
Code
g <- daily %>% 
  mutate(determinant_value = ifelse(determinant == "par", 
                                    determinant_value/10^2, determinant_value)) %>% 
  mutate(det_long = recode(determinant, 
                           "par" = 'Incoming~PAR~"["~mol~m^{-~2}~day^{-~1}~"]"',
                           "temperature" = 'Temperature~"["~degree~C~"]"',
                            "vpd_max" = '"Vapour Pressure Deficit ["~kPa~day^{-~1}~"]"',
                           "ws" = 'Wind~Speed~"["~m^{2}~s^{-~1}~"]"')) %>% 
  ggplot(aes(determinant_value, value, col = type)) +
  geom_point(alpha = 0.1) +
  theme_bw() +
  facet_grid(site ~ det_long, scales = "free", labeller = label_parsed) +
  theme(legend.position = "bottom") +
  geom_smooth(method = "lm", formula = "y ~ 1+log(x+10^-6)", se = FALSE) +
  ylab(expression("Evapotranspiration ["~mm~day^{-~1}~"]")) + 
  xlab("") +
  scale_color_manual("", values = as.vector(cols[c("obs", "sim")]), 
                     labels = c("Tower", "TROLL")) +
  scale_fill_manual("", values = as.vector(cols[c("obs", "sim")]), 
                     labels = c("Tower", "TROLL")) +
  ylim(0, 5.5) +
  ggpubr::stat_cor(aes(label = paste(..rr.label.., ..p.label.., sep = "~`,`~")),
                   p.accuracy = 0.001)
ggsave("figures/f13.png", g, dpi = 300, width = 10, height = 7, bg = "white")
g

Daily averages of evapotranspiration as a function of vapour pressure deficit, incoming photosynthetically active radiation, temperature, and wind speed for model-, satellite- and tower-based estimates at Paracou and Tapajos.
Code
daily %>% 
  pivot_wider(names_from = type, values_from = value) %>% 
  ggplot(aes(simulated ,observed, col = yday(date))) +
  facet_wrap(~ site) +
  theme_bw() +
  geom_point() +
  scale_color_viridis_c("Day") +
  geom_abline(col = "red") +
  ylab(expression("Observed ET ["~mm~day^{-~1}~"]")) + 
  xlab(expression("Simulated ET ["~mm~day^{-~1}~"]")) + 
  scale_color_viridis_c("Day") +
  ggpubr::stat_cor()

Evaluation of simulated versus observed daily means of ET in Paracou and Tapajos.
Code
daily %>% 
  pivot_wider(names_from = type, values_from = value) %>% 
  na.omit() %>% 
  nest_by(site, variable) %>% 
  mutate(R2 = summary(lm(observed ~ 0 + simulated, data = data))$r.squared,
         CC = cor(data$simulated, data$observed),
         RMSEP = sqrt(mean((data$simulated-data$observed)^2)),
         RRMSEP = sqrt(mean((data$simulated-data$observed)^2))/mean(data$observed),
         SD =sd(data$simulated-data$observed),
         RSD =sd(data$simulated-data$observed)/mean(data$observed)) %>% 
  select(-data) %>% 
  knitr::kable(caption = "Evaluation fo daily means of ET at Paracou and Tapajos.")
Evaluation fo daily means of ET at Paracou and Tapajos.
site variable R2 CC RMSEP RRMSEP SD RSD
Paracou et 0.9642259 0.6929455 0.6016211 0.1961181 0.5939954 0.1936323
Tapajos et 0.9536370 0.6545958 0.7509561 0.2965747 0.6295722 0.2486367

E/T

Code
g <- list(
  Paracou = read_tsv("results/eval/Paracou_R1/Paracou_R1_0_water_balance.txt") %>% 
     mutate(date = as_date("2004/01/01")+iter),
  Tapajos = read_tsv("results/eval/Tapajos_R1/Tapajos_R1_0_water_balance.txt") %>% 
     mutate(date = as_date("2002/01/01")+iter)
) %>% bind_rows(.id = "site") %>% 
  mutate(transpiration = (transpitation_0 + transpitation_1 + transpitation_2 + 
                            transpitation_3 + transpitation_4)*1000,
         "soil evaporation" = evaporation*1000,
         "canopy evaporation" = (precipitation/1000-throughfall)*1000) %>% 
  select(site, date, transpiration, "soil evaporation", "canopy evaporation") %>% 
  gather(variable, value, -site, -date) %>% 
  group_by(site, variable, date = floor_date(date, "15 days")) %>% 
  summarise_all(mean, na.rm = T) %>%
  mutate(week = week(date)) %>%  
  group_by(site, variable, week) %>% 
  summarise(l = quantile(value, 0.025, na.rm = TRUE), 
            m = mean(value, na.rm = TRUE), 
            h = quantile(value, 0.975, na.rm = TRUE)) %>% 
  ggplot(aes(week, m)) +
  geom_rect(aes(xmin = week, xmax = end), fill  = "#fff4e0",
           ymin = -Inf, ymax = Inf, alpha = 0.5,
           data = data.frame(week = week(as_date(c("2000-8-1", "2000-06-15"))),
                             m = -Inf,
                             end = week(as_date(c("2000-12-1", "2000-11-1"))),
                             site = c("Paracou", "Tapajos"))) +
  geom_ribbon(aes(ymin = l, ymax = h, fill = variable), col = NA, alpha = 0.2) +
  geom_smooth(aes(col = variable), se = FALSE) +
  theme_bw() +
  theme(legend.position = "bottom") +
  scale_fill_discrete("") +
  scale_color_discrete("") +
  facet_wrap(~ site, scales = "free_x") +
    scale_x_continuous(breaks = week(as_date(paste("2000-", 1:12, "-01"))),
                     labels = c("J", "F", "M", "A", "M", "J", "J", "A", "S", "O", "N", "D")) + 
  ylab(expression("Volume ["~mm~day^{-~1}~"]")) + xlab("")
ggsave("figures/fa09.png", g, dpi = 300, width = 8, height = 5, bg = "white")
g

E/T partitionning.

Relative Soil Water Content

We only had soil water content measurement for Paracou. Moreover, soil water content measurement are measured with electric measurement of conductance and rely a lot on calibration. We thus decided to use Relative Soil water Content (RSWC, %) to avoid bias of tool calibration and focus on within-year variations. The new version of TROLL correctly simulated the phenology of RSWC, with a higher RSWC in wet season around 100% with fully saturated soils and a strong drop in RSWC in the dry season. Focusing on the drop in dry seasons, the mean value simulated across year in Paracou dropped to 80% but exceptionally dry years drop up to 50%. The observed conditions are harsher with a mean observed drop around 50% across years that is below 50 most years and drop to 40% the driest years. Globally, simulated RSWC showed a good evaluation at Paracou with a correlation coefficient of 0.77 against daily observations from eddy-flux towers, and corresponding RMSEP of 23 %.

Code
daily <- read_tsv("outputs/evaluation_fluxes.tsv") %>% 
  filter(variable == "rswc10") %>% 
  left_join(read_tsv("outputs/guyaflux_swc.tsv") %>% 
              filter(variable == "swc10") %>% 
              group_by(site, year = year(date)) %>% 
              mutate(observed = value / quantile(value, 0.95, na.rm = T)) %>% 
              mutate(observed = ifelse(observed > 1, 1, observed)) %>% 
              ungroup() %>% 
              mutate(variable = "rswc10") %>% 
              select(-year, -value)) %>% 
  gather(type, value, -site, -date, -variable) %>% 
  na.omit()
monthly <- daily %>% 
  group_by(site, date = floor_date(date, "month"), variable, type) %>% 
  summarise(l = quantile(value, 0.025, na.rm = TRUE), 
            value = mean(value, na.rm = TRUE), 
            h = quantile(value, 0.975, na.rm = TRUE))
Code
daily %>% 
  ggplot(aes(date, value, col = type)) +
  geom_line(alpha = 0.5) +
  geom_line(data = monthly) +
  facet_wrap(~ site, scales = "free_x") +
  theme_bw() +
  theme(legend.position = "bottom") +
  xlab("") + 
  ylab(expression("Relative Soil Water Content ["~"%"~"]")) +
  scale_color_manual("", values = as.vector(cols[c("obs", "sim")]), 
                     labels = c("Tower", "TROLL"))

Daily and monthly means of relative soil water content for Paracou and Tapajos. Dark lines are the monthly means, semi-transparent lines are the daily means variations.
Code
g <- daily %>% 
  group_by(site, variable, type, date = floor_date(date, "15 days")) %>% 
  summarise_all(mean, na.rm = T) %>%
  mutate(week = week(date), year = year(date), m = value) %>% 
  na.omit() %>% 
  ggplot(aes(week, m)) +
  geom_rect(aes(xmin = week, xmax = end), fill  = "#fff4e0",
           ymin = -Inf, ymax = Inf, alpha = 0.5,
           data = data.frame(week = week(as_date(c("2000-8-1", "2000-06-15"))),
                             m = -Inf,
                             end = week(as_date(c("2000-12-1", "2000-11-1"))),
                             site = c("Paracou", "Tapajos"))) +
  geom_line(aes(group = paste(year, type), col = type), alpha = 0.5) +
  geom_smooth(aes(col = type), se = FALSE) +
  theme_bw() +
  theme(legend.position = "bottom") +
  scale_fill_discrete("") +
  scale_color_discrete("") +
  facet_wrap(~ site, scales = "free_x") +
    scale_x_continuous(breaks = week(as_date(paste("2000-", 1:12, "-01"))),
                     labels = c("J", "F", "M", "A", "M", "J", "J", "A", "S", "O", "N", "D")) + 
  ylab(expression("Relative Soil Water Content ["~"%"~"]")) + xlab("") +
  scale_color_manual("", values = as.vector(cols[c("obs", "sim")]), 
                     labels = c("Tower", "TROLL")) +
  scale_fill_manual("", values = as.vector(cols[c("obs", "sim")]), 
                     labels = c("Tower", "TROLL"))
ggsave("figures/fa10.png", g, dpi = 300, width = 8, height = 5, bg = "white")
g

Mean annual cycle from fortnightly means of relative soil water content for Paracou and Tapajos. Bands are the intervals of means across years, and rectangles in the background correspond to the site’s climatological dry season.
Code
daily %>% 
  pivot_wider(names_from = type, values_from = value) %>% 
  na.omit() %>% 
  nest_by(site, variable) %>% 
  mutate(R2 = summary(lm(observed ~ 0 + simulated, data = data))$r.squared,
         CC = cor(data$simulated, data$observed),
         RMSEP = sqrt(mean((data$simulated-data$observed)^2)),
         RRMSEP = sqrt(mean((data$simulated-data$observed)^2))/mean(data$observed),
         SD =sd(data$simulated-data$observed),
         RSD =sd(data$simulated-data$observed)/mean(data$observed)) %>% 
  select(-data) %>% 
  knitr::kable(caption = "Evaluation fo daily means of RSWC at Paracou and Tapajos.")
Evaluation fo daily means of RSWC at Paracou and Tapajos.
site variable R2 CC RMSEP RRMSEP SD RSD
Paracou rswc10 0.9675417 0.7739017 0.2337945 0.3217001 0.1274114 0.1753174
Tapajos rswc10 0.9826553 0.3900953 0.1972941 0.2445000 0.1078694 0.1336790
Code
daily <- read_tsv("outputs/evaluation_fluxes.tsv") %>% 
  filter(grepl("^swc", variable)) %>% 
  mutate(depth = as.numeric(gsub("swc", "", variable))) %>% 
  mutate(depth = recode(paste(site, depth), 
                        "Paracou 0" = 0.1,
                        "Tapajos 0" = 0.1,
                        "Paracou 1" = 0.33,
                        "Tapajos 1" = 0.5,
                        "Paracou 2" = 0.73,
                        "Tapajos 2" = 1.5,
                        "Paracou 3" = 1.53,
                        "Tapajos 3" = 4,
                        "Paracou 4" = 2.5,
                        "Tapajos 4" = 16.1)) %>% 
  mutate(day = yday(date), type = 'simulated', value = simulated) %>% 
  select(site, date, day, type, depth, value) %>% 
  bind_rows(read_tsv("outputs/guyaflux_swc.tsv") %>% 
              mutate(depth = as.numeric(gsub("swc", "", variable))/100) %>%
              mutate(day = yday(date), type = 'observed') %>% 
              select(site, date, day, type, depth, value))
g <- daily %>% 
  group_by(site, depth, type, day = yday(date)) %>% 
  summarise(l = quantile(value, 0.025, na.rm = TRUE), 
            m = mean(value, na.rm = TRUE), 
            h = quantile(value, 0.975, na.rm = TRUE)) %>% 
  mutate(depth = as.factor(depth)) %>% 
  ggplot(aes(day, m)) +
  geom_rect(aes(xmin = day, xmax = end), fill  = "#fff4e0",
           ymin = -Inf, ymax = Inf, alpha = 0.5,
           data = data.frame(day = yday(as_date(c("2000-8-1", "2000-06-15"))),
                             m = -Inf,
                             end = yday(as_date(c("2000-12-1", "2000-11-1"))),
                             site = c("Paracou", "Tapajos"))) +
  geom_ribbon(aes(ymin = l, ymax = h, col = depth, fill = depth, group = depth),
              col = NA, alpha = 0.2) +
  geom_line(aes(col = depth, fill = depth, group = depth)) +
  theme_bw() +
  scale_color_viridis_d("Depth (m)", direction = -1) +
  scale_fill_viridis_d("Depth (m)", direction = -1) +
  theme(axis.title.x = element_blank()) +
  ylab(expression(Soil~Water~Content~"["~m^{3}~m^{-~3}~"]")) +
  scale_x_continuous(breaks = c(1, 32, 61, 92, 122, 153, 183, 214, 245, 275, 306, 336),
                    labels = c("J", "F", "M", "A", "M", "J", "J", "A", "S", "O", "N", "D")) +
  facet_wrap(~ type ~ site, nrow = 2, scales = "free_y")
ggsave("figures/fa11.png", g, dpi = 300, width = 8, height = 5, bg = "white")
g

Mean annual cycle from daily means of soil water content for Paracou and Tapajos at different depths. The depth value indicates the maximum depth of the layer. Dark lines are the daily means across years, and bands are the intervals of means across ten years The vertical yellow bands in the background correspond to the site’s climatological dry season.