Merge branch 'master' into generalized_agg_funs

Former-commit-id: d7c9348

2_SWSF_p1of5_Settings_v51.R

@@ -35,6 +35,7 @@ rm(list=ls(all=TRUE))
 #------Overall timing
 t.overall <- Sys.time()
 be.quiet <- FALSE
+eta.estimate <- interactive()
 print.debug <- interactive()
 debug.warn.level <- sum(c(print.debug, interactive()))
 debug.dump.objects <- interactive()

2_SWSF_p2of5_CreateDB_Tables_v51.R

@@ -248,7 +248,7 @@ if (length(Tables) == 0 || cleanDB) {
 			#first add any from the experimentals table if its turned on
 			#next add any from the treatments table if its turned on
 			treatments_lookupweatherfolders <- character(0)
-			if(any(names(sw_input_treatments_use[-1][which(sw_input_treatments_use[-1] > 0 & is.finite(as.numeric(sw_input_treatments_use[-1])))])=="LookupWeatherFolder")) {
+			if(any(names(sw_input_treatments_use[sw_input_treatments_use])=="LookupWeatherFolder")) {
 				treatments_lookupweatherfolders <- c(treatments_lookupweatherfolders, sw_input_treatments$LookupWeatherFolder[runIDs_sites])
 			}
 			if(any(create_experimentals=="LookupWeatherFolder")) {

2_SWSF_p3of5_ExternalDataExtractions_v51.R

@@ -2116,7 +2116,9 @@ if (exinfo$GDODCPUCLLNL || exinfo$ExtractClimateChangeScenarios_CMIP5_BCSD_NEX_U
 
 			# extract the GCM data depending on parallel backend
 			if (identical(parallel_backend, "mpi")) {
-				export_objects_to_workers(list.export, list(parent = parent.frame()), "mpi")
+        export_objects_to_workers(list.export,
+          list(local = environment(), parent = parent.frame(), global = .GlobalEnv),
+          "mpi")
 				if (is_NEX && useRCurl && !saveNEXtempfiles)
 					Rmpi::mpi.bcast.cmd(library("RCurl", quietly=TRUE))
 				if (is_GDODCPUCLLNL)
@@ -2147,7 +2149,9 @@ if (exinfo$GDODCPUCLLNL || exinfo$ExtractClimateChangeScenarios_CMIP5_BCSD_NEX_U
 				Rmpi::mpi.bcast.cmd(gc())
 
 			} else if (identical(parallel_backend, "snow")) {
-				export_objects_to_workers(list.export, list(parent = parent.frame()), "snow", cl)
+        export_objects_to_workers(list.export,
+          list(local = environment(), parent = parent.frame(), global = .GlobalEnv),
+          "snow", cl)
 
 				if (is_NEX && useRCurl && !saveNEXtempfiles)
 					snow::clusterEvalQ(cl, library("RCurl", quietly = TRUE))
@@ -2637,18 +2641,22 @@ if (	exinfo$ExtractClimateChangeScenarios_CMIP3_ClimateWizardEnsembles_Global ||
 					#temp value in C
 					#ppt value in mm
 					#add data to sw_input_climscen and set the use flags
-					sw_input_climscen_values_use[i.temp <- match(paste("PPTmm_m", st_mo, "_sc", formatC(sc, width=2,format="d", flag="0"), sep=""), colnames(sw_input_climscen_values_use))] <- 1
+					i.temp <- paste0("PPTmm_m", st_mo, "_sc", formatC(sc, width=2,format="d", flag="0"))
+					sw_input_climscen_values_use[i.temp] <- TRUE
 					sw_input_climscen_values[, i.temp] <- sc.ppt
-					sw_input_climscen_values_use[i.temp <- match(paste("TempC_m", st_mo, "_sc", formatC(sc, width=2,format="d", flag="0"), sep=""), colnames(sw_input_climscen_values_use))] <- 1
+					i.temp <- paste0("TempC_m", st_mo, "_sc", formatC(sc, width=2,format="d", flag="0"))
+					sw_input_climscen_values_use[i.temp] <- TRUE
 					sw_input_climscen_values[, i.temp] <- sc.temp
 				}
 				if (exinfo$ExtractClimateChangeScenarios_CMIP3_ClimateWizardEnsembles_USA) {
 					sc.temp <- sc.temp * 5/9	#temp addand in C
 					sc.ppt <- 1 + sc.ppt/100	#ppt change as factor
 					#add data to sw_input_climscen and set the use flags
-					sw_input_climscen_use[i.temp <- match(paste("PPTfactor_m", st_mo, "_sc", formatC(sc, width=2,format="d", flag="0"), sep=""), colnames(sw_input_climscen_use))] <- 1
+					i.temp <- paste0("PPTfactor_m", st_mo, "_sc", formatC(sc, width=2,format="d", flag="0"))
+					sw_input_climscen_use[i.temp] <- TRUE
 					sw_input_climscen[, i.temp] <- sc.ppt
-					sw_input_climscen_use[i.temp <- match(paste("deltaTempC_m", st_mo, "_sc", formatC(sc, width=2,format="d", flag="0"), sep=""), colnames(sw_input_climscen_use))] <- 1
+					i.temp <- paste0("deltaTempC_m", st_mo, "_sc", formatC(sc, width=2,format="d", flag="0"))
+					sw_input_climscen_use[i.temp] <- TRUE
 					sw_input_climscen[, i.temp] <- sc.temp
 				}
 			}
@@ -2657,11 +2665,11 @@ if (	exinfo$ExtractClimateChangeScenarios_CMIP3_ClimateWizardEnsembles_Global ||
 			if (res > 0) print(paste(res, "sites didn't extract climate scenario information by 'ExtractClimateChangeScenarios_CMIP3_ClimateWizardEnsembles'"))
 
 			#write data to datafile.climatescenarios_values
-			tempdat <- rbind(sw_input_climscen_values_use, sw_input_climscen_values)
-			write.csv(tempdat, file=file.path(dir.sw.dat, datafile.climatescenarios_values), row.names=FALSE)
+			write.csv(reconstitute_inputfile(sw_input_climscen_values_use, sw_input_climscen_values),
+				file = file.path(dir.sw.dat, datafile.climatescenarios_values), row.names = FALSE)
 			unlink(file.path(dir.in, datafile.SWRWinputs_preprocessed))
 
-			rm(list.scenarios.datafile, list.scenarios.external, tempdat, sc.temp, sc.ppt, res, locations)
+			rm(list.scenarios.datafile, list.scenarios.external, sc.temp, sc.ppt, res, locations)
 		} else {
 			print("Not all scenarios requested in 'datafile.SWRunInformation' are available in with 'ExtractClimateChangeScenarios_CMIP3_ClimateWizardEnsembles'")
 		}
@@ -2850,23 +2858,27 @@ if (exinfo$ExtractSoilDataFromCONUSSOILFromSTATSGO_USA || exinfo$ExtractSoilData
 				#add data to sw_input_soils and set the use flags
 				i.temp <- grep("Matricd_L", names(sw_input_soils_use))
 				sw_input_soils[runIDs_sites[i_Done], i.temp[lys]] <- soil_data[i_good, lys, "matricd"]
-				sw_input_soils_use[i.temp][lys] <- 1
+				sw_input_soils_use[i.temp[lys]] <- TRUE
+				sw_input_soils_use[i.temp[-lys]] <- FALSE
 				i.temp <- grep("GravelContent_L", names(sw_input_soils_use))
 				sw_input_soils[runIDs_sites[i_Done], i.temp[lys]] <- soil_data[i_good, lys, "rockvol"]
-				sw_input_soils_use[i.temp][lys] <- 1
+				sw_input_soils_use[i.temp[lys]] <- TRUE
+				sw_input_soils_use[i.temp[-lys]] <- FALSE
 				i.temp <- grep("Sand_L", names(sw_input_soils_use))
 				sw_input_soils[runIDs_sites[i_Done], i.temp[lys]] <- soil_data[i_good, lys, "sand"]
-				sw_input_soils_use[i.temp][lys] <- 1
+				sw_input_soils_use[i.temp[lys]] <- TRUE
+				sw_input_soils_use[i.temp[-lys]] <- FALSE
 				i.temp <- grep("Clay_L", names(sw_input_soils_use))
 				sw_input_soils[runIDs_sites[i_Done], i.temp[lys]] <- soil_data[i_good, lys, "clay"]
-				sw_input_soils_use[i.temp][lys] <- 1
+				sw_input_soils_use[i.temp[lys]] <- TRUE
+				sw_input_soils_use[i.temp[-lys]] <- FALSE
 
 				#write data to datafile.soils
-				tempdat <- rbind(sw_input_soils_use, sw_input_soils)
-				write.csv(tempdat, file=file.path(dir.sw.dat, datafile.soils), row.names=FALSE)
+				write.csv(reconstitute_inputfile(sw_input_soils_use, sw_input_soils),
+					file = file.path(dir.sw.dat, datafile.soils), row.names = FALSE)
 				unlink(file.path(dir.in, datafile.SWRWinputs_preprocessed))
 
-				rm(tempdat, i.temp, i_Done)
+				rm(i.temp, i_Done)
 			}
 
 			if (!be.quiet)
@@ -2904,7 +2916,7 @@ if (exinfo$ExtractSoilDataFromCONUSSOILFromSTATSGO_USA || exinfo$ExtractSoilData
 			layer_N <- 5	#WISE contains five soil layers for each prid
 			layer_Nsim <- 6	#WISE contains five soil layers for each prid; I added one layer to account for lithosols (Ix), which have a soildepth of 10 cm; for all other soil types, my layers 0-10 cm and 10-20 cm contain the same wise information
 			layer_TopDep <- c(0, 10, 20, 40, 60, 80)	#in cm
-			layer_BotDep <- c(10, 20, 40, 60, 80)	#in cm
+			layer_BotDep <- c(10, 20, 40, 60, 80, 100)	#in cm
 
 			dir.ex.dat <- file.path(dir.ex.soil, "wise5by5min_v1b")
 			stopifnot(file.exists(dir.ex.dat), require(raster), require(sp), require(rgdal))
@@ -2914,7 +2926,7 @@ if (exinfo$ExtractSoilDataFromCONUSSOILFromSTATSGO_USA || exinfo$ExtractSoilData
 			is_ToDo <- seq_along(run_sites_wise)
 
 			#---extract data
-			grid_wise <- raster::raster(x=file.path(dir.ex.dat, "Grid", "smw5by5min"))
+			grid_wise <- raster::raster(file.path(dir.ex.dat, "Grid", "smw5by5min"))
 
 			#- List all the wise cells that are covered by the grid cell or point location
 			if (sim_cells_or_points == "point") {
@@ -2966,7 +2978,9 @@ if (exinfo$ExtractSoilDataFromCONUSSOILFromSTATSGO_USA || exinfo$ExtractSoilData
 
 					#call the simulations depending on parallel backend
 					if (identical(parallel_backend, "mpi")) {
-				    export_objects_to_workers(list.export, list(parent = parent.frame()), "mpi")
+            export_objects_to_workers(list.export,
+              list(local = environment(), parent = parent.frame(), global = .GlobalEnv),
+              "mpi")
 						Rmpi::mpi.bcast.cmd(library(raster, quietly=TRUE))
 
 						sim_cells_SUIDs <- Rmpi::mpi.applyLB(x=is_ToDo, fun=extract_SUIDs, res = cell_res_wise, grid = grid_wise, sp_sites = run_sites_wise)
@@ -2976,7 +2990,9 @@ if (exinfo$ExtractSoilDataFromCONUSSOILFromSTATSGO_USA || exinfo$ExtractSoilData
 						Rmpi::mpi.bcast.cmd(gc())
 
 					} else if (identical(parallel_backend, "snow")) {
-				    export_objects_to_workers(list.export, list(parent = parent.frame()), "snow", cl)
+            export_objects_to_workers(list.export,
+              list(local = environment(), parent = parent.frame(), global = .GlobalEnv),
+              "snow", cl)
 						snow::clusterEvalQ(cl, library(raster, quietly = TRUE))
 
 						sim_cells_SUIDs <- snow::clusterApplyLB(cl, x=is_ToDo, fun=extract_SUIDs, res = cell_res_wise, grid = grid_wise, sp_sites = run_sites_wise)
@@ -3097,7 +3113,9 @@ if (exinfo$ExtractSoilDataFromCONUSSOILFromSTATSGO_USA || exinfo$ExtractSoilData
 
 				#call the simulations depending on parallel backend
 				if (identical(parallel_backend, "mpi")) {
-				  export_objects_to_workers(list.export, list(parent = parent.frame()), "mpi")
+          export_objects_to_workers(list.export,
+            list(local = environment(), parent = parent.frame(), global = .GlobalEnv),
+            "mpi")
 
 					sim_cells_soils <- Rmpi::mpi.applyLB(x = is_ToDo, fun = try_weightedMeanForSimulationCell,
 						sim_cells_SUIDs = sim_cells_SUIDs,
@@ -3110,7 +3128,9 @@ if (exinfo$ExtractSoilDataFromCONUSSOILFromSTATSGO_USA || exinfo$ExtractSoilData
 					Rmpi::mpi.bcast.cmd(gc())
 
 				} else if (identical(parallel_backend, "snow")) {
-				  export_objects_to_workers(list.export, list(parent = parent.frame()), "snow", cl)
+          export_objects_to_workers(list.export,
+            list(local = environment(), parent = parent.frame(), global = .GlobalEnv),
+            "snow", cl)
 
 					sim_cells_soils <- snow::clusterApplyLB(cl, x = is_ToDo, fun = try_weightedMeanForSimulationCell,
 						sim_cells_SUIDs = sim_cells_SUIDs,
@@ -3167,10 +3187,10 @@ if (exinfo$ExtractSoilDataFromCONUSSOILFromSTATSGO_USA || exinfo$ExtractSoilData
 				sites_externalsoils_source[i_Done] <- "ISRICWISEv12_Global"
 
 				#set and save soil layer structure
-				lys <- 1:layer_Nsim
+				lys <- seq_len(layer_Nsim)
 				sw_input_soillayers[runIDs_sites[i_Done], "SoilDepth_cm"] <- round(sim_cells_soils[i_good, "soildepth"])
 				i.temp <- grep("depth_L", colnames(sw_input_soillayers))
-				sw_input_soillayers[runIDs_sites[i_Done], i.temp[lys]] <- matrix(data=rep(layer_BotDep[lys], times=sum(i_good)), ncol=length(lys), byrow=TRUE)
+				sw_input_soillayers[runIDs_sites[i_Done], i.temp[lys]] <- matrix(rep(layer_BotDep[lys], times=sum(i_good)), ncol=length(lys), byrow=TRUE)
 				sw_input_soillayers[runIDs_sites[i_Done], i.temp[-lys]] <- NA
 				write.csv(sw_input_soillayers, file=file.path(dir.in, datafile.soillayers), row.names=FALSE)
 				unlink(file.path(dir.in, datafile.SWRWinputs_preprocessed))
@@ -3179,23 +3199,27 @@ if (exinfo$ExtractSoilDataFromCONUSSOILFromSTATSGO_USA || exinfo$ExtractSoilData
 				#add data to sw_input_soils and set the use flags
 				i.temp <- grep("Matricd_L", names(sw_input_soils_use))
 				sw_input_soils[runIDs_sites[i_Done], i.temp[lys]] <- round(sim_cells_soils[i_good, paste0("bulk_L", lys)], 2)
-				sw_input_soils_use[i.temp][lys] <- 1
+				sw_input_soils_use[i.temp[lys]] <- TRUE
+				sw_input_soils_use[i.temp[-lys]] <- FALSE
 				i.temp <- grep("GravelContent_L", names(sw_input_soils_use))
 				sw_input_soils[runIDs_sites[i_Done], i.temp[lys]] <- round(sim_cells_soils[i_good, paste0("cfrag_L", lys)]) / 100
-				sw_input_soils_use[i.temp][lys] <- 1
+				sw_input_soils_use[i.temp[lys]] <- TRUE
+				sw_input_soils_use[i.temp[-lys]] <- FALSE
 				i.temp <- grep("Sand_L", names(sw_input_soils_use))
 				sw_input_soils[runIDs_sites[i_Done], i.temp[lys]] <- round(sim_cells_soils[i_good, paste0("sand_L", lys)]) / 100
-				sw_input_soils_use[i.temp][lys] <- 1
+				sw_input_soils_use[i.temp[lys]] <- TRUE
+				sw_input_soils_use[i.temp[-lys]] <- FALSE
 				i.temp <- grep("Clay_L", names(sw_input_soils_use))
 				sw_input_soils[runIDs_sites[i_Done], i.temp[lys]] <- round(sim_cells_soils[i_good, paste0("clay_L", lys)]) / 100
-				sw_input_soils_use[i.temp][lys] <- 1
+				sw_input_soils_use[i.temp[lys]] <- TRUE
+				sw_input_soils_use[i.temp[-lys]] <- FALSE
 
 				#write data to datafile.soils
-				tempdat <- rbind(sw_input_soils_use, sw_input_soils)
-				write.csv(tempdat, file=file.path(dir.sw.dat, datafile.soils), row.names=FALSE)
+				write.csv(reconstitute_inputfile(sw_input_soils_use, sw_input_soils),
+					file = file.path(dir.sw.dat, datafile.soils), row.names = FALSE)
 				unlink(file.path(dir.in, datafile.SWRWinputs_preprocessed))
 
-				rm(lys, tempdat, i.temp, i_Done)
+				rm(lys, i.temp, i_Done)
 			}
 
 			if (!be.quiet) print(paste("'ExtractSoilDataFromISRICWISEv12_Global' was extracted for n =", sum(i_good), "out of", sum(do_extract[[2]]), "sites"))
@@ -3586,17 +3610,18 @@ if (exinfo$ExtractSkyDataFromNOAAClimateAtlas_USA || exinfo$ExtractSkyDataFromNC
 
 				#add data to sw_input_cloud and set the use flags
 				i.temp <- grep("RH", names(sw_input_cloud_use))
-				sw_input_cloud_use[i.temp] <- 1
+				sw_input_cloud_use[i.temp] <- TRUE
 				sw_input_cloud[runIDs_sites[i_good], i.temp[st_mo]] <- round(monthlyclim[i_good, "RH", ], 2)
 				i.temp <- grep("SkyC", names(sw_input_cloud_use))
-				sw_input_cloud_use[i.temp] <- 1
+				sw_input_cloud_use[i.temp] <- TRUE
 				sw_input_cloud[runIDs_sites[i_good], i.temp[st_mo]] <- round(monthlyclim[i_good, "cover", ], 2)
 				i.temp <- grep("wind", names(sw_input_cloud_use))
-				sw_input_cloud_use[i.temp] <- 1
+				sw_input_cloud_use[i.temp] <- TRUE
 				sw_input_cloud[runIDs_sites[i_good], i.temp[st_mo]] <- round(monthlyclim[i_good, "wind", ], 2)
 
 				#write data to datafile.cloud
-				write.csv(rbind(sw_input_cloud_use, sw_input_cloud), file = file.path(dir.sw.dat, datafile.cloud), row.names = FALSE)
+				write.csv(reconstitute_inputfile(sw_input_cloud_use, sw_input_cloud),
+					file = file.path(dir.sw.dat, datafile.cloud), row.names = FALSE)
 				unlink(file.path(dir.in, datafile.SWRWinputs_preprocessed))
 
 				rm(i.temp)
@@ -3666,17 +3691,18 @@ if (exinfo$ExtractSkyDataFromNOAAClimateAtlas_USA || exinfo$ExtractSkyDataFromNC
 
 				#add data to sw_input_cloud and set the use flags
 				i.temp <- grep("RH", names(sw_input_cloud_use))
-				sw_input_cloud_use[i.temp] <- 1
+				sw_input_cloud_use[i.temp] <- TRUE
 				sw_input_cloud[runIDs_sites[i_good], i.temp][, st_mo] <- round(monthlyclim[i_good, "RH", ], 2)
 				i.temp <- grep("SkyC", names(sw_input_cloud_use))
-				sw_input_cloud_use[i.temp] <- 1
+				sw_input_cloud_use[i.temp] <- TRUE
 				sw_input_cloud[runIDs_sites[i_good], i.temp][, st_mo] <- round(monthlyclim[i_good, "cover", ], 2)
 				i.temp <- grep("wind", names(sw_input_cloud_use))
-				sw_input_cloud_use[i.temp] <- 1
+				sw_input_cloud_use[i.temp] <- TRUE
 				sw_input_cloud[runIDs_sites[i_good], i.temp][, st_mo] <- round(monthlyclim[i_good, "wind", ], 2)
 
 				#write data to datafile.cloud
-				write.csv(rbind(sw_input_cloud_use, sw_input_cloud), file=file.path(dir.sw.dat, datafile.cloud), row.names=FALSE)
+				write.csv(reconstitute_inputfile(sw_input_cloud_use, sw_input_cloud),
+					file = file.path(dir.sw.dat, datafile.cloud), row.names = FALSE)
 				unlink(file.path(dir.in, datafile.SWRWinputs_preprocessed))
 
 				rm(i.temp)