}
# https://watermark.silverchair.com/20-10-1927.pdf?token=AQECAHi208BE49Ooan9kkhW_Ercy7Dm3ZL_9Cf3qfKAc485ysgAAAs4wggLKBgkqhkiG9w0BBwagggK7MIICtwIBADCCArAGCSqGSIb3DQEHATAeBglghkgBZQMEAS4wEQQMLx4nUnGRfFHcce9AAgEQgIICgTyM3V2P57QKYMWOJ1v5BZcBjRpbjfkIxaqOoxqKpc-x6WAqu1xBubzaBhTxcmIlN-qK1tVElip6ZnbwM05_RVBYN_rvAuOfpT9MrQcujq7umh70w8AnD9h1LwgUApxONTLQ0T_tFXq2oNbFOgNa1TKCOq4ExKBVe47weRFPVRWaqn3i2fZi5iUR1Han1gxk6DRaLNCjG09L5zDjP6aFf6i4jTiMDjMncm-rcGv7B50cirGW7O9XcC83mH4_64eFVo4VB2B6mGE48st-_vVTJ-KJFURdAlTGQ5J7_p3woowFLO_vA6FZmNmQ8MkMwSoDO9Eghq3WTyj8IasfGM5uQ9361EvIMQ0xb_ql2gLbKsKEB-miD7GDt6uzdyUuDwjbaVcgkk1LI-ssq-ffk4lX6yE31--srLLx0G9Ule4f_udXCbtW06JBD4H85kaIRTMepKUpHKI2pJffNwzmCWmTYfsIl0616IEjMvHE6FyfxnIhYnLDUGt6_6cfTp8iIIqRMofAZvDpkFp1WUEaojarZHmTd1rVRSniYsmTkSmUwBit8ybUKnjecbPhAjxpaZjV_e7Bf1eHlIe18QGqwJM9Svwh5sQ0Hu3L03scIrA-fuUSXh9-jbB9O0oBpJ4v-877PLad2OFhES2C6w-2NFlQHds_pooIy6YeeFuD7P1YLSPsRChxwx4sbX1mmM2uOdEPgnA0PNj8fg_oQ8-GTPnAweAY-rZAVubJnJT9RlUYmz7SAHFUsAWQSgp6SgKyJo0wzDkgdOdVqRRuOxMNDLqFza2AqhC4pITUWf4ZqHsVziM2ABcszeASjaGaA_1JhCFzpFYefu1RYTDgjxjsIlYqY897
# Imberger and Patterson 1990
# 10.3 miles per h
10.3 * 1609.34 / 3600
opt.salt <- optim(par = 0.0, fn = optm_salt,
wtr.dat = 8,
wsp.dat = 4.6)
print(opt.salt$par)
out <- c()
# increase salt from 0 g/kg to 10 g/kg
inc_slt <- seq(0.0,10,0.001)
for (i in inc_slt){
out <- rbind(out, plot_salt(i, wtr.dat = 8, wsp.dat = 4.6))
}
out <- as.data.frame(out)
g1 <- ggplot(out, aes(V1, V3/V2)) +
geom_line() +
geom_vline(xintercept = as.numeric(opt.salt$par),linetype = 'dashed') +
geom_hline(yintercept = 1,linetype = 'dashed') +
xlab('Uniformly added salt (g/kg) below center of volume')+
ylab('LN (mass moment/wind moment)')+
ggtitle('Spring: 8 deg C, wind speed of 4.6 m/s')+
theme_minimal(); g1
plot_salt_3d <- function(x, wtr.dat = 12, wsp.dat = 1){
temp_top = wtr.dat
temp = temp_top  # deg C
salt_top = 0
salt = x # g/kg
wnd = wsp.dat
bth <- seq(from = 0, to = 25, by = 1)
area <- seq(from = 39850000, to = 0, length.out = length(bth))
zv <- bth %*% area / sum(area)
wtr <- c(rep(temp_top, zv), rep(temp, length(bth) - zv))
slt <- c(rep(get_dens(temp_top, salt_top), zv), rep(get_dens(temp,salt), length(bth) - zv))
ssi = schmidt.stability(wtr = wtr, depths = bth, bthA = area, bthD = bth, sal = slt)
wnd_shear <- 1.310e-3 * 1.4310e-3 * wnd^2
kinetic <- get_dens(temp = temp, salt = salt) *
wnd_shear *
area[1]^(3/2) *
(max(bth) - zv)
stable <- ssi * area[1] *
(max(bth) - zv)
return(c(x, wsp.dat, kinetic, stable))
}
out <- c()
# increase salt from 0 g/kg to 10 g/kg
inc_slt <- seq(0.0,10,0.1)
inc_wnd <- seq(0.0,10,0.1)
out.matrix <- matrix(NA, ncol = length(inc_slt), nrow = length(inc_wnd))
for (i in 1:length(inc_slt)){
print(i)
for (j in 1:length(inc_wnd)){
print(j)
out.matrix[j, i] = plot_salt_3d(inc_slt[i], wtr.dat = 8, wsp.dat = inc_wnd[j])[4]/plot_salt_3d(inc_slt[i], wtr.dat = 8, wsp.dat = inc_wnd[j])[3]
out <- rbind(out, plot_salt_3d(inc_slt[i], wtr.dat = 8, wsp.dat = inc_wnd[j]))
}
}
out <- as.data.frame(out)
v <- ggplot((out), aes(V1, V2, z = as.numeric(V4/V3)))
v + geom_contour(aes(
colour = factor(..level.. == 1,
levels = c(F, T),
labels = c("Others", "0.02")))) +
scale_colour_manual(values = c("black", "red"))
v + geom_point()
v + geom_contour() + ylim(0,10)
ggplot(subset(out, V2 == 4.6), aes(V1, V4/V3)) + geom_point()
df.out <- out %>%
mutate(LN = V4/V3) %>%
rename(Salt = V1, Wind = V2) %>%
select(Salt, Wind, LN) %>%
group_by(Salt, Wind)
out.one <- apply(out.matrix, 2, function(x) which.min(abs(x-1)))
out.two <- apply(out.matrix, 2, function(x) which.min(abs(x-2)))
out.half <- apply(out.matrix, 2, function(x) which.min(abs(x-0.5)))
plot(inc_slt, (inc_wnd[out.one]), ylim=c(0,10))
points(inc_slt, (inc_wnd[out.two]), ylim=c(0,10))
points(inc_slt, (inc_wnd[out.half]), ylim=c(0,10))
out.contour <- data.frame('Salt' = inc_slt, 'Wind' =inc_wnd,
'LN1' =  apply(out.matrix, 2, function(x) which.min(abs(x-1))),
'LN2' =  apply(out.matrix, 2, function(x) which.min(abs(x-2))),
'LN05' =  apply(out.matrix, 2, function(x) which.min(abs(x-0.5))),
'LN10' =  apply(out.matrix, 2, function(x) which.min(abs(x-10))),
'LN01' =  apply(out.matrix, 2, function(x) which.min(abs(x-0.1))))
g2 <- ggplot(out.contour) +
geom_line(aes(Salt, Wind[LN1], col = 'LN=1')) +
geom_line(aes(Salt, Wind[LN2], col = 'LN=2')) +
geom_line(aes(Salt, Wind[LN05], col = 'LN=0.5')) +
geom_line(aes(Salt, Wind[LN10], col = 'LN=10')) +
geom_line(aes(Salt, Wind[LN01], col = 'LN=0.1')) +
geom_vline(xintercept = as.numeric(opt.salt$par),linetype = 'dashed') +
geom_hline(yintercept = 4.6,linetype = 'dashed') +
xlab('Uniformly added salt (g/kg) below center of volume')+
ylab('Wind speed (m/s)')+
ggtitle('Lake Number as function of salt and wind speed')+
theme_minimal(); g2
g1 + g2 + plot_annotation(tag_levels = 'A')
library(ggplot2)
library(tidyverse)
library(patchwork)
# some dummy calculations, lets assume top and bottom have different temperature and salinities
temp_top = 4
temp = 4  # deg C
salt_top = 0
salt = 5 # g/kg
# get densitz from temp and salt
get_dens <- function(temp, salt){
dens = 999.842594 + (6.793952 * 10^-2 * temp) - (9.095290 * 10^-3 * temp^2) +
(1.001685 * 10^-4 * temp^3) - (1.120083 * 10^-6 * temp^4) + (6.536336 * 10^-9 * temp^5) +
(8.24493 * 10^-1 -4.0899 * 10^-3 * temp+ 7.6438 * 10^-5 * temp^2 - 8.2467 * 10^-7 * temp^3 +
5.3875 * 10^-9* temp^4) * salt+
(-5.72466 *  10^-3 + 1.0227 * 10^-4 * temp -1.6546 * 10^-6 * temp^2) * salt^(3/2) +
(4.8314*  10^-4 ) * salt
return(dens)
}
# use rLakeAnalyzer
library(rLakeAnalyzer)
# dummy value for depth, area, center of volume, wtr and salt (from the assumptions above)
bth <- seq(from = 0, to = 40, by = 1)
area <- seq(from = 250000, to = 0, length.out = length(bth))
zv <- bth %*% area / sum(area)
wtr <- c(rep(temp_top, zv), rep(temp, length(bth) - zv))
slt <- c(rep(get_dens(temp_top, salt_top), zv), rep(get_dens(temp,salt), length(bth) - zv))
# that gives us this much energy using the formulae for Lake Number (Imberger)
ssi = schmidt.stability(wtr = wtr, depths = bth, bthA = area, bthD = bth, sal = slt)
# lets assume high wind speed
wnd = 7
wnd_shear <- 1.310e-3 * 1.4310e-3 * wnd^2
kinetic <- get_dens(temp = temp_top, salt = salt_top) *
wnd_shear^2 *
area[1]^(1.5) *
(1 - (max(bth)-zv)/max(bth))
stable <- ssi *
(1 - (max(bth) - 15)/max(bth))
ln <- stable / kinetic
# ln >> 1 stable
# ln = 1 wind just sufficient to affect thermocline near the shore
# ln < 1 unstable
print(ln)
# optimization function
optm_salt <- function(x, wtr.dat = 12, wsp.dat = 1){
temp_top = wtr.dat
temp = temp_top  # deg C
salt_top = 0
salt = x # g/kg
wnd = wsp.dat
bth <- seq(from = 0, to = 25, by = 1)
area <- seq(from = 39850000, to = 0, length.out = length(bth))
zv <- bth %*% area / sum(area)
wtr <- c(rep(temp_top, zv), rep(temp, length(bth) - zv))
slt <- c(rep(get_dens(temp_top, salt_top), zv), rep(get_dens(temp,salt), length(bth) - zv))
ssi = schmidt.stability(wtr = wtr, depths = bth, bthA = area, bthD = bth, sal = slt)
wnd_shear <- 1.310e-3 * 1.4310e-3 * wnd^2
# kinetic <- get_dens(temp = temp_top, salt = salt_top) *
#   wnd_shear *
#   area[1]^(3/2) *
#   (1 - (max(bth)-zv)/max(bth))
# stable <- ssi * area[1] *
#   (1 - (max(bth) - zv)/max(bth))#15
kinetic <- get_dens(temp = temp, salt = salt) *
wnd_shear *
area[1]^(3/2) *
(max(bth) - zv)
stable <- ssi * area[1] *
(max(bth) - zv)
bthA = area
bthD = bth
uStar = sqrt(wnd_shear)
St = ssi
metaT = zv
metaB = 15
averageHypoDense = get_dens(temp = temp, salt = salt)
g	<-	9.81
dz	<-	0.1
# if bathymetry has negative values, remove.
# intepolate area and depth to 0
Ao	<-	bthA[1]
Zo	<-	bthD[1]
if (Ao==0){stop('Surface area cannot be zero, check *.bth file')}
#interpolates the bathymetry data
layerD	<-	seq(Zo,max(bthD),dz)
layerA	<-	stats::approx(bthD,bthA,layerD)$y
#find depth to the center of volume
Zv = layerD*layerA*dz
Zcv = sum(Zv)/sum(layerA)/dz
St_uC = St*Ao/g
# Calculates the Lake Number according to the formula provided
Ln = g*St_uC*(metaT+metaB)/(2*averageHypoDense*uStar^2*Ao^(3/2)*Zcv)
print(abs(kinetic - stable))
print(abs( g*St_uC*(metaT+metaB) -
(2*averageHypoDense*uStar^2*Ao^(3/2)*Zcv) ))
return(abs(kinetic - stable))
# return(abs( g*St_uC*(metaT+metaB) -
# (2*averageHypoDense*uStar^2*Ao^(3/2)*Zcv) ))
}
plot_salt <- function(x, wtr.dat = 12, wsp.dat = 1){
temp_top = wtr.dat
temp = temp_top  # deg C
salt_top = 0
salt = x # g/kg
wnd = wsp.dat
bth <- seq(from = 0, to = 25, by = 1)
area <- seq(from = 39850000, to = 0, length.out = length(bth))
zv <- bth %*% area / sum(area)
wtr <- c(rep(temp_top, zv), rep(temp, length(bth) - zv))
slt <- c(rep(get_dens(temp_top, salt_top), zv), rep(get_dens(temp,salt), length(bth) - zv))
ssi = schmidt.stability(wtr = wtr, depths = bth, bthA = area, bthD = bth, sal = slt)
wnd_shear <- 1.310e-3 * 1.4310e-3 * wnd^2
kinetic <- get_dens(temp = temp, salt = salt) *
wnd_shear *
area[1]^(3/2) *
(max(bth) - zv)
stable <- ssi * area[1] *
(max(bth) - zv)
return(c(x, kinetic, stable))
}
# https://watermark.silverchair.com/20-10-1927.pdf?token=AQECAHi208BE49Ooan9kkhW_Ercy7Dm3ZL_9Cf3qfKAc485ysgAAAs4wggLKBgkqhkiG9w0BBwagggK7MIICtwIBADCCArAGCSqGSIb3DQEHATAeBglghkgBZQMEAS4wEQQMLx4nUnGRfFHcce9AAgEQgIICgTyM3V2P57QKYMWOJ1v5BZcBjRpbjfkIxaqOoxqKpc-x6WAqu1xBubzaBhTxcmIlN-qK1tVElip6ZnbwM05_RVBYN_rvAuOfpT9MrQcujq7umh70w8AnD9h1LwgUApxONTLQ0T_tFXq2oNbFOgNa1TKCOq4ExKBVe47weRFPVRWaqn3i2fZi5iUR1Han1gxk6DRaLNCjG09L5zDjP6aFf6i4jTiMDjMncm-rcGv7B50cirGW7O9XcC83mH4_64eFVo4VB2B6mGE48st-_vVTJ-KJFURdAlTGQ5J7_p3woowFLO_vA6FZmNmQ8MkMwSoDO9Eghq3WTyj8IasfGM5uQ9361EvIMQ0xb_ql2gLbKsKEB-miD7GDt6uzdyUuDwjbaVcgkk1LI-ssq-ffk4lX6yE31--srLLx0G9Ule4f_udXCbtW06JBD4H85kaIRTMepKUpHKI2pJffNwzmCWmTYfsIl0616IEjMvHE6FyfxnIhYnLDUGt6_6cfTp8iIIqRMofAZvDpkFp1WUEaojarZHmTd1rVRSniYsmTkSmUwBit8ybUKnjecbPhAjxpaZjV_e7Bf1eHlIe18QGqwJM9Svwh5sQ0Hu3L03scIrA-fuUSXh9-jbB9O0oBpJ4v-877PLad2OFhES2C6w-2NFlQHds_pooIy6YeeFuD7P1YLSPsRChxwx4sbX1mmM2uOdEPgnA0PNj8fg_oQ8-GTPnAweAY-rZAVubJnJT9RlUYmz7SAHFUsAWQSgp6SgKyJo0wzDkgdOdVqRRuOxMNDLqFza2AqhC4pITUWf4ZqHsVziM2ABcszeASjaGaA_1JhCFzpFYefu1RYTDgjxjsIlYqY897
# Imberger and Patterson 1990
# 10.3 miles per h
10.3 * 1609.34 / 3600
opt.salt <- optim(par = 0.0, fn = optm_salt,
wtr.dat = 8,
wsp.dat = 4.6)
print(opt.salt$par)
out <- c()
# increase salt from 0 g/kg to 10 g/kg
inc_slt <- seq(0.0,10,0.001)
for (i in inc_slt){
out <- rbind(out, plot_salt(i, wtr.dat = 8, wsp.dat = 4.6))
}
out <- as.data.frame(out)
g1 <- ggplot(out, aes(V1, V3/V2)) +
geom_line() +
geom_vline(xintercept = as.numeric(opt.salt$par),linetype = 'dashed') +
geom_hline(yintercept = 1,linetype = 'dashed') +
xlab('Uniformly added salt (g/kg) below center of volume')+
ylab('LN (mass moment/wind moment)')+
ggtitle('Spring: 8 deg C, wind speed of 4.6 m/s')+
theme_minimal(); g1
plot_salt_3d <- function(x, wtr.dat = 12, wsp.dat = 1){
temp_top = wtr.dat
temp = temp_top  # deg C
salt_top = 0
salt = x # g/kg
wnd = wsp.dat
bth <- seq(from = 0, to = 25, by = 1)
area <- seq(from = 39850000, to = 0, length.out = length(bth))
zv <- bth %*% area / sum(area)
wtr <- c(rep(temp_top, zv), rep(temp, length(bth) - zv))
slt <- c(rep(get_dens(temp_top, salt_top), zv), rep(get_dens(temp,salt), length(bth) - zv))
ssi = schmidt.stability(wtr = wtr, depths = bth, bthA = area, bthD = bth, sal = slt)
wnd_shear <- 1.310e-3 * 1.4310e-3 * wnd^2
kinetic <- get_dens(temp = temp, salt = salt) *
wnd_shear *
area[1]^(3/2) *
(max(bth) - zv)
stable <- ssi * area[1] *
(max(bth) - zv)
return(c(x, wsp.dat, kinetic, stable))
}
# out <- c()
# increase salt from 0 g/kg to 10 g/kg
inc_slt <- seq(0.0,10,0.1)
inc_wnd <- seq(0.0,10,0.1)
out.matrix <- matrix(NA, ncol = length(inc_slt), nrow = length(inc_wnd))
for (i in 1:length(inc_slt)){
print(i)
for (j in 1:length(inc_wnd)){
print(j)
out.matrix[j, i] = plot_salt_3d(inc_slt[i], wtr.dat = 8, wsp.dat = inc_wnd[j])[4]/plot_salt_3d(inc_slt[i], wtr.dat = 8, wsp.dat = inc_wnd[j])[3]
# out <- rbind(out, plot_salt_3d(inc_slt[i], wtr.dat = 8, wsp.dat = inc_wnd[j]))
}
}
# out <- as.data.frame(out)
# v <- ggplot((out), aes(V1, V2, z = as.numeric(V4/V3)))
# v + geom_contour(aes(
#   colour = factor(..level.. == 1,
#                   levels = c(F, T),
#                   labels = c("Others", "0.02")))) +
#   scale_colour_manual(values = c("black", "red"))
# v + geom_point()
# v + geom_contour() + ylim(0,10)
# ggplot(subset(out, V2 == 4.6), aes(V1, V4/V3)) + geom_point()
# df.out <- out %>%
#   mutate(LN = V4/V3) %>%
#   rename(Salt = V1, Wind = V2) %>%
#   select(Salt, Wind, LN) %>%
#   group_by(Salt, Wind)
out.one <- apply(out.matrix, 2, function(x) which.min(abs(x-1)))
out.two <- apply(out.matrix, 2, function(x) which.min(abs(x-2)))
out.half <- apply(out.matrix, 2, function(x) which.min(abs(x-0.5)))
plot(inc_slt, (inc_wnd[out.one]), ylim=c(0,10))
points(inc_slt, (inc_wnd[out.two]), ylim=c(0,10))
points(inc_slt, (inc_wnd[out.half]), ylim=c(0,10))
out.contour <- data.frame('Salt' = inc_slt, 'Wind' =inc_wnd,
'LN1' =  apply(out.matrix, 2, function(x) which.min(abs(x-1))),
'LN2' =  apply(out.matrix, 2, function(x) which.min(abs(x-2))),
'LN05' =  apply(out.matrix, 2, function(x) which.min(abs(x-0.5))),
'LN10' =  apply(out.matrix, 2, function(x) which.min(abs(x-10))),
'LN01' =  apply(out.matrix, 2, function(x) which.min(abs(x-0.1))))
g2 <- ggplot(out.contour) +
geom_line(aes(Salt, Wind[LN1], col = 'LN=1')) +
geom_line(aes(Salt, Wind[LN2], col = 'LN=2')) +
geom_line(aes(Salt, Wind[LN05], col = 'LN=0.5')) +
geom_line(aes(Salt, Wind[LN10], col = 'LN=10')) +
geom_line(aes(Salt, Wind[LN01], col = 'LN=0.1')) +
geom_vline(xintercept = as.numeric(opt.salt$par),linetype = 'dashed') +
geom_hline(yintercept = 4.6,linetype = 'dashed') +
xlab('Uniformly added salt (g/kg) below center of volume')+
ylab('Wind speed (m/s)')+
ggtitle('Lake Number as function of salt and wind speed')+
theme_minimal(); g2
g1 + g2 + plot_annotation(tag_levels = 'A')
# out <- c()
# increase salt from 0 g/kg to 10 g/kg
inc_slt <- seq(0.0,20,0.1)
inc_wnd <- seq(0.0,20,0.1)
out.matrix <- matrix(NA, ncol = length(inc_slt), nrow = length(inc_wnd))
for (i in 1:length(inc_slt)){
print(i)
for (j in 1:length(inc_wnd)){
print(j)
out.matrix[j, i] = plot_salt_3d(inc_slt[i], wtr.dat = 8, wsp.dat = inc_wnd[j])[4]/plot_salt_3d(inc_slt[i], wtr.dat = 8, wsp.dat = inc_wnd[j])[3]
# out <- rbind(out, plot_salt_3d(inc_slt[i], wtr.dat = 8, wsp.dat = inc_wnd[j]))
}
}
out.one <- apply(out.matrix, 2, function(x) which.min(abs(x-1)))
out.two <- apply(out.matrix, 2, function(x) which.min(abs(x-2)))
out.half <- apply(out.matrix, 2, function(x) which.min(abs(x-0.5)))
plot(inc_slt, (inc_wnd[out.one]), ylim=c(0,10))
points(inc_slt, (inc_wnd[out.two]), ylim=c(0,10))
points(inc_slt, (inc_wnd[out.half]), ylim=c(0,10))
out.contour <- data.frame('Salt' = inc_slt, 'Wind' =inc_wnd,
'LN1' =  apply(out.matrix, 2, function(x) which.min(abs(x-1))),
'LN2' =  apply(out.matrix, 2, function(x) which.min(abs(x-2))),
'LN05' =  apply(out.matrix, 2, function(x) which.min(abs(x-0.5))),
'LN10' =  apply(out.matrix, 2, function(x) which.min(abs(x-10))),
'LN01' =  apply(out.matrix, 2, function(x) which.min(abs(x-0.1))))
g2 <- ggplot(out.contour) +
geom_line(aes(Salt, Wind[LN1], col = 'LN=1')) +
geom_line(aes(Salt, Wind[LN2], col = 'LN=2')) +
geom_line(aes(Salt, Wind[LN05], col = 'LN=0.5')) +
geom_line(aes(Salt, Wind[LN10], col = 'LN=10')) +
geom_line(aes(Salt, Wind[LN01], col = 'LN=0.1')) +
geom_vline(xintercept = as.numeric(opt.salt$par),linetype = 'dashed') +
geom_hline(yintercept = 4.6,linetype = 'dashed') +
xlab('Uniformly added salt (g/kg) below center of volume')+
ylab('Wind speed (m/s)')+
ggtitle('Lake Number as function of salt and wind speed')+
theme_minimal(); g2
g1 + g2 + plot_annotation(tag_levels = 'A')
library(ggplot2)
library(tidyverse)
library(patchwork)
library(ggrepel)
library(rLakeAnalyzer)
setwd(dirname(rstudioapi::getSourceEditorContext()$path))
# get density from temp and salt
get_dens <- function(temp, salt){
dens = 999.842594 + (6.793952 * 10^-2 * temp) - (9.095290 * 10^-3 * temp^2) +
(1.001685 * 10^-4 * temp^3) - (1.120083 * 10^-6 * temp^4) + (6.536336 * 10^-9 * temp^5) +
(8.24493 * 10^-1 -4.0899 * 10^-3 * temp+ 7.6438 * 10^-5 * temp^2 - 8.2467 * 10^-7 * temp^3 +
5.3875 * 10^-9* temp^4) * salt+
(-5.72466 *  10^-3 + 1.0227 * 10^-4 * temp -1.6546 * 10^-6 * temp^2) * salt^(3/2) +
(4.8314*  10^-4 ) * salt
return(dens)
}
bath.data <- read_csv('mendota_bathymetry.csv')
# optimization function
optm_salt <- function(x, wtr.dat = 12, wsp.dat = 1, bath.data = bath.data){
temp_top = wtr.dat
temp = temp_top  # deg C
salt_top = 0
salt = x # g/kg
wnd = wsp.dat
bth <- bath.data$Depth_meter # seq(from = 0, to = 25, by = 1)
area <- bath.data$Area_meterSquared # seq(from = 39850000, to = 0, length.out = length(bth))
zv <- bth %*% area / sum(area)
wtr <- c(rep(temp_top, round(zv)), rep(temp, length(bth) - round(zv)))
slt <- c(rep(get_dens(temp_top, salt_top), round(zv)), rep(get_dens(temp,salt), length(bth) - round(zv)))
ssi = schmidt.stability(wtr = wtr, depths = bth, bthA = area, bthD = bth, sal = slt)
wnd_shear <- 1.310e-3 * 1.4310e-3 * wnd^2
# kinetic <- get_dens(temp = temp_top, salt = salt_top) *
#   wnd_shear *
#   area[1]^(3/2) *
#   (1 - (max(bth)-zv)/max(bth))
# stable <- ssi * area[1] *
#   (1 - (max(bth) - zv)/max(bth))#15
kinetic <- get_dens(temp = temp, salt = salt) *
wnd_shear *
area[1]^(3/2) *
(max(bth) - zv)
stable <- ssi * area[1] *
(max(bth) - zv)
bthA = area
bthD = bth
uStar = sqrt(wnd_shear)
St = ssi
metaT = zv
metaB = 15
averageHypoDense = get_dens(temp = temp, salt = salt)
g	<-	9.81
dz	<-	0.1
# if bathymetry has negative values, remove.
# intepolate area and depth to 0
Ao	<-	bthA[1]
Zo	<-	bthD[1]
if (Ao==0){stop('Surface area cannot be zero, check *.bth file')}
#interpolates the bathymetry data
layerD	<-	seq(Zo,max(bthD),dz)
layerA	<-	stats::approx(bthD,bthA,layerD)$y
#find depth to the center of volume
Zv = layerD*layerA*dz
Zcv = sum(Zv)/sum(layerA)/dz
St_uC = St*Ao/g
# Calculates the Lake Number according to the formula provided
Ln = g*St_uC*(metaT+metaB)/(2*averageHypoDense*uStar^2*Ao^(3/2)*Zcv)
# print(abs(kinetic - stable))
# print(abs( g*St_uC*(metaT+metaB) -
# (2*averageHypoDense*uStar^2*Ao^(3/2)*Zcv) ))
# return(abs(kinetic - stable))
return(abs( g*St_uC*(metaT+metaB) -
(2*averageHypoDense*uStar^2*Ao^(3/2)*Zcv) ))
}
plot_salt <- function(x, wtr.dat = 12, wsp.dat = 1, bath.data = bath.data){
temp_top = wtr.dat
temp = temp_top  # deg C
salt_top = 0
salt = x # g/kg
wnd = wsp.dat
bth <- bath.data$Depth_meter # seq(from = 0, to = 25, by = 1)
area <- bath.data$Area_meterSquared # seq(from = 39850000, to = 0, length.out = length(bth))
zv <- bth %*% area / sum(area)
wtr <- c(rep(temp_top, round(zv)), rep(temp, length(bth) - round(zv)))
slt <- c(rep(get_dens(temp_top, salt_top), round(zv)), rep(get_dens(temp,salt), length(bth) - round(zv)))
ssi = schmidt.stability(wtr = wtr, depths = bth, bthA = area, bthD = bth, sal = slt)
wnd_shear <- 1.310e-3 * 1.4310e-3 * wnd^2
kinetic <- get_dens(temp = temp, salt = salt) *
wnd_shear *
area[1]^(3/2) *
(max(bth) - zv)
stable <- ssi * area[1] *
(max(bth) - zv)
# return(c(x, kinetic, stable))
bthA = area
bthD = bth
uStar = sqrt(wnd_shear)
St = ssi
metaT = zv
metaB = 15
averageHypoDense = get_dens(temp = temp, salt = salt)
g	<-	9.81
dz	<-	0.1
# if bathymetry has negative values, remove.
# intepolate area and depth to 0
Ao	<-	bthA[1]
Zo	<-	bthD[1]
if (Ao==0){stop('Surface area cannot be zero, check *.bth file')}
#interpolates the bathymetry data
layerD	<-	seq(Zo,max(bthD),dz)
layerA	<-	stats::approx(bthD,bthA,layerD)$y
#find depth to the center of volume
Zv = layerD*layerA*dz
Zcv = sum(Zv)/sum(layerA)/dz
St_uC = St*Ao/g
# Calculates the Lake Number according to the formula provided
Ln = g*St_uC*(metaT+metaB)/(2*averageHypoDense*uStar^2*Ao^(3/2)*Zcv)
return(c(x,  (2*averageHypoDense*uStar^2*Ao^(3/2)*Zcv) ,g*St_uC*(metaT+metaB)  ))
}
# https://watermark.silverchair.com/20-10-1927.pdf?token=AQECAHi208BE49Ooan9kkhW_Ercy7Dm3ZL_9Cf3qfKAc485ysgAAAs4wggLKBgkqhkiG9w0BBwagggK7MIICtwIBADCCArAGCSqGSIb3DQEHATAeBglghkgBZQMEAS4wEQQMLx4nUnGRfFHcce9AAgEQgIICgTyM3V2P57QKYMWOJ1v5BZcBjRpbjfkIxaqOoxqKpc-x6WAqu1xBubzaBhTxcmIlN-qK1tVElip6ZnbwM05_RVBYN_rvAuOfpT9MrQcujq7umh70w8AnD9h1LwgUApxONTLQ0T_tFXq2oNbFOgNa1TKCOq4ExKBVe47weRFPVRWaqn3i2fZi5iUR1Han1gxk6DRaLNCjG09L5zDjP6aFf6i4jTiMDjMncm-rcGv7B50cirGW7O9XcC83mH4_64eFVo4VB2B6mGE48st-_vVTJ-KJFURdAlTGQ5J7_p3woowFLO_vA6FZmNmQ8MkMwSoDO9Eghq3WTyj8IasfGM5uQ9361EvIMQ0xb_ql2gLbKsKEB-miD7GDt6uzdyUuDwjbaVcgkk1LI-ssq-ffk4lX6yE31--srLLx0G9Ule4f_udXCbtW06JBD4H85kaIRTMepKUpHKI2pJffNwzmCWmTYfsIl0616IEjMvHE6FyfxnIhYnLDUGt6_6cfTp8iIIqRMofAZvDpkFp1WUEaojarZHmTd1rVRSniYsmTkSmUwBit8ybUKnjecbPhAjxpaZjV_e7Bf1eHlIe18QGqwJM9Svwh5sQ0Hu3L03scIrA-fuUSXh9-jbB9O0oBpJ4v-877PLad2OFhES2C6w-2NFlQHds_pooIy6YeeFuD7P1YLSPsRChxwx4sbX1mmM2uOdEPgnA0PNj8fg_oQ8-GTPnAweAY-rZAVubJnJT9RlUYmz7SAHFUsAWQSgp6SgKyJo0wzDkgdOdVqRRuOxMNDLqFza2AqhC4pITUWf4ZqHsVziM2ABcszeASjaGaA_1JhCFzpFYefu1RYTDgjxjsIlYqY897
# Imberger and Patterson 1990
# typical spring wind speed: 10.3 miles per h
10.3 * 1609.34 / 3600
opt.salt <- optim(par = 0.0, fn = optm_salt,
wtr.dat = 8,
wsp.dat = 4.6, bath.data = bath.data)
print(opt.salt$par)
monona_bath.data <- read_csv('monona_bathymetry.csv')
opt.salt <- optim(par = 0.0, fn = optm_salt,
wtr.dat = 8,
wsp.dat = 4.6, bath.data = monona_bath.data)
print(opt.salt$par)
wtr.dat =8
wsp.dat = 4.6
bath.data = bath.data
temp_top = wtr.dat
temp = temp_top  # deg C
salt_top = 0
salt = x # g/kg
wnd = wsp.dat
bth <- bath.data$Depth_meter # seq(from = 0, to = 25, by = 1)
area <- bath.data$Area_meterSquared # seq(from = 39850000, to = 0, length.out = length(bth))
zv <- bth %*% area / sum(area)
x= 1.4
temp_top = wtr.dat
temp = temp_top  # deg C
salt_top = 0
salt = x # g/kg
wnd = wsp.dat
bth <- bath.data$Depth_meter # seq(from = 0, to = 25, by = 1)
area <- bath.data$Area_meterSquared # seq(from = 39850000, to = 0, length.out = length(bth))
zv <- bth %*% area / sum(area)
wtr <- c(rep(temp_top, round(zv)), rep(temp, length(bth) - round(zv)))
slt <- c(rep(get_dens(temp_top, salt_top), round(zv)), rep(get_dens(temp,salt), length(bth) - round(zv)))
ssi = schmidt.stability(wtr = wtr, depths = bth, bthA = area, bthD = bth, sal = slt)
wnd_shear <- 1.310e-3 * 1.4310e-3 * wnd^2
get_dens(temp = temp, salt = salt)
temp
get_dens(temp, salt_top)
get_dens(temp, salt_top) - get_dens(temp, salt)
abs(get_dens(temp, salt_top) - get_dens(temp, salt))
