Precipitation scavenging

A cloud-following parametrization for a mountainous path

G.Bonafè

2017-10-25

Parametrization of wet deposition

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

Evolution over a time period

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))

Path of a cloud

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)

Precipitation from the cloud

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

Wet deposition along the path

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")