West Florida Shelf: Hypoxia Summer 2023

Code

library(cmocean)
library(fields)
library(leaflet)
library(lubridate)
library(quarto)
library(knitr)
library(rmarkdown)
library(htmlwidgets)
library(terra)

world <- readRDS('fl_shp.RDS')
fl_topo <- readRDS('fl_topo.RDS')

ox.col1 <- colorRampPalette(c('gray20','firebrick4','red'))
ox.col2 <- colorRampPalette(c('darkgoldenrod4','goldenrod2','gold'))
ox.col3 <- colorRampPalette(c('dodgerblue4','deepskyblue2','cadetblue1','azure'))
o_brks <- seq(0,10,.5)
o_cols <- c(ox.col1(length(o_brks[o_brks<=2])-1),
            ox.col2(length(o_brks[o_brks>2 & o_brks<=3.5])),
            ox.col3(length(o_brks[o_brks>3.5])))

Overview

Below is an interactive map displaying all the available survey data for the West Florida Shelf for 2023. The circles are color coded for the data source (i.e, AOML, FCWC, NMFS, SEAMAP). The radius of the circles are proportional to the bottom dissolved oxygen. Clicking on a circle will display a callout balloon with more information for that data point. Additional plots per data source are following this map.

Code

dat <- read.csv('wfs_hyp23.csv')
dat$date <- ymd_hms(dat$date)

# basemap <- providers$CartoDB.Positron
# basemap <- providers$Esri.OceanBasemap
basemap <- providers$Esri.NatGeoWorldMap

cols <- colorRampPalette(c("#80B056","#D73A90","#9E9E9E","#EAC121"))
# "#000000" "#C3485D" "#80B056" "#39ACAD" "#25BCE5" "#6591D5" "#D73A90" "#EAC121" "#9E9E9E"
pal <- colorFactor(
  palette = cols(4),
  domain = dat$source
)

leaflet(data = dat) %>%
  addProviderTiles(basemap) %>%
  setView(-83, 26.5, zoom = 6)  %>%
  addScaleBar() %>%
  addCircleMarkers(~lon, ~lat, radius = round(dat$bot_oxy,2),
                   stroke = T, weight = 1, color = 'black',
                   fill = T, fillColor = ~pal(source), fillOpacity = 0.7,
                   popup = paste('Source:',dat$source, '<br>',
                                 'Date:',dat$date, '<br>',
                                 'Sample Depth (m):', round(dat$bot_z, 2), '<br>',
                                 "Longitude:", round(dat$lon, 4), '<br>',
                                 "Latitude:", round(dat$lat, 4), '<br>',
                                 "Bottom Temp (C):", round(dat$bot_temp, 2), '<br>',
                                 "Bottom Sal (psu):", round(dat$bot_sal, 2), '<br>',
                                 "Bottom DO (mg/l):", round(dat$bot_oxy, 2))) %>%
  addLegend('bottomright',
            colors = c("#80B056","#D73A90","#9E9E9E","#EAC121"),
            labels=c('AOML','FCWC','NMFS','SEAMAP'),
            opacity = 0.7)

---

---

Times series

These scatterplots display time series of bottom temperature (top), bottom salinity (middle), and bottom dissolved oxygen (bottom) from each cruise there are data available. The plots show the evolution of each parameter in the region from May to early September. On the dissolved oxygen plot, there are dashed line at 2 mg/l (red) and 3.5 mg/l (gold) representing hypoxia and low oxygen, respectively.

Code

colrs <- cols(4)

par(mfrow=c(3,1), mar=c(1,4,1,1),oma=c(3,1,1,1))
plot(dat$date, dat$bot_temp, 
     pch = as.numeric(factor(dat$source)) + 20, cex = 1.5,
     bg = colrs[as.numeric(factor(dat$source))],
     xaxt = 'n', xlab = '', ylab = 'Bottom Temperature (C)')
legend('topleft',c('AOML','FCWC','NMFS','SEAMAP'),
       pch = c(21, 22, 23, 24), 
       pt.bg = colrs, bty = 'n')

plot(dat$date, dat$bot_sal, 
     pch = as.numeric(factor(dat$source)) + 20, cex = 1.5,
     bg = colrs[as.numeric(factor(dat$source))],
     xaxt = 'n', xlab = '', ylab = 'Bottom Salinity (PSU)')

