Fast speed-dependent bottom-up emission inventory

Source: R/emis_speed.R

emis_speed estimates hourly emissions per street using speed-dependent emission factors obtained with ef_ldv_scaled or ef_hdv_scaled. The EMEP/EEA equations are evaluated in a compiled OpenMP kernel, which is orders of magnitude faster than looping over hours and ages in R.

Emissions are computed as $$E(s,h) = lkm(s) * \sum_a veh(s,a) * profile(h) * EF_a(speed(s,h))$$ and the result is returned aggregated by street and hour, and optionally by age and hour.

emis_speed(
  veh,
  lkm,
  ef,
  speed,
  profile,
  agemax = ncol(veh),
  by_age = TRUE,
  nt = ifelse(check_nt() == 1, 1, check_nt()/2),
  verbose = FALSE
)

Arguments

veh

numeric matrix or data.frame of vehicle flows, rows are streets and columns are ages (as in emis).

lkm

numeric vector with the length of each link in km.

ef

a list returned by ef_ldv_scaled or ef_hdv_scaled (it must carry the compiled programs attribute).

speed

data.frame or matrix of speeds (km/h), rows are streets and columns are hours (flattened hours x days).

profile

temporal profile, matrix (24 x 7) or vector. If missing, a profile of ones is used.

agemax

integer; number of ages to use.

by_age

logical; return the per-age hourly totals (sum over streets).

nt

integer; number of OpenMP threads.

verbose

logical.

Value

A list with streets (streets x hours) and, when by_age = TRUE, veh (ages x hours).

Examples

# 1) Local emission factors by age (CETESB, Brazil)
CO <- ef_cetesb(p = "CO", veh = "PC_G", year = 2018, agemax = 40, full = TRUE)

# 2) Scale the EMEP/EEA speed curve so that at the driving-cycle speed
#    (SDC) it reproduces the local emission factor
lef <- ef_ldv_scaled(dfcol = CO$CO, v = "PC", t = "4S", cc = "<=1400",
                     f = "G", eu = CO$EqEuro_PC, p = "CO")
lef[[1]](34.12)      # equals CO$CO[1]
#> [1] 0.173
length(lef)          # one function per age
#> [1] 40

# 3) A tiny network: 200 streets, 40 ages, 24 hours
S <- 200; A <- 40; H <- 24
veh <- matrix(100, nrow = S, ncol = A)
lkm <- units::set_units(rep(1, S), "km")
speed <- Speed(matrix(rep(c(10, 30, 50, 80), length.out = S * H), S, H))
profile <- matrix(1, 24, 1)

# 4) Fast inventory
E <- emis_speed(veh = veh, lkm = lkm, ef = lef, speed = speed,
                profile = profile, by_age = TRUE, nt = 1)
dim(E$streets)       # streets x hours
#> [1] 200  24
dim(E$veh)           # ages x hours
#> [1] 40 24
sum(E$streets)
#> [1] 200577239

# 5) Same result as the reference implementation emis()
Er <- emis(veh = veh, lkm = lkm, ef = lef, speed = speed,
           profile = profile, simplify = TRUE, agemax = A)
max(abs(apply(Er, c(1, 3), sum) - E$streets))
#> [1] 8.731149e-11