R/Slopecalc.r
In nrcan-cfs-fire/cffdrs: Canadian Forest Fire Danger Rating System
Defines functions
slope_adjustment
#' Slope Adjusted wind speed or slope direction of spread calculation
#'
#' @description Calculate the net effective windspeed (WSV), the net effective
#' wind direction (RAZ) or the wind azimuth (WAZ).
#'
#' All variables names are laid out in the same manner as FCFDG (1992) and
#' Wotton (2009).
#'
#'
#' Forestry Canada Fire Danger Group (FCFDG) (1992). "Development and
#' Structure of the Canadian Forest Fire Behavior Prediction System."
#' Technical Report ST-X-3, Forestry Canada, Ottawa, Ontario.
#'
#' Wotton, B.M., Alexander, M.E., Taylor, S.W. 2009. Updates and revisions to
#' the 1992 Canadian forest fire behavior prediction system. Nat. Resour.
#' Can., Can. For. Serv., Great Lakes For. Cent., Sault Ste. Marie, Ontario,
#' Canada. Information Report GLC-X-10, 45p.
#'
#' @param FUELTYPE The Fire Behaviour Prediction FuelType
#' @param FMC Fine Fuel Moisture Code
#' @param BUI The Buildup Index value
#' @param WS Windspeed (km/h)
#' @param WAZ Wind Azimuth
#' @param GS Ground Slope (%)
#' @param SAZ Slope Azimuth
#' @param FMC Foliar Moisture Content
#' @param SFC Surface Fuel Consumption (kg/m^2)
#' @param PC Percent Conifer (%)
#' @param PDF Percent Dead Balsam Fir (%)
#' @param CC Constant
#' @param CBH Crown Base Height (m)
#' @param ISI Initial Spread Index
#'
#' @returns RAZ and WSV
#' - Rate of spread azimuth (degrees) and Wind Slope speed (km/hr)
#'
#' @noRd
#'
slope_adjustment <- function(
FUELTYPE, FFMC, BUI, WS, WAZ, GS, SAZ, FMC, SFC, PC, PDF, CC, CBH, ISI) {
NoBUI <- rep(-1, length(FFMC))
# Eq. 39 (FCFDG 1992) - Calculate Spread Factor
SF <- ifelse(GS >= 70, 10, exp(3.533 * (GS / 100)^1.2))
# ISI with 0 wind on level grounds
ISZ <- initial_spread_index(FFMC, 0)
# Surface spread rate with 0 wind on level ground
RSZ <- rate_of_spread(FUELTYPE, ISZ, BUI = NoBUI, FMC, SFC, PC, PDF, CC, CBH)
# Eq. 40 (FCFDG 1992) - Surface spread rate with 0 wind upslope
RSF <- RSZ * SF
# setup some reference vectors
d <- c(
"C1", "C2", "C3", "C4", "C5", "C6", "C7",
"D1", "M1", "M2", "M3", "M4", "S1", "S2", "S3", "O1A", "O1B"
)
a <- c(
90, 110, 110, 110, 30, 30, 45,
30, 0, 0, 120, 100, 75, 40, 55, 190, 250
)
b <- c(
0.0649, 0.0282, 0.0444, 0.0293, 0.0697, 0.0800,
0.0305, 0.0232, 0, 0, 0.0572, 0.0404, 0.0297, 0.0438, 0.0829, 0.0310, 0.0350
)
c0 <- c(
4.5, 1.5, 3.0, 1.5, 4.0, 3.0, 2.0,
1.6, 0, 0, 1.4, 1.48, 1.3, 1.7, 3.2, 1.4, 1.7
)
names(a) <- names(b) <- names(c0) <- d
# initialize some local vars
RSZ <- rep(-99, length(FFMC))
RSF_C2 <- rep(-99, length(FFMC))
RSF_D1 <- rep(-99, length(FFMC))
RSF_M3 <- rep(-99, length(FFMC))
RSF_M4 <- rep(-99, length(FFMC))
CF <- rep(-99, length(FFMC))
ISF <- rep(-99, length(FFMC))
ISF_C2 <- rep(-99, length(FFMC))
ISF_D1 <- rep(-99, length(FFMC))
ISF_M3 <- rep(-99, length(FFMC))
ISF_M4 <- rep(-99, length(FFMC))
# Eqs. 41a, 41b (Wotton 2009) - Calculate the slope equivalent ISI
is_basic <- Vectorize(function(fuel) { fuel %in% c(
"C1", "C2", "C3", "C4", "C5", "C6", "C7", "D1", "S1", "S2", "S3"
) })(FUELTYPE)
basic_isf <- Vectorize(function(rsf, fuel) {
ifelse(
(1 - (rsf / a[fuel])**(1 / c0[fuel])) >= 0.01,
log(1 - (rsf / a[fuel])**(1 / c0[fuel])) / (-b[fuel]),
log(0.01) / (-b[fuel])
)
})
ISF <- ifelse(
is_basic,
basic_isf(RSF, FUELTYPE),
ISF
)
# When calculating the M1/M2 types, we are going to calculate for both C2
# and D1 types, and combine
# Surface spread rate with 0 wind on level ground
RSZ <- ifelse(
FUELTYPE %in% c("M1", "M2"),
rate_of_spread(
rep("C2", length(ISZ)),
ISZ, NoBUI, FMC, SFC, PC, PDF, CC, CBH
),
RSZ
)
# Eq. 40 (FCFDG 1992) - Surface spread rate with 0 wind upslope for C2
RSF_C2 <- ifelse(FUELTYPE %in% c("M1", "M2"), RSZ * SF, RSF_C2)
RSZ <- ifelse(
FUELTYPE %in% c("M1", "M2"),
rate_of_spread(
rep("D1", length(ISZ)),
ISZ, NoBUI, FMC, SFC, PC, PDF, CC, CBH
),
RSZ
)
# Eq. 40 (FCFDG 1992) - Surface spread rate with 0 wind upslope for D1
RSF_D1 <- ifelse(FUELTYPE %in% c("M1", "M2"), RSZ * SF, RSF_D1)
RSF0 <- 1 - (RSF_C2 / a[["C2"]])^(1 / c0[["C2"]])
# Eq. 41a (Wotton 2009) - Calculate the slope equivalent ISI
ISF_C2 <- ifelse(
FUELTYPE %in% c("M1", "M2") & RSF0 >= 0.01,
log(1 - (RSF_C2 / a[["C2"]])**(1 / c0[["C2"]])) / (-b[["C2"]]),
ISF_C2
)
# Eq. 41b (Wotton 2009) - Calculate the slope equivalent ISI
ISF_C2 <- ifelse(
FUELTYPE %in% c("M1", "M2") & RSF0 < 0.01,
log(0.01) / (-b[["C2"]]),
ISF_C2
)
RSF0 <- 1 - (RSF_D1 / a[["D1"]])^(1 / c0[["D1"]])
# Eq. 41a (Wotton 2009) - Calculate the slope equivalent ISI
ISF_D1 <- ifelse(
FUELTYPE %in% c("M1", "M2") & RSF0 >= 0.01,
log(1 - (RSF_D1 / a[["D1"]])**(1 / c0[["D1"]])) / (-b[["D1"]]),
ISF_D1
)
# Eq. 41b (Wotton 2009) - Calculate the slope equivalent ISI
ISF_D1 <- ifelse(
FUELTYPE %in% c("M1", "M2") & RSF0 < 0.01,
log(0.01) / (-b[["D1"]]),
ISF_D1
)
# Eq. 42a (Wotton 2009) - Calculate weighted average for the M1/M2 types
ISF <- ifelse(
FUELTYPE %in% c("M1", "M2"),
PC / 100 * ISF_C2 + (1 - PC / 100) * ISF_D1,
ISF
)
# Set % Dead Balsam Fir to 100%
PDF100 <- rep(100, length(ISI))
# Surface spread rate with 0 wind on level ground
RSZ <- ifelse(
FUELTYPE %in% c("M3"),
rate_of_spread(
rep("M3", length(FMC)),
ISZ, NoBUI, FMC, SFC, PC, PDF100, CC, CBH
),
RSZ
)
# Eq. 40 (FCFDG 1992) - Surface spread rate with 0 wind upslope for M3
RSF_M3 <- ifelse(FUELTYPE %in% c("M3"), RSZ * SF, RSF_M3)
# Surface spread rate with 0 wind on level ground, using D1
RSZ <- ifelse(
FUELTYPE %in% c("M3"),
rate_of_spread(
rep("D1", length(ISZ)),
ISZ, NoBUI, FMC, SFC, PC, PDF100, CC, CBH
),
RSZ
)
# Eq. 40 (FCFDG 1992) - Surface spread rate with 0 wind upslope for M3
RSF_D1 <- ifelse(FUELTYPE %in% c("M3"), RSZ * SF, RSF_D1)
RSF0 <- 1 - (RSF_M3 / a[["M3"]])^(1 / c0[["M3"]])
# Eq. 41a (Wotton 2009) - Calculate the slope equivalent ISI
ISF_M3 <- ifelse(
FUELTYPE %in% c("M3") & RSF0 >= 0.01,
log(1 - (RSF_M3 / a[["M3"]])**(1 / c0[["M3"]])) / (-b[["M3"]]),
ISF_M3
)
# Eq. 41b (Wotton 2009) - Calculate the slope equivalent ISI
ISF_M3 <- ifelse(
FUELTYPE %in% c("M3") & RSF0 < 0.01,
log(0.01) / (-b[["M3"]]),
ISF_M3
)
# Eq. 40 (FCFDG 1992) - Surface spread rate with 0 wind upslope for D1
RSF0 <- 1 - (RSF_D1 / a[["D1"]])^(1 / c0[["D1"]])
# Eq. 41a (Wotton 2009) - Calculate the slope equivalent ISI
ISF_D1 <- ifelse(
FUELTYPE %in% c("M3") & RSF0 >= 0.01,
log(1 - (RSF_D1 / a[["D1"]])**(1 / c0[["D1"]])) / (-b[["D1"]]),
ISF_D1
)
# Eq. 41b (Wotton 2009) - Calculate the slope equivalent ISI
ISF_D1 <- ifelse(
FUELTYPE %in% c("M3") & RSF0 < 0.01,
log(0.01) / (-b[["D1"]]),
ISF_D1
)
# Eq. 42b (Wotton 2009) - Calculate weighted average for the M3 type
ISF <- ifelse(
FUELTYPE %in% c("M3"),
PDF / 100 * ISF_M3 + (1 - PDF / 100) * ISF_D1,
ISF
)
# Surface spread rate with 0 wind on level ground, using M4
RSZ <- ifelse(
FUELTYPE %in% c("M4"),
rate_of_spread(
rep("M4", length(FMC)),
ISZ, NoBUI, FMC, SFC, PC, PDF100, CC, CBH
),
RSZ
)
# Eq. 40 (FCFDG 1992) - Surface spread rate with 0 wind upslope for M4
RSF_M4 <- ifelse(FUELTYPE %in% c("M4"), RSZ * SF, RSF_M4)
# Surface spread rate with 0 wind on level ground, using M4
RSZ <- ifelse(
FUELTYPE %in% c("M4"),
rate_of_spread(
rep("D1", length(ISZ)),
ISZ, NoBUI, FMC, SFC, PC, PDF100, CC, CBH
),
RSZ
)
# Eq. 40 (FCFDG 1992) - Surface spread rate with 0 wind upslope for D1
RSF_D1 <- ifelse(FUELTYPE %in% c("M4"), RSZ * SF, RSF_D1)
# Eq. 40 (FCFDG 1992) - Surface spread rate with 0 wind upslope for D1
RSF0 <- 1 - (RSF_M4 / a[["M4"]])^(1 / c0[["M4"]])
# Eq. 41a (Wotton 2009) - Calculate the slope equivalent ISI
ISF_M4 <- ifelse(
FUELTYPE %in% c("M4") & RSF0 >= 0.01,
log(1 - (RSF_M4 / a[["M4"]])**(1 / c0[["M4"]])) / (-b[["M4"]]),
ISF_M4
)
# Eq. 41b (Wotton 2009) - Calculate the slope equivalent ISI
ISF_M4 <- ifelse(
FUELTYPE %in% c("M4") & RSF0 < 0.01,
log(0.01) / (-b[["M4"]]),
ISF_M4
)
# Eq. 40 (FCFDG 1992) - Surface spread rate with 0 wind upslope for D1
RSF0 <- 1 - (RSF_D1 / a[["D1"]])^(1 / c0[["D1"]])
# Eq. 41a (Wotton 2009) - Calculate the slope equivalent ISI (D1)
ISF_D1 <- ifelse(
FUELTYPE %in% c("M4") & RSF0 >= 0.01,
log(1 - (RSF_D1 / a[["D1"]])**(1 / c0[["D1"]])) / (-b[["D1"]]),
ISF_D1
)
# Eq. 41b (Wotton 2009) - Calculate the slope equivalent ISI (D1)
ISF_D1 <- ifelse(
FUELTYPE %in% c("M4") & RSF0 < 0.01,
log(0.01) / (-b[["D1"]]),
ISF_D1
)
# Eq. 42c (Wotton 2009) - Calculate weighted average for the M4 type
ISF <- ifelse(
FUELTYPE %in% c("M4"),
PDF / 100 * ISF_M4 + (1 - PDF / 100.) * ISF_D1,
ISF
)
# Eqs. 35a, 35b (Wotton 2009) - Curing Factor pivoting around % 58.8
CF <- ifelse(
FUELTYPE %in% c("O1A", "O1B"),
ifelse(CC < 58.8,
0.005 * (exp(0.061 * CC) - 1),
0.176 + 0.02 * (CC - 58.8)
),
CF
)
# Eqs. 43a, 43b (Wotton 2009) - slope equivilent ISI for Grass
ISF <- ifelse(
FUELTYPE %in% c("O1A", "O1B"),
ifelse(
(1 - (RSF / (CF * a[FUELTYPE]))**(1 / c0[FUELTYPE])) >= 0.01,
log(1 - (RSF / (CF * a[FUELTYPE]))**(1 / c0[FUELTYPE])) / (-b[FUELTYPE]),
log(0.01) / (-b[FUELTYPE])
),
ISF
)
# Initialize RAZ and WSV
RAZ <- WSV <- rep(-99, length(FFMC))
# Eq. 46 (FCFDG 1992)
m <- FFMC_COEFFICIENT * (101 - FFMC) / (59.5 + FFMC)
# Eq. 45 (FCFDG 1992) - FFMC function from the ISI equation
fF <- 91.9 * exp(-.1386 * m) * (1 + (m**5.31) / 4.93e7)
# Eqs. 44a, 44d (Wotton 2009) - Slope equivalent wind speed
WSE <- 1 / 0.05039 * log(ISF / (0.208 * fF))
# Eqs. 44b, 44e (Wotton 2009) - Slope equivalent wind speed
WSE <- ifelse(
WSE > 40 & ISF < (0.999 * 2.496 * fF),
28 - (1 / 0.0818 * log(1 - ISF / (2.496 * fF))),
WSE
)
# Eqs. 44c (Wotton 2009) - Slope equivalent wind speed
WSE <- ifelse(WSE > 40 & ISF >= (0.999 * 2.496 * fF), 112.45, WSE)
# Eq. 47 (FCFDG 1992) - resultant vector magnitude in the x-direction
WSX <- WS * sin(WAZ) + WSE * sin(SAZ)
# Eq. 48 (FCFDG 1992) - resultant vector magnitude in the y-direction
WSY <- WS * cos(WAZ) + WSE * cos(SAZ)
# Eq. 49 (FCFDG 1992) - the net effective wind speed
WSV <- sqrt(WSX * WSX + WSY * WSY)
WSV <- ifelse(FUELTYPE %in% c("NF", "WA"), NA, WSV)
# Eq. 50 (FCFDG 1992) - the net effective wind direction (radians)
RAZ <- acos(WSY / WSV)
# Eq. 51 (FCFDG 1992) - convert possible negative RAZ into more understandable
# directions
RAZ <- ifelse(WSX < 0, 2 * pi - RAZ, RAZ)
RAZ <- ifelse(FUELTYPE %in% c("NF", "WA"), NA, RAZ)
return(list(WSV = WSV,
RAZ = RAZ))
}
.Slopecalc <- function(
FUELTYPE, FFMC, BUI, WS, WAZ, GS, SAZ, FMC, SFC, PC, PDF, CC, CBH, ISI,
output = "RAZ") {
.Deprecated("slope_adjustment")
# output options include: RAZ and WSV
# check for valid output types
validOutTypes <- c("RAZ", "WAZ", "WSV")
if (!(output %in% validOutTypes)) {
stop(paste0(
"In 'slopecalc()', '", output, "' is an invalid 'output' type."
))
}
values <- slope_adjustment(FUELTYPE, FFMC, BUI, WS, WAZ, GS, SAZ, FMC, SFC, PC, PDF, CC, CBH, ISI)
return(values[[output]])
}
nrcan-cfs-fire/cffdrs documentation built on Sept. 20, 2024, 12:30 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions slope_adjustment
#' Slope Adjusted wind speed or slope direction of spread calculation
#'
#' @description Calculate the net effective windspeed (WSV), the net effective
#' wind direction (RAZ) or the wind azimuth (WAZ).
#'
#' All variables names are laid out in the same manner as FCFDG (1992) and
#' Wotton (2009).
#'
#'
#' Forestry Canada Fire Danger Group (FCFDG) (1992). "Development and
#' Structure of the Canadian Forest Fire Behavior Prediction System."
#' Technical Report ST-X-3, Forestry Canada, Ottawa, Ontario.
#'
#' Wotton, B.M., Alexander, M.E., Taylor, S.W. 2009. Updates and revisions to
#' the 1992 Canadian forest fire behavior prediction system. Nat. Resour.
#' Can., Can. For. Serv., Great Lakes For. Cent., Sault Ste. Marie, Ontario,
#' Canada. Information Report GLC-X-10, 45p.
#'
#' @param FUELTYPE The Fire Behaviour Prediction FuelType
#' @param FMC Fine Fuel Moisture Code
#' @param BUI The Buildup Index value
#' @param WS Windspeed (km/h)
#' @param WAZ Wind Azimuth
#' @param GS Ground Slope (%)
#' @param SAZ Slope Azimuth
#' @param FMC Foliar Moisture Content
#' @param SFC Surface Fuel Consumption (kg/m^2)
#' @param PC Percent Conifer (%)
#' @param PDF Percent Dead Balsam Fir (%)
#' @param CC Constant
#' @param CBH Crown Base Height (m)
#' @param ISI Initial Spread Index
#'
#' @returns RAZ and WSV
#' - Rate of spread azimuth (degrees) and Wind Slope speed (km/hr)
#'
#' @noRd
#'
slope_adjustment <- function(
FUELTYPE, FFMC, BUI, WS, WAZ, GS, SAZ, FMC, SFC, PC, PDF, CC, CBH, ISI) {
NoBUI <- rep(-1, length(FFMC))
# Eq. 39 (FCFDG 1992) - Calculate Spread Factor
SF <- ifelse(GS >= 70, 10, exp(3.533 * (GS / 100)^1.2))
# ISI with 0 wind on level grounds
ISZ <- initial_spread_index(FFMC, 0)
# Surface spread rate with 0 wind on level ground
RSZ <- rate_of_spread(FUELTYPE, ISZ, BUI = NoBUI, FMC, SFC, PC, PDF, CC, CBH)
# Eq. 40 (FCFDG 1992) - Surface spread rate with 0 wind upslope
RSF <- RSZ * SF
# setup some reference vectors
d <- c(
"C1", "C2", "C3", "C4", "C5", "C6", "C7",
"D1", "M1", "M2", "M3", "M4", "S1", "S2", "S3", "O1A", "O1B"
)
a <- c(
90, 110, 110, 110, 30, 30, 45,
30, 0, 0, 120, 100, 75, 40, 55, 190, 250
)
b <- c(
0.0649, 0.0282, 0.0444, 0.0293, 0.0697, 0.0800,
0.0305, 0.0232, 0, 0, 0.0572, 0.0404, 0.0297, 0.0438, 0.0829, 0.0310, 0.0350
)
c0 <- c(
4.5, 1.5, 3.0, 1.5, 4.0, 3.0, 2.0,
1.6, 0, 0, 1.4, 1.48, 1.3, 1.7, 3.2, 1.4, 1.7
)
names(a) <- names(b) <- names(c0) <- d
# initialize some local vars
RSZ <- rep(-99, length(FFMC))
RSF_C2 <- rep(-99, length(FFMC))
RSF_D1 <- rep(-99, length(FFMC))
RSF_M3 <- rep(-99, length(FFMC))
RSF_M4 <- rep(-99, length(FFMC))
CF <- rep(-99, length(FFMC))
ISF <- rep(-99, length(FFMC))
ISF_C2 <- rep(-99, length(FFMC))
ISF_D1 <- rep(-99, length(FFMC))
ISF_M3 <- rep(-99, length(FFMC))
ISF_M4 <- rep(-99, length(FFMC))
# Eqs. 41a, 41b (Wotton 2009) - Calculate the slope equivalent ISI
is_basic <- Vectorize(function(fuel) { fuel %in% c(
"C1", "C2", "C3", "C4", "C5", "C6", "C7", "D1", "S1", "S2", "S3"
) })(FUELTYPE)
basic_isf <- Vectorize(function(rsf, fuel) {
ifelse(
(1 - (rsf / a[fuel])**(1 / c0[fuel])) >= 0.01,
log(1 - (rsf / a[fuel])**(1 / c0[fuel])) / (-b[fuel]),
log(0.01) / (-b[fuel])
)
})
ISF <- ifelse(
is_basic,
basic_isf(RSF, FUELTYPE),
ISF
)
# When calculating the M1/M2 types, we are going to calculate for both C2
# and D1 types, and combine
# Surface spread rate with 0 wind on level ground
RSZ <- ifelse(
FUELTYPE %in% c("M1", "M2"),
rate_of_spread(
rep("C2", length(ISZ)),
ISZ, NoBUI, FMC, SFC, PC, PDF, CC, CBH
),
RSZ
)
# Eq. 40 (FCFDG 1992) - Surface spread rate with 0 wind upslope for C2
RSF_C2 <- ifelse(FUELTYPE %in% c("M1", "M2"), RSZ * SF, RSF_C2)
RSZ <- ifelse(
FUELTYPE %in% c("M1", "M2"),
rate_of_spread(
rep("D1", length(ISZ)),
ISZ, NoBUI, FMC, SFC, PC, PDF, CC, CBH
),
RSZ
)
# Eq. 40 (FCFDG 1992) - Surface spread rate with 0 wind upslope for D1
RSF_D1 <- ifelse(FUELTYPE %in% c("M1", "M2"), RSZ * SF, RSF_D1)
RSF0 <- 1 - (RSF_C2 / a[["C2"]])^(1 / c0[["C2"]])
# Eq. 41a (Wotton 2009) - Calculate the slope equivalent ISI
ISF_C2 <- ifelse(
FUELTYPE %in% c("M1", "M2") & RSF0 >= 0.01,
log(1 - (RSF_C2 / a[["C2"]])**(1 / c0[["C2"]])) / (-b[["C2"]]),
ISF_C2
)
# Eq. 41b (Wotton 2009) - Calculate the slope equivalent ISI
ISF_C2 <- ifelse(
FUELTYPE %in% c("M1", "M2") & RSF0 < 0.01,
log(0.01) / (-b[["C2"]]),
ISF_C2
)
RSF0 <- 1 - (RSF_D1 / a[["D1"]])^(1 / c0[["D1"]])
# Eq. 41a (Wotton 2009) - Calculate the slope equivalent ISI
ISF_D1 <- ifelse(
FUELTYPE %in% c("M1", "M2") & RSF0 >= 0.01,
log(1 - (RSF_D1 / a[["D1"]])**(1 / c0[["D1"]])) / (-b[["D1"]]),
ISF_D1
)
# Eq. 41b (Wotton 2009) - Calculate the slope equivalent ISI
ISF_D1 <- ifelse(
FUELTYPE %in% c("M1", "M2") & RSF0 < 0.01,
log(0.01) / (-b[["D1"]]),
ISF_D1
)
# Eq. 42a (Wotton 2009) - Calculate weighted average for the M1/M2 types
ISF <- ifelse(
FUELTYPE %in% c("M1", "M2"),
PC / 100 * ISF_C2 + (1 - PC / 100) * ISF_D1,
ISF
)
# Set % Dead Balsam Fir to 100%
PDF100 <- rep(100, length(ISI))
# Surface spread rate with 0 wind on level ground
RSZ <- ifelse(
FUELTYPE %in% c("M3"),
rate_of_spread(
rep("M3", length(FMC)),
ISZ, NoBUI, FMC, SFC, PC, PDF100, CC, CBH
),
RSZ
)
# Eq. 40 (FCFDG 1992) - Surface spread rate with 0 wind upslope for M3
RSF_M3 <- ifelse(FUELTYPE %in% c("M3"), RSZ * SF, RSF_M3)
# Surface spread rate with 0 wind on level ground, using D1
RSZ <- ifelse(
FUELTYPE %in% c("M3"),
rate_of_spread(
rep("D1", length(ISZ)),
ISZ, NoBUI, FMC, SFC, PC, PDF100, CC, CBH
),
RSZ
)
# Eq. 40 (FCFDG 1992) - Surface spread rate with 0 wind upslope for M3
RSF_D1 <- ifelse(FUELTYPE %in% c("M3"), RSZ * SF, RSF_D1)
RSF0 <- 1 - (RSF_M3 / a[["M3"]])^(1 / c0[["M3"]])
# Eq. 41a (Wotton 2009) - Calculate the slope equivalent ISI
ISF_M3 <- ifelse(
FUELTYPE %in% c("M3") & RSF0 >= 0.01,
log(1 - (RSF_M3 / a[["M3"]])**(1 / c0[["M3"]])) / (-b[["M3"]]),
ISF_M3
)
# Eq. 41b (Wotton 2009) - Calculate the slope equivalent ISI
ISF_M3 <- ifelse(
FUELTYPE %in% c("M3") & RSF0 < 0.01,
log(0.01) / (-b[["M3"]]),
ISF_M3
)
# Eq. 40 (FCFDG 1992) - Surface spread rate with 0 wind upslope for D1
RSF0 <- 1 - (RSF_D1 / a[["D1"]])^(1 / c0[["D1"]])
# Eq. 41a (Wotton 2009) - Calculate the slope equivalent ISI
ISF_D1 <- ifelse(
FUELTYPE %in% c("M3") & RSF0 >= 0.01,
log(1 - (RSF_D1 / a[["D1"]])**(1 / c0[["D1"]])) / (-b[["D1"]]),
ISF_D1
)
# Eq. 41b (Wotton 2009) - Calculate the slope equivalent ISI
ISF_D1 <- ifelse(
FUELTYPE %in% c("M3") & RSF0 < 0.01,
log(0.01) / (-b[["D1"]]),
ISF_D1
)
# Eq. 42b (Wotton 2009) - Calculate weighted average for the M3 type
ISF <- ifelse(
FUELTYPE %in% c("M3"),
PDF / 100 * ISF_M3 + (1 - PDF / 100) * ISF_D1,
ISF
)
# Surface spread rate with 0 wind on level ground, using M4
RSZ <- ifelse(
FUELTYPE %in% c("M4"),
rate_of_spread(
rep("M4", length(FMC)),
ISZ, NoBUI, FMC, SFC, PC, PDF100, CC, CBH
),
RSZ
)
# Eq. 40 (FCFDG 1992) - Surface spread rate with 0 wind upslope for M4
RSF_M4 <- ifelse(FUELTYPE %in% c("M4"), RSZ * SF, RSF_M4)
# Surface spread rate with 0 wind on level ground, using M4
RSZ <- ifelse(
FUELTYPE %in% c("M4"),
rate_of_spread(
rep("D1", length(ISZ)),
ISZ, NoBUI, FMC, SFC, PC, PDF100, CC, CBH
),
RSZ
)
# Eq. 40 (FCFDG 1992) - Surface spread rate with 0 wind upslope for D1
RSF_D1 <- ifelse(FUELTYPE %in% c("M4"), RSZ * SF, RSF_D1)
# Eq. 40 (FCFDG 1992) - Surface spread rate with 0 wind upslope for D1
RSF0 <- 1 - (RSF_M4 / a[["M4"]])^(1 / c0[["M4"]])
# Eq. 41a (Wotton 2009) - Calculate the slope equivalent ISI
ISF_M4 <- ifelse(
FUELTYPE %in% c("M4") & RSF0 >= 0.01,
log(1 - (RSF_M4 / a[["M4"]])**(1 / c0[["M4"]])) / (-b[["M4"]]),
ISF_M4
)
# Eq. 41b (Wotton 2009) - Calculate the slope equivalent ISI
ISF_M4 <- ifelse(
FUELTYPE %in% c("M4") & RSF0 < 0.01,
log(0.01) / (-b[["M4"]]),
ISF_M4
)
# Eq. 40 (FCFDG 1992) - Surface spread rate with 0 wind upslope for D1
RSF0 <- 1 - (RSF_D1 / a[["D1"]])^(1 / c0[["D1"]])
# Eq. 41a (Wotton 2009) - Calculate the slope equivalent ISI (D1)
ISF_D1 <- ifelse(
FUELTYPE %in% c("M4") & RSF0 >= 0.01,
log(1 - (RSF_D1 / a[["D1"]])**(1 / c0[["D1"]])) / (-b[["D1"]]),
ISF_D1
)
# Eq. 41b (Wotton 2009) - Calculate the slope equivalent ISI (D1)
ISF_D1 <- ifelse(
FUELTYPE %in% c("M4") & RSF0 < 0.01,
log(0.01) / (-b[["D1"]]),
ISF_D1
)
# Eq. 42c (Wotton 2009) - Calculate weighted average for the M4 type
ISF <- ifelse(
FUELTYPE %in% c("M4"),
PDF / 100 * ISF_M4 + (1 - PDF / 100.) * ISF_D1,
ISF
)
# Eqs. 35a, 35b (Wotton 2009) - Curing Factor pivoting around % 58.8
CF <- ifelse(
FUELTYPE %in% c("O1A", "O1B"),
ifelse(CC < 58.8,
0.005 * (exp(0.061 * CC) - 1),
0.176 + 0.02 * (CC - 58.8)
),
CF
)
# Eqs. 43a, 43b (Wotton 2009) - slope equivilent ISI for Grass
ISF <- ifelse(
FUELTYPE %in% c("O1A", "O1B"),
ifelse(
(1 - (RSF / (CF * a[FUELTYPE]))**(1 / c0[FUELTYPE])) >= 0.01,
log(1 - (RSF / (CF * a[FUELTYPE]))**(1 / c0[FUELTYPE])) / (-b[FUELTYPE]),
log(0.01) / (-b[FUELTYPE])
),
ISF
)
# Initialize RAZ and WSV
RAZ <- WSV <- rep(-99, length(FFMC))
# Eq. 46 (FCFDG 1992)
m <- FFMC_COEFFICIENT * (101 - FFMC) / (59.5 + FFMC)
# Eq. 45 (FCFDG 1992) - FFMC function from the ISI equation
fF <- 91.9 * exp(-.1386 * m) * (1 + (m**5.31) / 4.93e7)
# Eqs. 44a, 44d (Wotton 2009) - Slope equivalent wind speed
WSE <- 1 / 0.05039 * log(ISF / (0.208 * fF))
# Eqs. 44b, 44e (Wotton 2009) - Slope equivalent wind speed
WSE <- ifelse(
WSE > 40 & ISF < (0.999 * 2.496 * fF),
28 - (1 / 0.0818 * log(1 - ISF / (2.496 * fF))),
WSE
)
# Eqs. 44c (Wotton 2009) - Slope equivalent wind speed
WSE <- ifelse(WSE > 40 & ISF >= (0.999 * 2.496 * fF), 112.45, WSE)
# Eq. 47 (FCFDG 1992) - resultant vector magnitude in the x-direction
WSX <- WS * sin(WAZ) + WSE * sin(SAZ)
# Eq. 48 (FCFDG 1992) - resultant vector magnitude in the y-direction
WSY <- WS * cos(WAZ) + WSE * cos(SAZ)
# Eq. 49 (FCFDG 1992) - the net effective wind speed
WSV <- sqrt(WSX * WSX + WSY * WSY)
WSV <- ifelse(FUELTYPE %in% c("NF", "WA"), NA, WSV)
# Eq. 50 (FCFDG 1992) - the net effective wind direction (radians)
RAZ <- acos(WSY / WSV)
# Eq. 51 (FCFDG 1992) - convert possible negative RAZ into more understandable
# directions
RAZ <- ifelse(WSX < 0, 2 * pi - RAZ, RAZ)
RAZ <- ifelse(FUELTYPE %in% c("NF", "WA"), NA, RAZ)
return(list(WSV = WSV,
RAZ = RAZ))
}
.Slopecalc <- function(
FUELTYPE, FFMC, BUI, WS, WAZ, GS, SAZ, FMC, SFC, PC, PDF, CC, CBH, ISI,
output = "RAZ") {
.Deprecated("slope_adjustment")
# output options include: RAZ and WSV
# check for valid output types
validOutTypes <- c("RAZ", "WAZ", "WSV")
if (!(output %in% validOutTypes)) {
stop(paste0(
"In 'slopecalc()', '", output, "' is an invalid 'output' type."
))
}
values <- slope_adjustment(FUELTYPE, FFMC, BUI, WS, WAZ, GS, SAZ, FMC, SFC, PC, PDF, CC, CBH, ISI)
return(values[[output]])
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.