plot(dat$date, dat$bot_oxy, 
     pch = as.numeric(factor(dat$source)) + 20, cex = 1.5, 
     bg = colrs[as.numeric(factor(dat$source))],
     xlab = 'Date', ylab = 'Bottom Oxygen (mg/l)')
abline(h = c(2, 3.5), col = c('red', 'gold'), lty = c(2, 5), lend = 2)

---

---

Individual Cruise plots

Below are scatterplots of bottom temperature (left), bottom salinity (middle), and bottom dissolved oxygen (right). The For each parameter, there is a common colorbar range to directly compare the values between cruises.

NMFS Plankton Survey, May 4 to May 26, maximum depth of CTD casts were 200m.

Code

# par(mfrow=c(1,1))

i5 <- which(dat$source=='nmfs' & month(dat$date)==5)
i6 <- which(dat$source=='seamap' & month(dat$date)==6)
i7 <- which(dat$source=='aoml' & month(dat$date)==7)
i8 <- which(dat$source=='nmfs' & month(dat$date)==8)

i_sub <- union(i5, i6)
i_sub <- union(i_sub, i7)
i_sub <- union(i_sub, i8)

dat_sub <- dat[i_sub,]
# temperature
t_brks <- pretty(dat_sub$bot_temp, n = 20)
t_cols <- cmocean('thermal')(length(t_brks)-1)
# salinity
s_brks <- pretty(dat_sub$bot_sal, n = 20)
s_cols <- cmocean('haline')(length(s_brks)-1)

dat5 <- dat[i5,]
xlim5 <- c(min(dat5$lon, na.rm = T) - .5, max(dat5$lon, na.rm = T) + .5)
ylim5 <- c(min(dat5$lat, na.rm = T) - .5, max(dat5$lat, na.rm = T) + .5)
t_cuts5 <- cut(dat5$bot_temp, t_brks)
s_cuts5 <- cut(dat5$bot_sal, s_brks)
o_cuts5 <- cut(dat5$bot_oxy, o_brks)

dat6 <- dat[i6,]
xlim6 <- c(min(dat6$lon, na.rm = T) - .1, max(dat6$lon, na.rm = T) + .1)
ylim6 <- c(min(dat6$lat, na.rm = T) - .1, max(dat6$lat, na.rm = T) + .1)
t_cuts6 <- cut(dat6$bot_temp, t_brks)
s_cuts6 <- cut(dat6$bot_sal, s_brks)
o_cuts6 <- cut(dat6$bot_oxy, o_brks)

dat7 <- dat[i7,]
xlim7 <- c(min(dat7$lon, na.rm = T) - .1, max(dat7$lon, na.rm = T) + .1)
ylim7 <- c(min(dat7$lat, na.rm = T) - .1, max(dat7$lat, na.rm = T) + .1)
t_cuts7 <- cut(dat7$bot_temp, t_brks)
s_cuts7 <- cut(dat7$bot_sal, s_brks)
o_cuts7 <- cut(dat7$bot_oxy, o_brks)

dat8 <- dat[i8,]
xlim8 <- c(min(dat8$lon, na.rm = T) - .1, max(dat8$lon, na.rm = T) + .1)
ylim8 <- c(min(dat8$lat, na.rm = T) - .1, max(dat8$lat, na.rm = T) + .1)
t_cuts8 <- cut(dat8$bot_temp, t_brks)
s_cuts8 <- cut(dat8$bot_sal, s_brks)
o_cuts8 <- cut(dat8$bot_oxy, o_brks)

### May NMFS
imagePlot(1:2, 1:2, matrix(NA,2,2),
          col = t_cols, breaks = t_brks, asp = 1,
          xlab = 'Longitude', ylab = 'Latitude', las = 1,
          xlim = xlim5, ylim = ylim5,
          nlevel = length(t_cols), legend.width = .7, legend.mar = 4)
points(dat5$lon, dat5$lat, 
       col = t_cols[as.numeric(t_cuts5)], bg = t_cols[as.numeric(t_cuts5)], pch = 21, cex=3)
plot(world, add=T)
contour(fl_topo$lon, fl_topo$lat, fl_topo$z, levels = c(-200, -100, -50, -25, -10), add=T, col = 'gray70')
mtext('Bottom temperature (C)', cex = 1.5, adj = 1)
imagePlot(1:2, 1:2, matrix(NA,2,2),
          col = s_cols, breaks = s_brks, asp = 1,
          xlab = 'Longitude', ylab = 'Latitude', las = 1,
          xlim = xlim5, ylim = ylim5,
          nlevel = length(s_cols), legend.width = .7, legend.mar = 4)
