#' Write a data frame to an AERSCREEN input file
#'
#' Output an AERSCREEN input file from a data frame of AERSCREEN parameters.
#' @param data Data frame of AERSCREEN modeling parameters.
#' @param path Path to write input file to. If blank, returns a character string.
#' Defaults to "aerscreen.inp".
#' @param out_file File to save AERSCREEN modeling results to.
#' Defaults to "aerscreen.out".
#' @param control Data frame of control parameters. If blank, control parameters from \code{data} are used.
#' @param sources Data frame of source parameters. If blank, source parameters from \code{data} are used.
#' @param buildings Data frame of building parameters for BPIP. If blank, building parameters from \code{data} are used.
#' @param surface Data frame of surface characteristics. If blank, surface characteristics from \code{data} are used.
#' @keywords aerscreen write save input
#' @export
#' @examples
#' aerscreen_inp <- new_aerscreen()
#'
#' write_aerscreen(data = aerscreen_inp, path = "aerscreen.inp")
#
#
write_aerscreen <- function(data = NULL,
path = NULL,
out_file = "aerscreen.out",
control = NULL,
sources = NULL,
buildings = NULL,
surface = NULL
) {
# Data tests
if ((is.null(data) || nrow(data) < 1) & (is.null(sources) || nrow(sources) < 1)) {
stop("Data frame is empty. AERMOD requires at least 1 emission source.")
}
# Set data to data.frame
if (!is.null(data)) data <- as.data.frame(data)
## Use pathway specific tables if provided
if(is.null(control) || !is.data.frame(control) || nrow(control) < 1) {
co <- data
co$title <- gsub("[.]out", "", out_file)
} else {
co <- control
}
if(is.null(sources) || !is.data.frame(sources) || nrow(sources) < 1) {
so <- data
} else {
so <- sources
}
if(is.null(buildings) || !is.data.frame(buildings) || nrow(buildings) < 1) {
bu <- data[1, ]
} else {
bu <- buildings[1, ]
}
if(is.null(surface) || !is.data.frame(surface) || nrow(surface) < 1) {
su <- data[1, ]
} else {
su <- surface[1, ]
}
## Check if urban population less than 10,000 people
if(aermod::is_valid(so$urban_pop) && so$urban_pop < 10000) {
so$urban_pop <- NA
}
# Replace `NA` values with Zeros to avoid printing 'NA'
co[is.na(co)] <- 0
so[is.na(so)] <- 0
bu[is.na(bu)] <- 0
su[is.na(su)] <- 0
# Create text input file
## AERSCREEN header
inp_text <- paste0("**\n",
"** AERSCREEN input file\n",
"** Created: ", format(Sys.Date(), "%m/%d/%Y"), "\n",
"**\n\n")
## STACK section
inp_text <- paste0(inp_text,
"** STACK DATA Rate Height Temp. Velocity Diam. Flow\n",
"** ",
receptors::fw(so$emit_gs, 13),
receptors::fw(so$height_m, 9),
receptors::fw(so$temp_k, 11),
receptors::fw(so$velocity_ms, 11),
receptors::fw(so$diameter_m, 10),
"000000.\n\n", collapse = "")
## BUILDING section
inp_text <- paste0(inp_text,
"** BUILDING DATA BPIP Height Max dim. Min dim. Orient. Direct. Offset\n",
"** ",
receptors::fw(bu$bpip_run, 6),
receptors::fw(as.numeric(bu$bld_height), 10),
receptors::fw(as.numeric(bu$long_side), 11),
receptors::fw(as.numeric(bu$short_side), 10),
receptors::fw(as.numeric(bu$bld_rotation), 10),
receptors::fw(as.numeric(bu$angle_from_source), 10),
as.numeric(bu$dist_from_source),
"\n\n", collapse = "")
## SURFACE section
inp_text <- paste0(inp_text,
"** MAKEMET DATA MinT MaxT Speed AnemHt Surf Clim Albedo Bowen Length SC FILE\n",
"** ",
receptors::fw(su$min_temp_k, 8),
receptors::fw(su$max_temp_k, 9),
receptors::fw(su$min_wind_speed, 6),
receptors::fw(su$anem_height, 10),
receptors::fw(su$surface_profile, 5),
receptors::fw(su$climate_profile, 4),
receptors::fw(su$albedo, 9),
receptors::fw(su$bowen, 9),
receptors::fw(su$z_length, 8),
'"NA"',
"\n\n", collapse = "")
## ADJUST U* section
inp_text <- paste0(inp_text,
"** ADJUST U* ", co$adjust_ustar[1],
"\n\n", collapse = "")
## TERRAIN section
inp_text <- paste0(inp_text,
"** TERRAIN DATA Terrain UTM East UTM North Zone Nada Probe PROFBASE Use AERMAP elev\n",
"** ",
"N 0.0 0.0 0 0 ",
receptors::fw(co$far_receptor[1], 16),
"0.00 N",
"\n\n", collapse = "")
## RECEPTOR section
inp_text <- paste0(inp_text,
"** DISCRETE RECEPTORS Discflag Receptor file\n",
"** ",
'N "NA"',
"\n\n", collapse = "")
## URBAN and FLAGPOLE section
inp_text <- paste0(inp_text,
"** UNITS/POPULATION Units R/U Population Amb. dist. Flagpole Flagpole height\n",
"** ",
"M ",
receptors::fw(ifelse(so$urban_pop > 99, "U", "R"), 8),
receptors::fw(so$urban_pop, 17),
receptors::fw(co$near_receptor, 13),
receptors::fw(ifelse(co$flagpole_height > 0, "Y", "N"), 10),
co$flagpole_height,
"\n\n", collapse = "")
## FUMIGATION section
inp_text <- paste0(inp_text,
"** FUMIGATION Inversion Break-up Shoreline Distance Direct Run AERSCREEN\n",
"** ",
"N N 0.00 0.0 Y ",
"\n\n", collapse = "")
## DEBUG section
inp_text <- paste0(inp_text,
"** DEBUG OPTION Debug\n",
"** ",
co$debug_opt[1],
"\n\n", collapse = "")
## OUTPUT section
inp_text <- paste0(inp_text,
'** OUTPUT FILE "', gsub("[.]out", "", out_file), '.out"',
"\n\n\n\n", collapse = "")
## TEMPORAL section
inp_text <- paste0(inp_text, "** Temporal sector: \n\n\n\n", collapse = "")
# Create AERMOD section
aermod_inp <- aermod::write_aermod(data = NULL,
control = co,
sources = so,
receptors = aermod::receptor_df(),
met = aermod::met_df(),
out = aermod::out_df())
# Combine AERMOD section & AERSCREEN section
inp_text <- paste0(inp_text, aermod_inp, collapse = "")
# Return results
# cat("\nGenerated input file: \n\n")
# invisible(writeLines(inp_text))
if(!aermod::is_valid(path)) {
return(inp_text)
} else {
con <- file(path)
writeLines(inp_text, con)
close(con)
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.