Parameters
depth <- 5 # depth of model (a bit smaller, not much happens < 3m)
dz <- 0.05 # node spacing (m)
N <- as.integer(depth/dz) + 1L # number of nodes
kappa <- 1.0e-6 # thermal diffusivity (m2/s)
run_duration <- 10 # run duration (days)
initial_temperature <- 10.0 # starting temperature (deg C)
mean_temperature <- 10.0 # mean surface temperature (deg C)
diurnal_temp_range <- 5.0 # diurnal temperature half-range (deg C)
period <- 24.0 * 3600.0 # period of surface temp variation (s)
plot_interval.s <- 0.5 * 3600.0 # plot interval (s)
dt <- 0.2 * dz * dz / kappa # define time step using CFL condition
alpha <- kappa * dt / (dz * dz) # lumped variable
num_time_steps = # total number of time steps
round(24 * 3600.0 * run_duration / dt) + 1L
Set up a 2D array for temperature & time (i.e. pre-allocate all the necessary memory).
# temperature array (good to initialize full size right away)
temp = array(initial_temperature, dim = c(N, num_time_steps))
str(temp)
## num [1:101, 1:1729] 10 10 10 10 10 10 10 10 10 10 ...
Main Loop
\[
T_i^{k+1} = T_i^k + \frac{\kappa \Delta t}{\Delta z^2} \left( T_{i+1}^k - 2 T_i^k + T_{i-1}^k \right)
\]
# let's use k the way it is defined in the finite-difference equation
inner <- 2:(N-1) # inner indices of the spacial domain (i)
for (k in 1:(num_time_steps - 1)) {
# Update the surface temperature
temp[1, k+1] <- mean_temperature +
diurnal_temp_range * sin(2.0 * pi * (k + 1) * dt / period)
# Update the inner-node temperature field
temp[inner, k+1] <-
temp[inner, k] +
alpha * (temp[inner+1, k] - 2 * temp[inner, k] + temp[inner-1, k])
# Set lowest node temp equal to that of its neighbor
temp[N, k+1] <- temp[N-1, k]
}
Tidy Data
# convert to tidy data for easy plotting
plot_df <- temp %>%
# turn matrix into data frame
as.data.frame.table() %>%
# dplyr df
tbl_df() %>%
# integer based indices
mutate_if(is.factor, as.integer) %>%
# proper names
rename(depth_i = Var1, time_i = Var2, temp = Freq) %>%
# add depth and time information
mutate(
# depth in meters
depth.m = (depth_i - 1) * dz,
# time in seconds
time.s = (time_i - 1) * dt,
# find the integer division to identify ploting frames
plot_frame = time.s %/% plot_interval.s
) %>%
# find first profile within each plotting frame
group_by(plot_frame) %>%
mutate(first_frame = time_i == min(time_i)) %>%
ungroup() %>%
# add time in days
mutate(time.d = round(time.s/3600/24, 3)) %>%
# arrange by depth for easier quick check
arrange(depth_i)
head(plot_df, 100)
Visualize
# generate plot template
p <-
ggplot() +
aes(depth.m, temp, frame = time.d) +
geom_line() +
theme_bw() +
scale_x_reverse(expand = c(0, 0)) +
labs(x = "Depth [m]", y = "Temperature [C]") +
coord_flip()
Static plot (start and end)
# static plot of initial and final profile
p %+% filter(plot_df, time_i %in% range(time_i)) +
facet_wrap(~time.d)
Interactive plot
# animate
p %+% filter(plot_df, first_frame) %>%
ggplotly() %>%
animation_opts(
frame = 50, # in ms
transition = 0,
redraw = FALSE
) %>%
animation_slider(
currentvalue = list(
xanchor = "left",
prefix = "Time [days]: ",
font = list(color="red"))
)