points(dat5$lon, dat5$lat, 
       col = s_cols[as.numeric(s_cuts5)], bg = s_cols[as.numeric(s_cuts5)], pch = 21, cex=3)
plot(world, add=T)
contour(fl_topo$lon, fl_topo$lat, fl_topo$z, levels = c(-200, -100, -50, -25, -10), add=T, col = 'gray70')
mtext('Bottom salinity (PSU)', cex = 1.5, adj = 1)
imagePlot(1:2, 1:2, matrix(NA,2,2),
          col = o_cols, breaks = o_brks, asp = 1,
          xlab = 'Longitude', ylab = 'Latitude', las = 1,
          xlim = xlim5, ylim = ylim5,
          nlevel = length(o_cuts), legend.width = .7, legend.mar = 4)
points(dat5$lon, dat5$lat, 
       col = o_cols[as.numeric(o_cuts5)], bg = o_cols[as.numeric(o_cuts5)], pch = 21, cex=3)
plot(world, add=T)
contour(fl_topo$lon, fl_topo$lat, fl_topo$z, levels = c(-200, -100, -50, -25, -10), add=T, col = 'gray70')
mtext('Bottom dissolved oxygen (mg/l)', cex = 1.5, adj = 1)

---

Florida SEAMAP Survey, June 7 to June 16.

Code

### June SEAMAP
imagePlot(1:2, 1:2, matrix(NA,2,2),
          col = t_cols, breaks = t_brks, asp = 1,
          xlab = 'Longitude', ylab = 'Latitude', las = 1,
          xlim = xlim6, ylim = ylim6,
          nlevel = length(t_cols), legend.width = .7, legend.mar = 4)
points(dat6$lon, dat6$lat, 
       col = t_cols[as.numeric(t_cuts6)], bg = t_cols[as.numeric(t_cuts6)], pch = 21, cex=3)
plot(world, add=T)
contour(fl_topo$lon, fl_topo$lat, fl_topo$z, levels = c(-200, -100, -50, -25, -10), add=T, col = 'gray70')
mtext('Bottom temperature (C)', cex = 1.5, adj = 1)
imagePlot(1:2, 1:2, matrix(NA,2,2),
          col = s_cols, breaks = s_brks, asp = 1,
          xlab = 'Longitude', ylab = 'Latitude', las = 1,
          xlim = xlim6, ylim = ylim6,
          nlevel = length(s_cols), legend.width = .7, legend.mar = 4)
points(dat6$lon, dat6$lat, 
       col = s_cols[as.numeric(s_cuts6)], bg = s_cols[as.numeric(s_cuts6)], pch = 21, cex=3)
plot(world, add=T)
contour(fl_topo$lon, fl_topo$lat, fl_topo$z, levels = c(-200, -100, -50, -25, -10), add=T, col = 'gray70')
mtext('Bottom salinity (PSU)', cex = 1.5, adj = 1)
imagePlot(1:2, 1:2, matrix(NA,2,2),
          col = o_cols, breaks = o_brks, asp = 1,
          xlab = 'Longitude', ylab = 'Latitude', las = 1,
          xlim = xlim6, ylim = ylim6,
          nlevel = length(o_cuts), legend.width = .7, legend.mar = 4)
points(dat6$lon, dat6$lat, 
       col = o_cols[as.numeric(o_cuts6)], bg = o_cols[as.numeric(o_cuts6)], pch = 21, cex=3)
plot(world, add=T)
contour(fl_topo$lon, fl_topo$lat, fl_topo$z, levels = c(-200, -100, -50, -25, -10), add=T, col = 'gray70')
mtext('Bottom dissolved oxygen (mg/l)', cex = 1.5, adj = 1)

---

AOML SFER Cruise, July 22 to July 28.

Code

### July AOML
imagePlot(1:2, 1:2, matrix(NA,2,2),
          col = t_cols, breaks = t_brks, asp = 1,
          xlab = 'Longitude', ylab = 'Latitude', las = 1,
          xlim = xlim7, ylim = ylim7,
          nlevel = length(t_cols), legend.width = .7, legend.mar = 4)
