R/zchunk_LA154.transportation_UCD.R

Defines functions module_energy_LA154.transportation_UCD

Documented in module_energy_LA154.transportation_UCD

# Copyright 2019 Battelle Memorial Institute; see the LICENSE file.

#' module_energy_LA154.transportation_UCD
#'
#' Generates transportation energy and other data using UCD transportation database and IEA data.
#'
#' @param command API command to execute
#' @param ... other optional parameters, depending on command
#' @return Depends on \code{command}: either a vector of required inputs,
#' a vector of output names, or (if \code{command} is "MAKE") all
#' the generated outputs: \code{L154.in_EJ_R_trn_m_sz_tech_F_Yh}, \code{L154.in_EJ_ctry_trn_m_sz_tech_F}, \code{L154.intensity_MJvkm_R_trn_m_sz_tech_F_Y}, \code{L154.loadfactor_R_trn_m_sz_tech_F_Y}, \code{L154.cost_usdvkm_R_trn_m_sz_tech_F_Y}, \code{L154.speed_kmhr_R_trn_m_sz_tech_F_Y}, \code{L154.out_mpkm_R_trn_nonmotor_Yh}. The corresponding file in the
#' original data system was \code{LA154.transportation_UCD.R} (energy level1).
#' @details L154.in_EJ_R_trn_m_sz_tech_F_Yh and L154.in_EJ_ctry_trn_m_sz_tech_F generated by aggregating IEA data UCD
#' transportation technologies, then scaling to transportation enduse data. Other outputs generated by aggregating UCD data
#' to GCAM regions.
#' @importFrom assertthat assert_that
#' @importFrom dplyr arrange bind_rows distinct filter if_else group_by left_join mutate select summarise group_by select
#' @importFrom tidyr gather replace_na spread
#' @importFrom data.table as.data.table setorderv rbindlist
#' @importFrom rlang :=
#' @author RH May 2017
module_energy_LA154.transportation_UCD <- function(command, ...) {

  if(command == driver.DECLARE_INPUTS) {
    return(c(FILE = "common/iso_GCAM_regID",
             FILE = "energy/mappings/calibrated_techs_trn_agg",
             FILE = "energy/mappings/enduse_fuel_aggregation",
             FILE = "energy/mappings/UCD_ctry",
             FILE = "energy/mappings/UCD_techs",
             #kbn 2019-10-09 Added size class divisions file here.
             FILE=  "energy/mappings/UCD_size_class_revisions",
             FILE = "energy/OTAQ_trn_data_EMF37",
             FILE =  "energy/UCD_trn_data_CORE",
             FILE =  "energy/UCD_trn_data_SSP1",
             FILE =  "energy/UCD_trn_data_SSP3",
             FILE = "energy/UCD_trn_data_SSP5",
             # This file is currently using a constant to select the correct SSP database
             # All SSP databases will be included in the input files
             "L101.in_EJ_ctry_trn_Fi_Yh",
             "L1011.in_EJ_ctry_intlship_TOT_Yh",
             "L131.in_EJ_R_Senduse_F_Yh",
             "L100.Pop_thous_ctry_Yh"))
  } else if(command == driver.DECLARE_OUTPUTS) {
    return(c("L154.in_EJ_R_trn_m_sz_tech_F_Yh",
             "L154.in_EJ_ctry_trn_m_sz_tech_F",
             "L154.intensity_MJvkm_R_trn_m_sz_tech_F_Y",
             "L154.loadfactor_R_trn_m_sz_tech_F_Y",
             "L154.cost_usdvkm_R_trn_m_sz_tech_F_Y",
             "L154.speed_kmhr_R_trn_m_sz_tech_F_Y",
             "L154.out_mpkm_R_trn_nonmotor_Yh",
             "L154.IEA_histfut_data_times_UCD_shares",
             "UCD_trn_data"))
  } else if(command == driver.MAKE) {

    ## silence package check.
    year <- value <- sector <- fuel <- EIA_value <- iso <- UCD_category <- variable <-
      UCD_region <- agg <- UCD_region.x <- UCD_region.y <- UCD_sector <- size.class <-
      UCD_technology <- UCD_fuel <- UCD_share <- GCAM_region_ID <- trn <- unscaled_value <-
      scaled_value <- unit <- vkt_veh_yr <- speed <- speed.x <- speed.y <- weight_EJ <-
      intensity <- Tvkm <- `load factor` <- `non-fuel costs` <- size.class.x <- Tpkm <-
      Tusd <- Thr <- intensity_MJvkm <- loadfactor <- cost_usdvkm <- speed_kmhr <- variable  <-
      population <- pkm_percap <- country_name <- year.x <- rev.mode <- rev_size.class <-
      mode.y <- size.class.y <- sce <- weight_EJ_core <- intensity_CORE <- loadfactor_CORE <-
      non_fuel_cost_core <- NULL

    all_data <- list(...)[[1]]

    # Load required inputs
    iso_GCAM_regID <- get_data(all_data, "common/iso_GCAM_regID")
    calibrated_techs_trn_agg <- get_data(all_data, "energy/mappings/calibrated_techs_trn_agg")
    enduse_fuel_aggregation <- get_data(all_data, "energy/mappings/enduse_fuel_aggregation")
    UCD_ctry <- get_data(all_data, "energy/mappings/UCD_ctry")
    UCD_techs <- get_data(all_data, "energy/mappings/UCD_techs")
    OTAQ_trn_data_EMF37 <- get_data(all_data, "energy/OTAQ_trn_data_EMF37")
    UCD_trn_data_CORE <- get_data(all_data, "energy/UCD_trn_data_CORE") %>%
      gather_years %>% mutate(sce=paste0("CORE"))
    # kbn 2020-06-02 get data for all SSPs. No data for SSP2.
    UCD_trn_data_SSP1 <- get_data(all_data,"energy/UCD_trn_data_SSP1") %>% gather_years %>% mutate(sce=paste0("SSP1"))
    UCD_trn_data_SSP3 <- get_data(all_data,"energy/UCD_trn_data_SSP3") %>% gather_years %>% mutate(sce=paste0("SSP3"))
    UCD_trn_data_SSP5 <- get_data(all_data,"energy/UCD_trn_data_SSP5") %>% gather_years %>% mutate(sce=paste0("SSP5"))
    UCD_trn_data <- bind_rows(UCD_trn_data_CORE,UCD_trn_data_SSP1,UCD_trn_data_SSP3,UCD_trn_data_SSP5)

    L101.in_EJ_ctry_trn_Fi_Yh <- get_data(all_data, "L101.in_EJ_ctry_trn_Fi_Yh")
    L1011.in_EJ_ctry_intlship_TOT_Yh <- get_data(all_data, "L1011.in_EJ_ctry_intlship_TOT_Yh")
    L131.in_EJ_R_Senduse_F_Yh <- get_data(all_data, "L131.in_EJ_R_Senduse_F_Yh")
    L100.Pop_thous_ctry_Yh <- get_data(all_data, "L100.Pop_thous_ctry_Yh")

    #kbn 2019-10-07: Read new size class assignments
    Size_class_New<- get_data(all_data, "energy/mappings/UCD_size_class_revisions")
    # ===================================================
    # Prepare EMF37 data for merging: first, repeat by the full set of scenarios
    OTAQ_trn_data_EMF37 %>%
      gather_years() %>%
      repeat_add_columns(tibble(sce = unique(UCD_trn_data$sce))) ->
      OTAQ_trn_data_EMF37_to_bind

    # Expand the OTAQ trn data to all of the required years in the UCD transportation database
    UCD_data_years <- sort(unique(UCD_trn_data$year))

    OTAQ_trn_data_EMF37_to_bind_noenergy <- filter(OTAQ_trn_data_EMF37_to_bind, variable != "energy") %>%
      complete(nesting(sce, UCD_region, UCD_sector, mode, size.class, UCD_technology, UCD_fuel, variable, unit),
               year = UCD_data_years) %>%
      group_by(sce, UCD_region, UCD_sector, mode, size.class, UCD_technology, UCD_fuel, variable, unit) %>%
      mutate(value = approx_fun(year, value, rule = 2)) %>%
      ungroup()

    UCD_trn_data_nocalibration <- UCD_trn_data %>%
      filter(!variable %in% c("energy", "service output")) %>%
      anti_join(OTAQ_trn_data_EMF37_to_bind_noenergy, by = c("sce", "UCD_region", "UCD_sector", "mode","size.class",
                                                    "UCD_technology", "UCD_fuel", "variable", "unit", "year")) %>%
      bind_rows(OTAQ_trn_data_EMF37_to_bind_noenergy) %>%
      arrange(sce, UCD_region, UCD_sector, mode, size.class, UCD_technology, UCD_fuel, variable, unit, year)

      UCD_trn_data_calibrated <- filter(UCD_trn_data, variable %in% c("energy", "service output")
                                    & year == min(year)) %>%
        anti_join(filter(OTAQ_trn_data_EMF37_to_bind, variable == "energy" & year == min(year)),
                  by = c("sce", "UCD_region", "UCD_sector", "mode","size.class",
                         "UCD_technology", "UCD_fuel", "variable", "unit", "year")) %>%
        bind_rows(filter(OTAQ_trn_data_EMF37_to_bind, variable == "energy" & year == min(year)))

      UCD_trn_data <- bind_rows(UCD_trn_data_calibrated, UCD_trn_data_nocalibration)

    # Part 1: downscaling country-level transportation energy data to UCD transportation technologies, then scaling to transportation
    # enduse data.

    ###kbn 2020-03-26 Changes in transportation related to BY update 2015. These changes are referenced throughout the code
    #1. Revised size classes,modes/ User defined size classes and modes- The user can now aggregate transportation data by the revised size classes using
    #the constant energy.TRAN_UCD_MODE and energy.TRAN_UCD_SIZE_CLASS. The aggregation in different places takes place with the help of these constants.
    #2. Enabling SSP processing for all SSPs within the code- The user can now process data for all SSPs within the code flexibly as opposed to running
    #the data system for multiple iterations to process data from different SSPs. This has been achieved by adding an sce column to the transporation outputs
    #that keeps track of output by SSP and the CORE.
    #3. Using data.table as opposed to dplyr to increase processing speed- In a number of places the group_bys from dplyr have been replaced with group_bys from
    #data.table to increase processing speeds.


    # NOTE: We are currently aggregating IEA's data on rail and road due to inconsistencies (e.g. no rail in the Middle East)
    # First, replace the international shipping data (swapping in EIA for IEA)
    # Only perform this swap for international shipping / refined liquids, and in countries in the EIA database

    IEA_data_EIA_intlship <- L101.in_EJ_ctry_trn_Fi_Yh %>%
      # expecting NAs here because we only want to replace certain values. JS 12/2020: Use left_join
      left_join(L1011.in_EJ_ctry_intlship_TOT_Yh %>% rename(EIA_value = value), by = c("iso", "year")) %>%
      mutate(value = if_else(sector == "in_trn_international ship" &
                               fuel == "refined liquids" &
                               !is.na(EIA_value), EIA_value, value),
             sector = sub("in_", "", sector)) %>%
      select(iso, sector, fuel, year, value)

    # Need to map IEA sector to UCD_category, calibrated_techs_trn_agg data is too busy
    UCD_category_mapping <- calibrated_techs_trn_agg %>% select(sector, UCD_category) %>% distinct

    # Aggregate IEA data to UCD_category in each country/year instead of sector
    IEA_data_aggregated_by_UCD_cat <- IEA_data_EIA_intlship %>%
      left_join_error_no_match(UCD_category_mapping, by = "sector") %>%
      group_by(iso, UCD_category, fuel, year) %>%
      summarise(value = sum(value)) %>%
      ungroup()


    #kbn 2019-10-07 Get new UCD size classes
    UCD_trn_data<- UCD_trn_data %>%
      left_join_error_no_match(Size_class_New,by = c("UCD_region", "mode", "size.class"))


    # Aggregating UCD transportation database by the general categories used for the IEA transportation data
    # These will be used to compute shares for allocation of energy to mode/technology/fuel within category/fuel
    UCD_trn_data_UCD_techs <- UCD_trn_data %>%
      filter(variable == "energy") %>%
      left_join_error_no_match(UCD_techs, by = c("UCD_sector", "mode", "size.class", "UCD_technology", "UCD_fuel"))

    UCD_trn_data_UCD_cat <- UCD_trn_data_UCD_techs %>%
      # Filtering only to base year for computing shares
      filter(year == energy.UCD_EN_YEAR) %>%
      #kbn 2020-29-01 adding sce to group_by here (to enable flexible use of SSPs). Changes described in detail in comment with search string,kbn 2020-03-26.
      #We will track the SSP data within each of the transportation outputs by adding an sce column which will track outputs
      #from each of the SSPs.
      group_by(UCD_region, UCD_category, fuel,sce) %>%
      summarise(agg = sum(value)) %>%
      ungroup()

    # Match these energy quantities back into the complete table for computation of shares of fuel in category
    UCD_trn_data_UCD_techs <- UCD_trn_data_UCD_techs %>%
      filter(year == energy.UCD_EN_YEAR) %>%
      #kbn 2020-29-01 Adding sce below (to enable flexible use of SSPs).Changes described in detail in comment with search string,kbn 2020-03-26.
      left_join_error_no_match(UCD_trn_data_UCD_cat, by = c("UCD_region", "UCD_category", "fuel","sce")) %>%
      # If the aggregate is 0 or value is NA, set share to 0, rather than NA
      mutate(UCD_share =  value / agg) %>%
      replace_na(list(UCD_share = 0))

    # Writing out the UC Davis mode/technology/fuel shares within category/fuel at the country level
    # First, creating a table of desired countries with their UCD regions
    ctry_iso_region <- tibble(iso = unique(L101.in_EJ_ctry_trn_Fi_Yh$iso)) %>%
      left_join_error_no_match(UCD_ctry, by = "iso")

    UCD_fuel_share_in_cat <- UCD_trn_data_UCD_techs %>%
      # Adds country name and region for all observations, filtering out by matching region in next step
      repeat_add_columns(ctry_iso_region) %>%
      filter(UCD_region.x == UCD_region.y) %>%
      #kbn 2019-09-10 select revised mode and revised size class here below.Changes described in detail in comment with search string,kbn 2020-03-26.
      #We now have the option to aggregate by the revised size classes as opposed to the original mode and size.class
      #structure in GCAM. To enable the same, we will select and group_by the revised size classes if that option is chosen.

      #kbn 2010-01-2020 Add sce to below to enable SSPs (to enable flexible use of SSPs).Changes described in detail in comment with search string,kbn 2020-03-26.
      select(iso, UCD_sector, mode, size.class, UCD_technology,
             UCD_fuel, UCD_category, fuel, UCD_share,rev.mode,rev_size.class,sce)

    # Multiplying historical energy by country/category/fuel times the shares of country/mode/tech/fuel within country/category/fuel
    # Need a value for each iso, year, UCD category, and fuel combo, even if not currently in L154.in_EJ_ctry_trn_Fi_Yh
    UCD_cat_fuel <- UCD_fuel_share_in_cat %>%
      select(UCD_category, fuel) %>%
      distinct
    iso_year <- IEA_data_aggregated_by_UCD_cat %>%
      ungroup %>%
      select(iso, year) %>%
      distinct


    #Add adjustment here. Technologies not represented in CORE but in scenarios are getting dropped (BEV bus for example)
    IEA_hist_data_times_UCD_shares <- UCD_cat_fuel %>%
      repeat_add_columns(iso_year) %>%
      left_join(UCD_fuel_share_in_cat, by = c("UCD_category", "fuel", "iso")) %>%
      fast_left_join(IEA_data_aggregated_by_UCD_cat, by = c("UCD_category", "fuel", "iso", "year")) %>%
      fast_left_join(iso_GCAM_regID %>% select(iso, GCAM_region_ID), by = "iso") %>%
      # Multiply value by share. Set missing values to 0. These are combinations not available in the data from IEA.
      replace_na(list(value = 0)) %>%
      filter(sce=="CORE") %>%
      select(-sce) %>%
      mutate(value = value * UCD_share) %>%
      #kbn 2019-09-10 select revised mode and revised size class here below.Changes described in detail in comment with search string,kbn 2020-03-26.
      #kbn 2020-29-01 Updating with sce below (to enable flexible use of SSPs). Changes described in detail in comment with search string,kbn 2020-03-26.
      select(iso, UCD_sector, mode, size.class, UCD_technology,
             UCD_fuel, UCD_category, fuel, GCAM_region_ID, year, value,rev.mode,rev_size.class)



    # kbn 2020-29-01 Add function for fast_group_by_sum.This function uses data.table instead of dplyr thus increasing speed.Creates a group_by and then summarises. This will be
    #added to utils.R as a function. We have submitted a separate issue PR on github for the same.
    fast_group_by_sum<- function(df,by,value){
      df <- as.data.table(df)

      df<- df[, value:=sum(value), by]
      df<- df[, c(by,"value"), with = FALSE]
      df<- as_tibble(df)
      df<- df %>%  distinct()

      return(df)
    }


    # Aggregating by GCAM region
    IEA_hist_data_times_UCD_shares_region <- IEA_hist_data_times_UCD_shares %>%
      #kbn 2019-09-10. Aggregate by size.class and mode structure defined in constants.Changes described in detail in comment with search string,kbn 2020-03-26.
      #kbn 2020-01-29 Adding sce below (to enable flexible use of SSPs). Changes described in detail in comment with search string,kbn 2020-03-26.
      group_by(GCAM_region_ID, UCD_sector, !!(as.name(energy.TRAN_UCD_MODE)), !!(as.name(energy.TRAN_UCD_SIZE_CLASS)), UCD_technology, UCD_fuel, fuel, year) %>%
      summarise(value = sum(value)) %>%
      ungroup()

    # Aggregating by fuel to calculate scalers
    IEA_UCD_shared_region_fuel_sum <- IEA_hist_data_times_UCD_shares_region %>%
      #kbn 2020-01-29 Adding sce below(to enable flexible use of SSPs). Changes described in detail in comment with search string,kbn 2020-03-26.
      group_by(GCAM_region_ID, fuel, year) %>%
      summarise(unscaled_value = sum(value)) %>%
      ungroup()

    trn_enduse_data <- L131.in_EJ_R_Senduse_F_Yh %>%
      # Filtering out transportation sectors only
      filter(grepl("trn", sector)) %>%
      # Need to match "aggregate" fuels from IEA
      left_join_error_no_match(enduse_fuel_aggregation %>% select(fuel, trn), by = c("fuel")) %>%
      select(-fuel, fuel = trn)

    trn_enduse_data_fuel_aggregated <- trn_enduse_data %>%
      group_by(GCAM_region_ID, fuel, year) %>%
      summarise(value = sum(value)) %>%
      ungroup()

    IEA_UCD_shared_scaled_to_enduse_data <- IEA_UCD_shared_region_fuel_sum %>%
      # Keep NAs and then set to zero
      left_join(trn_enduse_data_fuel_aggregated, by = c("GCAM_region_ID", "fuel", "year")) %>%
      mutate(scaled_value = value / unscaled_value) %>%
      replace_na(list(scaled_value = 0)) %>%
      select(-unscaled_value, -value)

    # Multiplying scalers by original estimates
    IEA_hist_data_times_UCD_shares_region_scaled_to_enduse_data <- IEA_hist_data_times_UCD_shares_region %>%
      #kbn 2020-29-01 Add sce below. Changes described in detail in comment with search string,kbn 2020-03-26.
      left_join(IEA_UCD_shared_scaled_to_enduse_data, by = c("GCAM_region_ID", "fuel", "year")) %>%
      mutate(value = value * scaled_value) %>%
      # Energy is being dropped due to zeroes in the UCD database. Might want to add new techs to the UC Davis database
      replace_na(list(value = 0)) %>%
      select(-scaled_value)

    #kbn 2019-10-11 change column names from revised to normal.
    #If the revised names are being tracked here, changing back to original structure.

    colnames(IEA_hist_data_times_UCD_shares_region_scaled_to_enduse_data)[colnames(IEA_hist_data_times_UCD_shares_region_scaled_to_enduse_data)=='rev.mode']<-"mode"
    colnames(IEA_hist_data_times_UCD_shares_region_scaled_to_enduse_data)[colnames(IEA_hist_data_times_UCD_shares_region_scaled_to_enduse_data)=='rev_size.class']<-"size.class"

    # Part 2: Downscaling of parameters in the UCD database to the country level
    # 2a: Merging of non-fuel costs to assign each technology with a single cost per vkm
    # Exogenous fixed charge rate to convert $/veh to $/veh/yr
    fcr_veh <- energy.DISCOUNT_RATE_VEH +
      energy.DISCOUNT_RATE_VEH / (((1 + energy.DISCOUNT_RATE_VEH) ^ energy.NPER_AMORT_VEH) - 1)

    UCD_trn_data_vkm_veh <- UCD_trn_data %>%
      filter(variable == "annual travel per vehicle") %>%
      # Dropping UCD technology and UCD fuel because they are "All"
      # kbn 2020-01-29 updating with sce below. Changes described in detail in comment with search string,kbn 2020-03-26.
      select(UCD_region, UCD_sector, mode, size.class,year, vkt_veh_yr = value, sce)

    UCD_trn_cost_data <- UCD_trn_data %>%
      filter(grepl("\\$", unit)) %>%
      # Use the fixed charge rate to convert to $/veh/yr
      mutate(value = if_else(unit == "2005$/veh", value * fcr_veh, value),
             unit = if_else(unit == "2005$/veh", "2005$/veh/yr", unit)) %>%
      # Match in the number of km per vehicle per year in order to calculate a levelized cost (per vkm)
      #kbn 2020-01-29 Updated with sce below. Changes described in detail in comment with search string,kbn 2020-03-26.
      left_join(UCD_trn_data_vkm_veh, by = c("UCD_region", "UCD_sector", "mode", "size.class", "year","sce")) %>%
      mutate(value = if_else(unit == "2005$/veh/yr", value / vkt_veh_yr, value),
             unit = if_else(unit == "2005$/veh/yr", "2005$/vkt", unit)) %>%
      #kbn 2020-01-29 Updated with sce below. Changes described in detail in comment with search string,kbn 2020-03-26.
      group_by(UCD_region, UCD_sector, mode, size.class, UCD_technology, UCD_fuel, unit, year,sce) %>%
      summarise(value = sum(value)) %>%
      ungroup() %>%
      mutate(variable = "non-fuel costs")


    #kbn 2019-10-18. We drop some columns in the above calculation with the summarise. To fix the same, we are adding back the original UCD_trn_data below.
    UCD_trn_data_for_join<-UCD_trn_data %>%
      select(-variable,-unit,-value)

    UCD_trn_cost_data<-UCD_trn_cost_data %>%
      #kbn 2020-01-29 Updating with sce below. Changes described in detail in comment with search string,kbn 2020-03-26.
      inner_join(UCD_trn_data_for_join,by=c("mode","size.class","UCD_region","UCD_sector", "UCD_technology", "UCD_fuel","year","sce"))



    # Creating tibble with all GCAM years to join with. The values will be filled out using the first available year.
    # Remove years in all GCAM years that are already in UCD database
    all_years <- tibble( year = c(HISTORICAL_YEARS, FUTURE_YEARS)) %>%
      filter(!(year %in% unique(UCD_trn_data$year)))

    UCD_trn_data_sce <- bind_rows(UCD_trn_data_SSP1,UCD_trn_data_SSP3,UCD_trn_data_SSP5)
    all_years_SSPs <- tibble( year = c(MODEL_FINAL_BASE_YEAR, MODEL_FUTURE_YEARS)) %>%
      filter(!(year %in% unique(UCD_trn_data$year)))
    #kbn 2020-01-30 We don't need all years for the SSPs. Only selecting years from 2015 on wards. Splitting years
    #into CORE years and SSP years.
    UCD_trn_data_allyears_CORE <- bind_rows(
      filter( UCD_trn_data, variable %in% c("intensity", "load factor", "speed")),
      UCD_trn_cost_data) %>%
      filter(sce == "CORE") %>%
      select(-year, -value) %>%
      distinct() %>%
      repeat_add_columns(all_years) %>%
      mutate(value = NA)

    UCD_trn_data_allyears_SSPs <- bind_rows(
      filter( UCD_trn_data, variable %in% c("intensity", "load factor", "speed")),
      UCD_trn_cost_data) %>%
      filter(sce != "CORE") %>%
      select(-year, -value) %>%
      distinct() %>%
      repeat_add_columns(all_years_SSPs) %>%
      mutate(value = NA)

    UCD_trn_data_allyears <- bind_rows(UCD_trn_data_allyears_CORE,UCD_trn_data_allyears_SSPs)
    UCD_trn_data_allyears$value<- as.numeric(as.character(UCD_trn_data_allyears$value))

    UCD_trn_data_fillout <- bind_rows(
      filter( UCD_trn_data, variable %in% c("intensity", "load factor", "speed")),
      UCD_trn_cost_data,
      UCD_trn_data_allyears)
    # Fill out all missing values with the nearest available year that is not missing
    #kbn 2020-06-02: Removing duplicates here. If they exist.
    UCD_trn_data_fillout %>%  distinct()->UCD_trn_data_fillout

    #kbn 2020 adding data.table here to increase speed.
    UCD_trn_data_fillout <- as.data.table(UCD_trn_data_fillout)
    #Set order
    #Changing below to year so that we don't add values for intermittent years for SSPs
    setorderv(UCD_trn_data_fillout,c("UCD_region", "UCD_sector", paste(energy.TRAN_UCD_MODE), paste(energy.TRAN_UCD_SIZE_CLASS), "UCD_technology", "UCD_fuel", "variable", "unit", "year"))
    #Making sure that value is numeric as a check so that we do not get a failure in the if_else
    UCD_trn_data_fillout <-    UCD_trn_data_fillout[, value :=as.numeric(value)]
    # Start interpolation
    UCD_trn_data_fillout <- UCD_trn_data_fillout[, value := if_else(is.na(value), as.numeric(approx_fun(year, value, rule = 2)), as.numeric(value)),by= c("UCD_region", "UCD_sector", "mode", "size.class", "UCD_technology", "UCD_fuel", "variable", "unit","sce")]

    #kbn 2020 filtering out SSP values that are the same. Basically if a certain combination has the same value for a SSP in a year compared to core,
    #just keep the core value.
    #setorderv(UCD_trn_data_fillout,c("sce","year"))
    #UCD_trn_data_fillout<- unique(UCD_trn_data_fillout, by= c("UCD_region", "UCD_sector", "size.class","rev_size.class", "mode","rev.mode", "UCD_technology", "UCD_fuel", "variable", "unit", "year","value"))
    #Convert back to tibble
    #UCD_trn_data_fillout <- as_tibble(UCD_trn_data_fillout)

    # Aggregate the country-level energy consumption by sector and mode. First need to add in the future years for matching purposes
    IEA_fut_data_times_UCD_shares <- IEA_hist_data_times_UCD_shares %>%
      select(-year, -value) %>%
      distinct() %>%
      repeat_add_columns(tibble(year = FUTURE_YEARS, value = NA))


    IEA_histfut_data_times_UCD_shares <- IEA_hist_data_times_UCD_shares %>%
      bind_rows(IEA_fut_data_times_UCD_shares) #%>%
    #kbn 2020-01-29 Adding sce below. Changes described in detail in comment with search string,kbn 2020-03-26.
    #kbn 2020-01-29 tUse data.table here instead of dplyr. Changes described in detail in comment with search string,kbn 2020-03-26.
    IEA_histfut_data_times_UCD_shares <- IEA_histfut_data_times_UCD_shares
    IEA_histfut_data_times_UCD_shares <- as.data.table(IEA_histfut_data_times_UCD_shares)
    IEA_histfut_data_times_UCD_shares <- IEA_histfut_data_times_UCD_shares[, value := if_else(is.na(value), approx_fun(year, value, rule = 2), value),by= c("iso", "UCD_sector", "mode", "size.class", "UCD_technology", "UCD_fuel", "UCD_category", "fuel")]
    IEA_histfut_data_times_UCD_shares <- IEA_histfut_data_times_UCD_shares[,c("iso", "UCD_sector", paste(energy.TRAN_UCD_MODE), paste(energy.TRAN_UCD_SIZE_CLASS), "UCD_technology", "UCD_fuel", "UCD_category", "fuel","value","year","GCAM_region_ID"),with=FALSE]
    IEA_histfut_data_times_UCD_shares <- as_tibble(IEA_histfut_data_times_UCD_shares)

    IEA_data_times_UCD_shares_UCD_sector_agg <- IEA_histfut_data_times_UCD_shares %>%
      #kbn 2019-10-09 group by mode selected by user below. Changes described in detail in comment with search string,kbn 2020-03-26.
      #kbn 2020 fast_group_by_sum is used instead of regular group_by for speed. Changes described in detail in comment with search string,kbn 2020-03-26.
      fast_group_by_sum(by=c("iso", "UCD_sector", paste(energy.TRAN_UCD_MODE), "year"))

    #kbn 2019-10-09 activate below if using new mode. We lose the mode and size_class columns during the group_by calls above. We need those columns in the calculations below
    #The below code brings back those columns.
    if (energy.TRAN_UCD_MODE=='rev.mode'){

      #kbn -Once again, we drop some data. We are adding those back in the old size classes so we can keep track of modes and size classes
      UCD_trn_data_fillout<-UCD_trn_data_fillout %>%
        inner_join(Size_class_New,by= c("UCD_region","rev.mode","rev_size.class"))


      colnames(UCD_trn_data_fillout)[colnames(UCD_trn_data_fillout)=='mode.x']<-'mode'
      colnames(UCD_trn_data_fillout)[colnames(UCD_trn_data_fillout)=='size.class.x']<-'size.class'

      UCD_trn_data_fillout <- UCD_trn_data_fillout %>%
        mutate(mode = if_else(is.na(mode), mode.y, mode),
               size.class = if_else(is.na(size.class), size.class.y, size.class)) %>%
        select(-mode.y,-size.class.y)
    }

    # Spreading by variable to join all at once
    UCD_trn_data_variable_spread <- UCD_trn_data_fillout %>%
      ungroup %>%
      distinct() %>%
      select(-unit) %>%
      spread(variable, value)


    #kbn 2019-10-10 we do not have data for certain vehicle categories. so we are dropping that data to avoid NAs.Note thathere,
    # we are trying to lose columns where the load factor, intensity and non-fuel costs are all not NAs but the speed IS an NA. We would
    #have to use a subset, but given the size of the dataset, the code below is much faster.
    UCD_trn_data_variable_spread<-UCD_trn_data_variable_spread[!(is.na(UCD_trn_data_variable_spread$`load factor`)&
                                                                   !(is.na(UCD_trn_data_variable_spread$intensity)) &
                                                                   !(is.na(UCD_trn_data_variable_spread$`non-fuel costs`)) &
                                                                   (is.na(UCD_trn_data_variable_spread$speed))),]

    ALL_ctry_var <- IEA_histfut_data_times_UCD_shares %>%
      left_join_error_no_match(UCD_ctry, by = "iso") %>%
      # The energy weights will be replaced by the energy weights of each mode, as many techs have 0 consumption in the base year
      select(-value) %>%
      fast_left_join(IEA_data_times_UCD_shares_UCD_sector_agg ,
                     by = c("iso", "UCD_sector", (energy.TRAN_UCD_MODE), "year")) %>%
      # Using a floor on the weighting factor to avoid having zero weights for any countries
      mutate(weight_EJ = pmax(value, energy.MIN_WEIGHT_EJ)) %>%
      # Next, match in the derived variables, specific to each individual country/sector/mode/size.class/tech/fuel, except speed
      # There will be NA non-fuel costs which can be set to zero
      #kbn 2019-10-10 joining by user selected categories. Changes described in detail in comment with search string,kbn 2020-03-26.
      #kbn 2020-01-29 Adding sce below. Changes described in detail in comment with search string,kbn 2020-03-26.
      fast_left_join(UCD_trn_data_variable_spread ,
                     by = c("UCD_sector", (energy.TRAN_UCD_MODE), (energy.TRAN_UCD_SIZE_CLASS), "UCD_technology", "UCD_fuel", "year", "UCD_region")) %>%
      replace_na(list(`non-fuel costs` = 0))

    # Adding in speed - this is matched by the mode and (for some) size class. Match size class first
    speed_data <- UCD_trn_data_variable_spread %>%
      #kbn 2019-10-09 select user defined modes, size classes here. Changes described in detail in comment with search string,kbn 2020-03-26.
      #kbn 2020-01-29 Adding sce below. Changes described in detail in comment with search string,kbn 2020-03-26.
      select(UCD_sector, year, UCD_region, speed, paste(energy.TRAN_UCD_MODE), paste(energy.TRAN_UCD_SIZE_CLASS),sce) %>%
      filter(!is.na(speed))

    #Get speed data by modes
    speed_data_by_mode <- speed_data %>% select("UCD_sector", paste(energy.TRAN_UCD_MODE), "UCD_region","speed") %>% distinct()


    #kbn 2019-10-10 joining by new categories. Changes described in detail in comment with search string,kbn 2020-03-26.
    ALL_ctry_var <- ALL_ctry_var %>%
      #kbn 2020-01-29 Adding sce below
      fast_left_join(speed_data,
                     by = c("UCD_sector", paste(energy.TRAN_UCD_MODE), paste(energy.TRAN_UCD_SIZE_CLASS), "year", "UCD_region","sce")) %>%
      # For the missing values, join using the mode ID
      #kbn 2020-01-29 Adding sce below. Changes described in detail in comment with search string,kbn 2020-03-26.
      left_join_keep_first_only(speed_data_by_mode ,
                                by = c("UCD_sector", paste(energy.TRAN_UCD_MODE), "UCD_region"))
    #kbn 2020 Using data tables here instead of dplyr to increase processing time. Changes described in detail in comment with search string,kbn 2020-03-26.
    ALL_ctry_var <- as.data.table(ALL_ctry_var)
    ALL_ctry_var[, speed.x := if_else(is.na(speed.x), speed.y, speed.x)]
    ALL_ctry_var[, speed.x := if_else(is.na(speed.x), 1, speed.x)]
    ALL_ctry_var <- as_tibble(ALL_ctry_var)
    #Separate out this by CORE and for SSPs
    ALL_ctry_var_CORE <- ALL_ctry_var %>%
      filter(sce=="CORE") %>%
      select(-sce) %>%
      select("UCD_technology","UCD_fuel", "UCD_sector", "rev.mode", "rev_size.class","mode","size.class", "year", "GCAM_region_ID","load factor","weight_EJ","intensity","non-fuel costs") %>%
      rename(loadfactor_CORE = `load factor`, weight_EJ_core = weight_EJ, intensity_CORE =intensity, non_fuel_cost_core = `non-fuel costs`)


    ALL_ctry_var %>%
      filter(sce != "CORE") %>%
      left_join_keep_first_only(ALL_ctry_var_CORE, by= c("UCD_technology","UCD_fuel", "UCD_sector", "mode", "size.class","rev.mode","rev_size.class", "year", "GCAM_region_ID")) %>%
      mutate(weight_EJ =if_else(is.na(weight_EJ),weight_EJ_core,weight_EJ),intensity =if_else(is.na(intensity),intensity_CORE,intensity), `load factor`=if_else(is.na(`load factor`),loadfactor_CORE,`load factor`), `non-fuel costs`=if_else(`non-fuel costs` == 0,non_fuel_cost_core,`non-fuel costs`)) %>%
      select(-loadfactor_CORE,-weight_EJ_core,-intensity_CORE,-non_fuel_cost_core) %>%
      filter(`non-fuel costs` != 0)-> ALL_ctry_var_SSPS


    #kbn 2020 bind using rbindlist to increase processing speed. A separate PR submitted on github to functionalize this for future use.
    list_for_bind <- list((ALL_ctry_var %>%  filter(sce=="CORE")), (ALL_ctry_var_SSPS))
    ALL_ctry_var <- rbindlist(list_for_bind, use.names=TRUE)


    size_class <- (paste(energy.TRAN_UCD_SIZE_CLASS,".x",sep=""))
    ALL_region_var <- ALL_ctry_var %>%
      mutate(Tvkm = weight_EJ / intensity,
             Tpkm = Tvkm * `load factor`,
             Tusd = Tvkm * `non-fuel costs`,
             Thr = Tvkm / speed.x) %>%
      #kbn 2019-10-09 calculate weighted volumes below using revised size classes
      #kbn 2020-01-29 Adding sce below. Changes described in detail in comment with search string,kbn 2020-03-26.
      group_by(UCD_technology,UCD_fuel, UCD_sector, !!(as.name(energy.TRAN_UCD_MODE)), !!(as.name(energy.TRAN_UCD_SIZE_CLASS)), year, GCAM_region_ID,sce) %>%
      summarise(weight_EJ = sum(weight_EJ), Tvkm = sum(Tvkm), Tpkm = sum(Tpkm),Tusd = sum(Tusd), Thr = sum(Thr)) %>%
      ungroup()




    # Reverse the calculations to calculate the weighted average of each derived variable
    ALL_region_var <- ALL_region_var %>%
      mutate(intensity_MJvkm = weight_EJ / Tvkm,
             loadfactor = Tpkm / Tvkm,
             cost_usdvkm = Tusd / Tvkm,
             speed_kmhr = Tvkm / Thr) %>%
      # Dropping unnecessary columns
      select(-Tvkm, -Tpkm, -Tusd, -Thr, -weight_EJ) %>%
      gather(variable, value, intensity_MJvkm, loadfactor, cost_usdvkm, speed_kmhr) %>%
      # Reordering columns
      #kbn 2019-10-09 use user defined mode and size classes below. Changes described in detail in comment with search string,kbn 2020-03-26.
      #kbn 2020-01-29 Adding sce below. Changes described in detail in comment with search string,kbn 2020-03-26.
      select(GCAM_region_ID, UCD_sector, mode=!!(as.name(energy.TRAN_UCD_MODE)), size.class = !!(as.name(energy.TRAN_UCD_SIZE_CLASS)), UCD_technology, UCD_fuel, variable, year, value,sce)

    # Build the final data frames by variable
    out_var_df <- split(ALL_region_var, ALL_region_var$variable) %>%
      lapply(function(df) {select(df, -variable)})

    # Part 3: Downscaling of non-motorized transport to the country level, using population
    # Filtering population to UCD energy year and then aggregating by UCD region
    # Note - using inner_join to avoid having to account for every single country in the UN population database as many are not in
    # the IEA data and as such do not otherwise have transportation data (e.g. pitcairn island)
    Pop_thous_UCD_R <- L100.Pop_thous_ctry_Yh %>%
      filter(year == energy.UCD_EN_YEAR) %>%
      inner_join(UCD_ctry, by = "iso") %>%
      group_by(UCD_region) %>%
      summarise(population = sum(value)) %>%
      ungroup()

    # Calculating non-motorized passenger-km per person
    PKM_percap_nonmotor_UCD_R <- UCD_trn_data %>%
      filter(mode %in% c("Walk", "Cycle"), variable == "service output") %>%
      left_join_error_no_match(Pop_thous_UCD_R, by = "UCD_region") %>%
      mutate(pkm_percap = value * CONV_BIL_MIL * CONV_MIL_THOUS / population) %>%
      select(UCD_region, mode, year, pkm_percap) %>% distinct()

    # Compute the nonmotorized service output at the country level, using the historical population
    # use inner_join to avoid including countries with population data but not energy data
    PKM_nonmotor_ctry <- L100.Pop_thous_ctry_Yh %>%
      #kbn 2020-01-29 Add in sce below. Using only CORE for these.
      repeat_add_columns(tibble(mode = c("Walk", "Cycle"),sce=c("CORE"))) %>%
      inner_join(UCD_ctry %>% select(-country_name), by = "iso") %>%
      inner_join(PKM_percap_nonmotor_UCD_R %>% filter(year == energy.UCD_EN_YEAR),
                               by = c("UCD_region", "mode")) %>%
      mutate(value = value * 1 / CONV_MIL_THOUS * pkm_percap)

    # Aggregate by GCAM region and write it out
    PKM_nonmotor_GCAM_R <- PKM_nonmotor_ctry %>%
      left_join_error_no_match(iso_GCAM_regID, by = "iso") %>%
      group_by(GCAM_region_ID, mode, year = year.x) %>%
      summarise(value = sum(value)) %>%
      ungroup() %>%
      filter(year %in% HISTORICAL_YEARS)

    # ===================================================

    # Produce outputs
    IEA_hist_data_times_UCD_shares_region_scaled_to_enduse_data %>%
      add_title("Regional transportation energy data at UCD transportation technology level") %>%
      add_units("EJ") %>%
      add_comments("Aggregated country-level transportation energy data to UCD transportation technologies") %>%
      add_comments("Scaled to transport end-use data") %>%
      add_legacy_name("L154.in_EJ_R_trn_m_sz_tech_F_Yh") %>%
      add_precursors("common/iso_GCAM_regID", "L101.in_EJ_ctry_trn_Fi_Yh",
                     "L1011.in_EJ_ctry_intlship_TOT_Yh", "L131.in_EJ_R_Senduse_F_Yh",
                     "energy/mappings/calibrated_techs_trn_agg", "energy/mappings/enduse_fuel_aggregation",
                     "energy/mappings/UCD_ctry", "energy/mappings/UCD_techs",
                     "energy/UCD_trn_data_SSP1","energy/UCD_trn_data_SSP3","energy/UCD_trn_data_SSP5","energy/UCD_trn_data_CORE",
                     "energy/mappings/UCD_size_class_revisions") ->
      L154.in_EJ_R_trn_m_sz_tech_F_Yh

    #Adding outputs for country level data
    IEA_histfut_data_times_UCD_shares %>%
      add_title("Country transportation energy data at UCD transportation technology level") %>%
      add_units("EJ") %>%
      add_comments("Aggregated country-level transportation energy data to UCD transportation technologies") %>%
      add_comments("Scaled to transport end-use data") %>%
      add_legacy_name("L154.IEA_hist_data_times_UCD_shares") %>%
      add_precursors("common/iso_GCAM_regID", "L101.in_EJ_ctry_trn_Fi_Yh",
                     "L1011.in_EJ_ctry_intlship_TOT_Yh", "L131.in_EJ_R_Senduse_F_Yh",
                     "energy/mappings/calibrated_techs_trn_agg", "energy/mappings/enduse_fuel_aggregation",
                     "energy/mappings/UCD_ctry", "energy/mappings/UCD_techs",
                     "energy/UCD_trn_data_SSP1","energy/UCD_trn_data_SSP3","energy/UCD_trn_data_SSP5","energy/UCD_trn_data_CORE",
                     "energy/mappings/UCD_size_class_revisions") ->L154.IEA_histfut_data_times_UCD_shares


    IEA_hist_data_times_UCD_shares %>%
      add_title("Country-level transportation energy data at UCD transportation technology level") %>%
      add_units("EJ") %>%
      add_comments("Aggregated country-level transportation energy data to UCD transportation technologies") %>%
      add_legacy_name("L154.in_EJ_ctry_trn_m_sz_tech_F") %>%
      add_precursors("common/iso_GCAM_regID", "L101.in_EJ_ctry_trn_Fi_Yh",
                     "energy/UCD_trn_data_CORE","energy/UCD_trn_data_SSP1","energy/UCD_trn_data_SSP3","energy/UCD_trn_data_SSP5",
                     "energy/mappings/UCD_size_class_revisions",
                     "energy/mappings/calibrated_techs_trn_agg",
                     "energy/mappings/UCD_ctry", "energy/mappings/UCD_techs",
                     "L1011.in_EJ_ctry_intlship_TOT_Yh") ->
      L154.in_EJ_ctry_trn_m_sz_tech_F

    out_var_df[["intensity_MJvkm"]] %>%
      add_title("Transportation energy intensity") %>%
      add_units("MJ/vkm") %>%
      add_comments("UCD transportation database data aggregated to GCAM region") %>%
      add_legacy_name("L154.intensity_MJvkm_R_trn_m_sz_tech_F_Y") %>%
      add_precursors("energy/UCD_trn_data_SSP1","energy/UCD_trn_data_SSP3","energy/UCD_trn_data_SSP5","energy/UCD_trn_data_CORE",
                     "energy/mappings/UCD_size_class_revisions", "energy/mappings/UCD_ctry",
                     "common/iso_GCAM_regID", "energy/mappings/calibrated_techs_trn_agg", "energy/mappings/enduse_fuel_aggregation",
                     "energy/mappings/UCD_techs",
                     "L131.in_EJ_R_Senduse_F_Yh", "common/iso_GCAM_regID", "energy/mappings/calibrated_techs_trn_agg",
                     "energy/mappings/enduse_fuel_aggregation", "energy/mappings/UCD_techs",
                     "L101.in_EJ_ctry_trn_Fi_Yh", "L1011.in_EJ_ctry_intlship_TOT_Yh",
                     "L131.in_EJ_R_Senduse_F_Yh") ->
      L154.intensity_MJvkm_R_trn_m_sz_tech_F_Y

    out_var_df[["loadfactor"]] %>%
      add_title("Transortation load factors") %>%
      add_units("pers/veh or tonnes/veh") %>%
      add_comments("UCD transportation database data aggregated to GCAM region") %>%
      add_legacy_name("L154.loadfactor_R_trn_m_sz_tech_F_Y") %>%
      add_precursors("energy/UCD_trn_data_CORE","energy/UCD_trn_data_SSP1","energy/UCD_trn_data_SSP3","energy/UCD_trn_data_SSP5",
                     "energy/mappings/UCD_size_class_revisions", "energy/mappings/UCD_ctry",
                     "common/iso_GCAM_regID", "energy/mappings/calibrated_techs_trn_agg", "energy/mappings/enduse_fuel_aggregation",
                     "energy/mappings/UCD_techs",
                     "L131.in_EJ_R_Senduse_F_Yh", "common/iso_GCAM_regID", "energy/mappings/calibrated_techs_trn_agg",
                     "energy/mappings/enduse_fuel_aggregation", "energy/mappings/UCD_techs",
                     "L101.in_EJ_ctry_trn_Fi_Yh", "L1011.in_EJ_ctry_intlship_TOT_Yh",
                     "L131.in_EJ_R_Senduse_F_Yh") ->
      L154.loadfactor_R_trn_m_sz_tech_F_Y

    out_var_df[["cost_usdvkm"]] %>%
      add_title("Transportation non-fuel costs") %>%
      add_units("2005USD/vkm") %>%
      add_comments("UCD transportation database data aggregated to GCAM region") %>%
      add_legacy_name("L154.cost_usdvkm_R_trn_m_sz_tech_F_Y") %>%
      add_precursors("energy/UCD_trn_data_CORE","energy/UCD_trn_data_SSP1","energy/UCD_trn_data_SSP3","energy/UCD_trn_data_SSP5",
                     "energy/mappings/UCD_size_class_revisions", "energy/mappings/UCD_ctry",
                     "common/iso_GCAM_regID", "energy/mappings/calibrated_techs_trn_agg", "energy/mappings/enduse_fuel_aggregation",
                     "energy/mappings/UCD_techs",
                     "L131.in_EJ_R_Senduse_F_Yh", "common/iso_GCAM_regID", "energy/mappings/calibrated_techs_trn_agg",
                     "energy/mappings/enduse_fuel_aggregation", "energy/mappings/UCD_techs",
                     "L101.in_EJ_ctry_trn_Fi_Yh", "L1011.in_EJ_ctry_intlship_TOT_Yh",
                     "L131.in_EJ_R_Senduse_F_Yh") ->
      L154.cost_usdvkm_R_trn_m_sz_tech_F_Y

    out_var_df[["speed_kmhr"]] %>%
      add_title("Transportation vehicle speeds") %>%
      add_units("km/hr") %>%
      add_comments("UCD transportation database data aggregated to GCAM region") %>%
      add_legacy_name("L154.speed_kmhr_R_trn_m_sz_tech_F_Y") %>%
      add_precursors("energy/UCD_trn_data_CORE","energy/UCD_trn_data_SSP1","energy/UCD_trn_data_SSP3","energy/UCD_trn_data_SSP5",
                     "energy/mappings/UCD_size_class_revisions", "energy/mappings/UCD_ctry",
                     "common/iso_GCAM_regID", "energy/mappings/calibrated_techs_trn_agg", "energy/mappings/enduse_fuel_aggregation",
                     "energy/mappings/UCD_techs",
                     "L131.in_EJ_R_Senduse_F_Yh", "common/iso_GCAM_regID", "energy/mappings/calibrated_techs_trn_agg",
                     "energy/mappings/enduse_fuel_aggregation", "energy/mappings/UCD_techs",
                     "L101.in_EJ_ctry_trn_Fi_Yh", "L1011.in_EJ_ctry_intlship_TOT_Yh",
                     "L131.in_EJ_R_Senduse_F_Yh") ->
      L154.speed_kmhr_R_trn_m_sz_tech_F_Y

    PKM_nonmotor_GCAM_R %>%
      add_title("Non-motor transportation service output") %>%
      add_units("Million passenger kilometers") %>%
      add_comments("UCD transportation data combined with population data") %>%
      add_legacy_name("L154.out_mpkm_R_trn_nonmotor_Yh") %>%
      add_precursors("common/iso_GCAM_regID", "energy/mappings/UCD_ctry",
                     "energy/UCD_trn_data_CORE","energy/UCD_trn_data_SSP1","energy/UCD_trn_data_SSP3","energy/UCD_trn_data_SSP5",
                     "energy/mappings/UCD_size_class_revisions", "energy/mappings/UCD_size_class_revisions",
                     "L100.Pop_thous_ctry_Yh") ->
      L154.out_mpkm_R_trn_nonmotor_Yh

    UCD_trn_data %>%
      add_title("Transportation database (merged between OTAQ/EMF-37 and UCD, all scenarios)") %>%
      add_units("Indicated within table") %>%
      add_comments("All variables required for transportation models") %>%
      add_precursors("common/iso_GCAM_regID", "energy/mappings/UCD_ctry",
                     "energy/UCD_trn_data_CORE", "energy/OTAQ_trn_data_EMF37",
                     "energy/mappings/UCD_size_class_revisions", "energy/mappings/UCD_size_class_revisions") ->
      UCD_trn_data


    return_data(L154.in_EJ_R_trn_m_sz_tech_F_Yh, L154.in_EJ_ctry_trn_m_sz_tech_F,
                L154.intensity_MJvkm_R_trn_m_sz_tech_F_Y, L154.loadfactor_R_trn_m_sz_tech_F_Y,
                L154.cost_usdvkm_R_trn_m_sz_tech_F_Y, L154.speed_kmhr_R_trn_m_sz_tech_F_Y,
                L154.out_mpkm_R_trn_nonmotor_Yh,L154.IEA_histfut_data_times_UCD_shares,
                UCD_trn_data)
  } else {
    stop("Unknown command")
  }
}
bpbond/gcamdata documentation built on March 22, 2023, 4:52 a.m.