The parameterization of wet deposition follows EMEP (2003) approach, including in-cloud and below-cloud scavenging of gas and particles, and is actually implemented in the AERO0 configuration of FARM model.
The in-cloud scavenging of a component1 valid only for soluble components? of concentration C is computed as:
\[\Delta C_{wet} = -C \frac{W_{in}\cdot P}{\Delta z\cdot \rho_{w}}\]
where P is the precipitation rate (\(kg ~m^{-2} ~s ^{-1}\)), Δz is the scavenging depth (assumed to be 1000\(~m\)), \(\rho_{w}\) is the water density (1000\(~kg ~m^{-3}\)) and \(W_{in}=10^6\) is the in-cloud scavenging ratio.
In case of particles, below-cloud scavenging is computed by means of Scott (1979) relationship:
\[\Delta C_{wet} = -C \frac{A\cdot P}{V_{dr}} \bar{E}\]
where \(A = 5.2 ~m^3 ~kg^{-1} ~s^{-1}\) is an empirical coefficient (a Marshall-Palmer size distribution is assumed for rain drops), \(V_{dr}\) is the raindrop fall speed (assumed to be \(5 ~m ~s^{-1}\)) and \(\bar{E}\) is the size-dependent collision efficiency of aerosols by the raindrops (0.1 for fine PM, 0.4 for coarse PM).
According to these equations, let’s define two R functions:
deltaC_in <- function(C, P, W_in=10^6, delta_z=1000, rho_w=1000){
-C * (W_in*P)/(delta_z*rho_w)
}
deltaC_below <- function(C, P, A=5.2, V_dr=5, E){
-C * (A*P*E)/(V_dr)
}
Given a precipitation rate2 About the precipitation rate: to convert mm/h to \(kg ~m^{-2} ~s ^{-1}\), we just need to divide by 3600. of 5\(~mm/h\) and an initial concentration of 100\(~ng/m^3\):
deltaC_in(C = 100, P = 5/3600)
## [1] -0.1388889
deltaC_below(C = 70, P = 5/3600, E=0.1)
## [1] -0.01011111
deltaC_below(C = 30, P = 5/3600, E=0.4)
## [1] -0.01733333
We can iterate the process, to parametrize a cloud with precipitation and wet deposition.
wet_dep_cloud <- function(init_C_in = 100, # initial concentration in the cloud
init_C_below_fine = 70, # init. conc. below the cloud (fine)
init_C_below_coarse = 30, # init. conc. below (coarse)
prec = rep(5/3600, # precipitation rate (kg/m2/s)
60*60*3), # constant over 3 hrs
dt = 1, # timestep (s)
depth_cloud = 1000, # m
height_cloud = rep(1000, # m
60*60*3) # constant over 3 hrs
) {
# initialization
cloud <- data.frame(prec, depth_cloud, height_cloud,
C_in = NA, C_below_fine = NA, C_below_coarse = NA,
dC_in = NA, dC_below_fine = NA, dC_below_coarse = NA)
cloud$C_in[1] <- init_C_in
cloud$C_below_fine[1] <- init_C_below_fine
cloud$C_below_coarse[1] <- init_C_below_coarse
# concentration change
cloud$dC_in[1] <- deltaC_in (C = cloud$C_in[1],
P = cloud$prec[1])
cloud$dC_below_fine[1] <- deltaC_below(C = cloud$C_below_fine[1],
P = cloud$prec[1], E = 0.1)
cloud$dC_below_coarse[1] <- deltaC_below(C = cloud$C_below_coarse[1],
P = cloud$prec[1], E = 0.4)
for (i in 2:nrow(cloud)) {
cloud$C_in[i] <- cloud$C_in[i-1] +cloud$dC_in[i-1]
cloud$C_below_fine[i] <- cloud$C_below_fine[i-1] +cloud$dC_below_fine[i-1]
cloud$C_below_coarse[i] <- cloud$C_below_coarse[i-1]+cloud$dC_below_coarse[i-1]
cloud$dC_in[i] <- dt*deltaC_in (C = cloud$C_in[i],
P = cloud$prec[i])
cloud$dC_below_fine[i] <- dt*deltaC_below(C = cloud$C_below_fine[i],
P = cloud$prec[i], E = 0.1)
cloud$dC_below_coarse[i] <- dt*deltaC_below(C = cloud$C_below_coarse[i],
P = cloud$prec[i], E = 0.4)
}
# wet deposition
library(dplyr)
cloud <- data.frame(cloud, cum_prec = cumsum(prec))
cloud %>% mutate(D_in = -dC_in* depth_cloud,
D_below_fine = -dC_below_fine* height_cloud,
D_below_coarse = -dC_below_coarse*height_cloud,
Drate_in = D_in,
Drate_below_fine = D_below_fine,
Drate_below_coarse = D_below_coarse) -> cloud
return(cloud)
}
We set the timestep to one second in this case.
dt <- 1 # timestep=1s
wet_dep_cloud(dt = dt) -> cc
ff <- t(apply(X = cc, MARGIN = 2, FUN = fivenum))
colnames(ff) <- c("min","p25","median","p75","max")
knitr::kable(formatC(ff, digits = 2, format = "g"))
| min | p25 | median | p75 | max | |
|---|---|---|---|---|---|
| prec | 0.0014 | 0.0014 | 0.0014 | 0.0014 | 0.0014 |
| depth_cloud | 1e+03 | 1e+03 | 1e+03 | 1e+03 | 1e+03 |
| height_cloud | 1e+03 | 1e+03 | 1e+03 | 1e+03 | 1e+03 |
| C_in | 3e-05 | 0.0013 | 0.055 | 2.3 | 1e+02 |
| C_below_fine | 15 | 22 | 32 | 47 | 70 |
| C_below_coarse | 0.058 | 0.28 | 1.3 | 6.3 | 30 |
| dC_in | -0.14 | -0.0033 | -7.6e-05 | -1.8e-06 | -4.2e-08 |
| dC_below_fine | -0.01 | -0.0068 | -0.0046 | -0.0031 | -0.0021 |
| dC_below_coarse | -0.017 | -0.0036 | -0.00076 | -0.00016 | -3.4e-05 |
| cum_prec | 0.0014 | 3.8 | 7.5 | 11 | 15 |
| D_in | 4.2e-05 | 0.0018 | 0.076 | 3.3 | 1.4e+02 |
| D_below_fine | 2.1 | 3.1 | 4.6 | 6.8 | 10 |
| D_below_coarse | 0.034 | 0.16 | 0.76 | 3.6 | 17 |
| Drate_in | 4.2e-05 | 0.0018 | 0.076 | 3.3 | 1.4e+02 |
| Drate_below_fine | 2.1 | 3.1 | 4.6 | 6.8 | 10 |
| Drate_below_coarse | 0.034 | 0.16 | 0.76 | 3.6 | 17 |
par(mar=c(5,5,1,1))
plot(cc$C_in, type="l",xlab = "time (min)",
ylab = expression("concentration in the air"~(n*g/m^3)), xaxt="n")
hh <- c(0,0.25,0.5,1:6)
axis(1, at = hh*3600, label=hh*60)
lines(cc$C_below_coarse+cc$C_below_fine,lty=2)
lines(cc$C_below_coarse,lty=3)
legend("topright", legend = c("in the cloud","below the cloud (total)",
"below the cloud (coarse)"), lty=1:3)
If we assume the cloud is not moving, or if we follow it during the precipitation:
par(mar=c(5,5,1,1))
plot((cc$Drate_in+cc$Drate_below_coarse+cc$Drate_below_fine),
type="l",xlab = "time (min)",
ylab = expression("deposition rate"~(n*g~m^{-2}~s^{-1})),
xaxt="n",lwd=2)
hh <- c(0,0.25,0.5,1:6)
axis(1, at = hh*3600, label=hh*60)
lines(cc$Drate_in,lty=1)
lines((cc$Drate_below_coarse+cc$Drate_below_fine),lty=2)
legend("topright",
legend = c("total","from the cloud",
"from the air below the cloud"),
lty=c(1,1,2), lwd=c(2,1,1))
Now we can calculate the deposition of a cloud along its path. Let’s define a path overcoming some mountains.
library(googleway)
source("secrets.R") # a file where google API keys are defined
point_A <- google_geocode("Tarcento", key = gkey_geocoding)$results$geometry$location
point_B <- google_geocode("Tarvisio", key = gkey_geocoding)$results$geometry$location
df <- rbind(point_A, point_B)
colnames(df) <- c("lat","lon")
google_elevation(df_locations = df,
location_type = "path",
samples = 300,
key = gkey_elevation,
simplify = TRUE)$results -> path
plot(path$location$lat, path$elevation, type="l")
text(x=c(path$location$lat[1], path$location$lat[nrow(path)]),
y=c(path$elevation[1], path$elevation[nrow(path)]),
labels=c(" Tarcento", " Tarvisio"), srt=90, adj=0)
points(x=c(path$location$lat[1], path$location$lat[nrow(path)]),
y=c(path$elevation[1], path$elevation[nrow(path)]))
Let’s define the height of the cloud base \(h_C\), along its path \[h_C=\bar{h}_C + h'_C + h''_C\] where \(\bar{h}_C = 1200~m\) is the unperturbed height and the other are lifting terms. The first lifting term is a function of the smoothed ground elevation below the cloud
\[h'_C = h_{GS}-h_{C0}+d\cdot log \left( 1+e^{\frac{h_C0-h_{GS}-d/2}{d}} \right)\] where \(d=500~m\) and \(h_{GS}=smoothing(h_G)\), with \(h_G\) elevation of the ground.
The second lifting term avoids the cloud going underground
\[h''_C = max(0, h_G - \bar{h}_C - h'_C)\]
library(caTools)
h_G <- path$elevation
h_GS <- runmean(h_G, 21, align="center")
d <- 500
D_C <- 500 # cloud depth
h_C0 <- rep(1200, nrow(path)) # height of unperturbed cloud
h_C1 <- h_GS-h_C0+d*log(1+exp((h_C0-h_GS-d/2)/d)) # first lifting term
h_C2 <- pmax(0, h_G-h_C0-h_C1) # second lifting term
h_C <- h_C0 + h_C1 + h_C2 # cloud base
h_Ctop <- h_C + D_C # cloud top
plot(path$location$lat, h_G, type="l",
ylim=c(0,max(h_Ctop)))
lines(path$location$lat, h_C, lty=2)
lines(path$location$lat, h_Ctop, lty=2)
Let say the precipitation rate is proportional to the part of cloud exceeding a given height above sea level, with an attenuation factor \(\alpha\) for the leeward precipitation3 equation 17 in Jiang, Q., & Smith, R. B. (2003). Cloud timescales and orographic precipitation. Journal of the atmospheric sciences, 60(13), 1543-1559.
\[\alpha = \frac{PE_{lee}}{PE_{ww}} = \frac{1}{\tau_a/\tau_f+\tau_a/\tau_{sub}}\] where \(\tau_a\), \(\tau_f\) and \(\tau_{sub}\) are timescales for advection, hydrometeor fallout and snow sublimation:
\[\tau_f \approx \frac{H_C+D_C/2 }{v_{prec}}\] where \(H_C\) is the cloud-base height above ground and \(D_C\) the cloud depth; \[\tau_a \approx \frac{a_m}{ v_{wind}}\] where \(a\) is half the horizontal dimension of the mountain and \(v_{wind}\) the mean wind speed; \[\tau_{sub} \approx \frac{H_{sub}\cdot a_m}{v_{wind} \cdot h_m}\] where \(H_{sub}=1~km\) is a “scale height” for sublimation and \(h_m\) the height of the mountain.
alpha <- function(a_m, h_m, v_wind, H_C, D_C) {
v_prec <- 5
H_s <- 1000
tau_a <- a_m/v_wind
tau_f <- (H_C+D_C/2)/v_prec
tau_s <- (H_s*a_m)/(v_wind*h_m)
1/(tau_a/tau_f+tau_a/tau_s)
}
CL <- 1800 # condensation level
max_prec <- 30/3600 # maximum precipitation rate (kg/m2/s)
v_wind <- 5 # wind speed (m/s)
isPrec <- h_Ctop>CL
prec <- pmin(pmax((h_Ctop-CL)/D_C, 0), 1)*max_prec*isPrec # precipitation rate (kg/m2/s)
isLee <- runmean(h_G, 11, align="left")<runmean(h_G, 11, align="right")
prec[isLee] <- prec[isLee]*alpha(a_m = 3000, h_m = 2000,
v_wind = v_wind,
H_C = mean(h_C[isPrec]),
D_C = D_C)
prec <- runmean(prec, 21, align="center")
par(mar=c(5,5,1,5))
plot(path$location$lat, h_G, type="l", ylab = "elevation (m)",
ylim=c(0,max(h_G)))
lines(path$location$lat, prec/max_prec*max(h_G),
lty=2, yaxt="n")
ll <- pretty(c(0,max_prec*3600))
axis(4,labels = ll, at=ll/max_prec*max(h_G)/3600)
mtext(side = 4, line = 3, "precipitation rate (mm/h)")
legend("topleft",
legend = c("elevation","precipitation rate"),
lty=c(1,2))
We need to know the timestep, i.e. the time \(\Delta t\) each point of the cloud needs to cross a discrete step \(\Delta x\) of its path
library(rgdal)
library(sp)
PL <- path$location
coordinates(PL) <- ~lng+lat
proj4string(PL) <- CRS("+proj=longlat +datum=WGS84")
PL <- spTransform(PL, CRSobj = CRS("+init=epsg:23033"))
xx <- PL@coords[,1]
yy <- PL@coords[,2]
dx <- mean(sqrt((xx - lag(xx))^2 + (yy - lag(yy))^2), na.rm=T)
dx
## [1] 127.8603
dt <- dx/v_wind
dt
## [1] 25.57206
Now we can calculate the wet deposition rates \(D_{in}\), \(D_{below}^{fine}\) and \(D_{below}^{coarse}\) along the path. We assume the following initial concentrations (in \(ng/m^3\))
init_C_in = 0.05
init_C_below_fine = 0.1
init_C_below_coarse = 0.05
wd <- wet_dep_cloud(init_C_in = init_C_in,
init_C_below_fine = init_C_below_fine,
init_C_below_coarse = init_C_below_coarse,
prec = prec, depth_cloud = D_C, height_cloud = h_C-h_G)
par(mar=c(5,5,1,5))
plot(path$location$lat, h_G, type="l", ylab = "elevation (m)",
ylim=c(0,max(h_G)), col="darkgrey", lwd=3)
max_dep <- max(wd$Drate_in,wd$Drate_below_fine,wd$Drate_below_coarse)
lines(path$location$lat,
wd$Drate_in /max_dep*max(h_G), lty=1, yaxt="n")
lines(path$location$lat,
wd$Drate_below_fine /max_dep*max(h_G), lty=2, yaxt="n")
lines(path$location$lat,
wd$Drate_below_coarse/max_dep*max(h_G), lty=3, yaxt="n")
ll <- pretty(c(0,max_dep))
axis(4,labels = ll, at=ll/max_dep*max(h_G))
mtext(side = 4, line = 3,
expression("deposition rate"~(n*g~m^{-2}~s^{-1})))
legend("topleft", y.intersp = 1.7,
legend = c(expression(h[G]),
expression("D"["in"]),
expression("D"["below"]^"fine"),
expression("D"["below"]^"coarse")),
lty=c(1,1:3), col=c("darkgrey",rep("black",3)),
lwd=c(3,rep(1,3)))
Now we can calculate the concentration in the precipitated water \[C_w=\frac{D_{tot}}{P}=\frac{D_{in}+D_{below}^{fine}+D_{below}^{coarse}}{P}\]
Cw_in <- wd$Drate_in /wd$prec
Cw_below_fine <- wd$Drate_below_fine /wd$prec
Cw_below_coarse <- wd$Drate_below_coarse/wd$prec
Cw_in [wd$prec==0]<- NA
Cw_below_fine [wd$prec==0]<- NA
Cw_below_coarse[wd$prec==0]<- NA
Cw_max <- max(Cw_in,Cw_below_fine,Cw_below_coarse,na.rm=T)
par(mar=c(5,5,1,5))
plot(path$location$lat, h_G, type="l", ylab = "elevation (m)",
ylim=c(0,max(h_G)), col="grey", lwd=3)
lines(path$location$lat,
Cw_in /Cw_max*max(h_G), lty=1, yaxt="n")
lines(path$location$lat,
Cw_below_fine /Cw_max*max(h_G), lty=2, yaxt="n")
lines(path$location$lat,
Cw_below_coarse/Cw_max*max(h_G), lty=3, yaxt="n")
ll <- pretty(c(0,Cw_max))
axis(4,labels = ll, at=ll/Cw_max*max(h_G))
mtext(side = 4, line = 3,
"concentration in the precipitated water")
mtext(side = 4, line = 4, expression((n*g/kg)))
legend("topleft", y.intersp = 1.7,
legend = c(expression(h[G]),
expression("C"["w"]["in"]^"total"),
expression("C"["w"]["below"]^"fine"),
expression("C"["w"]["below"]^"coarse")),
lty=c(1,1:3), col=c("grey",rep("black",3)),
lwd=c(3,rep(1,3)), bty = "n")