points(dat7$lon, dat7$lat, 
       col = t_cols[as.numeric(t_cuts7)], bg = t_cols[as.numeric(t_cuts7)], pch = 21, cex=3)
plot(world, add=T)
contour(fl_topo$lon, fl_topo$lat, fl_topo$z, levels = c(-200, -100, -50, -25, -10), add=T, col = 'gray70')
mtext('Bottom temperature (C)', cex = 1.5, adj = 1)
imagePlot(1:2, 1:2, matrix(NA,2,2),
          col = s_cols, breaks = s_brks, asp = 1,
          xlab = 'Longitude', ylab = 'Latitude', las = 1,
          xlim = xlim7, ylim = ylim7,
          nlevel = length(s_cols), legend.width = .7, legend.mar = 4)
points(dat7$lon, dat7$lat, 
       col = s_cols[as.numeric(s_cuts7)], bg = s_cols[as.numeric(s_cuts7)], pch = 21, cex=3)
plot(world, add=T)
contour(fl_topo$lon, fl_topo$lat, fl_topo$z, levels = c(-200, -100, -50, -25, -10), add=T, col = 'gray70')
mtext('Bottom salinity (PSU)', cex = 1.5, adj = 1)
imagePlot(1:2, 1:2, matrix(NA,2,2),
          col = o_cols, breaks = o_brks, asp = 1,
          xlab = 'Longitude', ylab = 'Latitude', las = 1,
          xlim = xlim7, ylim = ylim7,
          nlevel = length(o_cuts), legend.width = .7, legend.mar = 4)
points(dat7$lon, dat7$lat, 
       col = o_cols[as.numeric(o_cuts7)], bg = o_cols[as.numeric(o_cuts7)], pch = 21, cex=3)
plot(world, add=T)
contour(fl_topo$lon, fl_topo$lat, fl_topo$z, levels = c(-200, -100, -50, -25, -10), add=T, col = 'gray70')
mtext('Bottom dissolved oxygen (mg/l)', cex = 1.5, adj = 1)

---

NMFS Groundfish Survey, August 16 to August 25.

Code

### Aug NMFS
imagePlot(1:2, 1:2, matrix(NA,2,2),
          col = t_cols, breaks = t_brks, asp = 1,
          xlab = 'Longitude', ylab = 'Latitude', las = 1,
          xlim = xlim8, ylim = ylim8,
          nlevel = length(t_cols), legend.width = .7, legend.mar = 4)
points(dat8$lon, dat8$lat, 
       col = t_cols[as.numeric(t_cuts8)], bg = t_cols[as.numeric(t_cuts8)], pch = 21, cex=3)
plot(world, add=T)
contour(fl_topo$lon, fl_topo$lat, fl_topo$z, levels = c(-200, -100, -50, -25, -10), add=T, col = 'gray70')
mtext('Bottom temperature (C)', cex = 1.5, adj = 1)
imagePlot(1:2, 1:2, matrix(NA,2,2),
          col = s_cols, breaks = s_brks, asp = 1,
          xlab = 'Longitude', ylab = 'Latitude', las = 1,
          xlim = xlim8, ylim = ylim8,
          nlevel = length(s_cols), legend.width = .7, legend.mar = 4)
points(dat8$lon, dat8$lat, 
       col = s_cols[as.numeric(s_cuts8)], bg = s_cols[as.numeric(s_cuts8)], pch = 21, cex=3)
plot(world, add=T)
contour(fl_topo$lon, fl_topo$lat, fl_topo$z, levels = c(-200, -100, -50, -25, -10), add=T, col = 'gray70')
mtext('Bottom salinity (PSU)', cex = 1.5, adj = 1)
imagePlot(1:2, 1:2, matrix(NA,2,2),
          col = o_cols, breaks = o_brks, asp = 1,
          xlab = 'Longitude', ylab = 'Latitude', las = 1,
          xlim = xlim8, ylim = ylim8,
          nlevel = length(o_cuts), legend.width = .7, legend.mar = 4)
points(dat8$lon, dat8$lat, 
       col = o_cols[as.numeric(o_cuts8)], bg = o_cols[as.numeric(o_cuts8)], pch = 21, cex=3)
plot(world, add=T)
contour(fl_topo$lon, fl_topo$lat, fl_topo$z, levels = c(-200, -100, -50, -25, -10), add=T, col = 'gray70')
mtext('Bottom dissolved oxygen (mg/l)', cex = 1.5, adj = 1)