Objective
In my opinion there are some funky things going on with the N2O RF becaucse of the concentrations, which I think is related to what we were seeing with the CH4 concentrations. That the natural emissions had to be updated to be cocnsistent with the new preindustrial values.
library(hector)
library(dplyr)
library(ggplot2)
## library(hector) # note this is a speicifc branch krd_epa2
DIR <- "/Users/dorh012/projects/2021/EPA_Hector" # define the analysis directory
vars <- c(ATMOSPHERIC_N2O(), RF_N2O(), EMISSIONS_N2O(), NAT_EMISSIONS_N2O(), GLOBAL_TEMP())
inis <- c("hector_ssp119.ini", "hector_ssp245.ini", "hector_ssp126.ini", "hector_rcp45.ini")
lapply(inis, function(f){
ini <- file.path(DIR, "input", f)
core <- newcore(ini, name = gsub(x = f, pattern = "hector_|.ini", replacement = ""))
run(core, runtodate = 2050)
out <- fetchvars(core, 1745:2100, vars)
out$source <- "hector"
out
}) %>%
bind_rows() ->
hector
names <- c("ssp119_emiss-constraints.csv", "ssp126_emiss-constraints.csv", "ssp245_emiss-constraints.csv")
lapply(names, function(f){
out <- read.csv(file.path(DIR, "input", "emissions", f), comment.char = ";") %>%
select(year = Date, value = "N2O_constrain") %>%
mutate(variable = "N2O", scenario = gsub(f, pattern = "_emiss-constraints.csv", replacement = ""))
}) %>%
bind_rows() ->
inputs
file.path(DIR, "input", "emissions", "rcp45_emiss-constraints.csv") %>%
read.csv(stringsAsFactors = FALSE, comment.char = ";") %>%
select(year = Date, value = N2O_constrain) %>%
mutate(scenario = "rcp45", variable = "N2O") ->
expected
Problem
Looking at the N2O concentrations the shape of the concentrations is some what off from the expected values. We were seeing some similar problems with the CH4 concentrations being caused by the natural CH4 emissions. Could this be caused by the natural N2O emissions?
inputs <- bind_rows(inputs, expected)
hector$source <- 'hector'
inputs$source <- 'expected'
bind_rows(hector, inputs) %>%
filter(year < 2100) %>%
filter(variable == ATMOSPHERIC_N2O()) %>%
filter(source %in% c("hector", "expected")) %>%
ggplot(aes(year, value, color = source)) +
geom_line(size = 0.5) +
facet_wrap("scenario", scales = "free") +
labs(y = "[N2O]")

inis <- c("hector_ssp119.ini", "hector_ssp245.ini", "hector_ssp126.ini", "hector_rcp45.ini")
lapply(inis, function(f){
ini <- file.path(DIR, "input", f)
core <- newcore(ini, name = gsub(x = f, pattern = "hector_|.ini", replacement = ""))
setvar(core, dates = 1745:2100, values = 9.9, var = NAT_EMISSIONS_N2O(), unit = "Tg N")
reset(core)
run(core, runtodate = 2050)
out <- fetchvars(core, 1745:2100, vars)
out$source <- "hector"
out
}) %>%
bind_rows() ->
hector_new
What happens when we play around with the natural emissions?
hector_new$source <- paste(hector_new$source, " nat N2O 9.9 Tg")
hector$source <- paste(hector$source, " nat og")
bind_rows(hector_new, hector, inputs) %>%
filter(variable == NAT_EMISSIONS_N2O()) %>%
filter(year <= 2050) %>%
ggplot(aes(year, value, color = source)) +
geom_line(size = 0.5) +
facet_wrap("scenario", scales = "free") +
labs(y = "Natural N2O Emissions")

bind_rows(hector_new, hector, inputs) %>%
filter(variable == ATMOSPHERIC_N2O()) %>%
filter(year <= 2050) %>%
ggplot(aes(year, value, color = source)) +
geom_line(size = 0.5) +
facet_wrap("scenario", scales = "free") +
labs(y = "[N2O]")

