Refactor met.process and dbfiles

base/db/R/dbfiles.R

@@ -50,9 +50,8 @@ dbfile.input.insert <- function(in.path, in.prefix, siteid, startdate, enddate,
 
 
   # setup parent part of query if specified
-  if (is.na(parentid)) {
-    parent <- ""
-  } else {
+  parent <- ""
+  if (!is.na(parentid)) {
     parent <- paste0(" AND parent_id=", parentid)
   }
 
@@ -242,13 +241,13 @@ dbfile.input.check <- function(siteid, startdate = NULL, enddate = NULL, mimetyp
   formatid <- get.id(table = "formats", colnames = c("mimetype_id", "name"), values = c(mimetypeid, formatname), con = con)
 
   if (is.null(formatid)) {
-    invisible(data.frame())
+    return (invisible(data.frame()))
   }
 
   # setup parent part of query if specified
-  if (is.na(parentid)) {
-    parent <- ""
-  } else {
+  parent <- ""
+
+  if (!is.na(parentid)) {
     parent <- paste0(" AND parent_id=", parentid)
   }
 
@@ -450,7 +449,7 @@ dbfile.posterior.check <- function(pft, mimetype, formatname, con, hostname = PE
   # find appropriate pft
   pftid <- get.id(table = "pfts", values = "name", colnames = pft, con = con)
   if (is.null(pftid)) {
-    invisible(data.frame())
+    return (invisible(data.frame()))
   }
 
   # find appropriate format
@@ -461,7 +460,7 @@ dbfile.posterior.check <- function(pft, mimetype, formatname, con, hostname = PE
   formatid <- get.id(table = "formats", colnames = c("mimetype_id", "name"), values = c(mimetypeid, formatname), con = con)
 
   if (is.null(formatid)) {
-    invisible(data.frame())
+    return (invisible(data.frame()))
   }
 
   # find appropriate posterior
@@ -473,7 +472,7 @@ dbfile.posterior.check <- function(pft, mimetype, formatname, con, hostname = PE
     con = con
   )[["id"]]
   if (is.null(posteriorid)) {
-    invisible(data.frame())
+    return (invisible(data.frame()))
   }
 
   invisible(dbfile.check(type = "Posterior", container.id = posteriorid, con = con, hostname = hostname))
@@ -639,12 +638,12 @@ dbfile.file <- function(type, id, con, hostname = PEcAn.remote::fqdn()) {
 
   if (nrow(files) > 1) {
     PEcAn.logger::logger.warn("multiple files found for", id, "returned; using the first one found")
-    invisible(file.path(files[1, "file_path"], files[1, "file_name"]))
+    return(invisible(file.path(files[1, "file_path"], files[1, "file_name"])))
   } else if (nrow(files) == 1) {
-    invisible(file.path(files[1, "file_path"], files[1, "file_name"]))
+    return(invisible(file.path(files[1, "file_path"], files[1, "file_name"])))
   } else {
     PEcAn.logger::logger.warn("no files found for ", id, "in database")
-    invisible(NA)
+    return(invisible(NA))
   }
 }
 
@@ -662,7 +661,8 @@ dbfile.id <- function(type, file, con, hostname = PEcAn.remote::fqdn()) {
   # find appropriate host
   hostid <- db.query(query = paste0("SELECT id FROM machines WHERE hostname='", hostname, "'"), con = con)[["id"]]
   if (is.null(hostid)) {
-    invisible(NA)
+    PEcAn.logger::logger.warn("hostid not found in database")
+    return (invisible(NA))
   }
 
   # find file

modules/data.atmosphere/R/met.process.R

@@ -255,13 +255,14 @@ met.process <- function(site, input_met, start_date, end_date, model,
   #--------------------------------------------------------------------------------------------------#
   # Change to Site Level - Standardized Met (i.e. ready for conversion to model specific format)
   if (stage$standardize) {
-    standardize_result <- list()
-
+    id_stdized <- list()
+    ready.id <- list(input.id = NULL, dbfile.id = NULL)
+
     for (i in seq_along(cf.id[[1]])) {
 
       if (register$scale == "regional") {
         #### Site extraction
-        standardize_result[[i]] <- .extract.nc.module(cf.id = list(input.id = cf.id$container_id[i],
+        id_stdized <- .extract.nc.module(cf.id = list(input.id = cf.id$container_id[i],
                                                                    dbfile.id = cf.id$id[i]), 
                                        register = register, 
                                        dir = dir, 
@@ -277,7 +278,7 @@ met.process <- function(site, input_met, start_date, end_date, model,
                                        # Expand to support ensemble names in the future
       } else if (register$scale == "site") {
         ##### Site Level Processing
-        standardize_result[[i]] <- .metgapfill.module(cf.id = list(input.id = cf.id$input.id[i], dbfile.id = cf.id$dbfile.id[i]), 
+        id_stdized <- .metgapfill.module(cf.id = list(input.id = cf.id$input.id[i], dbfile.id = cf.id$dbfile.id[i]), 
                                        register = register,
                                        dir = dir,
                                        met = met, 
@@ -288,15 +289,15 @@ met.process <- function(site, input_met, start_date, end_date, model,
                                        host = host, 
                                        overwrite = overwrite$standardize,
                                        ensemble_name = i)
+      } else {
+        # No action taken. These ids will be dropped from ready.id
+        id_stdized <- NULL
       }
+
+      ready.id$input.id <- c(ready.id$input.id, id_stdized$input.id)
+      ready.id$dbfile.id <- c(ready.id$dbfile.id, id_stdized$dbfile.id)
 
     } # End for loop
-    ready.id <- list(input.id = NULL, dbfile.id = NULL)
-
-    for (i in seq_along(standardize_result)) {
-      ready.id$input.id <- c(ready.id$input.id, standardize_result[[i]]$input.id)
-      ready.id$dbfile.id <- c(ready.id$dbfile.id, standardize_result[[i]]$dbfile.id)
-    }
 
   } else {
     ready.id <- input_met$id