Merge pull request #56 from bjoernbos/master

Solves bug and allows to keep temporary files in the working directory

R/add_trajectory_params.R

@@ -24,6 +24,7 @@ add_trajectory_params <- function(model,
                                   binary_path = NULL,
                                   met_dir = NULL,
                                   exec_dir = NULL,
+                                  softrun = FALSE,
                                   clean_up = TRUE) {
 
   if (!is.null(lat)) {
@@ -82,6 +83,14 @@ add_trajectory_params <- function(model,
     model$binary_path <- binary_path
   }
 
+  if (!is.null(softrun)) {
+    model$softrun <- softrun
+  }
+
+  if (!is.null(clean_up)) {
+    model$clean_up <- clean_up
+  }
+
   model
 }
 
@@ -96,7 +105,10 @@ add_dispersion_params <- function(model,
                                   model_height = NULL,
                                   exec_dir = NULL,
                                   met_dir = NULL,
-                                  binary_path = NULL) {
+                                  binary_path = NULL,
+                                  binary_name = NULL,
+                                  softrun = FALSE,
+                                  clean_up = TRUE) {
 
   if (!is.null(start_time)) {
     model$start_time <- start_time
@@ -134,5 +146,13 @@ add_dispersion_params <- function(model,
     model$binary_path <- binary_path
   }
 
+  if (!is.null(softrun)) {
+    model$softrun <- softrun
+  }
+
+  if (!is.null(clean_up)) {
+    model$clean_up <- clean_up
+  }
+
   model
 }

R/get_met_gdas1.R

@@ -14,64 +14,58 @@ get_met_gdas1 <- function(days,
                           direction,
                           path_met_files) {
 
-  # Determine the minimum month (as a `Date`) for the model run
+  # Determine the minimum date (as a `Date`) for the model run
   if (direction == "backward") {
-    min_month <- 
+    min_date <- 
       (lubridate::as_date(days[1]) - (duration / 24)) %>%
-      lubridate::floor_date(unit = "month")
+      lubridate::floor_date(unit = "day")
   } else if (direction == "forward") {
-    min_month <- 
-      (lubridate::as_date(days[1]) + (duration / 24)) %>%
-      lubridate::floor_date(unit = "month")
+    min_date <- 
+      (lubridate::as_date(days[1])) %>%
+      lubridate::floor_date(unit = "day")
   }
 
-  # Determine the maximum month (as a `Date`) for the model run
+  # Determine the maximum date (as a `Date`) for the model run
   if (direction == "backward") {
-    max_month <- 
-      (lubridate::as_date(days[length(days)]) - (duration / 24)) %>%
-      lubridate::floor_date(unit = "month")
+    max_date <- 
+      (lubridate::as_date(days[length(days)])) %>%
+      lubridate::floor_date(unit = "day")
   } else if (direction == "forward") {
-    max_month <- 
+    max_date <- 
       (lubridate::as_date(days[length(days)]) + (duration / 24)) %>%
-      lubridate::floor_date(unit = "month")
+      lubridate::floor_date(unit = "day")
   }
 
-  met_months <- 
-    seq(min_month, max_month, by = "1 month") %>%
-    rep(each = 5)
+  met_days <- 
+    seq(min_date, max_date, by = "1 day") %>% 
+    lubridate::day()
 
-  month_names <-
-    met_months %>%
-    lubridate::month(label = TRUE, abbr = TRUE) %>%
+  month_names <- 
+    seq(min_date, max_date, by = "1 day") %>%
+    lubridate::month(label = TRUE, abbr = TRUE, locale = "en_US.UTF-8")  %>%
     as.character() %>%
     tolower()
 
   met_years <- 
-    met_months %>%
+    seq(min_date, max_date, by = "1 day") %>%
+    lubridate::year() %>% 
     substr(3, 4)
 
-  if (!all(lubridate::leap_year(lubridate::year(days)))) {
-
-    not_leap_years_lgl <- !lubridate::leap_year(lubridate::ymd(days))
-
-    exclusion_years_feb_5 <- 
-      lubridate::year(days[not_leap_years_lgl]) %>%
-      unique()
-
-    excluded_files <- 
-      paste0("gdas1.feb", substr(exclusion_years_feb_5, 3, 4), ".w5")
-
-  } else {
-    excluded_files <- character(0)
-  }
+  # Only consider the weeks of the month we need:
+  #.w1 - days 1-7
+  #.w2 - days 8-14
+  #.w3 - days 15-21
+  #.w4 - days 22-28
+  #.w5 - days 29 - rest of the month 
 
-  files <- paste0("gdas1.", month_names, met_years, ".w", 1:5)
+  met_week <- ceiling(met_days / 7)
 
-  files <- files %>% base::setdiff(excluded_files)
+  files <- paste0("gdas1.", month_names, met_years, ".w", met_week) %>% unique()
 
   get_met_files(
     files = files,
     path_met_files = path_met_files,
     ftp_dir = "ftp://arlftp.arlhq.noaa.gov/archives/gdas1"
   )
+
 }

R/hysplit_dispersion.R

@@ -4,6 +4,7 @@
 #' runs using specified meteorological datasets.
 #' 
 #' @inheritParams hysplit_trajectory
+#' @param binary_name An optional file name for the hysplit binary code. Defaults to "hycs_std", but could be "hycm_std", for example.
 #' @param start_day the day that the model will initialize and run. This should
 #'   take the form of a single-length vector for a day (`"YYYY-MM-DD"`).
 #' @param start_hour a single daily hour as an integer hour (from `0` to `23`).
@@ -31,8 +32,10 @@ hysplit_dispersion <- function(lat = 49.263,
                                species,
                                disp_name = NULL,
                                binary_path = NULL, 
+                               binary_name = NULL,
                                exec_dir = NULL,
                                met_dir = NULL,
+                               softrun = NULL,
                                clean_up = TRUE) {
 
   # If the execution dir isn't specified, use the working directory
@@ -41,11 +44,13 @@ hysplit_dispersion <- function(lat = 49.263,
   # If the meteorology dir isn't specified, use the working directory
   if (is.null(met_dir)) met_dir <- getwd()
 
-  # Set the path for the `hycs_std` binary file
+  # Set the path for the binary file. Defaults to "hycs_std"
+  if (is.null(binary_name)) binary_name <- "hycs_std"
+
   hycs_std_binary_path <- 
     set_binary_path(
       binary_path = binary_path,
-      binary_name = "hycs_std"
+      binary_name = binary_name
     )
 
   parhplot_binary_path <-
@@ -151,6 +156,7 @@ hysplit_dispersion <- function(lat = 49.263,
     exec_dir = exec_dir
   )
 
+
   # The CONTROL file is now complete and in the
   # working directory, so, execute the model run
   sys_cmd <- 
@@ -164,7 +170,9 @@ hysplit_dispersion <- function(lat = 49.263,
       ")"
     )
 
-  execute_on_system(sys_cmd, system_type = system_type)
+  if (isFALSE(softrun)) {
+    execute_on_system(sys_cmd, system_type = system_type)
+  }
 
   # Extract the particle positions at every hour
   sys_cmd <- 
@@ -178,8 +186,11 @@ hysplit_dispersion <- function(lat = 49.263,
       ")"
     )
 
-  execute_on_system(sys_cmd, system_type = system_type)
+  if (isFALSE(softrun)) {
+    execute_on_system(sys_cmd, system_type = system_type)
+  }
 
+  if (isFALSE(softrun)) {
   dispersion_file_list <-
     list.files(
       path = exec_dir,
@@ -215,6 +226,7 @@ hysplit_dispersion <- function(lat = 49.263,
 
     dispersion_tbl <-
       dplyr::bind_rows(dispersion_tbl, disp_tbl)
+    }
   }
 
   if (clean_up) {

R/hysplit_trajectory.R

@@ -87,6 +87,7 @@ hysplit_trajectory <- function(lat = 49.263,
                                binary_path = NULL,
                                met_dir = NULL,
                                exec_dir = NULL,
+                               softrun = NULL, # This is not evaluated, yet
                                clean_up = TRUE) {
 
   # If the execution dir isn't specified, use the working directory

R/run_model.R

@@ -29,7 +29,9 @@ run_model <- function(model) {
         traj_name = model$traj_name,
         exec_dir = model$exec_dir,
         met_dir = model$met_dir,
-        binary_path = model$binary_path
+        binary_path = model$binary_path,
+        softrun = model$softrun,
+        clean_up = model$clean_up
       )
 
     model$traj_df <- traj_df
@@ -46,8 +48,8 @@ run_model <- function(model) {
       # Get time window for observations
       start_day <- model$start_time %>% lubridate::floor_date()
       start_hour <- model$start_time %>% lubridate::hour() 
-      duration <- as.numeric(model$end_time - model$start_time)
-      
+      duration <- as.numeric(difftime(model$end_time, model$start_time, units = "hours"))
+
       # Get ith source parameters
       lat <- model$sources[i, ][["lat"]]
       lon <- model$sources[i, ][["lon"]]
@@ -80,7 +82,10 @@ run_model <- function(model) {
           species = species_list,
           exec_dir = model$exec_dir,
           met_dir = model$met_dir,
-          binary_path = model$binary_path
+          binary_path = model$binary_path,
+          binary_name = model$binary_name,
+          softrun = model$softrun,
+          clean_up = model$clean_up
         )
 
       model$disp_df <- disp_df

R/utils.R

@@ -179,10 +179,12 @@ execute_on_system <- function(sys_cmd, system_type) {
 set_binary_path <- function(binary_path,
                             binary_name) {
 
-  # binary names should be either:
+  # By default, binary names should be either:
   #  - hyts_std (trajectory models)
   #  - hycs_std (dispersion models)
 
+  # If a user uses another binary name, the path to it should also be specified
+
   if (is.null(binary_path)) {
 
     system_os <- get_os()
@@ -210,6 +212,8 @@ set_binary_path <- function(binary_path,
           package = "splitr"
         )
     }
+  } else {
+    binary_path <- paste0(binary_path, binary_name)
   }
 
   binary_path