When we swtich to a constant natural emissions there is a smoother transition N2O concentrations that is more similar to what we would expect. And below the when we have a constant natural N2O emissions there is better agreement with the IPCC AR6 RF during the historical period and slightly better in the future but over esitmates RF & concentrations starting in 1950.
AR6_dir <- "/Users/dorh012/Documents/2021/Chapter-7/data_output/SSPs"
files <- c("ERF_ssp245_1750-2500.csv", "ERF_ssp119_1750-2500.csv", "ERF_ssp126_1750-2500.csv")
lapply(files, function(f){
read.csv(file.path(AR6_dir, f)) %>%
select(year, value = n2o) %>%
mutate(scenario = gsub(pattern = "ERF_|_1750-2500.csv", replacement = "", f),
variable = RF_N2O(),
source = "IPCCC AR6")
}) %>%
bind_rows() ->
ipcc_rf
bind_rows(hector_new, hector, inputs, ipcc_rf) %>%
filter(variable == RF_N2O()) %>%
filter(year <= 2050) %>%
ggplot(aes(year, value, color = source)) +
geom_line(size = 0.5) +
facet_wrap("scenario", scales = "free") +
labs(y = "RF N2O")

However this change only causes relatively minor changes in the temperature output.
bind_rows(hector_new, hector, inputs) %>%
filter(variable == GLOBAL_TEMP()) %>%
filter(year <= 2050) %>%
ggplot(aes(year, value, color = source)) +
geom_line(size = 0.5) +
facet_wrap("scenario", scales = "free") +
labs(y = "Global Temp")

