Badger on a bike/issue44

DESCRIPTION

@@ -1,8 +1,8 @@
 Type: Package
 Package: cffdrs
 Title: Canadian Forest Fire Danger Rating System
-Version: 1.9.2
-Date: 2025-08-21
+Version: 1.10.0
+Date: 2026-05-07
 Authors@R: c(
     person("Xianli", "Wang", , "Xianli.Wang@nrcan-rncan.gc.ca", role = "aut"),
     person("Alan", "Cantin", , "Alan.Cantin@nrcan-rncan.gc.ca", role = "aut"),

NEWS.md

@@ -1,3 +1,12 @@
+# cffdrs 1.10.0
+
+## Enhancements
+
+### Updated Foliar Moisture Content
+
+Foliar moisture content now properly calculates the date of minimum moisture and
+will append it to the output so allow the user to see the `D0` in the output.
+
 # cffdrs 1.9.2
 
 # version 1.9.2

R/fire_behaviour_prediction.r

@@ -220,7 +220,11 @@ fire_behaviour_prediction <- function(
   LAT <- ifelse(LAT < -90 | LAT > 90, 0, LAT)
   LAT <- ifelse(is.na(LAT), 55, LAT)
   LONG <- ifelse(LONG < -180 | LONG > 360, 0, LONG)
+  LONG <- ifelse(LONG > 180, LONG - 180, LONG)
   LONG <- ifelse(is.na(LONG), -120, LONG)
+  # Any negative longitudes (western hemisphere) are translated to positive
+  #  longitudes
+  LONG <- ifelse(LONG < 0, -LONG, LONG)
   THETA <- ifelse(is.na(THETA) | THETA < -2 * pi | THETA > 2 * pi, 0, THETA)
   SD <- ifelse(SD < 0 | SD > 1e+05, -999, SD)
   SD <- ifelse(is.na(SD), 0, SD)
@@ -247,9 +251,7 @@ fire_behaviour_prediction <- function(
   WAZ <- ifelse(WAZ > 2 * pi, WAZ - 2 * pi, WAZ)
   SAZ <- ASPECT + pi
   SAZ <- ifelse(SAZ > 2 * pi, SAZ - 2 * pi, SAZ)
-  # Any negative longitudes (western hemisphere) are translated to positive
-  #  longitudes
-  LONG <- ifelse(LONG < 0, -LONG, LONG)
+
   ############################################################################
   #                         END
   ############################################################################
@@ -272,12 +274,16 @@ fire_behaviour_prediction <- function(
   }
   CBH <- crown_base_height(FUELTYPE, CBH, SD, SH)
   CFL <- crown_fuel_load(FUELTYPE, CFL)
+  D0 <- ifelse(D0 <= 0, foliar_moisture_content_minimum(LAT, LONG, ELV, DJ, D0), D0)
   FMC <- ifelse(
     FMC <= 0 | FMC > 120 | is.na(FMC),
     foliar_moisture_content(LAT, LONG, ELV, DJ, D0),
     FMC
   )
+
   FMC <- ifelse(FUELTYPE %in% c("D1", "S1", "S2", "S3", "O1A", "O1B"), 0, FMC)
+  D0 <- ifelse(FUELTYPE %in% c("D1", "S1", "S2", "S3", "O1A", "O1B"), 0, D0)
+
   ############################################################################
   #                         END
   ############################################################################

R/foliar_moisture_content.r

@@ -9,56 +9,59 @@
 #' @param LAT    Latitude (decimal degrees)
 #' @param LONG   Longitude (decimal degrees)
 #' @param ELV    Elevation (metres)
-#' @param DJ     Day of year (offeren referred to as julian date)
+#' @param DJ     Day of year (julian date)
 #' @param D0     Date of minimum foliar moisture content. _If D0, date of min
 #'                   FMC, is not known then D0 = NULL._
+#' @param FMCo Foliar Moisture Content Override - For use when outside of North
+#'                America
 #'
 #' @return FMC: Foliar Moisture Content value
 #' @noRd
 
-foliar_moisture_content <- function(LAT, LONG, ELV, DJ, D0) {
-  # Initialize vectors
-  FMC <- rep(-1, length(LAT))
-  LATN <- rep(0, length(LAT))
-  # Calculate Normalized Latitude
-  # Eqs. 1 & 3 (FCFDG 1992)
-  LATN <- ifelse(
-    D0 <= 0,
-    ifelse(
-      ELV <= 0,
-      46 + 23.4 * exp(-0.0360 * (150 - LONG)),
-      43 + 33.7 * exp(-0.0351 * (150 - LONG))
-    ),
-    LATN
-  )
-  # Calculate Date of minimum foliar moisture content
-  # Eqs. 2 & 4 (FCFDG 1992)
-  D0 <- ifelse(
-    D0 <= 0,
-    ifelse(
-      ELV <= 0,
-      151 * (LAT / LATN),
-      142.1 * (LAT / LATN) + 0.0172 * ELV
-    ),
-    D0
-  )
-  # Round D0 to the nearest integer because it is a date
-  D0 <- round(D0, 0)
+foliar_moisture_content <- function(LAT, LONG, ELV, DJ, D0=NA,FMCo=NULL) {
+
+  if(any(LAT < 7 | LONG > 140 | LONG < 52)){warning({"Location outside of North America. Please define an FMC override in the FMCo variable."})}
+  if(!is.null(FMCo)){
+  if(!is.na(FMCo)){FMC <- FMCo;
+                     message("FMC Override provided, returning as FMC.");
+                     return(FMC)
+  }}
+
+  ## In the event a user wants to calculate the FMC outside of the FBP function this will ensure D0 gets calculated.
+
+  D0 <- if(any(D0 <= 0| is.na(D0))){foliar_moisture_content_minimum(LAT, LONG, ELV, DJ, D0)}else{D0}
+
+
   # Number of days between day of year and date of min FMC
+
   # Eq. 5 (FCFDG 1992)
+
   ND <- abs(DJ - D0)
+
   # Calculate final FMC
+
   # Eqs. 6, 7, & 8 (FCFDG 1992)
+
   FMC <- ifelse(
+
     ND < 30,
+
     85 + 0.0189 * ND^2,
+
     ifelse(
+
       ND >= 30 & ND < 50,
+
       32.9 + 3.17 * ND - 0.0288 * ND^2,
+
       120
+
     )
+
   )
+
   return(FMC)
+
 }
 
 .FMCcalc <- function(...) {

R/foliar_moisture_content_minimum.r

@@ -0,0 +1,59 @@
+#' Foliar Moisture Content Minimum Calculator
+#'
+#' @description Calculate date of Foliar Moisture Content Minimum.
+#' All variables names are laid out in the same manner as 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. This function returns the date of
+#' minimum foliar moisture content.
+#'
+#' @param LAT    Latitude (decimal degrees)
+#' @param LONG   Longitude (decimal degrees)
+#' @param ELV    Elevation (metres)
+#' @param DJ     Day of year (offeren referred to as julian date)
+#' @param D0     Date of minimum foliar moisture content. _If D0, date of min
+#'                   FMC, is not known then D0 = NULL._
+#'
+#' @return D0: Date of minimum foliar moisture content
+#' @noRd
+
+foliar_moisture_content_minimum <- function(LAT, LONG, ELV, DJ,D0) {
+
+  # Initialize vectors
+
+  FMC <- rep(-1, length(LAT))
+  LATN <- rep(0, length(LAT))
+
+  # Calculate Normalized Latitude
+
+  # Eqs. 1 & 3 (FCFDG 1992)
+
+  LATN <- ifelse(
+    D0 <= 0|is.na(D0),
+    ifelse(
+      ELV <= 0,
+      46 + 23.4 * exp(-0.0360 * (150 - LONG)),
+      43 + 33.7 * exp(-0.0351 * (150 - LONG))
+    ),LATN)
+
+
+  # Calculate Date of minimum foliar moisture content
+
+  # Eqs. 2 & 4 (FCFDG 1992)
+
+  D0 <- ifelse(
+    D0 <= 0|is.na(D0),
+    ifelse(
+      ELV <= 0,
+      151 * (LAT / LATN),
+      142.1 * (LAT / LATN) + 0.0172 * ELV
+    ),
+    D0
+  )
+
+  # Round D0 to the nearest integer because it is a date
+
+  D0 <- round(D0, 0)
+  return(D0)
+
+}