LS0tCnRpdGxlOiAiTjJPIE5hdHVyYWwgRW1pc3Npb25zIgpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sKLS0tCgoKIyBPYmplY3RpdmUgCgpJbiBteSBvcGluaW9uIHRoZXJlIGFyZSBzb21lIGZ1bmt5IHRoaW5ncyBnb2luZyBvbiB3aXRoIHRoZSBOMk8gUkYgYmVjYXVjc2Ugb2YgdGhlIGNvbmNlbnRyYXRpb25zLCB3aGljaCBJIHRoaW5rIGlzIHJlbGF0ZWQgdG8gd2hhdCB3ZSB3ZXJlIHNlZWluZyB3aXRoIHRoZSBDSDQgY29uY2VudHJhdGlvbnMuIFRoYXQgdGhlIG5hdHVyYWwgZW1pc3Npb25zIGhhZCB0byBiZSB1cGRhdGVkIHRvIGJlIGNvY25zaXN0ZW50IHdpdGggdGhlIG5ldyBwcmVpbmR1c3RyaWFsIHZhbHVlcy4gCgoKYGBge3IsIHdhcm5pbmc9RkFMU0UsIG1lc3NhZ2U9RkFMU0V9CmxpYnJhcnkoaGVjdG9yKQpsaWJyYXJ5KGRwbHlyKQpsaWJyYXJ5KGdncGxvdDIpCmBgYAoKCmBgYHtyfQojIyBsaWJyYXJ5KGhlY3RvcikgIyBub3RlIHRoaXMgaXMgYSBzcGVpY2lmYyBicmFuY2gga3JkX2VwYTIgIApESVIgPC0gIi9Vc2Vycy9kb3JoMDEyL3Byb2plY3RzLzIwMjEvRVBBX0hlY3RvciIgIyBkZWZpbmUgdGhlIGFuYWx5c2lzIGRpcmVjdG9yeQp2YXJzIDwtIGMoQVRNT1NQSEVSSUNfTjJPKCksIFJGX04yTygpLCBFTUlTU0lPTlNfTjJPKCksIE5BVF9FTUlTU0lPTlNfTjJPKCksIEdMT0JBTF9URU1QKCkpCgppbmlzIDwtIGMoImhlY3Rvcl9zc3AxMTkuaW5pIiwgImhlY3Rvcl9zc3AyNDUuaW5pIiwgImhlY3Rvcl9zc3AxMjYuaW5pIiwgImhlY3Rvcl9yY3A0NS5pbmkiKQpsYXBwbHkoaW5pcywgZnVuY3Rpb24oZil7CiAgICAKICAgIGluaSA8LSBmaWxlLnBhdGgoRElSLCAiaW5wdXQiLCBmKQogICAgY29yZSA8LSBuZXdjb3JlKGluaSwgbmFtZSA9ICBnc3ViKHggPSBmLCBwYXR0ZXJuID0gImhlY3Rvcl98LmluaSIsIHJlcGxhY2VtZW50ID0gIiIpKQogICAgcnVuKGNvcmUsIHJ1bnRvZGF0ZSA9IDIwNTApCiAgICBvdXQgPC0gZmV0Y2h2YXJzKGNvcmUsIDE3NDU6MjEwMCwgdmFycykKICAgIG91dCRzb3VyY2UgPC0gImhlY3RvciIKICAgIG91dAp9KSAlPiUgCiAgICBiaW5kX3Jvd3MoKSAtPiAKICAgIGhlY3RvcgoKbmFtZXMgPC0gYygic3NwMTE5X2VtaXNzLWNvbnN0cmFpbnRzLmNzdiIsICJzc3AxMjZfZW1pc3MtY29uc3RyYWludHMuY3N2IiwgInNzcDI0NV9lbWlzcy1jb25zdHJhaW50cy5jc3YiKQpsYXBwbHkobmFtZXMsIGZ1bmN0aW9uKGYpewogICAgb3V0IDwtIHJlYWQuY3N2KGZpbGUucGF0aChESVIsICJpbnB1dCIsICJlbWlzc2lvbnMiLCBmKSwgY29tbWVudC5jaGFyID0gIjsiKSAlPiUgCiAgICAgICAgc2VsZWN0KHllYXIgPSBEYXRlLCB2YWx1ZSA9ICJOMk9fY29uc3RyYWluIikgJT4lIAogICAgICAgIG11dGF0ZSh2YXJpYWJsZSA9ICJOMk8iLCBzY2VuYXJpbyA9IGdzdWIoZiwgcGF0dGVybiA9ICJfZW1pc3MtY29uc3RyYWludHMuY3N2IiwgcmVwbGFjZW1lbnQgPSAiIikpCn0pICU+JSAKICAgIGJpbmRfcm93cygpIC0+IAogICAgaW5wdXRzCgpmaWxlLnBhdGgoRElSLCAiaW5wdXQiLCAiZW1pc3Npb25zIiwgInJjcDQ1X2VtaXNzLWNvbnN0cmFpbnRzLmNzdiIpICU+JSAKICAgIHJlYWQuY3N2KHN0cmluZ3NBc0ZhY3RvcnMgPSBGQUxTRSwgY29tbWVudC5jaGFyID0gIjsiKSAlPiUgCiAgICBzZWxlY3QoeWVhciA9IERhdGUsIHZhbHVlID0gTjJPX2NvbnN0cmFpbikgJT4lIAogICAgbXV0YXRlKHNjZW5hcmlvID0gInJjcDQ1IiwgdmFyaWFibGUgPSAiTjJPIikgLT4gCiAgICBleHBlY3RlZApgYGAKCiMgUHJvYmxlbSAKCkxvb2tpbmcgYXQgdGhlIE4yTyBjb25jZW50cmF0aW9ucyB0aGUgc2hhcGUgb2YgdGhlIGNvbmNlbnRyYXRpb25zIGlzIHNvbWUgd2hhdCBvZmYgZnJvbSB0aGUgZXhwZWN0ZWQgdmFsdWVzLiBXZSB3ZXJlIHNlZWluZyBzb21lIHNpbWlsYXIgcHJvYmxlbXMgd2l0aCB0aGUgQ0g0IGNvbmNlbnRyYXRpb25zIGJlaW5nIGNhdXNlZCBieSB0aGUgbmF0dXJhbCBDSDQgZW1pc3Npb25zLiBDb3VsZCB0aGlzIGJlIGNhdXNlZCBieSB0aGUgbmF0dXJhbCBOMk8gZW1pc3Npb25zPyAKCmBgYHtyfQppbnB1dHMgPC0gYmluZF9yb3dzKGlucHV0cywgZXhwZWN0ZWQpCmhlY3RvciRzb3VyY2UgPC0gJ2hlY3RvcicgCmlucHV0cyRzb3VyY2UgPC0gJ2V4cGVjdGVkJyAKCmJpbmRfcm93cyhoZWN0b3IsIGlucHV0cykgJT4lIAogICAgZmlsdGVyKHllYXIgPCAyMTAwKSAlPiUgCiAgICBmaWx0ZXIodmFyaWFibGUgPT0gQVRNT1NQSEVSSUNfTjJPKCkpICU+JSAKICAgIGZpbHRlcihzb3VyY2UgJWluJSBjKCJoZWN0b3IiLCAiZXhwZWN0ZWQiKSkgJT4lIAogICAgZ2dwbG90KGFlcyh5ZWFyLCB2YWx1ZSwgY29sb3IgPSBzb3VyY2UpKSArIAogICAgZ2VvbV9saW5lKHNpemUgPSAwLjUpICsgCiAgICBmYWNldF93cmFwKCJzY2VuYXJpbyIsIHNjYWxlcyA9ICJmcmVlIikgKyAKICAgIGxhYnMoeSA9ICJbTjJPXSIpCmBgYAoKCmBgYHtyfQppbmlzIDwtIGMoImhlY3Rvcl9zc3AxMTkuaW5pIiwgImhlY3Rvcl9zc3AyNDUuaW5pIiwgImhlY3Rvcl9zc3AxMjYuaW5pIiwgImhlY3Rvcl9yY3A0NS5pbmkiKQpsYXBwbHkoaW5pcywgZnVuY3Rpb24oZil7CiAgICAKICAgIGluaSA8LSBmaWxlLnBhdGgoRElSLCAiaW5wdXQiLCBmKQogICAgY29yZSA8LSBuZXdjb3JlKGluaSwgbmFtZSA9ICBnc3ViKHggPSBmLCBwYXR0ZXJuID0gImhlY3Rvcl98LmluaSIsIHJlcGxhY2VtZW50ID0gIiIpKQogICAgc2V0dmFyKGNvcmUsIGRhdGVzID0gMTc0NToyMTAwLCB2YWx1ZXMgPSA5LjksIHZhciA9IE5BVF9FTUlTU0lPTlNfTjJPKCksIHVuaXQgPSAiVGcgTiIpCiAgICByZXNldChjb3JlKQogICAgcnVuKGNvcmUsIHJ1bnRvZGF0ZSA9IDIwNTApCiAgICBvdXQgPC0gZmV0Y2h2YXJzKGNvcmUsIDE3NDU6MjEwMCwgdmFycykKICAgIG91dCRzb3VyY2UgPC0gImhlY3RvciIKICAgIG91dAp9KSAlPiUgCiAgICBiaW5kX3Jvd3MoKSAtPiAKICAgIGhlY3Rvcl9uZXcKYGBgCgojIFdoYXQgaGFwcGVucyB3aGVuIHdlIHBsYXkgYXJvdW5kIHdpdGggdGhlIG5hdHVyYWwgZW1pc3Npb25zPyAKCmBgYHtyfQpoZWN0b3JfbmV3JHNvdXJjZSA8LSBwYXN0ZShoZWN0b3JfbmV3JHNvdXJjZSwgIiBuYXQgTjJPIDkuOSBUZyIpCmhlY3RvciRzb3VyY2UgPC0gcGFzdGUoaGVjdG9yJHNvdXJjZSwgIiBuYXQgb2ciKQoKCmJpbmRfcm93cyhoZWN0b3JfbmV3LCBoZWN0b3IsIGlucHV0cykgJT4lIAogICAgZmlsdGVyKHZhcmlhYmxlID09IE5BVF9FTUlTU0lPTlNfTjJPKCkpICU+JSAKICAgIGZpbHRlcih5ZWFyIDw9IDIwNTApICU+JSAKICAgIGdncGxvdChhZXMoeWVhciwgdmFsdWUsIGNvbG9yID0gc291cmNlKSkgKyAKICAgIGdlb21fbGluZShzaXplID0gMC41KSArIAogICAgZmFjZXRfd3JhcCgic2NlbmFyaW8iLCBzY2FsZXMgPSAiZnJlZSIpICsgCiAgICBsYWJzKHkgPSAiTmF0dXJhbCBOMk8gRW1pc3Npb25zIikKYGBgCgoKYGBge3J9CmJpbmRfcm93cyhoZWN0b3JfbmV3LCBoZWN0b3IsIGlucHV0cykgJT4lIAogICAgZmlsdGVyKHZhcmlhYmxlID09IEFUTU9TUEhFUklDX04yTygpKSAlPiUgCiAgICBmaWx0ZXIoeWVhciA8PSAyMDUwKSAlPiUgCiAgICBnZ3Bsb3QoYWVzKHllYXIsIHZhbHVlLCBjb2xvciA9IHNvdXJjZSkpICsgCiAgICBnZW9tX2xpbmUoc2l6ZSA9IDAuNSkgKyAKICAgIGZhY2V0X3dyYXAoInNjZW5hcmlvIiwgc2NhbGVzID0gImZyZWUiKSArIAogICAgbGFicyh5ID0gIltOMk9dIikKYGBgCgoKV2hlbiB3ZSBzd3RpY2ggdG8gYSBjb25zdGFudCBuYXR1cmFsIGVtaXNzaW9ucyB0aGVyZSBpcyBhIHNtb290aGVyIHRyYW5zaXRpb24gTjJPIGNvbmNlbnRyYXRpb25zIHRoYXQgaXMgbW9yZSBzaW1pbGFyIHRvIHdoYXQgd2Ugd291bGQgZXhwZWN0LiBBbmQgYmVsb3cgdGhlIHdoZW4gd2UgaGF2ZSBhIGNvbnN0YW50IG5hdHVyYWwgTjJPIGVtaXNzaW9ucyB0aGVyZSBpcyBiZXR0ZXIgYWdyZWVtZW50IHdpdGggdGhlIElQQ0MgQVI2IFJGIGR1cmluZyB0aGUgaGlzdG9yaWNhbCBwZXJpb2QgYW5kIHNsaWdodGx5IGJldHRlciBpbiB0aGUgZnV0dXJlIGJ1dCBvdmVyIGVzaXRtYXRlcyBSRiAmIGNvbmNlbnRyYXRpb25zIHN0YXJ0aW5nIGluIDE5NTAuCgpgYGB7cn0KCkFSNl9kaXIgPC0gIi9Vc2Vycy9kb3JoMDEyL0RvY3VtZW50cy8yMDIxL0NoYXB0ZXItNy9kYXRhX291dHB1dC9TU1BzIgpmaWxlcyA8LSBjKCJFUkZfc3NwMjQ1XzE3NTAtMjUwMC5jc3YiLCAiRVJGX3NzcDExOV8xNzUwLTI1MDAuY3N2IiwgICJFUkZfc3NwMTI2XzE3NTAtMjUwMC5jc3YiKQoKbGFwcGx5KGZpbGVzLCBmdW5jdGlvbihmKXsKICAgIHJlYWQuY3N2KGZpbGUucGF0aChBUjZfZGlyLCBmKSkgJT4lIAogICAgc2VsZWN0KHllYXIsIHZhbHVlID0gbjJvKSAlPiUgCiAgICBtdXRhdGUoc2NlbmFyaW8gPSBnc3ViKHBhdHRlcm4gPSAiRVJGX3xfMTc1MC0yNTAwLmNzdiIsICByZXBsYWNlbWVudCA9ICIiLCBmKSwgCiAgICAgICAgICAgdmFyaWFibGUgPSBSRl9OMk8oKSwgCiAgICAgICAgICAgc291cmNlID0gIklQQ0NDIEFSNiIpCn0pICU+JSAKICAgIGJpbmRfcm93cygpIC0+IAogICAgaXBjY19yZgoKYmluZF9yb3dzKGhlY3Rvcl9uZXcsIGhlY3RvciwgaW5wdXRzLCBpcGNjX3JmKSAlPiUgCiAgICBmaWx0ZXIodmFyaWFibGUgPT0gUkZfTjJPKCkpICU+JSAKICAgIGZpbHRlcih5ZWFyIDw9IDIwNTApICU+JSAKICAgIGdncGxvdChhZXMoeWVhciwgdmFsdWUsIGNvbG9yID0gc291cmNlKSkgKyAKICAgIGdlb21fbGluZShzaXplID0gMC41KSArIAogICAgZmFjZXRfd3JhcCgic2NlbmFyaW8iLCBzY2FsZXMgPSAiZnJlZSIpICsgCiAgICBsYWJzKHkgPSAiUkYgTjJPIikKYGBgCgoKSG93ZXZlciB0aGlzIGNoYW5nZSBvbmx5IGNhdXNlcyByZWxhdGl2ZWx5IG1pbm9yIGNoYW5nZXMgaW4gdGhlIHRlbXBlcmF0dXJlIG91dHB1dC4gCgpgYGB7cn0KYmluZF9yb3dzKGhlY3Rvcl9uZXcsIGhlY3RvciwgaW5wdXRzKSAlPiUgCiAgICBmaWx0ZXIodmFyaWFibGUgPT0gR0xPQkFMX1RFTVAoKSkgJT4lIAogICAgZmlsdGVyKHllYXIgPD0gMjA1MCkgJT4lIAogICAgZ2dwbG90KGFlcyh5ZWFyLCB2YWx1ZSwgY29sb3IgPSBzb3VyY2UpKSArIAogICAgZ2VvbV9saW5lKHNpemUgPSAwLjUpICsgCiAgICBmYWNldF93cmFwKCJzY2VuYXJpbyIsIHNjYWxlcyA9ICJmcmVlIikgKyAKICAgIGxhYnMoeSA9ICJHbG9iYWwgVGVtcCIpCmBgYAoKCg==