diff --git a/.gitattributes b/.gitattributes new file mode 100644 index 00000000..cfd99d6d --- /dev/null +++ b/.gitattributes @@ -0,0 +1 @@ +*.sqlite3 filter=lfs diff=lfs merge=lfs -text diff --git a/.travis.yml b/.travis.yml index 5b30be84..f956be36 100644 --- a/.travis.yml +++ b/.travis.yml @@ -53,6 +53,8 @@ before_install: - git clone -b master --single-branch --recursive https://github.com/DrylandEcology/rSOILWAT2.git ../rSOILWAT2 # Install rSOILWAT2 without help pages and without vignettes - R CMD INSTALL --no-docs --no-help ../rSOILWAT2 + # Use git-lfs to pull reference files for package checking + - git lfs pull install: # Install rSFSW2 dependencies, but remove `Rmpi` etc. diff --git a/DESCRIPTION b/DESCRIPTION index d82e9d10..382001dc 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: rSFSW2 Title: Simulation Framework for SOILWAT2 -Version: 3.1.5 -Date: 2019-03-14 +Version: 4.0.0 +Date: 2019-05-03 Authors@R: c( person("Daniel", "Schlaepfer", email = "daniel.schlaepfer@yale.edu", comment = c(ORCID = "0000-0001-9973-2065"), role = c("aut", "cre")), @@ -12,9 +12,9 @@ Authors@R: c( Description: Setting up, carrying out, and analyzing ecosystem water balance simulation experiments with SOILWAT2. Depends: - R (>= 3.4.0) + R (>= 3.5.0) Imports: - rSOILWAT2 (>= 2.3.5), + rSOILWAT2 (>= 3.0.0), RSQLite (>= 2.1.1), DBI (>= 1.0), Rcpp (>= 0.12.12), @@ -45,7 +45,7 @@ Suggests: spelling (>= 1.1), hunspell (>= 2.9), covr, - lintr (>= 1.0.3), + lintr (>= 1.0.3.9000), goodpractice Remotes: github::dschlaep/weathergen diff --git a/NAMESPACE b/NAMESPACE index c36ce89f..c794294a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -9,23 +9,12 @@ export(ExtractGriddedDailyWeatherFromDayMet_NorthAmerica_dbW) export(ExtractGriddedDailyWeatherFromDayMet_NorthAmerica_swWeather) export(ExtractGriddedDailyWeatherFromMaurer2002_NorthAmerica) export(ExtractGriddedDailyWeatherFromNRCan_10km_Canada) -export(Grass_ANPP) export(GriddedDailyWeatherFromNCEPCFSR_Global) export(PrepareClimateScenarios) -export(SMR_logic) -export(SMR_names) -export(SMRq_names) -export(STR_logic) -export(STR_names) -export(SWPtoVWC) -export(Shrub_ANPP) -export(TranspCoeffByVegType) -export(VWCtoSWP) export(align_with_target_grid) export(align_with_target_res) export(calc_BareSoilEvapCoefs) export(calc_RequestedSoilLayers) -export(calc_SiteClimate) export(check_aggregated_output) export(check_cltool) export(check_lock_content) @@ -73,8 +62,6 @@ export(downscale.deltahybrid) export(downscale.deltahybrid3mod) export(downscale.raw) export(enable_debug_dump) -export(estimate_PotNatVeg_biomass) -export(estimate_PotNatVeg_composition) export(exit_SFSW2_cluster) export(export_objects_to_workers) export(extract_SFSW2_cells_from_raster) diff --git a/R/Aggregation_Functions.R b/R/Aggregation_Functions.R index e25ae463..c440f238 100644 --- a/R/Aggregation_Functions.R +++ b/R/Aggregation_Functions.R @@ -780,9 +780,9 @@ fields_dailyNRCS_SoilMoistureTemperatureRegimes <- function(aon, ...) { # nolint if (isTRUE(aon[[id]])) { temp <- paste0("NRCS_", c( - paste0("SoilTemperatureRegime_", STR_names()), - paste0("SoilMoistureRegime_", SMR_names()), - paste0("SoilMoistureRegimeQualifier_", SMRq_names()))) + paste0("SoilTemperatureRegime_", rSOILWAT2::STR_names()), + paste0("SoilMoistureRegime_", rSOILWAT2::SMR_names()), + paste0("SoilMoistureRegimeQualifier_", rSOILWAT2::SMRq_names()))) } list(aon = id, N = length(temp), fields = list(coerce_sqlNames(temp))) diff --git a/R/ExtractData_ClimateDownscaling.R b/R/ExtractData_ClimateDownscaling.R index 107297e9..6891a559 100644 --- a/R/ExtractData_ClimateDownscaling.R +++ b/R/ExtractData_ClimateDownscaling.R @@ -565,8 +565,7 @@ applyDelta_oneYear <- function(obs, delta_ts, ppt_fun, daily, monthly, ppt_type <- match.arg(ppt_type, c(NA, "detailed", "simple")) - month <- 1 + as.POSIXlt(seq(ISOdate(obs@year, 1, 1, tz = "UTC"), - ISOdate(obs@year, 12, 31, tz = "UTC"), by = "day"))$mon + month <- 1 + as.POSIXlt(rSOILWAT2::days_in_years(obs@year, obs@year))$mon ydeltas <- delta_ts[delta_ts[, "Year"] == obs@year, -(1:2)] add_days <- ppt_fun[month] == "+" mult_days <- !add_days diff --git a/R/Mathematical_Functions.R b/R/Mathematical_Functions.R index a5d94787..627f33a2 100644 --- a/R/Mathematical_Functions.R +++ b/R/Mathematical_Functions.R @@ -25,44 +25,8 @@ in_box <- function(xy, xbounds, ybounds, i_use) { } -cut0Inf <- function(x, val = NA) { - x[x < 0] <- val - x -} -NAto0 <- function(x) { - x[is.na(x)] <- 0 - x -} -finite01 <- function(x, val_low = 0, val_high = 1) { - x[x < 0 | is.na(x)] <- val_low - x[x > 1] <- val_high - x -} - -calc.loess_coeff <- function(N, span) { - # prevent call to loessc.c:ehg182(104): - # "span too small. fewer data values than degrees of freedom" - lcoef <- list(span = min(1, span), degree = 2) - if (span <= 1) { - # see R/trunk/src/library/stats/src/loessf.f:ehg136() - nf <- floor(lcoef$span * N) - 1 - if (nf > 2) { - lcoef$degree <- 2 - } else if (nf > 1) { - lcoef$degree <- 1 - } else { - lcoef <- Recall(N, lcoef$span + 0.1) - } - } - lcoef -} - - -calc_starts <- function(x) { - temp1 <- rle(as.logical(x)) - temp2 <- cumsum(c(0, temp1$lengths)) + 1 - temp2[-length(temp2)][temp1$values] -} +cut0Inf <- rSOILWAT2:::cut0Inf +finite01 <- rSOILWAT2:::finite01 diff --git a/R/Miscellaneous_Functions.R b/R/Miscellaneous_Functions.R index 217b7715..a6fc3a9a 100644 --- a/R/Miscellaneous_Functions.R +++ b/R/Miscellaneous_Functions.R @@ -312,118 +312,6 @@ dir_safe_create <- function(paths, showWarnings = FALSE, recursive = TRUE, } -#' Calculate variables required to estimate percent C4 species in North America -#' -#' @return A named numeric vector of length 6. -#' @references Teeri J.A., Stowe L.G. (1976) Climatic patterns and the -#' distribution of C4 grasses in North America. Oecologia, 23, 1-12. -sw_dailyC4_TempVar <- function(dailyTempMin, dailyTempMean, simTime2) { - - temp7 <- simTime2$month_ForEachUsedDay_NSadj == 7 - Month7th_MinTemp_C <- tapply(dailyTempMin[temp7], - simTime2$year_ForEachUsedDay_NSadj[temp7], min) - FrostFree_Days <- tapply(dailyTempMin, simTime2$year_ForEachUsedDay_NSadj, - function(x) { - temp <- rle(x > 0) - if (any(temp$values)) max(temp$lengths[temp$values], na.rm = TRUE) else 0 - }) - - # 18.333 C = 65 F with (65 - 32) * 5 / 9 - temp_base65F <- dailyTempMean - 18.333 - temp_base65F[temp_base65F < 0] <- 0 - DegreeDaysAbove65F_DaysC <- tapply(temp_base65F, - simTime2$year_ForEachUsedDay_NSadj, sum) - - # if southern Hemisphere, then 7th month of last year is not included - nyrs <- seq_along(Month7th_MinTemp_C) - temp <- cbind(Month7th_MinTemp_C[nyrs], FrostFree_Days[nyrs], - DegreeDaysAbove65F_DaysC[nyrs]) - res <- c(apply(temp, 2, mean), apply(temp, 2, stats::sd)) - temp <- c("Month7th_NSadj_MinTemp_C", - "LengthFreezeFreeGrowingPeriod_NSadj_Days", - "DegreeDaysAbove65F_NSadj_DaysC") - names(res) <- c(temp, paste0(temp, ".sd")) - - res -} - -#' Calculate climate variables from daily weather -#' -#' @param weatherList A list. Each element is an object of class -#' \code{\link[rSOILWAT2:swWeatherData-class]{rSOILWAT2::swWeatherData}} -#' containing daily weather data of a specific year. -#' @param year.start An integer value. The first year of the range of years for -#' which climate variables should be calculated. -#' @param year.end An integer value. The last year of the range of years for -#' which climate variables should be calculated. -#' @param do.C4vars A logical value. If \code{TRUE} then additional output is -#' returned. -#' @param simTime2 An object as returned from function -#' \code{\link{simTiming_ForEachUsedTimeUnit}}. Only needed if -#' \code{isTRUE(do.C4vars)}. -#' -#' @return A list with named elements \itemize{ -#' \item{\var{\dQuote{meanMonthlyTempC}}} {A numeric vector of length 12. -#' Mean monthly mean daily air temperature in degree Celsius.} -#' \item{\var{\dQuote{minMonthlyTempC}}} {A numeric vector of length 12. -#' Mean monthly minimum daily air temperature in degree Celsius.} -#' \item{\var{\dQuote{maxMonthlyTempC}}} {A numeric vector of length 12. -#' Mean monthly maximum daily air temperature in degree Celsius.} -#' \item{\var{\dQuote{meanMonthlyPPTcm}}} {A numeric vector of length 12. -#' Mean monthly precipitation in centimeters.} -#' \item{\var{\dQuote{MAP_cm}}} {A numeric value. Mean annual precipitation -#' in centimeters.} -#' \item{\var{\dQuote{MAT_C}}} {A numeric value. Mean annual air temperature -#' in degree Celsius.} -#' \item{\var{\dQuote{dailyTempMin}}} {A numeric vector. If -#' \code{isTRUE(do.C4vars)}, then minimum daily air temperature in degree -#' Celsius for each day of time period between \code{year.start} and -#' \code{year.end}. If \code{!isTRUE(do.C4vars)}, then \code{NA}.} -#' \item{\var{\dQuote{dailyTempMean}}} {A numeric vector. Similar as for -#' \code{dailyTempMin} but for mean daily air temperature.} -#' \item{\var{\dQuote{dailyC4vars}}} {If \code{isTRUE(do.C4vars)}, then a -#' named numeric vector containing the output of -#' \code{\link{sw_dailyC4_TempVar}}, else \code{NA}.} -#' } -#' @export -calc_SiteClimate <- function(weatherList, year.start, year.end, - do.C4vars = FALSE, simTime2 = NULL) { - - x <- rSOILWAT2::dbW_weatherData_to_dataframe(weatherList) - - # Trim to years - years <- as.numeric(unlist(lapply(weatherList, function(x) x@year))) - years <- years[year.start <= years & year.end >= years] - - x <- x[year.start <= x[, "Year"] & year.end >= x[, "Year"], ] - temp <- seq(from = ISOdate(years[1], 1, 1, tz = "UTC"), - to = ISOdate(years[length(years)], 12, 31, tz = "UTC"), by = "1 day") - xl <- list(months = as.POSIXlt(temp)$mon + 1, - Tmean_C = rowMeans(x[, c("Tmax_C", "Tmin_C")])) - - index <- xl[["months"]] + 100 * x[, "Year"] - temp <- vapply(list(xl[["Tmean_C"]], x[, "Tmin_C"], x[, "Tmax_C"]), - function(data) matrix(tapply(data, index, mean), nrow = 12), - FUN.VALUE = matrix(NA_real_, nrow = 12, ncol = length(years))) - tempPPT <- matrix(tapply(x[, "PPT_cm"], index, sum), nrow = 12) - - list( - meanMonthlyTempC = apply(temp[, , 1, drop = FALSE], 1, mean), - minMonthlyTempC = apply(temp[, , 2, drop = FALSE], 1, mean), - maxMonthlyTempC = apply(temp[, , 3, drop = FALSE], 1, mean), - meanMonthlyPPTcm = apply(tempPPT, 1, mean), - - MAP_cm = sum(tempPPT) / length(years), - MAT_C = mean(xl[["Tmean_C"]]), - - dailyTempMin = if (do.C4vars) x[, "Tmin_C"] else NA, - dailyTempMean = if (do.C4vars) xl[["Tmean_C"]] else NA, - dailyC4vars = if (do.C4vars) { - sw_dailyC4_TempVar(dailyTempMin = x[, "Tmin_C"], - dailyTempMean = xl[["Tmean_C"]], simTime2) - } else NA - ) -} @@ -465,38 +353,7 @@ vpd <- function(Tmin, Tmax, RHmean = NULL) { } - - -max_duration <- function(x, target_val = 1L, return_doys = FALSE) { - r <- rle(x) - rgood <- r$values == target_val - igood <- which(rgood) - - if (length(igood) > 0) { - len <- max(r$lengths[igood]) - - if (return_doys) { - imax <- which(rgood & r$lengths == len)[1] - - rdoys <- cumsum(r$lengths) - doys <- if (imax == 1L) { - c(start = 1L, end = rdoys[1]) - } else { - c(start = rdoys[imax - 1] + 1, - end = rdoys[imax]) - } - } - - } else { - len <- 0L - doys <- c(start = NA, end = NA) - } - - if (return_doys) - return(c(len, doys)) - - len -} +max_duration <- rSOILWAT2:::max_duration startDoyOfDuration <- function(x, duration = 10) { r <- rle(x) @@ -1015,7 +872,7 @@ setup_scenarios <- function(sim_scens, future_yrs) { # ConcScen = concentration scenarios, e.g., SRESs, RCPs colnames(climScen) <- c("Downscaling", "DeltaStr_yrs", "ConcScen", "Model") - # see 'setup_simulation_time' for how 'future_yrs' is created + # see 'setup_time_simulation_project' for how 'future_yrs' is created climScen[, "Delta_yrs"] <- as.integer(substr(climScen[, "DeltaStr_yrs"], 2, nchar(climScen[, "DeltaStr_yrs"]) - 3)) diff --git a/R/OutputDatabase.R b/R/OutputDatabase.R index 29e0e3c0..fd75fbde 100644 --- a/R/OutputDatabase.R +++ b/R/OutputDatabase.R @@ -2023,13 +2023,24 @@ dbOutput_create_Design <- function(con_dbOut, SFSW2_prj_meta, temp_df <- SFSW2_prj_inputs[["sw_input_treatments"]][, temp, drop = FALSE] db_treatments <- unique(temp_df) db_treatments_rows <- nrow(db_treatments) + #this maps locations from reduced - temp <- duplicated(temp_df) + temp2 <- data.frame(t(temp_df), stringsAsFactors = FALSE) treatments_unique_map <- rep(NA, nrow(temp_df)) - temp2 <- data.frame(t(temp_df)) - treatments_unique_map[temp] <- match(data.frame(t(temp_df[temp, ])), temp2) - treatments_unique_map[!temp] <- match(data.frame(t(temp_df[!temp, ])), - temp2) + + temp <- duplicated(temp_df) + tempno <- !temp + if (any(temp)) { + treatments_unique_map[temp] <- match( + x = data.frame(t(temp_df[temp, ]), stringsAsFactors = FALSE), + table = temp2) + } + if (any(tempno)) { + treatments_unique_map[tempno] <- match( + x = data.frame(t(temp_df[tempno, ]), stringsAsFactors = FALSE), + table = temp2) + } + db_treatments_map <- unique(treatments_unique_map) treatments_unique_map <- sapply(treatments_unique_map, function(x) which(db_treatments_map == x)) @@ -2233,7 +2244,7 @@ dbOutput_create_Design <- function(con_dbOut, SFSW2_prj_meta, } else { simulation_years[, "EndYear"] <- SFSW2_prj_meta[["sim_time"]][["endyr"]] } - simulation_years[, "StartYear"] <- getStartYear( + simulation_years[, "StartYear"] <- rSOILWAT2::getStartYear( simulation_years[, "simulationStartYear"], SFSW2_prj_meta[["sim_time"]][["spinup_N"]]) @@ -2394,57 +2405,74 @@ dbOutput_create_Design <- function(con_dbOut, SFSW2_prj_meta, #------ CREATE VIEW + sites_columns1 <- req_fields_SWRunInformation() if (length(SFSW2_prj_meta[["opt_out_fix"]][["Index_RunInformation"]]) > 0) { - sites_columns <- colnames(SFSW2_prj_inputs[["SWRunInformation"]])[ - SFSW2_prj_meta[["opt_out_fix"]][["Index_RunInformation"]]] + sites_columns2 <- colnames(SFSW2_prj_inputs[["SWRunInformation"]])[ + SFSW2_prj_meta[["opt_out_fix"]][["Index_RunInformation"]]] - for (k_excl in c("label", "WeatherFolder", "Include_YN")) { - icol <- grep(k_excl, sites_columns, ignore.case = TRUE) + for (k_excl in sites_columns1) { + icol <- grep(k_excl, sites_columns2, ignore.case = TRUE) if (length(icol) > 0) - sites_columns <- sites_columns[-icol] + sites_columns2 <- sites_columns2[-icol] } - } else { - sites_columns <- NULL + sites_columns2 <- NULL + } + + for (k_excl in c("Labels", "Experimental_Label", "WeatherFolder")) { + icol <- grep(k_excl, sites_columns1, ignore.case = TRUE) + if (length(icol) > 0) + sites_columns1 <- sites_columns1[-icol] } + treatment_columns <- colnames(db_combined_exp_treatments)[- (1:3)] - if (useTreatmentWeatherFolder) + + if (useTreatmentWeatherFolder) { treatment_columns <- treatment_columns[-grep("WeatherFolder", treatment_columns)] + } + header_columns <- paste(c( "runs.P_id", "run_labels.label AS Labels", - "sites.Include_YN AS Include_YN", - if (!is.null(sites_columns)) - paste0("sites.\"", sites_columns, "\"", collapse = ", "), - if (useExperimentals) - "experimental_labels.label AS Experimental_Label", + paste0("sites.\"", sites_columns1, "\" AS \"", sites_columns1, "\"", + collapse = ", "), + if (!is.null(sites_columns2)) { + paste0("sites.\"", sites_columns2, "\"", collapse = ", ") + }, + if (useExperimentals) { + "experimental_labels.label AS Experimental_Label" + }, "weatherfolders.folder AS WeatherFolder", - if (useExperimentals || useTreatments) - paste("treatments", treatment_columns, sep = ".", collapse = ", "), + if (useExperimentals || useTreatments) { + paste("treatments", treatment_columns, sep = ".", collapse = ", ") + }, "simulation_years.StartYear", - "simulation_years.simulationStartYear AS SimStartYear", + "simulation_years.simulationStartYear", "simulation_years.EndYear", "scenario_labels.label AS Scenario"), collapse = ", ") dbExecute(con_dbOut, paste0( - "CREATE VIEW header AS SELECT ", header_columns, - " FROM runs, run_labels, sites, ", - if (useExperimentals) - "experimental_labels, ", - "treatments, scenario_labels, simulation_years, weatherfolders", - " WHERE runs.label_id=run_labels.id AND runs.site_id=sites.id AND", - " runs.treatment_id=treatments.id AND", - " runs.scenario_id=scenario_labels.id AND ", - if (useTreatmentWeatherFolder) { - "treatments.LookupWeatherFolder_id=weatherfolders.id AND " - } else { - "sites.WeatherFolder_id=weatherfolders.id AND " - }, - if (useExperimentals) - "treatments.experimental_id=experimental_labels.id AND ", - "treatments.simulation_years_id=simulation_years.id;" + "CREATE VIEW header ", + "AS SELECT ", header_columns, " ", + "FROM runs, run_labels, sites, ", + if (useExperimentals) "experimental_labels, ", + "treatments, scenario_labels, simulation_years, weatherfolders ", + "WHERE ", + "runs.label_id=run_labels.id AND ", + "runs.site_id=sites.id AND ", + "runs.treatment_id=treatments.id AND ", + "runs.scenario_id=scenario_labels.id AND ", + if (useTreatmentWeatherFolder) { + "treatments.LookupWeatherFolder_id=weatherfolders.id AND " + } else { + "sites.WeatherFolder_id=weatherfolders.id AND " + }, + if (useExperimentals) { + "treatments.experimental_id=experimental_labels.id AND " + }, + "treatments.simulation_years_id=simulation_years.id" )) invisible(NULL) diff --git a/R/Pedotransfer_Functions.R b/R/Pedotransfer_Functions.R deleted file mode 100644 index 2b5dc587..00000000 --- a/R/Pedotransfer_Functions.R +++ /dev/null @@ -1,169 +0,0 @@ -#' Pedotransfer functions to convert between soil moisture (volumetric water -#' content, \var{VWC}) and soil water potential (\var{SWP}) -#' -#' @param sand A numeric value or vector. Sand content of the soil layer(s) as -#' fractional value in \code{[0,1]}. -#' @param clay A numeric value or vector. Clay content of the soil layer(s) as -#' fractional value in \code{[0,1]}. -#' -#' @references Cosby, B. J., G. M. Hornberger, R. B. Clapp, and T. R. Ginn. -#' 1984. A statistical exploration of the relationships of soil moisture -#' characteristics to the physical properties of soils. Water Resources Research -#' 20:682-690. -#' -#' @name pedotransfer -NULL - -#' @rdname pedotransfer -#' @section Note: either \code{swp} or \code{sand}/\code{clay} needs be a -#' single value -pdf_to_vwc <- function(swp, sand, clay, thetas, psis, b, MPa_toBar = -10, - bar_conversion = 1024) { - - thetas * (psis / (swp * MPa_toBar * bar_conversion)) ^ (1 / b) / 100 -} - -#' @rdname pedotransfer -#' @section Note: either \code{vwc} or \code{sand}/\code{clay} needs be a -#' single value -pdf_to_swp <- function(vwc, sand, clay, thetas, psis, b, bar_toMPa = -0.1, - bar_conversion = 1024) { - - psis / ((vwc * 100 / thetas) ^ b * bar_conversion) * bar_toMPa -} - -pedotransfer <- function(x, sand, clay, pdf) { - stopifnot(length(sand) && length(sand) == length(clay)) - sand <- finite01(sand, NA, NA) - clay <- finite01(clay, NA, NA) - - if (any(stats::complete.cases(sand, clay))) { - thetas <- -14.2 * sand - 3.7 * clay + 50.5 - psis <- 10 ^ (-1.58 * sand - 0.63 * clay + 2.17) - b <- -0.3 * sand + 15.7 * clay + 3.10 - if (any(b <= 0, na.rm = TRUE)) - stop("Pedotransfer for soil texture with b <= 0 is not possible.") - - np_x <- NROW(x) * NCOL(x) - - if (NROW(x) == 1 || NCOL(x) == 1) { - # cases 1-4 - if (np_x == 1 || length(sand) == 1) { - # cases 1-3 - res <- pdf(x, sand, clay, thetas, psis, b) - - } else { - # case 4; Note: case 3 could also be calculated with the code for - # case 4, but is much slower, unless x is a data.frame with one column - temp <- lapply(x, function(v) pdf(v, sand, clay, thetas, psis, b)) - res <- matrix(unlist(temp), nrow = np_x, byrow = TRUE) - } - - } else { - # cases 5-6 - dx <- dim(x) - - if (length(sand) == 1) { - # case 5 - res <- vapply(seq_len(dx[2]), function(d) { - pdf(x[, d], sand, clay, thetas, psis, b) - }, rep(1, dx[1]), USE.NAMES = FALSE) - - } else { - # case 6 - stopifnot(dx[2] == length(sand)) - res <- vapply(seq_len(dx[2]), function(d) { - pdf(x[, d], sand[d], clay[d], thetas[d], psis[d], b[d]) - }, rep(1, dx[1]), USE.NAMES = FALSE) - } - } - - } else { - res <- x - res[] <- NA - } - - # if SWP then in units of MPa [-Inf, 0]; if VWC then in units of m3/m3 [0, 1] - res -} - -#' Calculate volumetric water content from soil water potential and soil texture -#' @rdname pedotransfer -#' @param swp A numeric value, vector, or 2-dimensional object -#' (matrix or data.frame). The soil water potential (of the soil matrix) in -#' units of \var{MPa}, i.e., the soil without the volume of rock and gravel. -#' -#' @return Volumetric water content in units of m^3 (of water) / m^3 (of soil) -#' \code{[0, 1]}. There are six use cases:\enumerate{ -#' \item 1) \itemize{ -#' \item Input: \code{SWP} [single value]; \code{sand} and \code{clay} -#' [single values] -#' \item Output: \code{VWC} [single value]} -#' \item 2) \itemize{ -#' \item Input: \code{SWP} [single value]; \code{sand} and \code{clay} -#' [vectors of length d] -#' \item Output: \code{VWC} [vector of length d]} -#' \item 3) \itemize{ -#' \item Input: \code{SWP} [vector of length l]; \code{sand} and -#' \code{clay} infraction [single values] -#' \item Output: \code{VWC} [vector of length l]} -#' \item 4) \itemize{ -#' \item Input: \code{SWP} [vector of length l]; \code{sand} and -#' \code{clay} [vectors of length d] -#' \item Output: \code{VWC} [l x d matrix] where \code{SWP} is -#' repeated for each column} -#' \item 5) \itemize{ -#' \item Input: \code{SWP} [l x d matrix]; \code{sand} and \code{clay} -#' [single values] -#' \item Output: \code{VWC} [l x d matrix]} -#' \item 6) \itemize{ -#' \item Input: \code{SWP} [l x d matrix]; \code{sand} and \code{clay} -#' [vectors of length d] -#' \item Output: \code{VWC} [l x d matrix], \code{sand} and \code{clay} -#' vectors are repeated for each row} -#' } -#' @export -SWPtoVWC <- function(swp, sand, clay) { - pedotransfer(swp, sand, clay, pdf = pdf_to_vwc) -} - - -#' Calculate soil water potential from volumetric water content and soil texture -#' @rdname pedotransfer -#' @param vwc A numeric value, vector, or 2-dimensional object -#' (matrix or data.frame). The matric soil moisture, i.e., reduced by the -#' volume of rock and gravel. -#' -#' @return Soil water potential in units of \var{MPa} \code{[-Inf, 0]}. -#' There are six use cases: \enumerate{ -#' \item 1) \itemize{ -#' \item Input: \code{VWC} [single value]; \code{sand} and \code{clay} -#' [single values] -#' \item Output: \code{SWP} [single value]} -#' \item 2) \itemize{ -#' \item Input: \code{VWC} [single value]; \code{sand} and \code{clay} -#' [vectors of length d] -#' \item Output: \code{SWP} [vector of length d]} -#' \item 3) \itemize{ -#' \item Input: \code{VWC} [vector of length l]; \code{sand} and -#' \code{clay} in fraction [single values] -#' \item Output: \code{SWP} [vector of length l]} -#' \item 4) \itemize{ -#' \item Input: \code{VWC} [vector of length l]; \code{sand} and -#' \code{clay} [vectors of length d] -#' \item Output: \code{SWP} [l x d matrix] where \code{VWC} is repeated for -#' each column} -#' \item 5) \itemize{ -#' \item Input: \code{VWC} [l x d matrix]; \code{sand} and \code{clay} -#' [single values] -#' \item Output: \code{SWP} [l x d matrix]} -#' \item 6) \itemize{ -#' \item Input: \code{VWC} [l x d matrix]; \code{sand} and \code{clay} -#' [vectors of length d] -#' \item Output: \code{SWP} [l x d matrix], \code{sand} and \code{clay} -#' vectors are repeated for each row} -#' } -#' @export -VWCtoSWP <- function(vwc, sand, clay) { - pedotransfer(vwc, sand, clay, pdf = pdf_to_swp) -} diff --git a/R/PriorCalculations.R b/R/PriorCalculations.R index 5ff86548..e90b2c0d 100644 --- a/R/PriorCalculations.R +++ b/R/PriorCalculations.R @@ -11,7 +11,7 @@ #' #' @export calc_RequestedSoilLayers <- function(SFSW2_prj_meta, - SFSW2_prj_inputs, runIDs_adjust, verbose = FALSE) { + SFSW2_prj_inputs, runIDs_adjust, keep_old_depth = TRUE, verbose = FALSE) { requested_soil_layers <- SFSW2_prj_meta[["opt_input"]][["requested_soil_layers"]] @@ -64,8 +64,10 @@ calc_RequestedSoilLayers <- function(SFSW2_prj_meta, if (length(layer_sets) > 0) { has_changed <- FALSE sw_input_soils_data <- lapply(var_layers, function(x) - as.matrix(SFSW2_prj_inputs[["sw_input_soils"]][runIDs_adjust_ws, - grep(x, names(SFSW2_prj_inputs[["sw_input_soils"]]))[ids_layers]])) + as.matrix(SFSW2_prj_inputs[["sw_input_soils"]][ + runIDs_adjust_ws, + grep(x, names(SFSW2_prj_inputs[["sw_input_soils"]]))[ids_layers], + drop = FALSE])) sw_input_soils_data2 <- NULL for (ils in seq_along(layer_sets)) { @@ -74,13 +76,15 @@ calc_RequestedSoilLayers <- function(SFSW2_prj_meta, # Identify which requested layers to add ldset <- stats::na.exclude(layers_depth[which(il_set)[1], ]) - req_sl_toadd <- setdiff(requested_soil_layers, ldset) - req_sd_toadd <- req_sl_toadd[req_sl_toadd < max(ldset)] + req_sd_toadd <- setdiff(requested_soil_layers, ldset) + if (isTRUE(keep_old_depth)) { + req_sd_toadd <- req_sd_toadd[req_sd_toadd < max(ldset)] + } if (length(req_sd_toadd) == 0) next # Add identified layers - sw_input_soils_data2 <- lapply(seq_along(var_layers), function(iv) - sw_input_soils_data[[iv]][il_set, ]) + sw_input_soils_data2 <- lapply(seq_along(var_layers), + function(iv) sw_input_soils_data[[iv]][il_set, , drop = FALSE]) for (lnew in req_sd_toadd) { ilnew <- findInterval(lnew, ldset) il_weight <- calc_weights_from_depths(ilnew, lnew, ldset) diff --git a/R/Simulation_Project.R b/R/Simulation_Project.R index 139bc4b2..ab653c7d 100644 --- a/R/Simulation_Project.R +++ b/R/Simulation_Project.R @@ -302,7 +302,7 @@ init_rSFSW2_project <- function(fmetar, update = FALSE, verbose = TRUE, init_timer(SFSW2_prj_meta[["fnames_out"]][["timerfile"]]) #--- Update simulation time - SFSW2_prj_meta[["sim_time"]] <- setup_simulation_time( + SFSW2_prj_meta[["sim_time"]] <- setup_time_simulation_project( SFSW2_prj_meta[["sim_time"]], add_st2 = TRUE, adjust_NS = SFSW2_prj_meta[["opt_agg"]][["adjust_NorthSouth"]], use_doy_range = SFSW2_prj_meta[["opt_agg"]][["use_doy_range"]], @@ -787,7 +787,9 @@ populate_rSFSW2_project_with_data <- function(SFSW2_prj_meta, opt_behave, # noli if (todo_intracker(SFSW2_prj_meta, "req_soillayers", "prepared")) { temp <- calc_RequestedSoilLayers(SFSW2_prj_meta, SFSW2_prj_inputs, - runIDs_adjust, verbose = opt_verbosity[["verbose"]]) + runIDs_adjust, + keep_old_depth = SFSW2_prj_meta[["opt_input"]][["keep_old_depth"]], + verbose = opt_verbosity[["verbose"]]) SFSW2_prj_meta <- temp[["SFSW2_prj_meta"]] SFSW2_prj_inputs <- temp[["SFSW2_prj_inputs"]] diff --git a/R/Simulation_Run.R b/R/Simulation_Run.R index db2ae5d2..aefdd5d2 100644 --- a/R/Simulation_Run.R +++ b/R/Simulation_Run.R @@ -68,9 +68,9 @@ do_OneSite <- function(i_sim, i_SWRunInformation, i_sw_input_soillayers, # will eventually be repeated, and below replaced with experimental values # i_exp = the row of sw_input_experimentals for the i_sim-th simulation run # P_id = is a unique id number for each scenario in each run - + t.do_OneSite <- Sys.time() - + # ID of worker fid <- if (SFSW2_glovars[["p_has"]]) { if (SFSW2_glovars[["p_type"]] == "mpi") { @@ -322,7 +322,8 @@ do_OneSite <- function(i_sim, i_SWRunInformation, i_sw_input_soillayers, #year when SOILWAT2 starts the simulation isim_time[["simstartyr"]] <- i_sw_input_treatments$YearStart #first year that is used for output aggregation, e.g., simstartyr + 1 - isim_time[["startyr"]] <- getStartYear(isim_time[["simstartyr"]], isim_time[["spinup_N"]]) + isim_time[["startyr"]] <- rSOILWAT2::getStartYear( + isim_time[["simstartyr"]], isim_time[["spinup_N"]]) } if (any(create_treatments == "YearEnd")) { #year when SOILWAT2 ends the simulation @@ -330,9 +331,10 @@ do_OneSite <- function(i_sim, i_SWRunInformation, i_sw_input_soillayers, } #------simulation timing needs to be adjusted - isim_time <- setup_simulation_time(isim_time, add_st2 = FALSE) + isim_time <- setup_time_simulation_project(isim_time, add_st2 = FALSE) - simTime2 <- simTiming_ForEachUsedTimeUnit(isim_time, + simTime2 <- rSOILWAT2::simTiming_ForEachUsedTimeUnit( + useyrs = isim_time[["useyrs"]], sim_tscales = c("daily", "monthly", "yearly"), latitude = i_SWRunInformation$Y_WGS84, account_NorthSouth = opt_agg[["adjust_NorthSouth"]], @@ -360,8 +362,11 @@ do_OneSite <- function(i_sim, i_SWRunInformation, i_sw_input_soillayers, EVCO_done <- TRCO_done <- FALSE #to check whether we get information for evaporation and transpiration coefficients TRRG_done <- FALSE #to check whether we get information for transpiration regions - # Data objects used also during aggregation - grasses.c3c4ann.fractions <- rep(list(rep(NA, 3)), sim_scens[["N"]]) #Init fractions of C3, C4, and annual grasses of grass-vegetation type fraction; used in create and aggregate + #--- Data objects used also during aggregation + # Init vector with relative composition of C3, C4, and annual grasses + temp <- c(Grasses_C3 = NA, Grasses_C4 = NA, Grasses_Annuals = NA) + grasses.c3c4ann.fractions <- rep(list(temp), sim_scens[["N"]]) + ClimatePerturbationsVals <- matrix(c(rep(1, 12), rep(0, 24)), nrow = sim_scens[["N"]], ncol = 12 * 3, byrow = TRUE) #, dimnames = list(NULL, paste0(rep(paste0("ClimatePerturbations.", c("PrcpMultiplier.m", "TmaxAddand.m", "TminAddand.m")), each = 12), SFSW2_glovars[["st_mo"]], rep(c("_none", "_C", "_C"), each = 12), "_const")) @@ -515,7 +520,7 @@ do_OneSite <- function(i_sim, i_SWRunInformation, i_sw_input_soillayers, break } else { - trco <- TranspCoeffByVegType( + trco <- rSOILWAT2::TranspCoeffByVegType( tr_input_code = tr_input_TranspCoeff_Code, tr_input_coeff = tr_input_TranspCoeff, soillayer_no = soilLayers_N, trco_type = i_sw_input_treatments[1, do_vegs[["flag"]][k]], @@ -531,7 +536,7 @@ do_OneSite <- function(i_sim, i_SWRunInformation, i_sw_input_soillayers, #add data to sw_input_soils i_sw_input_soils[i.temp[seq_along(trco)]] <- trco } else { - print(paste0(tag_simfid, ": the function 'TranspCoeffByVegType' returned NA ", + print(paste0(tag_simfid, ": the function 'rSOILWAT2::TranspCoeffByVegType' returned NA ", "or does not sum to greater than 0 for type", do_vegs[["adjustType"]][k])) tasks[, "create"] <- 0L break @@ -661,9 +666,10 @@ do_OneSite <- function(i_sim, i_SWRunInformation, i_sw_input_soillayers, } for (k in c("Grass", "Shrub", "Tree", "Forb")) { - rSOILWAT2::swProd_MonProd_veg(swRunScenariosData[[1]], k) <- update_biomass( - fg = k, use = sw_input_prod_use, prod_input = i_sw_input_prod, - prod_default = swRunScenariosData[[1]]@prod) + rSOILWAT2::swProd_MonProd_veg(swRunScenariosData[[1]], k) <- + rSOILWAT2::update_biomass(fg = k, use = sw_input_prod_use, + prod_input = i_sw_input_prod, + prod_default = swRunScenariosData[[1]]@prod) } } @@ -968,13 +974,13 @@ do_OneSite <- function(i_sim, i_SWRunInformation, i_sw_input_soillayers, print_debug(opt_verbosity, tag_simfid, "creating", "daily weather done") - #Check that extraction of weather data was successful + # Check that extraction of weather data was successful if (inherits(i_sw_weatherList, "try-error") || length(i_sw_weatherList) == 0) { tasks[, "create"] <- 0L print(paste0(tag_simfid, ": i_sw_weatherList ERROR: ", i_sw_weatherList)) } - #copy and make climate scenarios from datafiles + # Copy and make climate scenarios from datafiles if (any(tasks[, "create"] > 0L)) for (sc in seq_len(sim_scens[["N"]])) { tag_simpidfid <- paste0("[run", i_sim, "/PID", all_Pids[sc], "/sc", sc, "/work", fid, "]") @@ -994,11 +1000,11 @@ do_OneSite <- function(i_sim, i_SWRunInformation, i_sw_input_soillayers, if (prj_todos[["need_cli_means"]]) { print_debug(opt_verbosity, tag_simpidfid, "creating", "climate") - do.C4vars <- any(create_treatments == "PotentialNaturalVegetation_CompositionShrubsC3C4_Paruelo1996") || isTRUE(prj_todos[["aon"]][["dailyC4_TempVar"]]) + do_C4vars <- any(create_treatments == "PotentialNaturalVegetation_CompositionShrubsC3C4_Paruelo1996") || isTRUE(prj_todos[["aon"]][["dailyC4_TempVar"]]) #redo SiteClimate_Ambient - SiteClimate_Ambient <- calc_SiteClimate(weatherList = i_sw_weatherList[[1]], + SiteClimate_Ambient <- rSOILWAT2::calc_SiteClimate(weatherList = i_sw_weatherList[[1]], year.start = min(isim_time$useyrs), year.end = max(isim_time$useyrs), - do.C4vars = do.C4vars, simTime2 = simTime2) + do_C4vars = do_C4vars, simTime2 = simTime2) } } @@ -1150,17 +1156,17 @@ do_OneSite <- function(i_sim, i_SWRunInformation, i_sw_input_soillayers, SiteClimate_Scenario$maxMonthlyTempC <- SiteClimate_Ambient$maxMonthlyTempC + t_max_f SiteClimate_Scenario$MAP_cm <- sum(SiteClimate_Scenario$meanMonthlyPPTcm) SiteClimate_Scenario$MAT_C <- mean(SiteClimate_Scenario$meanMonthlyTempC) - if (do.C4vars) { + if (do_C4vars) { SiteClimate_Scenario$dailyTempMin <- SiteClimate_Ambient$dailyTempMin + t_min_f[simTime2$month_ForEachUsedDay] SiteClimate_Scenario$dailyTempMean <- SiteClimate_Ambient$dailyTempMean + tmean_f[simTime2$month_ForEachUsedDay] - SiteClimate_Scenario$dailyC4vars <- sw_dailyC4_TempVar(SiteClimate_Scenario$dailyTempMin, SiteClimate_Scenario$dailyTempMean, simTime2) + SiteClimate_Scenario$dailyC4vars <- rSOILWAT2::sw_dailyC4_TempVar(SiteClimate_Scenario$dailyTempMin, SiteClimate_Scenario$dailyTempMean, simTime2) } } } else { - SiteClimate_Scenario <- calc_SiteClimate(weatherList = i_sw_weatherList[[sc]], + SiteClimate_Scenario <- rSOILWAT2::calc_SiteClimate(weatherList = i_sw_weatherList[[sc]], year.start = min(isim_time$useyrs), year.end = max(isim_time$useyrs), - do.C4vars = do.C4vars, simTime2 = simTime2) + do_C4vars = do_C4vars, simTime2 = simTime2) if (sc > 1) { ppt_sc <- (temp <- rSOILWAT2::swWeather_MonScalingParams(swRunScenariosData[[sc]]))[, 1] @@ -1331,10 +1337,11 @@ do_OneSite <- function(i_sim, i_SWRunInformation, i_sw_input_soillayers, isNorth <- i_SWRunInformation$Y_WGS84 >= 0 - #TODO: Include forbs and bareground in estimate_PotNatVeg_composition - temp <- try(estimate_PotNatVeg_composition(MAP_mm, MAT_C, - mean_monthly_ppt_mm = monthly.ppt, dailyC4vars, isNorth = isNorth, + pnv <- try(rSOILWAT2::estimate_PotNatVeg_composition(MAP_mm, MAT_C, + mean_monthly_ppt_mm = monthly.ppt, mean_monthly_Temp_C = monthly.temp, + dailyC4vars = dailyC4vars, isNorth = isNorth, shrub_limit = opt_sim[["shrub_limit"]], + fix_succulents = TRUE, Succulents_Fraction = 0, fix_annuals = any(create_treatments == "PotentialNaturalVegetation_CompositionAnnuals_Fraction"), Annuals_Fraction = i_sw_input_treatments$PotentialNaturalVegetation_CompositionAnnuals_Fraction, fix_C4grasses = any(create_treatments == "PotentialNaturalVegetation_CompositionC4_Fraction"), @@ -1343,21 +1350,27 @@ do_OneSite <- function(i_sim, i_SWRunInformation, i_sw_input_soillayers, C3_Fraction = i_sw_input_treatments$PotentialNaturalVegetation_CompositionC3_Fraction, fix_shrubs = any(create_treatments == "PotentialNaturalVegetation_CompositionShrubs_Fraction"), Shrubs_Fraction = i_sw_input_treatments$PotentialNaturalVegetation_CompositionShrubs_Fraction, - fix_forbs = any(create_treatments == "PotentialNaturalVegetation_CompositionForb_Fraction"), - Forbs_Fraction = i_sw_input_treatments$PotentialNaturalVegetation_CompositionForb_Fraction, + fix_forbs = TRUE, Forbs_Fraction = 0, fix_trees = any(create_treatments == "PotentialNaturalVegetation_CompositionTrees_Fraction"), Trees_Fraction = i_sw_input_treatments$PotentialNaturalVegetation_CompositionTrees_Fraction, fix_BareGround = any(create_treatments == "PotentialNaturalVegetation_CompositionBareGround_Fraction"), - BareGround_Fraction = i_sw_input_treatments$PotentialNaturalVegetation_CompositionBareGround_Fraction)) + BareGround_Fraction = i_sw_input_treatments$PotentialNaturalVegetation_CompositionBareGround_Fraction, + fill_empty_with_BareGround = TRUE) + ) - if (inherits(temp, "try-error")) { + if (inherits(pnv, "try-error")) { tasks[sc, "create"] <- 0L break } else { - grass.fraction <- temp$Composition[1] - rSOILWAT2::swProd_Composition(swRunScenariosData[[sc]]) <- temp$Composition - grasses.c3c4ann.fractions[[sc]] <- temp$grasses.c3c4ann.fractions + # ---- `veg.in`: Composition of vegetation type components + # Grasses Shrubs Trees Forbs BareGround + ids <- c("SW_GRASS", "SW_SHRUB", "SW_TREES", "SW_FORBS", + "SW_BAREGROUND") + temp <- finite01(pnv[["Rel_Abundance_L1"]][ids]) + rSOILWAT2::swProd_Composition(swRunScenariosData[[sc]]) <- temp + + grasses.c3c4ann.fractions[[sc]] <- pnv[["Grasses"]] } } @@ -1370,7 +1383,7 @@ do_OneSite <- function(i_sim, i_SWRunInformation, i_sw_input_soillayers, (any(create_treatments == "AdjMonthlyBioMass_Precipitation") && i_sw_input_treatments$AdjMonthlyBioMass_Precipitation))) { - temp <- estimate_PotNatVeg_biomass( + temp <- rSOILWAT2::estimate_PotNatVeg_biomass( tr_VegBiom = tr_VegetationComposition, do_adjBiom_by_temp = any(create_treatments == "AdjMonthlyBioMass_Temperature") && i_sw_input_treatments$AdjMonthlyBioMass_Temperature, do_adjBiom_by_ppt = any(create_treatments == "AdjMonthlyBioMass_Precipitation") & i_sw_input_treatments$AdjMonthlyBioMass_Precipitation, @@ -1434,21 +1447,21 @@ do_OneSite <- function(i_sim, i_SWRunInformation, i_sw_input_soillayers, } if (rSOILWAT2::swProd_Composition(swRunScenariosData[[sc]])[1] > 0) { - C3.trco <- TranspCoeffByVegType( + C3.trco <- rSOILWAT2::TranspCoeffByVegType( tr_input_code = tr_input_TranspCoeff_Code, tr_input_coeff = tr_input_TranspCoeff, soillayer_no = soilLayers_N, trco_type = trco_type_C3, layers_depth = layers_depth, adjustType = "positive") - C4.trco <- TranspCoeffByVegType( + C4.trco <- rSOILWAT2::TranspCoeffByVegType( tr_input_code = tr_input_TranspCoeff_Code, tr_input_coeff = tr_input_TranspCoeff, soillayer_no = soilLayers_N, trco_type = trco_type_C4, layers_depth = layers_depth, adjustType = "positive") - Annuals.trco <- TranspCoeffByVegType( + Annuals.trco <- rSOILWAT2::TranspCoeffByVegType( tr_input_code = tr_input_TranspCoeff_Code, tr_input_coeff = tr_input_TranspCoeff, soillayer_no = soilLayers_N, trco_type = trco_type_annuals, @@ -1460,7 +1473,7 @@ do_OneSite <- function(i_sim, i_SWRunInformation, i_sw_input_soillayers, Annuals.trco * grasses.c3c4ann.fractions[[sc]][3] } else { - Grass.trco <- TranspCoeffByVegType( + Grass.trco <- rSOILWAT2::TranspCoeffByVegType( tr_input_code = tr_input_TranspCoeff_Code, tr_input_coeff = tr_input_TranspCoeff, soillayer_no = soilLayers_N, trco_type = "FILL", @@ -1471,19 +1484,19 @@ do_OneSite <- function(i_sim, i_SWRunInformation, i_sw_input_soillayers, if (anyNA(Grass.trco)) Grass.trco <- rep(0, soilLayers_N) - Shrub.trco <- TranspCoeffByVegType( + Shrub.trco <- rSOILWAT2::TranspCoeffByVegType( tr_input_code = tr_input_TranspCoeff_Code, tr_input_coeff = tr_input_TranspCoeff, soillayer_no = soilLayers_N, trco_type = trco_type_shrubs, layers_depth = layers_depth, adjustType = "inverse") - Tree.trco <- TranspCoeffByVegType( + Tree.trco <- rSOILWAT2::TranspCoeffByVegType( tr_input_code = tr_input_TranspCoeff_Code, tr_input_coeff = tr_input_TranspCoeff, soillayer_no = soilLayers_N, trco_type = tro_type_tree, layers_depth = layers_depth, adjustType = "inverse") - Forb.trco <- TranspCoeffByVegType( + Forb.trco <- rSOILWAT2::TranspCoeffByVegType( tr_input_code = tr_input_TranspCoeff_Code, tr_input_coeff = tr_input_TranspCoeff, soillayer_no = soilLayers_N, trco_type = tro_type_forb, @@ -1665,8 +1678,10 @@ do_OneSite <- function(i_sim, i_SWRunInformation, i_sw_input_soillayers, print_debug(opt_verbosity, tag_simpidfid, "tasks =", paste(temp, ", evco = ", EVCO_done, ", trco = ", TRCO_done, ", trrg = ", TRRG_done)) - }#end do scenario creations + } #end do scenario creations + + # Check that all flags are good across scenarios if (!EVCO_done) { print(paste0(tag_simfid, ": evaporation coefficients not set for this run.")) } else if (!TRCO_done) { @@ -1679,6 +1694,14 @@ do_OneSite <- function(i_sim, i_SWRunInformation, i_sw_input_soillayers, tasks[, "create"] <- 0L } + # Check that input data are prepared for each requested scenario + n_sc_good <- length(swRunScenariosData) + if (n_sc_good < sim_scens[["N"]]) { + has_failed <- n_sc_good:sim_scens[["N"]] + tasks[has_failed, "create"] <- 0L + } + + # Update tasks has_failed <- tasks[, "create"] == 0L if (any(has_failed)) { tasks[has_failed, "execute"] <- tasks[has_failed, "aggregate"] <- -1L @@ -1686,11 +1709,12 @@ do_OneSite <- function(i_sim, i_SWRunInformation, i_sw_input_soillayers, tasks[!has_failed, "create"] <- 2L - - if (opt_out_run[["saveRsoilwatInput"]]) + # Save input data if requested + if (opt_out_run[["saveRsoilwatInput"]]) { save(swRunScenariosData, i_sw_weatherList, grasses.c3c4ann.fractions, ClimatePerturbationsVals, isim_time, simTime2, file = f_sw_input) - }#end if do create runs + } + } #end if do create runs if (opt_out_run[["makeInputForExperimentalDesign"]] && sim_size[["expN"]] > 0 && length(create_experimentals) > 0) { @@ -1803,6 +1827,7 @@ do_OneSite <- function(i_sim, i_SWRunInformation, i_sw_input_soillayers, # #' \code{DeltaX[2]}: -1 == failed; 0 == no run yet; # #' 1 == deltaX_Param successfully approved; 2 == deltaX_Param successfully modified DeltaX <- c(NA, 0L) + is_SOILTEMP_INSTABLE <- rep(NA, sim_scens[["N"]]) for (sc in sim_seq_scens) { tag_simpidfid <- paste0("[run", i_sim, "/PID", all_Pids[sc], "/sc", sc, @@ -1820,7 +1845,6 @@ do_OneSite <- function(i_sim, i_SWRunInformation, i_sw_input_soillayers, if (tasks[sc, "execute"] == 1L) { runDataSC <- NULL - is_SOILTEMP_INSTABLE <- rep(NA, sim_scens[["N"]]) scw <- if (opt_sim[["use_dbW_future"]]) sc else 1L mDepth <- rSOILWAT2::swSite_SoilTemperatureConsts(swRunScenariosData[[sc]])["MaxDepth"] @@ -1831,12 +1855,12 @@ do_OneSite <- function(i_sim, i_SWRunInformation, i_sw_input_soillayers, if (DeltaX[2] == 2L) rSOILWAT2::swSite_SoilTemperatureConsts(swRunScenariosData[[sc]])["deltaX_Param"] <- DeltaX[1] } - + runDataSC <- try(rSOILWAT2::sw_exec(inputData = swRunScenariosData[[sc]], weatherList = i_sw_weatherList[[scw]], echo = FALSE, quiet = TRUE), silent = TRUE) - + # Testing for error in soil temperature module is_SOILTEMP_INSTABLE[sc] <- rSOILWAT2::has_soilTemp_failed() @@ -1859,12 +1883,12 @@ do_OneSite <- function(i_sim, i_SWRunInformation, i_sw_input_soillayers, rSOILWAT2::swSite_SoilTemperatureConsts(swRunScenariosData[[sc]])["deltaX_Param"] <- min(DeltaX[1], mDepth) print_debug(opt_verbosity, tag_simpidfid, "SOILWAT2 called again with deltaX (cm) =", rSOILWAT2::swSite_SoilTemperatureConsts(swRunScenariosData[[sc]])["deltaX_Param"]) - + runDataSC <- try(rSOILWAT2::sw_exec(inputData = swRunScenariosData[[sc]], weatherList = i_sw_weatherList[[scw]], echo = FALSE, quiet = TRUE), silent = TRUE) - + ## Test to check and see if SOILTEMP is stable so that the loop can break - this will be based on parts being > 1.0 is_SOILTEMP_INSTABLE[sc] <- rSOILWAT2::has_soilTemp_failed() i_soil_rep <- i_soil_rep + 1 @@ -2777,7 +2801,7 @@ do_OneSite <- function(i_sim, i_SWRunInformation, i_sw_input_soillayers, print_debug(opt_verbosity, tag_simpidfid, "aggregating", "dailyC4_TempVar") if (!exists("temp.dy")) temp.dy <- get_Temp_dy(runDataSC, isim_time) - resMeans[nv:(nv+2)] <- (temp <- as.numeric(sw_dailyC4_TempVar(dailyTempMin = temp.dy$min, dailyTempMean = temp.dy$mean, simTime2)))[1:3] #adjust_NorthSouth + resMeans[nv:(nv+2)] <- (temp <- as.numeric(rSOILWAT2::sw_dailyC4_TempVar(dailyTempMin = temp.dy$min, dailyTempMean = temp.dy$mean, simTime2)))[1:3] #adjust_NorthSouth resSDs[nv:(nv+2)] <- temp[4:6] nv <- nv+3 @@ -3220,13 +3244,13 @@ do_OneSite <- function(i_sim, i_SWRunInformation, i_sw_input_soillayers, if (!exists("swcbulk.dy")) swcbulk.dy <- get_Response_aggL(swof["sw_swcbulk"], tscale = "dy", scaler = 10, FUN = sum, x = runDataSC, st = isim_time, st2 = simTime2, topL = topL, bottomL = bottomL) recharge.dy <- NULL - recharge.dy$top <- swcbulk.dy$top / (SWPtoVWC(-0.033, texture$sand.top, texture$clay.top) * 10 * sum(layers_width[topL])) + recharge.dy$top <- swcbulk.dy$top / (rSOILWAT2::SWPtoVWC(-0.033, texture$sand.top, texture$clay.top) * 10 * sum(layers_width[topL])) extremes <- matrix(NA, nrow = isim_time$no.useyr, ncol = 2 * 4) temp <- tapply(recharge.dy$top, simTime2$year_ForEachUsedDay, extreme_values_and_doys) extremes[, 1:4] <- matrix(unlist(temp), ncol = 4, byrow = TRUE) if (length(bottomL) > 0 && !identical(bottomL, 0)) { - recharge.dy$bottom <- swcbulk.dy$bottom / (SWPtoVWC(-0.033, texture$sand.bottom, texture$clay.bottom) * 10 * sum(layers_width[bottomL])) + recharge.dy$bottom <- swcbulk.dy$bottom / (rSOILWAT2::SWPtoVWC(-0.033, texture$sand.bottom, texture$clay.bottom) * 10 * sum(layers_width[bottomL])) temp <- tapply(recharge.dy$bottom, simTime2$year_ForEachUsedDay, extreme_values_and_doys) extremes[, 5:8] <- matrix(unlist(temp), ncol = 4, byrow = TRUE) } @@ -3249,607 +3273,63 @@ do_OneSite <- function(i_sim, i_SWRunInformation, i_sw_input_soillayers, #---Aggregation: Ecological dryness #35a - regimes_done <- FALSE if (isTRUE(prj_todos[["aon"]][["dailyNRCS_SoilMoistureTemperatureRegimes"]]) || isTRUE(prj_todos[["aon"]][["dailyNRCS_SoilMoistureTemperatureRegimes_Intermediates"]])) { - print_debug(opt_verbosity, tag_simpidfid, "aggregating", "dailyNRCS_SoilMoistureTemperatureRegimes") - #Based on references provided by Chambers, J. C., D. A. Pyke, J. D. Maestas, M. Pellant, C. S. Boyd, S. B. Campbell, S. Espinosa, D. W. Havlina, K. E. Mayer, and A. Wuenschel. 2014. Using Resistance and Resilience Concepts to Reduce Impacts of Invasive Annual Grasses and Altered Fire Regimes on the Sagebrush Ecosystem and Greater Sage-Grouse: A Strategic Multi-Scale Approach. Gen. Tech. Rep. RMRS-GTR-326. U.S. Department of Agriculture, Forest Service, Rocky Mountain Research Station, Fort Collins, CO. - #Soil Survey Staff. 2014. Keys to soil taxonomy, 12th ed., USDA Natural Resources Conservation Service, Washington, DC. - - stopifnot(any(opt_agg[["NRCS_SMTRs"]][["aggregate_at"]] == c("data", "conditions", "regime"))) - - #Result containers - has_simulated_SoilTemp <- has_realistic_SoilTemp <- NA - SMTR <- list() - temp <- STR_names() - SMTR[["STR"]] <- matrix(0, nrow = 1, ncol = length(temp), dimnames = list(NULL, temp)) - temp <- c(SMR_names(), SMRq_names()) - SMTR[["SMR"]] <- matrix(0, nrow = 1, ncol = length(temp), dimnames = list(NULL, temp)) - - MCS_depth <- Lanh_depth <- rep(NA, 2) - Fifty_depth <- permafrost_yrs <- has_Ohorizon <- NA - SMR_normalyears_N <- 0 - temp_annual <- matrix(NA, nrow = isim_time$no.useyr, ncol = 45, dimnames = - list(NULL, c("MATLanh", "MAT50", "T50jja", "T50djf", "CSPartSummer", - "meanTair_Tsoil50_offset_C", paste0("V", 7:45)))) - - if (rSOILWAT2::swSite_SoilTemperatureFlag(swRunScenariosData[[sc]]) && - isTRUE(!is_SOILTEMP_INSTABLE[sc])) { #we need soil temperature - - has_simulated_SoilTemp <- 1 - if (!exists("soiltemp.dy.all")) soiltemp.dy.all <- get_Response_aggL(swof["sw_soiltemp"], tscale = "dyAll", scaler = 1, FUN = stats::weighted.mean, weights = layers_width, x = runDataSC, st = isim_time, st2 = simTime2, topL = topL, bottomL = bottomL) - - if (!anyNA(soiltemp.dy.all$val) && all(soiltemp.dy.all$val[, -(1:2)] < 100)) { - # 100 C as upper realistic limit from Garratt, J.R. (1992). Extreme maximum land surface temperatures. Journal of Applied Meteorology, 31, 1096-1105. - has_realistic_SoilTemp <- 1 - if (!exists("soiltemp.yr.all")) soiltemp.yr.all <- get_Response_aggL(swof["sw_soiltemp"], tscale = "yrAll", scaler = 1, FUN = stats::weighted.mean, weights = layers_width, x = runDataSC, st = isim_time, st2 = simTime2, topL = topL, bottomL = bottomL) - if (!exists("soiltemp.mo.all")) soiltemp.mo.all <- get_Response_aggL(swof["sw_soiltemp"], tscale = "moAll", scaler = 1, FUN = stats::weighted.mean, weights = layers_width, x = runDataSC, st = isim_time, st2 = simTime2, topL = topL, bottomL = bottomL) - if (!exists("vwcmatric.dy.all")) vwcmatric.dy.all <- get_Response_aggL(swof["sw_vwcmatric"], tscale = "dyAll", scaler = 1, FUN = stats::weighted.mean, weights = layers_width, x = runDataSC, st = isim_time, st2 = simTime2, topL = topL, bottomL = bottomL) - if (!exists("swpmatric.dy.all")) swpmatric.dy.all <- get_SWPmatric_aggL(vwcmatric.dy.all, texture, sand, clay) - if (!exists("prcp.yr")) prcp.yr <- get_PPT_yr(runDataSC, isim_time) - if (!exists("prcp.mo")) prcp.mo <- get_PPT_mo(runDataSC, isim_time) - if (!exists("pet.mo")) pet.mo <- get_PET_mo(runDataSC, isim_time) - if (!exists("temp.mo")) temp.mo <- get_Temp_mo(runDataSC, isim_time) - - # Prepare data - #Water year starting Oct 1 - # 1. water-year: N-hemisphere: October 1st = 1 day of water year; S-hemisphere: April 1st = 1 day of water year - wateryears <- simTime2$year_ForEachUsedDay_NSadj + - ifelse(simTime2$doy_ForEachUsedDay_NSadj > 273, 1, 0) - wyears <- (temp <- unique(wateryears))[-length(temp)]#eliminate last year - - if (opt_agg[["NRCS_SMTRs"]][["use_normal"]]) { - # Normal years for soil moisture regimes (Soil Survey Staff 2014: p.29) - # Should have a time period of 30 years to determine normal years - if (isim_time$no.useyr < 30) - print(paste0(tag_simpidfid, ": has only", isim_time$no.useyr, "years ", - "of data; determination of normal years for NRCS soil moisture ", - "regimes should be based on >= 30 years.")) - - # - Annual precipitation that is plus or minus one standard precipitation - # - and Mean monthly precipitation that is plus or minus one standard deviation of the long-term monthly precipitation for 8 of the 12 months - MAP <- c(mean(prcp.yr$ppt), stats::sd(prcp.yr$ppt)) - normal1 <- as.vector((prcp.yr$ppt >= MAP[1] - MAP[2]) & - (prcp.yr$ppt <= MAP[1] + MAP[2])) - MMP <- tapply(prcp.mo$ppt, simTime2$month_ForEachUsedMonth_NSadj, - function(x) c(mean(x), stats::sd(x))) - MMP <- matrix(unlist(MMP), nrow = 2, ncol = 12) - normal2 <- tapply(prcp.mo$ppt, simTime2$yearno_ForEachUsedMonth_NSadj, - function(x) sum((x >= MMP[1, ] - MMP[2, ]) & (x <= MMP[1, ] + MMP[2, ])) >= 8) - - st_NRCS <- list( - yr_used = yr_used <- wyears[normal1 & normal2], - i_yr_used = findInterval(yr_used, wyears)) - - rm(list = c("MAP", "MMP", "normal1", "normal2")) - - } else { - st_NRCS <- list( - yr_used = isim_time$useyrs, - i_yr_used = findInterval(isim_time$useyrs, wyears)) - } - - st_NRCS <- c(st_NRCS, list( - N_yr_used = length(st_NRCS[["yr_used"]]), - i_dy_used = i_dy_used <- wateryears %in% st_NRCS[["yr_used"]], - N_dy_used = sum(i_dy_used), - i_mo_used = seq_len(isim_time$no.usemo)[rep(wyears, each = 12) %in% st_NRCS[["yr_used"]]], - days_per_yr_used = as.integer(table(wateryears[i_dy_used], dnn = FALSE)))) - - SMR_normalyears_N <- st_NRCS[["N_yr_used"]] - - soiltemp_nrsc <- list( - yr = list(data = {temp <- isim_time$index.useyr[st_NRCS[["i_yr_used"]]] - soiltemp.yr.all$val[temp, , drop = FALSE]}, nheader = 1), - mo = list(data = {temp <- isim_time$index.usemo[st_NRCS[["i_mo_used"]]] - soiltemp.mo.all$val[temp, , drop = FALSE]}, nheader = 2), - dy = list(data = {temp <- isim_time$index.usedy[st_NRCS[["i_dy_used"]]] - soiltemp.dy.all$val[temp, , drop = FALSE]}, nheader = 2) - ) - vwc_dy_nrsc <- vwcmatric.dy.all - - if (opt_agg[["NRCS_SMTRs"]][["aggregate_at"]] == "data") { - # Aggregate SOILWAT2 output to mean conditions before determining conditions and regimes - soiltemp_nrsc <- list( - yr = list(data = matrix(colMeans(soiltemp_nrsc[["yr"]][["data"]]), nrow = 1), - nheader = soiltemp_nrsc[["yr"]][["nheader"]]), - mo = list(data = stats::aggregate(soiltemp_nrsc[["mo"]][["data"]], - by = list(simTime2$month_ForEachUsedMonth[st_NRCS[["i_mo_used"]]]), mean)[, -1], - nheader = soiltemp_nrsc[["mo"]][["nheader"]]), - dy = list(data = stats::aggregate(soiltemp_nrsc[["dy"]][["data"]], - by = list(simTime2$doy_ForEachUsedDay[st_NRCS[["i_dy_used"]]]), mean)[, -1], - nheader = soiltemp_nrsc[["dy"]][["nheader"]]) - ) - vwc_dy_nrsc <- lapply(vwcmatric.dy.all, function(x) - stats::aggregate(as.matrix(x)[isim_time$index.usedy[st_NRCS[["i_dy_used"]]], ], - list(simTime2$doy_ForEachUsedDay[st_NRCS[["i_dy_used"]]]), mean)[, -1]) - - temp <- dim(vwc_dy_nrsc$val)[1] - st_NRCS <- c(st_NRCS, list( - index_usedy = seq_len(temp), - month_ForMonth = SFSW2_glovars[["st_mo"]], - yearno_ForMonth = rep(1, 12), - doy_ForDay = seq_len(temp) - )) - # adjust st_NRCS for the aggregation - st_NRCS <- utils::modifyList(st_NRCS, list( - yr_used = 1, - N_yr_used = 1, - i_yr_used = 1, - i_mo_used = SFSW2_glovars[["st_mo"]], - i_dy_used = rep(TRUE, temp), - N_dy_used = temp, - days_per_yr_used = temp)) - - wateryears <- rep(1, temp) - wyears <- 1 - - } else { - # Determine regimes based on time-series output and then determine conditions and regime - st_NRCS <- c(st_NRCS, list( - index_usedy = isim_time$index.usedy[st_NRCS[["i_dy_used"]]], - month_ForMonth = simTime2$month_ForEachUsedMonth_NSadj[st_NRCS[["i_mo_used"]]], - yearno_ForMonth = simTime2$yearno_ForEachUsedMonth_NSadj[st_NRCS[["i_mo_used"]]], - doy_ForDay = simTime2$doy_ForEachUsedDay_NSadj[st_NRCS[["i_dy_used"]]] - )) - } - - #Required soil layers - soildat <- rSOILWAT2::swSoils_Layers(swRunScenariosData[[sc]])[, c("depth_cm", "sand_frac", "clay_frac", "impermeability_frac"), drop = FALSE] - #TODO: adjust this once TOC is incorporated into rSOILWAT2 - soildat <- cbind(soildat, soil_TOC) - #50cm soil depth or impermeable layer (whichever is shallower; Soil Survey Staff 2014: p.31) - imp_depth <- which(soildat[, "impermeability_frac"] >= opt_agg[["NRCS_SMTRs"]][["impermeability"]]) - imp_depth <- min(imp_depth, max(soildat[, "depth_cm"])) #Interpret maximum soil depth as possible impermeable layer - Fifty_depth <- min(50, imp_depth) - - #Definition of MCS (Soil Survey Staff 2014: p.29): The moisture control section (MCS) of a soil: the depth to which a dry (tension of more than 1500 kPa, but not air-dry) soil will be moistened by 2.5 cm of water within 24 hours. The lower boundary is the depth to which a dry soil will be moistened by 7.5 cm of water within 48 hours. - sand_temp <- stats::weighted.mean(sand, layers_width) - clay_temp <- stats::weighted.mean(clay, layers_width) - #Practical depth definition of MCS - # - 10 to 30 cm below the soil surface if the particle-size class of the soil is fine-loamy, coarse-silty, fine-silty, or clayey - # - 20 to 60 cm if the particle-size class is coarse-loamy - # - 30 to 90 cm if the particle-size class is sandy. - MCS_depth <- if (clay_temp >= 0.18) { c(10, 30) - } else if (sand_temp < 0.15) { c(10, 30) - } else if (sand_temp >= 0.50) { c(30, 90) - } else c(20, 60) - #If 7.5 cm of water moistens the soil to a densic, lithic, paralithic, or petroferric contact or to a petrocalcic or petrogypsic horizon or a duripan, the contact or the upper boundary of the cemented horizon constitutes the lower boundary of the soil moisture control section. If a soil is moistened to one of these contacts or horizons by 2.5 cm of water, the soil moisture control section is the boundary of the contact itself. The control section of such a soil is considered moist if the contact or upper boundary of the cemented horizon has a thin film of water. If that upper boundary is dry, the control section is considered dry. - - MCS_depth <- adjustLayer_byImp(depths = MCS_depth, imp_depth = imp_depth, - sdepths = soildat[, "depth_cm"]) - - #Soil layer 10-70 cm used for anhydrous layer definition; adjusted for impermeable layer - Lanh_depth <- adjustLayer_byImp(depths = c(10, 70), imp_depth = imp_depth, - sdepths = soildat[, "depth_cm"]) - - #Permafrost (Soil Survey Staff 2014: p.28) is defined as a thermal condition in which a material (including soil material) remains below 0 C for 2 or more years in succession - permafrost_yrs <- max(apply(soiltemp.yr.all$val[isim_time$index.useyr, -1, drop = FALSE], 2, function(x) { - temp <- rle(x < 0) - if (any(temp$values)) max(temp$lengths[temp$values]) else 0L - })) - - has_notenough_normalyears <- FALSE - if (SMR_normalyears_N > 0) { - temp_annual <- temp_annual[st_NRCS[["i_yr_used"]], , drop = FALSE] - - #Set soil depths and intervals accounting for shallow soil profiles: Soil Survey Staff 2014: p.31) - ##Calculate soil temperature at necessary depths using a weighted mean - i_depth50 <- findInterval(Fifty_depth, soildat[, "depth_cm"]) - calc50 <- !(Fifty_depth == soildat[i_depth50, "depth_cm"]) - if (calc50) { - weights50 <- calc_weights_from_depths(i_depth50, Fifty_depth, soildat[, "depth_cm"]) - soildat <- t(add_layer_to_soil(t(soildat), i_depth50, weights50)) - i_depth50 <- findInterval(Fifty_depth, soildat[, "depth_cm"]) - - soiltemp_nrsc <- lapply(soiltemp_nrsc, function(st) - list(data = add_layer_to_soil(st[["data"]], st[["nheader"]] + i_depth50, weights50), - nheader = st[["nheader"]])) - vwc_dy_nrsc$val <- add_layer_to_soil(vwc_dy_nrsc$val, 2 + i_depth50, weights50) - rm(weights50) - } - - i_MCS <- findInterval(MCS_depth, soildat[, "depth_cm"]) - calcMCS <- !(MCS_depth == soildat[i_MCS, "depth_cm"]) - if (any(calcMCS)) for (k in which(calcMCS)) { - weightsMCS <- calc_weights_from_depths(i_MCS[k], MCS_depth[k], soildat[, "depth_cm"]) - soildat <- t(add_layer_to_soil(t(soildat), i_MCS[k], weightsMCS)) - i_MCS <- findInterval(MCS_depth, soildat[, "depth_cm"]) - - soiltemp_nrsc <- lapply(soiltemp_nrsc, function(st) - list(data = add_layer_to_soil(st[["data"]], st[["nheader"]] + i_MCS[k], weightsMCS), - nheader = st[["nheader"]])) - vwc_dy_nrsc$val <- add_layer_to_soil(vwc_dy_nrsc$val, 2 + i_MCS[k], weightsMCS) - rm(weightsMCS) - } - - i_Lanh <- findInterval(Lanh_depth, soildat[, "depth_cm"]) - calcLanh <- !(Lanh_depth == soildat[i_Lanh, "depth_cm"]) - if (any(calcLanh)) for (k in which(calcLanh)) { - weightsLanh <- calc_weights_from_depths(i_Lanh[k], Lanh_depth[k], soildat[, "depth_cm"]) - soildat <- t(add_layer_to_soil(t(soildat), i_Lanh[k], weightsLanh)) - i_Lanh <- findInterval(Lanh_depth, soildat[, "depth_cm"]) - - soiltemp_nrsc <- lapply(soiltemp_nrsc, function(st) - list(data = add_layer_to_soil(st[["data"]], st[["nheader"]] + i_Lanh[k], weightsLanh), - nheader = st[["nheader"]])) - vwc_dy_nrsc$val <- add_layer_to_soil(vwc_dy_nrsc$val, 2 + i_Lanh[k], weightsLanh) - rm(weightsLanh) - } - - soiltemp_nrsc <- lapply(soiltemp_nrsc, function(st) st[["data"]]) - - swp_recalculate <- calc50 || any(calcMCS) || any(calcLanh) - if (swp_recalculate) { - soilLayers_N_NRCS <- dim(soildat)[1] - - if (opt_verbosity[["verbose"]]) - print(paste0(tag_simpidfid, ": interpolated soil layers for NRCS soil ", - "regimes because of insufficient soil layers: required would be {", - paste(sort(unique(c(Fifty_depth, MCS_depth, Lanh_depth))), - collapse = ", "), "} and available are {", - paste(layers_depth, collapse = ", "), "}")) - } else { - soilLayers_N_NRCS <- soilLayers_N - } - - swp_dy_nrsc <- if (swp_recalculate || opt_agg[["NRCS_SMTRs"]][["aggregate_at"]] == "data") { - get_SWPmatric_aggL(vwc_dy_nrsc, texture = texture, - sand = soildat[, "sand_frac"], clay = soildat[, "clay_frac"]) - } else { - swpmatric.dy.all - } - swp_dy_nrsc <- swp_dy_nrsc$val[st_NRCS[["index_usedy"]], -(1:2), drop = FALSE] - - #MCS (Soil Survey Staff 2014: p.29) - #What soil layer info used for MCS - i_MCS <- identify_soillayers(MCS_depth, soildat[, "depth_cm"]) - #Repeat for Anhydrous soil layer moisture delineation - i_Lanh <- identify_soillayers(Lanh_depth, soildat[, "depth_cm"]) - - #mean soil temperature in Lahn depths (10 - 70 cm) - temp_annual[, "MATLanh"] <- apply(soiltemp_nrsc[["yr"]][, 1 + i_Lanh, drop = FALSE], 1, - stats::weighted.mean, w = soildat[i_Lanh, "depth_cm"]) - - #---Calculate variables - crit_agree <- opt_agg[["NRCS_SMTRs"]][["crit_agree_frac"]] * st_NRCS[["N_yr_used"]] - - #mean soil temperatures at 50cm depth - temp_annual[, "MAT50"] <- soiltemp_nrsc[["yr"]][, 1 + i_depth50] - temp <- soiltemp_nrsc[["mo"]][, 2 + i_depth50][st_NRCS[["month_ForMonth"]] %in% 6:8] - temp_annual[, "T50jja"] <- apply(matrix(temp, ncol = st_NRCS[["N_yr_used"]]), 2, mean) - temp <- soiltemp_nrsc[["mo"]][, 2 + i_depth50][st_NRCS[["month_ForMonth"]] %in% c(12, 1:2)] - temp_annual[, "T50djf"] <- apply(matrix(temp, ncol = st_NRCS[["N_yr_used"]]), 2, mean) - T50 <- soiltemp_nrsc[["dy"]][, 2 + i_depth50] - # offset between soil and air temperature - fc <- temp.mo$mean[st_NRCS[["i_mo_used"]]] - soiltemp_nrsc[["mo"]][, 2 + i_depth50] - temp_annual[, "meanTair_Tsoil50_offset_C"] <- tapply(fc, - st_NRCS[["yearno_ForMonth"]], mean) - - #CSPartSummer: Is the soil saturated with water during some part of the summer June1 ( = regular doy 244) - Aug31 ( = regular doy 335) - isummer <- st_NRCS[["doy_ForDay"]] >= 244 & st_NRCS[["doy_ForDay"]] <= 335 - temp_annual[, "CSPartSummer"] <- vapply(st_NRCS[["yr_used"]], function(yr) { - temp <- apply(swp_dy_nrsc[wateryears[st_NRCS[["i_dy_used"]]] == yr & isummer, , drop = FALSE], 1, - function(x) all(x >= opt_agg[["NRCS_SMTRs"]][["SWP_sat"]])) - rtemp <- rle(temp) - if (any(rtemp$values)) max(rtemp$lengths[rtemp$values]) else 0 - }, FUN.VALUE = NA_real_) - - # "saturated with water for X cumulative days in normal years" - days_saturated_layers <- vapply(st_NRCS[["yr_used"]], function(yr) { - apply(swp_dy_nrsc[wateryears[st_NRCS[["i_dy_used"]]] == yr, , drop = FALSE], 2, - function(x) sum(x >= opt_agg[["NRCS_SMTRs"]][["SWP_sat"]])) - }, FUN.VALUE = rep(NA_real_, soilLayers_N_NRCS)) - if (!is.matrix(days_saturated_layers)) { - days_saturated_layers <- matrix(days_saturated_layers, - nrow = soilLayers_N_NRCS, ncol = st_NRCS[["N_yr_used"]]) - } - - somCOND0 <- t(days_saturated_layers) >= 30 - #if (opt_agg[["NRCS_SMTRs"]][["aggregate_at"]] == "conditions") { - somCOND0 <- matrix(colSums(somCOND0), nrow = 1, ncol = soilLayers_N_NRCS) >= - crit_agree - #} - - # Organic versus mineral soil material per layer - organic_carbon_wfraction <- soildat[, "soil_TOC"] / 1000 # units(TOC) = g C / kg soil - - is_mineral_layer <- (!somCOND0 & organic_carbon_wfraction < 0.2) | - (somCOND0 & - (soildat[, "clay_frac"] >= 0.6 & organic_carbon_wfraction < 0.18) | - (organic_carbon_wfraction < 0.12 + 0.1 * soildat[, "clay_frac"])) - - # determine presence of O horizon - # TODO: guess (critical levels 'crit_Oh' are made up and not based on data): - # O-horizon if 50% trees or 75% shrubs or lots of litter - crit_Oh <- c(0.5, 0.75, 0.8) - veg_comp <- rSOILWAT2::swProd_Composition(swRunScenariosData[[sc]])[1:4] - - temp <- cbind(rSOILWAT2::swProd_MonProd_grass(swRunScenariosData[[sc]])[, "Litter"], - rSOILWAT2::swProd_MonProd_shrub(swRunScenariosData[[sc]])[, "Litter"], - rSOILWAT2::swProd_MonProd_tree(swRunScenariosData[[sc]])[, "Litter"], - rSOILWAT2::swProd_MonProd_forb(swRunScenariosData[[sc]])[, "Litter"]) - - veg_litter <- mean(apply(sweep(temp, 2, veg_comp, "*"), 1, sum)) - crit_litter <- crit_Oh[3] * - sum(rSOILWAT2::swProd_Es_param_limit(swRunScenariosData[[sc]]) * veg_comp) - - has_Ohorizon <- (veg_litter >= crit_litter) && - if (!is.finite(is_mineral_layer[1])) { - veg_comp["Trees"] > crit_Oh[1] || veg_comp["Shrubs"] > crit_Oh[2] - } else { - !is_mineral_layer[1] - } - - #---Soil temperature regime: based on Soil Survey Staff 2014 (Key to Soil Taxonomy): p.31 - #we ignore distinction between iso- and not iso- - icol <- c("MAT50", "T50jja", "CSPartSummer") - stCONDs <- temp_annual[, icol, drop = FALSE] - if (opt_agg[["NRCS_SMTRs"]][["aggregate_at"]] == "conditions") { - temp <- colMeans(stCONDs) - temp["CSPartSummer"] <- temp["CSPartSummer"] > - opt_agg[["NRCS_SMTRs"]][["crit_agree_frac"]] - stCONDs <- matrix(temp, nrow = 1, ncol = length(icol), - dimnames = list(NULL, icol)) - } - has_permafrost <- permafrost_yrs >= 2 - - SMTR[["STR"]] <- t(apply(stCONDs, 1, function(x) - STR_logic(MAST = x["MAT50"], MSST = x["T50jja"], - SatSoilSummer_days = x["CSPartSummer"], - has_permafrost = has_permafrost, has_Ohorizon = has_Ohorizon))) - - - if (SMR_normalyears_N > 2) { - #Structures used Lanh delineation - #Days are moists in half of the Lanh soil depth (and not soil layers!) - n_Lanh <- length(i_Lanh) - width_Lanh <- diff(c(0, soildat[, "depth_cm"]))[i_Lanh] # stopifnot(sum(width_Lanh) == Lanh_depth[2] - Lanh_depth[1]) - temp <- swp_dy_nrsc[, i_Lanh, drop = FALSE] > opt_agg[["NRCS_SMTRs"]][["SWP_dry"]] - temp <- temp * matrix(width_Lanh, nrow = st_NRCS[["N_dy_used"]], ncol = length(i_Lanh), byrow = TRUE) - Lanh_Dry_Half <- .rowSums(temp, m = st_NRCS[["N_dy_used"]], n = n_Lanh) <= sum(width_Lanh) / 2 - - #Conditions for Anhydrous soil delineation - ACS_CondsDF_day <- data.frame( - Years = rep(st_NRCS[["yr_used"]], st_NRCS[["days_per_yr_used"]]), - T50_at0C = T50 > 0, # days where T @ 50 is > 0 C - Lanh_Dry_Half = Lanh_Dry_Half - ) - ACS_CondsDF_yrs <- data.frame( - Years = st_NRCS[["yr_used"]], - MAT50 = temp_annual[, "MAT50"], - MATLanh = temp_annual[, "MATLanh"] - ) - - #Mean Annual soil temperature is less than or equal to 0C - ACS_CondsDF_yrs$COND1 <- ACS_CondsDF_yrs$MAT50 <= 0 - #Soil temperature in the Lahn Depth is never greater than 5 - ACS_CondsDF_day$COND2_Test <- apply(soiltemp_nrsc[["dy"]][, 1 + i_Lanh, drop = FALSE], - 1, function(st) all(st < 5)) - ACS_CondsDF_yrs$COND2 <- with(ACS_CondsDF_day, - tapply(COND2_Test, Years, all)) - #In the Lahn Depth, 1/2 of soil dry > 1/2 CUMULATIVE days when Mean Annual ST > 0C - ACS_CondsDF_day$COND3_Test <- with(ACS_CondsDF_day, - Lanh_Dry_Half == T50_at0C) #TRUE = where are both these conditions met - ACS_CondsDF_yrs$HalfDryDaysCumAbove0C <- with(ACS_CondsDF_day, - tapply(COND3_Test, Years, sum)) - ACS_CondsDF_yrs$SoilAbove0C <- with(ACS_CondsDF_day, - tapply(T50_at0C, Years, sum)) - ACS_CondsDF_yrs$COND3 <- with(ACS_CondsDF_yrs, - HalfDryDaysCumAbove0C > .5 * SoilAbove0C) #TRUE = Half of soil layers are dry greater than half the days where MAST >0c - - icol <- c('COND1', 'COND2', 'COND3') - icol_new <- paste0("ACS_", icol) - ACS_CondsDF3 <- as.matrix(ACS_CondsDF_yrs[, icol, drop = FALSE]) - if (opt_agg[["NRCS_SMTRs"]][["aggregate_at"]] == "conditions") { - temp <- matrix(colSums(ACS_CondsDF3, na.rm = TRUE), nrow = 1, - ncol = length(icol), dimnames = list(NULL, icol_new)) - ACS_CondsDF3 <- temp >= crit_agree - } else { - dimnames(ACS_CondsDF3)[[2]] <- icol_new - } - - #Structures used for MCS delineation - MCS_CondsDF_day <- data.frame( - Years = rep(st_NRCS[["yr_used"]], st_NRCS[["days_per_yr_used"]]), - DOY = st_NRCS[["doy_ForDay"]], - T50_at5C = T50 > 5, # days where T @ 50cm exceeds 5C - T50_at8C = T50 > 8, # days where T @ 50cm exceeds 8C - MCS_Moist_All = apply(swp_dy_nrsc[, i_MCS, drop = FALSE] > opt_agg[["NRCS_SMTRs"]][["SWP_dry"]], 1, all), - MCS_Dry_All = apply(swp_dy_nrsc[, i_MCS, drop = FALSE] < opt_agg[["NRCS_SMTRs"]][["SWP_dry"]], 1, all) - ) - MCS_CondsDF_yrs <- data.frame( - Years = st_NRCS[["yr_used"]], - MAT50 = temp_annual[, "MAT50"], - T50jja = temp_annual[, "T50jja"], - T50djf = temp_annual[, "T50djf"] - ) - - #COND0 - monthly PET < PPT - MCS_CondsDF_yrs$COND0 <- if (opt_agg[["NRCS_SMTRs"]][["aggregate_at"]] == "data") { - all(tapply(prcp.mo$ppt - pet.mo$val, - simTime2$month_ForEachUsedMonth, mean) > 0) - } else { - tapply(prcp.mo$ppt > pet.mo$val, - simTime2$yearno_ForEachUsedMonth, all)[st_NRCS[["i_yr_used"]]] - } - - #COND1 - Dry in ALL parts for more than half of the CUMULATIVE days per year when the soil temperature at a depth of 50cm is above 5C - MCS_CondsDF_day$COND1_Test <- with(MCS_CondsDF_day, - MCS_Dry_All & T50_at5C) #TRUE = where are both these conditions met - MCS_CondsDF_yrs$DryDaysCumAbove5C <- with(MCS_CondsDF_day, - tapply(COND1_Test, Years, sum)) - MCS_CondsDF_yrs$SoilAbove5C <- with(MCS_CondsDF_day, - tapply(T50_at5C, Years, sum)) - MCS_CondsDF_yrs$COND1 <- with(MCS_CondsDF_yrs, - DryDaysCumAbove5C > .5 * SoilAbove5C) #TRUE =Soils are dry greater than 1/2 cumulative days/year - - #Cond2 - Moist in SOME or all parts for less than 90 CONSECUTIVE days when the the soil temperature at a depth of 50cm is above 8C - MCS_CondsDF_day$COND2_Test <- with(MCS_CondsDF_day, - !MCS_Dry_All & T50_at8C) #TRUE = where are both these conditions met - MCS_CondsDF_yrs$MaxContDaysAnyMoistCumAbove8 <- with(MCS_CondsDF_day, - tapply(COND2_Test, Years, max_duration)) # Maximum consecutive days - MCS_CondsDF_yrs$COND2 <- MCS_CondsDF_yrs$MaxContDaysAnyMoistCumAbove8 < 90 # TRUE = moist less than 90 consecutive days during >8 C soils, FALSE = moist more than 90 consecutive days - MCS_CondsDF_yrs$COND2_1 <- MCS_CondsDF_yrs$MaxContDaysAnyMoistCumAbove8 < 180 - MCS_CondsDF_yrs$COND2_2 <- MCS_CondsDF_yrs$MaxContDaysAnyMoistCumAbove8 < 270 - MCS_CondsDF_yrs$COND2_3 <- MCS_CondsDF_yrs$MaxContDaysAnyMoistCumAbove8 <= 45 - - #COND3 - MCS is Not dry in ANY part as long as 90 CUMULATIVE days - Can't be dry longer than 90 cum days - MCS_CondsDF_yrs$DryDaysCumAny <- with(MCS_CondsDF_day, - tapply(!MCS_Moist_All, Years, sum)) #Number of days where any soils are dry - MCS_CondsDF_yrs$COND3 <- MCS_CondsDF_yrs$DryDaysCumAny < 90 #TRUE = Not Dry for as long 90 cumlative days, FALSE = Dry as long as as 90 Cumlative days - MCS_CondsDF_yrs$COND3_1 <- MCS_CondsDF_yrs$DryDaysCumAny < 30 - - #COND4 - The means annual soil temperature at 50cm is < or > 22C - MCS_CondsDF_yrs$COND4 <- MCS_CondsDF_yrs$MAT50 >= 22 #TRUE - Greater than 22, False - Less than 22 - - #COND5 - The absolute difference between the temperature in winter @ 50cm and the temperature in summer @ 50cm is > or < 6 - MCS_CondsDF_yrs$AbsDiffSoilTemp_DJFvsJJA <- with(MCS_CondsDF_yrs, - abs(T50djf - T50jja)) - MCS_CondsDF_yrs$COND5 <- MCS_CondsDF_yrs$AbsDiffSoilTemp_DJFvsJJA >= 6 #TRUE - Greater than 6, FALSE - Less than 6 - - #COND6 - Dry in ALL parts LESS than 45 CONSECUTIVE days in the 4 months following the summer solstice - temp <- with(MCS_CondsDF_day[MCS_CondsDF_day$DOY %in% c(172:293), ], - tapply(MCS_Dry_All, Years, max_duration)) #Consecutive days of dry soil after summer solsitice - ids <- match( MCS_CondsDF_yrs[, "Years"], as.integer(names(temp)), - nomatch = 0) - MCS_CondsDF_yrs[ids > 0, "DryDaysConsecSummer"] <- temp[ids] - MCS_CondsDF_yrs$COND6 <- MCS_CondsDF_yrs$DryDaysConsecSummer < 45 # TRUE = dry less than 45 consecutive days - MCS_CondsDF_yrs$COND6_1 <- MCS_CondsDF_yrs$DryDaysConsecSummer > 90 - - #COND7 - MCS is MOIST in SOME parts for more than 180 CUMULATIVE days - MCS_CondsDF_yrs$MoistDaysCumAny <- with(MCS_CondsDF_day, - tapply(!MCS_Dry_All, Years, sum))#Number of days where any soils are moist - MCS_CondsDF_yrs$COND7 <- MCS_CondsDF_yrs$MoistDaysCumAny > 180 #TRUE = Not Dry or Moist for as long 180 cumlative days - - #Cond8 - MCS is MOIST in SOME parts for more than 90 CONSECUTIVE days - MCS_CondsDF_yrs$MoistDaysConsecAny <- with(MCS_CondsDF_day, tapply(!MCS_Dry_All, Years, max_duration)) #Consecutive days of Moist soil - MCS_CondsDF_yrs$COND8 <- MCS_CondsDF_yrs$MoistDaysConsecAny > 90 # TRUE = Moist more than 90 Consecutive Days - - #COND9 - Moist in ALL parts MORE than 45 CONSECUTIVE days in the 4 months following the winter solstice - temp <- with(MCS_CondsDF_day[MCS_CondsDF_day$DOY %in% c(355:365, 1:111), ], - tapply(MCS_Moist_All, Years, max_duration))#Consecutive days of moist soil after winter solsitice - ids <- match( MCS_CondsDF_yrs[, "Years"], as.integer(names(temp)), - nomatch = 0) - MCS_CondsDF_yrs[ids > 0, "MoistDaysConsecWinter"] <- temp[ids] - MCS_CondsDF_yrs$COND9 <- MCS_CondsDF_yrs$MoistDaysConsecWinter > 45 # TRUE = moist more than 45 consecutive days - - #COND10 - MCS is Dry in ALL layers for more or equal to 360 days - MCS_CondsDF_yrs$AllDryDaysCumAny <- with(MCS_CondsDF_day, - tapply(MCS_Dry_All, Years, sum)) #Number of days where all soils are dry - MCS_CondsDF_yrs$COND10 <- MCS_CondsDF_yrs$AllDryDaysCumAny >= 360 - - icol <- c('COND0', 'COND1', 'COND2', 'COND2_1', 'COND2_2', 'COND2_3', - 'COND3', 'COND3_1', 'COND4', 'COND5', 'COND6', 'COND6_1', 'COND7', - 'COND8', 'COND9', 'COND10') - icol_new <- paste0("MCS_", icol) - MCS_CondsDF3 <- as.matrix(MCS_CondsDF_yrs[, icol, drop = FALSE]) - if (opt_agg[["NRCS_SMTRs"]][["aggregate_at"]] == "conditions") { - temp <- matrix(colSums(MCS_CondsDF3, na.rm = TRUE), - nrow = 1, ncol = length(icol), dimnames = list(NULL, icol_new)) - MCS_CondsDF3 <- temp >= crit_agree - } else { - dimnames(MCS_CondsDF3)[[2]] <- icol_new - } - - - #---Soil moisture regime: Soil Survey Staff 2014 (Key to Soil Taxonomy): p.28-31 - SMTR[["SMR"]] <- t(apply(cbind(ACS_CondsDF3, MCS_CondsDF3), 1, - function(x) do.call(SMR_logic, args = c(as.list(x), - list(has_permafrost = has_permafrost))))) - - temp_annual[, 7:14] <- as.matrix(cbind(ACS_CondsDF_yrs - [, c("COND1", "COND2", "COND3", "HalfDryDaysCumAbove0C", "SoilAbove0C")], - stats::aggregate(ACS_CondsDF_day[, c('T50_at0C', 'Lanh_Dry_Half', 'COND3_Test')], - by = list(ACS_CondsDF_day$Years), mean)[, -1])) - - dtemp <- stats::aggregate(MCS_CondsDF_day[, c("T50_at5C", "T50_at8C", - "MCS_Moist_All", "COND1_Test", "COND2_Test")], - by = list(MCS_CondsDF_day$Years), mean)[, -1] - icols_conds <- c("COND0", - "DryDaysCumAbove5C", "SoilAbove5C", "COND1", - "MaxContDaysAnyMoistCumAbove8", "COND2", "COND2_1", "COND2_2", "COND2_3", - "DryDaysCumAny", "COND3", "COND3_1", - "COND4", - "AbsDiffSoilTemp_DJFvsJJA", "COND5", - "DryDaysConsecSummer", "COND6", "COND6_1", - "MoistDaysCumAny", "COND7", - "MoistDaysConsecAny", "COND8", - "MoistDaysConsecWinter", "COND9", - "AllDryDaysCumAny", "COND10") - temp_annual[, 15:45] <- as.matrix(cbind(MCS_CondsDF_yrs[, icols_conds], - dtemp)) - - regimes_done <- TRUE - - to_del <- c("n_Lanh", "width_Lanh", "Lanh_Dry_Half", "ACS_CondsDF_day", - "ACS_CondsDF_yrs", "ACS_CondsDF3", "MCS_CondsDF_day", "MCS_CondsDF_yrs", - "MCS_CondsDF3") - #to_del <- to_del[to_del %in% ls()] - if (length(to_del) > 0) - try(rm(list = to_del), silent = TRUE) + print_debug(opt_verbosity, tag_simpidfid, "aggregating", + "dailyNRCS_SoilMoistureTemperatureRegimes") - } else { - has_notenough_normalyears <- TRUE - SMTR[["SMR"]][] <- NA - } - - to_del <- c("calc50", "calcLanh", "calcMCS", "clay_temp", - "i_depth50", "i_Lanh", "i_MCS", "imp_depth", "isummer", - "sand_temp", "soildat", "soiltemp_nrsc", "st_NRCS", "swp_dy_nrsc", - "vwc_dy_nrsc", "wateryears", "wyears") - #to_del <- to_del[to_del %in% ls()] - if (length(to_del) > 0) { - try(rm(list = to_del), silent = TRUE) - } - - } else { - SMTR[["STR"]][] <- SMTR[["SMR"]][] <- NA - has_notenough_normalyears <- TRUE - } - - if (has_notenough_normalyears) { - if (opt_verbosity[["verbose"]]) { - print(paste0(tag_simpidfid, ": number of normal years is ", - SMR_normalyears_N, " which is insufficient to calculate ", - "NRCS soil moisture", if (SMR_normalyears_N <= 0) "/temperature", - " regimes.")) - } - } - - } else { - if (opt_verbosity[["verbose"]]) { - print(paste0(tag_simpidfid, ": has unrealistic soil temperature values: ", - "NRCS soil moisture/temperature regimes not calculated.")) - } - SMTR[["STR"]][] <- SMTR[["SMR"]][] <- NA - has_realistic_SoilTemp <- 0 - } - - } else { - if (opt_verbosity[["verbose"]]) { - print(paste0(tag_simpidfid, ": soil temperature module turned off but ", - "required for NRCS Soil Moisture/Temperature Regimes.")) - } - SMTR[["STR"]][] <- SMTR[["SMR"]][] <- NA - has_simulated_SoilTemp <- 0 - } + if (!exists("soiltemp.dy.all")) soiltemp.dy.all <- get_Response_aggL(swof["sw_soiltemp"], tscale = "dyAll", scaler = 1, FUN = stats::weighted.mean, weights = layers_width, x = runDataSC, st = isim_time, st2 = simTime2, topL = topL, bottomL = bottomL) + if (!exists("soiltemp.yr.all")) soiltemp.yr.all <- get_Response_aggL(swof["sw_soiltemp"], tscale = "yrAll", scaler = 1, FUN = stats::weighted.mean, weights = layers_width, x = runDataSC, st = isim_time, st2 = simTime2, topL = topL, bottomL = bottomL) + if (!exists("soiltemp.mo.all")) soiltemp.mo.all <- get_Response_aggL(swof["sw_soiltemp"], tscale = "moAll", scaler = 1, FUN = stats::weighted.mean, weights = layers_width, x = runDataSC, st = isim_time, st2 = simTime2, topL = topL, bottomL = bottomL) + if (!exists("vwcmatric.dy.all")) vwcmatric.dy.all <- get_Response_aggL(swof["sw_vwcmatric"], tscale = "dyAll", scaler = 1, FUN = stats::weighted.mean, weights = layers_width, x = runDataSC, st = isim_time, st2 = simTime2, topL = topL, bottomL = bottomL) + if (!exists("swpmatric.dy.all")) swpmatric.dy.all <- get_SWPmatric_aggL(vwcmatric.dy.all, texture, sand, clay) + if (!exists("prcp.yr")) prcp.yr <- get_PPT_yr(runDataSC, isim_time) + if (!exists("prcp.mo")) prcp.mo <- get_PPT_mo(runDataSC, isim_time) + if (!exists("pet.mo")) pet.mo <- get_PET_mo(runDataSC, isim_time) + if (!exists("temp.mo")) temp.mo <- get_Temp_mo(runDataSC, isim_time) + sim_agg <- list( + soiltemp.dy.all = soiltemp.dy.all, + soiltemp.yr.all = soiltemp.yr.all, + soiltemp.mo.all = soiltemp.mo.all, + vwcmatric.dy.all = vwcmatric.dy.all, + swpmatric.dy.all = swpmatric.dy.all, + prcp.yr = prcp.yr, + prcp.mo = prcp.mo, + pet.mo = pet.mo, + temp.mo = temp.mo + ) + + SMTR <- rSOILWAT2::calc_SMTRs( + sim_in = swRunScenariosData[[sc]], sim_agg = sim_agg, + soil_TOC = soil_TOC, + has_soil_temperature = isTRUE(!is_SOILTEMP_INSTABLE[sc]), + opt_SMTR = opt_agg[["NRCS_SMTRs"]], + simTime1 = isim_time, simTime2 = simTime2, + verbose = opt_verbosity[["verbose"]], msg_tag = tag_simpidfid) if (isTRUE(prj_todos[["aon"]][["dailyNRCS_SoilMoistureTemperatureRegimes_Intermediates"]])) { nv01 <- nv nv_new <- nv + 10 - resMeans[nv:(nv_new - 1)] <- c(has_simulated_SoilTemp, has_realistic_SoilTemp, - Fifty_depth, MCS_depth[1:2], Lanh_depth[1:2], - permafrost_yrs, SMR_normalyears_N, as.integer(has_Ohorizon)) + resMeans[nv:(nv_new - 1)] <- c(SMTR[["has_simulated_SoilTemp"]], + SMTR[["has_realistic_SoilTemp"]], SMTR[["Fifty_depth"]], + SMTR[["MCS_depth"]][1:2], SMTR[["Lanh_depth"]][1:2], + SMTR[["permafrost_yrs"]], SMTR[["SMR_normalyears_N"]], + as.integer(SMTR[["has_Ohorizon"]])) nv <- nv_new - nv_new <- nv + dim(temp_annual)[2] - resMeans[nv:(nv_new - 1)] <- t(apply(temp_annual, 2, mean, na.rm = TRUE)) - resSDs[nv:(nv_new - 1)] <- t(apply(temp_annual, 2, stats::sd, na.rm = TRUE)) + + nv_new <- nv + dim(SMTR[["cond_annual"]])[2] + resMeans[nv:(nv_new - 1)] <- t(apply(SMTR[["cond_annual"]], 2, + mean, na.rm = TRUE)) + resSDs[nv:(nv_new - 1)] <- t(apply(SMTR[["cond_annual"]], 2, + stats::sd, na.rm = TRUE)) nv <- nv_new - print_debugN(opt_verbosity, tag_simpidfid, prj_todos, nv - nv01, "dailyNRCS_SoilMoistureTemperatureRegimes_Intermediates") + stopifnot(nv - nv01 == + prj_todos[["aon_fields"]]["dailyNRCS_SoilMoistureTemperatureRegimes_Intermediates", "N"]) + print_debugN(opt_verbosity, tag_simpidfid, prj_todos, nv - nv01, + "dailyNRCS_SoilMoistureTemperatureRegimes_Intermediates") } Tregime <- colMeans(SMTR[["STR"]]) @@ -3858,140 +3338,58 @@ do_OneSite <- function(i_sim, i_SWRunInformation, i_sw_input_soillayers, if (isTRUE(prj_todos[["aon"]][["dailyNRCS_SoilMoistureTemperatureRegimes"]])) { nv02 <- nv - nv_new <- nv + length(Tregime) - resMeans[nv:(nv_new - 1)] <- Tregime - nv <- nv_new - nv_new <- nv + length(Sregime) - resMeans[nv:(nv_new - 1)] <- Sregime + nv_new <- nv + prj_todos[["aon_fields"]]["dailyNRCS_SoilMoistureTemperatureRegimes", "N"] + resMeans[nv:(nv_new - 1)] <- c(Tregime, Sregime) nv <- nv_new - print_debugN(opt_verbosity, tag_simpidfid, prj_todos, nv - nv02, "dailyNRCS_SoilMoistureTemperatureRegimes") + print_debugN(opt_verbosity, tag_simpidfid, prj_todos, nv - nv02, + "dailyNRCS_SoilMoistureTemperatureRegimes") } Tregime <- Tregime >= opt_agg[["NRCS_SMTRs"]][["crit_agree_frac"]] Sregime <- Sregime >= opt_agg[["NRCS_SMTRs"]][["crit_agree_frac"]] - to_del <- c("MCS_depth", "Lanh_depth", "Fifty_depth", "permafrost_yrs", - "SMTR", "SMR_normalyears_N", "temp_annual") - #to_del <- to_del[to_del %in% ls()] - if (length(to_del) > 0) - try(rm(list = to_del), silent = TRUE) + rm(SMTR) } - #35b #Based on Table 1 in Chambers, J. C., D. A. Pyke, J. D. Maestas, M. Pellant, C. S. Boyd, S. B. Campbell, S. Espinosa, D. W. Havlina, K. E. Mayer, and A. Wuenschel. 2014. Using Resistance and Resilience Concepts to Reduce Impacts of Invasive Annual Grasses and Altered Fire Regimes on the Sagebrush Ecosystem and Greater Sage-Grouse: A Strategic Multi-Scale Approach. Gen. Tech. Rep. RMRS-GTR-326. U.S. Department of Agriculture, Forest Service, Rocky Mountain Research Station, Fort Collins, CO. + #35b #Requires "dailyNRCS_SoilMoistureTemperatureRegimes" if (isTRUE(prj_todos[["aon"]][["dailyNRCS_Chambers2014_ResilienceResistance"]])) { nv0 <- nv - print_debug(opt_verbosity, tag_simpidfid, "aggregating", "dailyNRCS_Chambers2014_ResilienceResistance") + print_debug(opt_verbosity, tag_simpidfid, "aggregating", + "dailyNRCS_Chambers2014_ResilienceResistance") if (!exists("prcp.yr")) prcp.yr <- get_PPT_yr(runDataSC, isim_time) - #Result containers - cats <- c("Low", "ModeratelyLow", "Moderate", "ModeratelyHigh", "High") - resilience <- resistance <- rep(0, times = length(cats)) - names(resilience) <- names(resistance) <- cats - - if (regimes_done && (isTRUE(prj_todos[["aon"]][["dailyNRCS_SoilMoistureTemperatureRegimes"]]) || - isTRUE(prj_todos[["aon"]][["dailyNRCS_SoilMoistureTemperatureRegimes_Intermediates"]])) && - any(!is.na(Tregime)) && any(!is.na(Sregime))) { - #---Table 1 in Chambers et al. 2014 - rows_resilience <- c("ModeratelyHigh", "ModeratelyHigh", "Moderate", "Low", - "Low") - rows_resistance <- c("High", "Moderate", "ModeratelyLow", "Moderate", "Low") - #Ecological type - Table1_EcologicalType <- matrix(c("Cryic", "Xeric", "Frigid", "Xeric", - "Mesic", "Xeric", "Frigid", "Aridic", "Mesic", "Aridic"), - ncol = 2, byrow = TRUE) - Type <- as.logical(Tregime[Table1_EcologicalType[, 1]]) & - as.logical(Sregime[Table1_EcologicalType[, 2]]) - - #Characteristics - MAP <- mean(prcp.yr$ppt) - Table1_Characteristics_mm <- matrix(c(14, Inf, 12, 22, 12, 16, 6, 12, 8, 12), - ncol = 2, byrow = TRUE) * 2.54 * 10 - Characteristics <- MAP >= Table1_Characteristics_mm[, 1] & - MAP <= Table1_Characteristics_mm[, 2] - - #Resilience and Resistance - is_notRR <- which(!is.na(Type) & !Type & Characteristics) - for (ir in is_notRR) { - resilience[rows_resilience[ir]] <- 0 - resistance[rows_resistance[ir]] <- 0 - } - is_RR <- which(!is.na(Type) & Type & Characteristics) - for (ir in is_RR) { - resilience[rows_resilience[ir]] <- 1 - resistance[rows_resistance[ir]] <- 1 - } - - rm(rows_resilience, rows_resistance, Table1_EcologicalType, Type, - MAP, Table1_Characteristics_mm, Characteristics, is_RR, is_notRR) - } else { - resilience <- resistance <- rep(NA, times = length(cats)) - } - - resMeans[nv:(nv+2*length(cats)-1)] <- c(resilience, resistance) - nv <- nv + 2*length(cats) + RR <- rSOILWAT2::calc_RRs_Chambers2014(Tregime, Sregime, + MAP_mm = mean(prcp.yr$ppt)) - rm(cats, resilience, resistance) + nv_new <- nv + prj_todos[["aon_fields"]]["dailyNRCS_Chambers2014_ResilienceResistance", "N"] + resMeans[nv:(nv_new - 1)] <- RR + nv <- nv_new - print_debugN(opt_verbosity, tag_simpidfid, prj_todos, nv - nv0, "dailyNRCS_Chambers2014_ResilienceResistance") + print_debugN(opt_verbosity, tag_simpidfid, prj_todos, nv - nv0, + "dailyNRCS_Chambers2014_ResilienceResistance") } #35c #Requires "dailyNRCS_SoilMoistureTemperatureRegimes" - #Based on Maestas, J.D., Campbell, S.B., Chambers, J.C., Pellant, M. & Miller, R.F. (2016). Tapping Soil Survey Information for Rapid Assessment of Sagebrush Ecosystem Resilience and Resistance. Rangelands, 38, 120-128. if (isTRUE(prj_todos[["aon"]][["dailyNRCS_Maestas2016_ResilienceResistance"]])) { nv0 <- nv - print_debug(opt_verbosity, tag_simpidfid, "aggregating", "dailyNRCS_Maestas2016_ResilienceResistance") - - RR <- c(Low = NA, Moderate = NA, High = NA) - - if (regimes_done && (isTRUE(prj_todos[["aon"]][["dailyNRCS_SoilMoistureTemperatureRegimes"]]) || - isTRUE(prj_todos[["aon"]][["dailyNRCS_SoilMoistureTemperatureRegimes_Intermediates"]])) && - any(!is.na(Tregime)) && any(!is.na(Sregime))) { - #---Table 1 in Maestas et al. 2016 - # assumptions - # - "Dry-Xeric" == "Xeric bordering on Aridic" - # - "Weak-Aridic" == "Aridic bordering on Xeric" - Table1 <- matrix(c( - "Cryic", "Typic-Xeric", "High", - "Cryic", "Dry-Xeric", "High", - "Frigid", "Typic-Xeric", "High", - "Cryic", "Weak-Aridic", "High", - - "Cryic", "Typic-Aridic", "Moderate", - "Frigid", "Dry-Xeric", "Moderate", - "Frigid", "Typic-Aridic", "Moderate", - "Frigid", "Weak-Aridic", "Moderate", - "Mesic", "Typic-Xeric", "Moderate", - - "Mesic", "Dry-Xeric", "Low", - "Mesic", "Weak-Aridic", "Low", - "Mesic", "Typic-Aridic", "Low"), - ncol = 3, byrow = TRUE) - - temp <- as.logical(Tregime[Table1[, 1]]) & as.logical(Sregime[Table1[, 2]]) - is_notRR <- !is.na(temp) & !temp - if (any(is_notRR)) { - RR[Table1[is_notRR, 3]] <- 0 - } - is_RR <- !is.na(temp) & temp - if (any(is_RR)) { - RR[Table1[is_RR, 3]] <- 1 - } - rm(Table1, is_RR, is_notRR) - } + print_debug(opt_verbosity, tag_simpidfid, "aggregating", + "dailyNRCS_Maestas2016_ResilienceResistance") + + RR <- rSOILWAT2::calc_RRs_Maestas2016(Tregime, Sregime) - nv_new <- nv + 3 + nv_new <- nv + prj_todos[["aon_fields"]]["dailyNRCS_Maestas2016_ResilienceResistance", "N"] resMeans[nv:(nv_new - 1)] <- RR nv <- nv_new - rm(RR) - - print_debugN(opt_verbosity, tag_simpidfid, prj_todos, nv - nv0, "dailyNRCS_Maestas2016_ResilienceResistance") + print_debugN(opt_verbosity, tag_simpidfid, prj_todos, nv - nv0, + "dailyNRCS_Maestas2016_ResilienceResistance") } - rm(regimes_done) - if (isTRUE(prj_todos[["aon"]][["dailyNRCS_SoilMoistureTemperatureRegimes"]])) - rm(Tregime, Sregime) + if (isTRUE(prj_todos[["aon"]][["dailyNRCS_SoilMoistureTemperatureRegimes"]])) { + if (exists("Tregime")) rm(Tregime) + if (exists("Sregime")) rm(Sregime) + } #35.2 #Wet degree days on daily temp and swp if (isTRUE(prj_todos[["aon"]][["dailyWetDegreeDays"]])) { @@ -4271,11 +3669,11 @@ do_OneSite <- function(i_sim, i_SWRunInformation, i_sw_input_soillayers, suitable <- (SWE.dy$val == 0) & (temp.dy$mean >= opt_agg[["Tbase_DD_C"]]) for (icrit in seq(along = opt_agg[["SWPcrit_MPa"]])) { - SWCcritT <- SWPtoVWC(opt_agg[["SWPcrit_MPa"]][icrit], texture$sand.top, texture$clay.top) * 10 * sum(layers_width[topL]) + SWCcritT <- rSOILWAT2::SWPtoVWC(opt_agg[["SWPcrit_MPa"]][icrit], texture$sand.top, texture$clay.top) * 10 * sum(layers_width[topL]) swa.top <- ifelse(suitable, cut0Inf(swcbulk.dy$top - SWCcritT, val = 0), 0) if (length(bottomL) > 0 && !identical(bottomL, 0)) { - SWCcritB <- SWPtoVWC(opt_agg[["SWPcrit_MPa"]][icrit], texture$sand.bottom, texture$clay.bottom) * 10 * sum(layers_width[bottomL]) + SWCcritB <- rSOILWAT2::SWPtoVWC(opt_agg[["SWPcrit_MPa"]][icrit], texture$sand.bottom, texture$clay.bottom) * 10 * sum(layers_width[bottomL]) swa.bottom <- ifelse(suitable, cut0Inf(swcbulk.dy$bottom - SWCcritB, val = 0), 0) } else { swa.bottom <- rep(0, length(swa.top)) @@ -4437,14 +3835,14 @@ do_OneSite <- function(i_sim, i_SWRunInformation, i_sw_input_soillayers, for (icrit in seq(along = opt_agg[["SWPcrit_MPa"]])) { #amount of SWC required so that layer wouldn't be dry - SWCcritT <- SWPtoVWC(opt_agg[["SWPcrit_MPa"]][icrit], texture$sand.top, texture$clay.top) * sum(layers_width[topL])*10 + SWCcritT <- rSOILWAT2::SWPtoVWC(opt_agg[["SWPcrit_MPa"]][icrit], texture$sand.top, texture$clay.top) * sum(layers_width[topL])*10 missingSWCtop <- cut0Inf(SWCcritT - SWCtop, val = 0) IntensitySum_top <- c(mean(temp <- sapply(isim_time$useyrs, FUN = function(y) sum(missingSWCtop[simTime2$year_ForEachUsedDay == y])), na.rm = TRUE), stats::sd(temp, na.rm = TRUE)) IntensityMean_top <- c(mean(temp <- sapply(isim_time$useyrs, FUN = function(y) mean((temp <- missingSWCtop[simTime2$year_ForEachUsedDay == y])[temp > 0], na.rm = TRUE)), na.rm = TRUE), stats::sd(temp, na.rm = TRUE)) IntensityDurationAndNumber_top <- c(apply(temp <- sapply(isim_time$useyrs, FUN = function(y) c(mean(temp <- (temp <- rle(missingSWCtop[simTime2$year_ForEachUsedDay == y] > 0))$lengths[temp$values]), length(temp))), 1, mean), apply(temp, 1, stats::sd))[c(1, 3, 2, 4)] if (length(bottomL) > 0 && !identical(bottomL, 0)) { - SWCcritB <- SWPtoVWC(opt_agg[["SWPcrit_MPa"]][icrit], texture$sand.bottom, texture$clay.bottom) * sum(layers_width[bottomL])*10 + SWCcritB <- rSOILWAT2::SWPtoVWC(opt_agg[["SWPcrit_MPa"]][icrit], texture$sand.bottom, texture$clay.bottom) * sum(layers_width[bottomL])*10 missingSWCbottom <- cut0Inf(SWCcritB - SWCbottom, val = 0) IntensitySum_bottom <- c(mean(temp <- sapply(isim_time$useyrs, FUN = function(y) sum(missingSWCbottom[simTime2$year_ForEachUsedDay == y])), na.rm = TRUE), stats::sd(temp, na.rm = TRUE)) IntensityMean_bottom <- c(mean(temp <- sapply(isim_time$useyrs, FUN = function(y) mean((temp <- missingSWCbottom[simTime2$year_ForEachUsedDay == y])[temp > 0], na.rm = TRUE)), na.rm = TRUE), stats::sd(temp, na.rm = TRUE)) @@ -4788,9 +4186,9 @@ do_OneSite <- function(i_sim, i_SWRunInformation, i_sw_input_soillayers, print_debug(opt_verbosity, tag_simpidfid, "aggregating", "monthlySWAbulk") if (!exists("vwcmatric.mo")) vwcmatric.mo <- get_Response_aggL(swof["sw_vwcmatric"], tscale = "mo", scaler = 1, FUN = stats::weighted.mean, weights = layers_width, x = runDataSC, st = isim_time, st2 = simTime2, topL = topL, bottomL = bottomL) - VWCcritsT <- SWPtoVWC(opt_agg[["SWPcrit_MPa"]], texture$sand.top, texture$clay.top) + VWCcritsT <- rSOILWAT2::SWPtoVWC(opt_agg[["SWPcrit_MPa"]], texture$sand.top, texture$clay.top) VWCcritsB <- if (length(bottomL) > 0 && !identical(bottomL, 0)) { - SWPtoVWC(opt_agg[["SWPcrit_MPa"]], texture$sand.bottom, texture$clay.bottom) + rSOILWAT2::SWPtoVWC(opt_agg[["SWPcrit_MPa"]], texture$sand.bottom, texture$clay.bottom) } else { rep(NA, opt_agg[["SWPcrit_N"]]) } @@ -5544,7 +4942,7 @@ do_OneSite <- function(i_sim, i_SWRunInformation, i_sw_input_soillayers, ir <- (al - 1) * 366 + 1:366 res.dailyMean[ir] <- stats::aggregate(scaler * agg.dat[[al]], by = list(simTime2$doy_ForEachUsedDay), FUN = mean)[, 2] if (agg.resp == "SWPmatric") { ##post-aggregate calculation of SWP: convert VWC to SWP - res.dailyMean[ir] <- VWCtoSWP(res.dailyMean[ir], textureDAgg$sand[al], textureDAgg$clay[al]) + res.dailyMean[ir] <- rSOILWAT2::VWCtoSWP(res.dailyMean[ir], textureDAgg$sand[al], textureDAgg$clay[al]) res.dailySD[ir] <- 0 #was NA now 0 } else { res.dailySD[ir] <- stats::aggregate(scaler * agg.dat[[al]], by = list(simTime2$doy_ForEachUsedDay), FUN = stats::sd)[, 2] @@ -5553,7 +4951,7 @@ do_OneSite <- function(i_sim, i_SWRunInformation, i_sw_input_soillayers, #post-aggregate calculation of SWA based on SWC for each SWPcrit if (agg.resp == "SWAbulk") { - swc.swpcrit.layers <- layers_width * 10 * SWPtoVWC(index.SWPcrit, sand, clay) + swc.swpcrit.layers <- layers_width * 10 * rSOILWAT2::SWPtoVWC(index.SWPcrit, sand, clay) for (al in seq_len(agg.no)) { ir <- (al - 1) * 366 + 1:366 diff --git a/R/SoilMTRegimes.R b/R/SoilMTRegimes.R deleted file mode 100644 index 33411d20..00000000 --- a/R/SoilMTRegimes.R +++ /dev/null @@ -1,246 +0,0 @@ -######################## -#------ SMTR functions - -# Based on references provided by Chambers, J. C., D. A. Pyke, J. D. Maestas, M. -# Pellant, C. S. Boyd, S. B. Campbell, S. Espinosa, D. W. Havlina, K. E. Mayer, -# and A. Wuenschel. 2014. Using Resistance and Resilience Concepts to Reduce -# Impacts of Invasive Annual Grasses and Altered Fire Regimes on the Sagebrush -# Ecosystem and Greater Sage-Grouse: A Strategic Multi-Scale Approach. Gen. -# Tech. Rep. RMRS-GTR-326. U.S. Department of Agriculture, Forest Service, Rocky -# Mountain Research Station, Fort Collins, CO. -# - -#' Categories of soil temperature regimes and soil moisture regimes -#' -#' @section Definitions: Soil temperature and moisture regimes are defined in -#' SSS 2014. Our operationalization is explained in the vignette -#' \var{SoilMoistureRegimes_SoilTemperatureRegimes}. -#' -#' @references Soil Survey Staff. 2014. Keys to soil taxonomy, 12th ed., USDA -#' Natural Resources Conservation Service, Washington, DC. -#' @examples -#' vignette("SoilMoistureRegimes_SoilTemperatureRegimes", package = "rSFSW2") -#' @name STMR -NULL - -#' Soil temperature regime categories -#' @rdname STMR -#' @export -STR_names <- function() { - c("Hyperthermic", "Thermic", "Mesic", "Frigid", "Cryic", "Gelic") -} - -#' Soil moisture regime categories -#' @rdname STMR -#' @export -SMR_names <- function() { - c("Anhydrous", "Aridic", "Xeric", "Ustic", "Udic", "Perudic", "Aquic") -} - -#' Soil moisture regime categories including qualifiers -#' @rdname STMR -#' @export -SMRq_names <- function() { - c("Extreme-Aridic", "Typic-Aridic", "Weak-Aridic", #Aridic - "Dry-Xeric", "Typic-Xeric", # Xeric - "Typic-Tempustic", "Xeric-Tempustic", "Wet-Tempustic", "Aridic-Tropustic", - "Typic-Tropustic", "Udic-Ustic", # Ustic - "Typic-Udic", "Dry-Tropudic", "Dry-Tempudic") # Udic -} - -#' Soil temperature regime: based on Soil Survey Staff 2014 (Key to Soil -#' Taxonomy): p.31 we ignore distinction between iso- and not iso- -#' @export -STR_logic <- function(MAST, MSST, SatSoilSummer_days, has_permafrost, - has_Ohorizon) { - - temp <- STR_names() - Tregime <- rep(0L, length(temp)) - names(Tregime) <- temp - - if (anyNA(MAST) || anyNA(has_permafrost)) { - Tregime[] <- NA - return(Tregime) - } - - if (MAST >= 22) { - Tregime["Hyperthermic"] <- 1L - } else if (MAST >= 15) { - Tregime["Thermic"] <- 1L - } else if (MAST >= 8) { - Tregime["Mesic"] <- 1L - - } else if (MAST > 0 && !has_permafrost) { - if (any(anyNA(SatSoilSummer_days), anyNA(has_Ohorizon), anyNA(MSST))) { - Tregime[c("Cryic", "Frigid")] <- NA - return(Tregime) - } - - # mineral soils - if (SatSoilSummer_days > 0) { - # "soil is saturated with water during some part of summer" - if (has_Ohorizon) { - # TODO: should be: 'O-horizon' OR 'histic epipedon' - if (MSST < 6) { - Tregime["Cryic"] <- 1L - } else { - Tregime["Frigid"] <- 1L - } - } else { - if (MSST < 13) { - Tregime["Cryic"] <- 1L - } else { - Tregime["Frigid"] <- 1L - } - } - - } else { - # "not saturated with water during some part of the summer" - if (has_Ohorizon) { - if (MSST < 8) { - Tregime["Cryic"] <- 1L - } else { - Tregime["Frigid"] <- 1L - } - } else { - if (MSST < 15) { - Tregime["Cryic"] <- 1L - } else { - Tregime["Frigid"] <- 1L - } - } - } - # TODO: else organic soils: cryic if mean(T50jja) > 0 C and < 6 C - - } else if (MAST <= 0 || has_permafrost) { - # limit should be 1 C for Gelisols - Tregime["Gelic"] <- 1L - } - - Tregime -} - - -#' Soil moisture regime: Soil Survey Staff 2014 (Key to Soil Taxonomy): p.28-31 -#' @export -SMR_logic <- function(ACS_COND1, ACS_COND2, ACS_COND3, MCS_COND0, - MCS_COND1, MCS_COND2, MCS_COND2_1, MCS_COND2_2, MCS_COND2_3, MCS_COND3, - MCS_COND3_1, MCS_COND4, MCS_COND5, MCS_COND6, MCS_COND6_1, MCS_COND7, - MCS_COND8, MCS_COND9, MCS_COND10, has_permafrost) { - - temp <- c(SMR_names(), SMRq_names()) - Sregime <- rep(0L, length(temp)) - names(Sregime) <- temp - - # Anhydrous condition: Soil Survey Staff 2010: p.16 - # == Soil Survey Staff 2014: p.18 - # we ignore test for 'ice-cemented permafrost' and 'rupture-resistance class' - if (any(anyNA(ACS_COND1), anyNA(ACS_COND2), anyNA(ACS_COND3))) { - Sregime["Anhydrous"] <- NA - - } else if (ACS_COND1 && ACS_COND2 && ACS_COND3) { - Sregime["Anhydrous"] <- 1L - } - - # We ignore 'Aquic' because we have no information on soil oxygen content - if (any(anyNA(MCS_COND0), anyNA(MCS_COND1), anyNA(MCS_COND2), - anyNA(MCS_COND2_1), anyNA(MCS_COND2_2), anyNA(MCS_COND2_3), - anyNA(MCS_COND3), anyNA(MCS_COND3_1), anyNA(MCS_COND4), anyNA(MCS_COND5), - anyNA(MCS_COND6), anyNA(MCS_COND6_1), anyNA(MCS_COND7), anyNA(MCS_COND8), - anyNA(MCS_COND9), anyNA(MCS_COND10), anyNA(has_permafrost))) { - - Sregime[-which("Anhydrous" == names(Sregime))] <- NA - return(Sregime) - } - - if (MCS_COND0) { - # Perudic soil moisture regime - Sregime["Perudic"] <- 1L - - } else if (MCS_COND1 && MCS_COND2) { - # Aridic soil moisture regime; The limits set for soil temperature - # exclude from these soil moisture regimes soils in the very cold and dry - # polar regions and in areas at high elevations. Such soils are considered - # to have anhydrous condition - Sregime["Aridic"] <- 1L - - # Qualifier for aridic SMR - if (MCS_COND10) { - Sregime["Extreme-Aridic"] <- 1L - } else if (MCS_COND2_3) { - # NOTE: COND2_3: assumes that 'MaxContDaysAnyMoistCumAbove8' is - # equivalent to jNSM variable 'ncpm[2]' - Sregime["Typic-Aridic"] <- 1L - } else { - Sregime["Weak-Aridic"] <- 1L - } - - } else if (!MCS_COND6 && MCS_COND9 && !MCS_COND4 && MCS_COND5) { - # Xeric soil moisture regime - Sregime["Xeric"] <- 1L - - #Qualifier for xeric SMR - if (MCS_COND6_1) { - # NOTE: this conditional assumes that 'DryDaysConsecSummer' is equivalent - # to jNSM variable 'nccd' - Sregime["Dry-Xeric"] <- 1L - } else { - Sregime["Typic-Xeric"] <- 1L - } - - } else if (MCS_COND3 && (!MCS_COND4 && MCS_COND5 && MCS_COND6 || - (MCS_COND4 || !MCS_COND5))) { - - # Udic soil moisture regime - #we ignore test for 'three- phase system' - # during T50 > 5 - Sregime["Udic"] <- 1L - - # Qualifier for udic SMR - if (MCS_COND3_1) { - Sregime["Typic-Udic"] <- 1L - } else if (!MCS_COND5) { - Sregime["Dry-Tropudic"] <- 1L - } else { - Sregime["Dry-Tempudic"] <- 1L - } - - } else if (!has_permafrost && !MCS_COND3 && - ((MCS_COND4 || !MCS_COND5) && (MCS_COND7 || MCS_COND8) || - !MCS_COND4 && MCS_COND5 && !MCS_COND1 && - (MCS_COND9 && MCS_COND6 || !MCS_COND9))) { - - # Ustic soil moisture regime - Sregime["Ustic"] <- 1L - - # Qualifier for ustic SMR - if (MCS_COND5) { - if (!MCS_COND9) { - # NOTE: this conditional assumes that 'MoistDaysConsecWinter' is - # equivalent to jNSM variable 'nccm' - Sregime["Typic-Tempustic"] <- 1L - } else if (!MCS_COND6) { - # NOTE: this conditional assumes that 'DryDaysConsecSummer' is - # equivalent to jNSM variable 'nccd' - Sregime["Xeric-Tempustic"] <- 1L - } else { - Sregime["Wet-Tempustic"] <- 1L - } - } else { - # NOTE: COND2_1 and COND2_2: assume that 'MaxContDaysAnyMoistCumAbove8' - # is equivalent to jNSM variable 'ncpm[2]' - if (MCS_COND2_1) { - Sregime["Aridic-Tropustic"] <- 1L - } else if (MCS_COND2_2) { - Sregime["Typic-Tropustic"] <- 1L - } else { - Sregime["Udic-Ustic"] <- 1L - } - } - } - - Sregime -} - - -#------ End of SMTR functions -######################## diff --git a/R/Soils_Functions.R b/R/Soils_Functions.R index 37cb43ba..19d7860a 100644 --- a/R/Soils_Functions.R +++ b/R/Soils_Functions.R @@ -1,4 +1,7 @@ +getLayersWidth <- rSOILWAT2:::getLayersWidth +calc_weights_from_depths <- rSOILWAT2:::calc_weights_from_depths +add_layer_to_soil <- rSOILWAT2:::add_layer_to_soil #' The wrapper only handles 1-cm resolution of soil depths #' (mainly because of the \var{trco}) @@ -6,7 +9,6 @@ adjustLayersDepth <- function(layers_depth, d) { round(layers_depth[seq_len(d)]) } -getLayersWidth <- function(layers_depth) diff(c(0, layers_depth)) setLayerSequence <- function(d) seq_len(d) @@ -113,136 +115,6 @@ assign_aggregation_soillayers <- function(layers_depth, daily_lyr_agg) { vals } - - -calc_weights_from_depths <- function(il_new, target_cm, depths_cm) { - if (il_new == 0) { - c(target_cm, depths_cm[1] - target_cm) - - } else if (il_new >= length(depths_cm)) { - c(0, target_cm) - - } else { - abs(target_cm - depths_cm[il_new + c(1, 0)]) - - } -} - - - -#' Split soil layer in two layers -#' -#' @param x A numeric data.frame or matrix. Columns are soil layers. -#' @param il An integer value. The column/soil layer number after which a new -#' layer is added. -#' @param w A numeric vector of length one or two. The weights used to calculate -#' the values of the new layer. -#' @param method A character string. See \code{Details}. -#' -#' @section Details: If the weight vector is of length one and \code{x} contains -#' a row with name 'depth_cm', then it is assumed that the value of \code{w} -#' corresponds to the weight of the first layer and the weight of the second -#' layer is calculated as \code{(depth of first layer of x) - (first value of -#' w)}. If this is case and if the added layer is either more shallow or -#' deeper than any input layers, then the depth of the added layer is -#' calculated proportionally if \code{sum(w) <= 1} otherwise additively. -#' @section Details: The method \code{interpolate} calculates the weighted mean -#' of the columns/layers \code{il} and \code{il + 1}. If \code{il == 0}, i.e., -#' add layer at a more shallow depth than any existing layer, then values from -#' the previously first layer are copied to the newly created layer. The -#' method \code{exhaust} distributes the value of \code{il + 1} according to -#' the weights. -#' -#' @return An object like x with one column more at position \code{il + 1}. -add_layer_to_soil <- function(x, il, w, method = c("interpolate", "exhaust")) { - method <- match.arg(method) - if (!is.matrix(x)) { - x <- as.matrix(x) - } - ncols <- dim(x)[2] - if (length(w) == 1L && "depth_cm" %in% dimnames(x)[[1]] && - x["depth_cm", 1] >= w) { - w <- c(w, x["depth_cm", 1] - w) - } - - stopifnot(length(w) == 2L, ncols > 0, is.finite(il), il >= 0, il <= ncols) - w_sum <- sum(w) - - if (ncols > il) { - # Add layer at an intermediate depth of existing layers - x <- x[, c(seq_len(il), NA, (il + 1):ncols)] - - if (method == "interpolate") { - if (il > 0) { - x[, il + 1] <- (x[, il] * w[1] + x[, il + 2] * w[2]) / w_sum - - } else { - # Add layer at a more shallow depth than any existing layer - x[, 1] <- x[, 2] - if ("depth_cm" %in% dimnames(x)[[1]]) - x["depth_cm", 1] <- if (w_sum <= 1 || w[1] > x["depth_cm", 2]) { - x["depth_cm", 2] * w[1] / w_sum - } else { - w[1] - } - } - - } else if (method == "exhaust") { - x[, il + 1] <- x[, il + 2] * w[1] / w_sum - x[, il + 2] <- x[, il + 2] * w[2] / w_sum - } - - } else if (ncols == il) { - # Add a deeper layer than any existing layer - x <- x[, c(seq_len(ncols), NA)] - - if (method == "interpolate") { - x[, il + 1] <- x[, il] - if ("depth_cm" %in% dimnames(x)[[1]]) - x["depth_cm", il + 1] <- if (w_sum <= 1) { - x["depth_cm", il] * (1 + w[2] / w_sum) - } else { - x["depth_cm", il] + w[2] - } - - } else if (method == "exhaust") { - x[, il + 1] <- x[, il] * w[2] / w_sum - x[, il] <- x[, il] * w[1] / w_sum - } - } - - x -} - -identify_soillayers <- function(depths, sdepth) { - it <- findInterval(depths, sdepth) - if (any(is.na(it))) { - as.integer(stats::na.exclude(it)) - } else if (length(it) > 1 && diff(it) > 0) { - (1 + it[1]):(it[2]) - } else { - it[1] - } -} - -adjustLayer_byImp <- function(depths, imp_depth, sdepths) { - if (any(imp_depth < depths[1])) { - depths <- imp_depth - if (length(sdepths) >= 2) { - temp <- findInterval(imp_depth, sdepths) - if (temp > 1) { - depths <- c(sdepths[temp - 1], imp_depth) - } else { - depths <- c(imp_depth, sdepths[temp + 1]) - } - } - } else if (any(imp_depth < depths[2])) { - depths <- c(depths[1], imp_depth) - } - - depths -} - init_soiltemperature <- function(layers_depth, lower.Tdepth, soilTupper, soilTlower) { diff --git a/R/Testproject_Functions.R b/R/Testproject_Functions.R index fbf5288b..b54b96dd 100644 --- a/R/Testproject_Functions.R +++ b/R/Testproject_Functions.R @@ -27,7 +27,9 @@ #' one character string \code{referenceDB} of the reference database name #' against which this run of the test project was compared.} #' \item{report}{A character vector describing differences between -#' test and reference databases} } +#' test and reference databases including the output of a call to +#' \code{\link{compare_test_output}}} +#' } #' @export run_test_projects <- function(dir_tests, dir_prj_tests = NULL, dir_ref = NULL, dir_prev = NULL, which_tests_torun = seq_along(dir_tests), @@ -486,6 +488,17 @@ check_aggregated_output <- function(x) { #' } #' #' @seealso \code{\link{compare_two_dbOutput}} +#' +#' @examples +#' \dontrun{ +#' # Run test project 4 inside development version of package +#' # Assume that working directory is `tests/test_data/TestPrj4/` +#' source("SFSW2_project_code.R") +#' +#' # Compare output database with reference database +#' comp <- compare_test_output(".", dir_ref = "../0_ReferenceOutput/") +#' } +#' #' @export compare_test_output <- function(dir_test, dir_ref = NULL) { diff_msgs <- list() diff --git a/R/Time_SimulationWorld.R b/R/Time_SimulationWorld.R index 5bc48495..d875d976 100644 --- a/R/Time_SimulationWorld.R +++ b/R/Time_SimulationWorld.R @@ -1,49 +1,15 @@ #------ FUNCTIONS THAT DEAL WITH SIMULATION TIME -getStartYear <- function(simstartyr, spinup_N = 1L) { - as.integer(simstartyr + spinup_N) -} - - -isLeapYear <- function(y) { - #from package: tis - y %% 4 == 0 & (y %% 100 != 0 | y %% 400 == 0) -} - -#' The sequence of month numbers for each day in the period from - to -#' -#' @examples -#' month1 <- function() as.POSIXlt(seq(from = ISOdate(1980, 1, 1, tz = "UTC"), -#' to = ISOdate(2010, 12, 31, tz = "UTC"), by = "1 day"))$mon + 1 -#' month2 <- function() seq_month_ofeach_day(list(1980, 1, 1), -#' list(2010, 12, 31), tz = "UTC") -#' -#' \dontrun{ -#' if (requireNamespace("microbenchmark", quietly = TRUE)) -#' # barely any difference -#' microbenchmark::microbenchmark(month1(), month2()) -#' } -seq_month_ofeach_day <- function(from = list(year = 1900, month = 1, day = 1), - to = list(year = 1900, month = 12, day = 31), tz = "UTC") { - - x <- paste(from[[1]], from[[2]], from[[3]], 12, 0, 0, sep = "-") - from0 <- unclass(as.POSIXct.POSIXlt(strptime(x, "%Y-%m-%d-%H-%M-%OS", - tz = tz))) - x <- paste(to[[1]], to[[2]], to[[3]], 12, 0, 0, sep = "-") - to0 <- unclass(as.POSIXct.POSIXlt(strptime(x, "%Y-%m-%d-%H-%M-%OS", tz = tz))) - - res <- seq.int(0, to0 - from0, by = 86400) + from0 - as.POSIXlt.POSIXct(.POSIXct(res, tz = tz))$mon + 1 -} +isLeapYear <- rSOILWAT2:::isLeapYear #' Determine maximal span of simulation years across all experimental and design #' treatments #' #' @param st An object as returned from the function -#' \code{\link{setup_simulation_time}}. +#' \code{\link{setup_time_simulation_project}}. #' @param SFSW2_prj_inputs An object as returned from function #' \code{\link{process_inputs}}. #' @return The object \code{st} augmented with two named elements \itemize{ @@ -92,12 +58,13 @@ get_simulation_time <- function(st, SFSW2_prj_inputs) { #' Describe the time of a simulation project #' -#' @param sim_time A list with at least values for three named elements: -#' \var{\dQuote{simstartyr}} and \var{\dQuote{endyr}} and one of the following -#' two: \var{\dQuote{startyr}} or \var{\dQuote{spinup_N}}. +#' @param sim_time A list with at least values for four named elements: +#' \var{\dQuote{simstartyr}} and \var{\dQuote{endyr}}, one of the following +#' two: \var{\dQuote{startyr}} or \var{\dQuote{spinup_N}}, and +#' \var{dQuote{future_yrs}}. #' @param add_st2 A logical value. If \code{TRUE}, the output of calling the -#' function \code{\link{simTiming_ForEachUsedTimeUnit}} is appended to the -#' returned list. +#' function \code{\link[rSOILWAT2]{simTiming_ForEachUsedTimeUnit}} +#' is appended to the returned list. #' @param use_doy_range A logical value. If \code{TRUE}, then the result is #' additional daily indices indicating whether the \var{DOY} is within the #' days indicated in the \code{doy_ranges}. @@ -107,21 +74,12 @@ get_simulation_time <- function(st, SFSW2_prj_inputs) { #' corrected for locations on the southern vs. northern hemisphere. Only used #' if \code{add_st2} is \code{TRUE}. #' @param A named list, i.e., the updated version of \code{sim_time}. -setup_simulation_time <- function(sim_time, add_st2 = FALSE, +#' +#' @seealso \code{\link[rSOILWAT2]{setup_time_simulation_run}} +setup_time_simulation_project <- function(sim_time, add_st2 = FALSE, adjust_NS = FALSE, use_doy_range = FALSE, doy_ranges = list()) { - if (is.null(sim_time[["spinup_N"]])) { - sim_time[["spinup_N"]] <- sim_time[["startyr"]] - sim_time[["simstartyr"]] - - } else { - sim_time[["startyr"]] <- getStartYear(sim_time[["simstartyr"]], - sim_time[["spinup_N"]]) - } - - stopifnot(!is.null(sim_time[["spinup_N"]]), - !is.null(sim_time[["simstartyr"]]), - !is.null(sim_time[["startyr"]]), - !is.null(sim_time[["endyr"]])) + sim_time <- rSOILWAT2::setup_time_simulation_run(sim_time = sim_time) if (is.matrix(sim_time[["future_yrs"]])) { stopifnot(dim(sim_time[["future_yrs"]])[2] == 3) @@ -137,42 +95,27 @@ setup_simulation_time <- function(sim_time, add_st2 = FALSE, sim_time[["future_yrs"]] <- temp } else { - stop("'setup_simulation_time': incorrect format of 'future_yrs'") + stop("'setup_time_simulation_project': incorrect format of 'future_yrs'") } sim_time[["future_N"]] <- dim(sim_time[["future_yrs"]])[1] - temp <- ISOdate(sim_time[["startyr"]], 1, 1, tz = "UTC") - discarddy <- as.numeric(temp - ISOdate(sim_time[["simstartyr"]], 1, 1, - tz = "UTC")) - - sim_time[["useyrs"]] <- sim_time[["startyr"]]:sim_time[["endyr"]] - - sim_time[["no.useyr"]] <- sim_time[["endyr"]] - sim_time[["startyr"]] + 1 - sim_time[["no.usemo"]] <- sim_time[["no.useyr"]] * 12 - sim_time[["no.usedy"]] <- as.numeric(ISOdate(sim_time[["endyr"]], 12, 31, - tz = "UTC") - temp) + 1 - - sim_time[["index.useyr"]] <- sim_time[["spinup_N"]] + - seq_len(sim_time[["no.useyr"]]) - sim_time[["index.usemo"]] <- sim_time[["spinup_N"]] * 12 + - seq_len(sim_time[["no.usemo"]]) - sim_time[["index.usedy"]] <- discarddy + seq_len(sim_time[["no.usedy"]]) - if (add_st2) { - sim_time[["sim_time2_North"]] <- simTiming_ForEachUsedTimeUnit(sim_time, - sim_tscales = c("daily", "monthly", "yearly"), - use_doy_range = use_doy_range, - doy_ranges = doy_ranges, - latitude = 90, account_NorthSouth = adjust_NS) - - if (adjust_NS) { - sim_time[["sim_time2_South"]] <- simTiming_ForEachUsedTimeUnit(sim_time, + sim_time[["sim_time2_North"]] <- + rSOILWAT2::simTiming_ForEachUsedTimeUnit(sim_time[["useyrs"]], sim_tscales = c("daily", "monthly", "yearly"), use_doy_range = use_doy_range, - doy_ranges = doy_ranges, - latitude = -90, - account_NorthSouth = TRUE) + doy_ranges = doy_ranges, + latitude = 90, account_NorthSouth = adjust_NS) + + if (adjust_NS) { + sim_time[["sim_time2_South"]] <- + rSOILWAT2::simTiming_ForEachUsedTimeUnit(sim_time[["useyrs"]], + sim_tscales = c("daily", "monthly", "yearly"), + use_doy_range = use_doy_range, + doy_ranges = doy_ranges, + latitude = -90, + account_NorthSouth = TRUE) } else { sim_time[["sim_time2_South"]] <- sim_time[["sim_time2_North"]] @@ -181,200 +124,3 @@ setup_simulation_time <- function(sim_time, add_st2 = FALSE, sim_time } - - -#' Calculate indices along different time steps for simulation time -#' -#' -#' @param st An object as returned from the function -#' \code{\link{setup_simulation_time}}. -#' @param sim_tscales A vector of character strings. One or multiple of -#' \code{c("daily", "weekly", "monthly", "yearly")}. -#' @param use_doy_range A logical value. If \code{TRUE}, then the result is -#' additional daily indices indicating whether the \var{DOY} is within the -#' days indicated in the \code{doy_ranges}. -#' @param doy_ranges A named list. Aggregation output variables and the daily -#' \code{c(min, max)} of days you wish to calculate the aggregation over. -#' @param latitude A numeric value. The latitude in decimal degrees for which a -#' hemispheric adjustment is requested; however, the code extracts only the -#' sign. Positive values are interpreted as from the northern hemisphere; -#' negative latitudes as from the southern hemisphere. -#' @param account_NorthSouth A logical value. If \code{TRUE}, then the result is -#' corrected for locations on the southern vs. northern hemisphere. -#' @return A named list. -simTiming_ForEachUsedTimeUnit <- function(st, - sim_tscales = c("daily", "weekly", "monthly", "yearly"), - use_doy_range = FALSE, doy_ranges = list(), - latitude = 90, account_NorthSouth = TRUE) { - - res <- list() - - if (any(sim_tscales == "daily")) { - temp <- as.POSIXlt(seq(from = ISOdate(min(st$useyrs), 1, 1, tz = "UTC"), - to = ISOdate(max(st$useyrs), 12, 31, tz = "UTC"), - by = "1 day")) - - res$doy_ForEachUsedDay <- temp$yday + 1 - res$month_ForEachUsedDay <- temp$mon + 1 - res$year_ForEachUsedDay <- res$year_ForEachUsedDay_NSadj <- temp$year + 1900 - - if (latitude < 0 && account_NorthSouth) { - #- Shift doys - # New month either at end of year or in the middle because the two - # halfs (6+6 months) of a year are of unequal length - # (182 (183 if leap year) and 183 days): I chose to have a new month at - # end of year (i.e., 1 July -> 1 Jan & 30 June -> 31 Dec; - # but, 1 Jan -> July 3/4): and instead of a day with doy = 366, - # there are two with doy = 182 - dshift <- as.POSIXlt(ISOdate(st$useyrs, 6, 30, tz = "UTC"))$yday + 1 - res$doy_ForEachUsedDay_NSadj <- unlist(lapply(seq_along(st$useyrs), - function(x) { - temp <- st$useyrs[x] == res$year_ForEachUsedDay - temp1 <- res$doy_ForEachUsedDay[temp] - temp2 <- 1:dshift[x] - c(temp1[-temp2], temp1[temp2]) - })) - - #- Shift months - temp <- paste(res$year_ForEachUsedDay, res$doy_ForEachUsedDay_NSadj, - sep = "-") - res$month_ForEachUsedDay_NSadj <- strptime(temp, format = "%Y-%j")$mon + 1 - - #- Shift years - temp1 <- length(res$year_ForEachUsedDay) - delta <- if (dshift[1] == 182) 2 else 3 - temp2 <- dshift[1] + delta - res$year_ForEachUsedDay_NSadj <- c( - # add previous calendar year for shifted days of first simulation year - rep(st$useyrs[1] - 1, times = temp2), - # remove a corresponding number of days at end of simulation period - res$year_ForEachUsedDay[- ((temp1 - temp2 + 1):temp1)] - ) - res$useyrs_NSadj <- unique(res$year_ForEachUsedDay_NSadj) - res$no.useyr_NSadj <- length(res$useyrs_NSadj) - - } else { - res$doy_ForEachUsedDay_NSadj <- res$doy_ForEachUsedDay - res$month_ForEachUsedDay_NSadj <- res$month_ForEachUsedDay - res$year_ForEachUsedDay_NSadj <- res$year_ForEachUsedDay - res$useyrs_NSadj <- st$useyrs - res$no.useyr_NSadj <- st$no.useyr - } - - #Adjust years to water-years - # In North, Water year starting Oct 1 - Using DOY 274, which is Oct 1st in - # Leap Years, but Oct 2nd in typical years - # In South, Water year starting April 1 - Using DOY 92, which is April 1st - # in Leap Years, but April 2nd in typical years - - temp <- res$doy_ForEachUsedDay[1] == res$doy_ForEachUsedDay_NSadj[1] - FirstDOY_WaterYear <- if (temp) 274 else 92 - - temp <- res$doy_ForEachUsedDay_NSadj > FirstDOY_WaterYear - res$year_ForEachUsedDay_NSadj_WaterYearAdj <- # nolint - res$year_ForEachUsedDay_NSadj + ifelse(temp, 1, 0) - - if (isTRUE(use_doy_range)) { - # North or Southern hemisphere? eliminate unnecessary water years values - if (latitude > 0) { - Idx <- grep("_S", names(doy_ranges)) - doy_ranges[Idx] <- NULL - } else { - Idx <- grep("_N", names(doy_ranges)) - doy_ranges[Idx] <- NULL - } - - for (dr in seq_along(doy_ranges)) { - if (!is.null(doy_ranges[[dr]])) { - # for all non-NULL doy_range values - doy_range_values <- doy_ranges[[dr]] - - # Create daily logical vector indicating whether that doy is within - # range or not - res[[paste0("doy_NSadj_", names(doy_ranges[dr]), "_doyRange")]] <- - if (doy_range_values[1] > doy_range_values[2]) { - temp <- c(doy_range_values[1]:366, 1:doy_range_values[2]) - res$doy_ForEachUsedDay_NSadj %in% temp - } else { - temp <- doy_range_values[1]:doy_range_values[2] - res$doy_ForEachUsedDay_NSadj %in% temp - } - } - } - } - } - - - - if (any(sim_tscales == "weekly")) { - - } - - if (any(sim_tscales == "monthly")) { - res$yearno_ForEachUsedMonth <- res$yearno_ForEachUsedMonth_NSadj <- - rep(seq_len(st$no.useyr), each = 12) - res$month_ForEachUsedMonth <- res$month_ForEachUsedMonth_NSadj <- - rep(SFSW2_glovars[["st_mo"]], times = st$no.useyr) - - if (latitude < 0 && account_NorthSouth) { - res$month_ForEachUsedMonth_NSadj <- - (res$month_ForEachUsedMonth + 5) %% 12 + 1 - } - } - - if (any(sim_tscales == "yearly")) { - - } - - res -} - - -#' Check requested years -#' -#' @param start_year An integer value. The requested first year to extract -#' weather data. -#' @param end_year An integer value. The requested last year to extract weather -#' data. -#' @param has_start_year An integer value. The available first year of the -#' weather data. -#' @param has_end_year An integer value. The available last year of the weather -#' data. -#' @param temp_call A character string. An identifier of the calling function -#' used for printing. -#' @param verbose A logical value. If \code{TRUE} prints statements if first or -#' last year were updated. -#' -#' @return A list with two named elements \itemize{ \item \code{start_year} to -#' updated first year no smaller than \code{has_start_year} \item -#' \code{end_year} to updated last year no larger than \code{has_end_year} } -update_requested_years <- function(start_year, end_year, has_start_year, - has_end_year, temp_call = NULL, verbose = FALSE) { - - if (start_year < has_start_year) { - if (verbose) { - print(paste0(shQuote(temp_call), ": covers years ", has_start_year, "-", - has_end_year, "; requested start year ", start_year, " was changed to ", - has_start_year, ".")) - } - start_year <- as.integer(has_start_year) - - } else { - start_year <- as.integer(start_year) - } - - if (end_year > has_end_year) { - if (verbose) { - print(paste0(shQuote(temp_call), ": covers years ", has_start_year, "-", - has_end_year, "; requested end year ", end_year, " was changed to ", - has_end_year, ".")) - } - end_year <- as.integer(has_end_year) - - } else { - end_year <- as.integer(end_year) - } - - - list(start_year = start_year, end_year = end_year) -} diff --git a/R/Vegetation.R b/R/Vegetation.R deleted file mode 100644 index a5429ffe..00000000 --- a/R/Vegetation.R +++ /dev/null @@ -1,733 +0,0 @@ - -#' Calculate the composition of a potential natural vegetation based of shrub, -#' C3 grass, and C4 grass functional group components using climate -#' relationships -#' -#' Equations by Paruelo & Lauenroth 1996 are used to estimate shrub, C3 grass, -#' and C3 grass components. Equations by Teeri & Stowe 1976 are used to limit -#' occurrence of C4 grasses. -#' -#' @section Note: This function does not estimate cover of the tree, forb, -#' and bare-ground components; instead, these are set to 0. -#' -#' @param MAP_mm A numeric value. Mean annual precipitation in millimeter of the -#' location. -#' @param MAT_C A numeric value. Mean annual temperature in degree Celsius. -#' @param mean_monthly_ppt_mm A numeric vector of length 12. Mean monthly -#' precipitation in millimeter. -#' @param dailyC4vars A named numeric vector of length 3. \describe{ -#' \item{\code{Month7th_NSadj_MinTemp_C}}{Mean minimum temperature of July on -#' the northern hemisphere and January on the southern hemisphere} -#' \item{\code{DegreeDaysAbove65F_NSadj_DaysC}}{Degree days above 65 F = 18.33 -#' C in units of days x degree Celsius} -#' \item{\code{LengthFreezeFreeGrowingPeriod_NSadj_Days}}{Mean annual number -#' of days of the longest continuous period where minimum daily temperature -#' remain above freezing} } -#' @param isNorth A logical value. \code{TRUE} for locations on northern -#' hemisphere. -#' @param shrub_limit A numeric value. Default value is 0.2 based on page 1213 -#' of Paruelo & Lauenroth 1996. -#' @param fix_annuals A logical value. If \code{TRUE}, then value for the annual -#' component is fixed at \code{Annuals_Fraction}. -#' @param Annuals_Fraction A numeric value. Default value is 0. A value between -#' 0 and 1. -#' @param fix_C4grasses A logical value. If \code{TRUE}, then value for the -#' C4-grass component is fixed at \code{C4_Fraction} instead of calculated -#' from climatic relationships. -#' @param C4_Fraction A numeric value between 0 and 1. \code{NA} is treated as -#' if \code{fix_C4grasses} is \code{FALSE}. -#' @param fix_C3grasses A logical value. If \code{TRUE}, then value for the -#' C3-grass component is fixed at \code{C3_Fraction} instead of calculated -#' from climatic relationships. -#' @param C3_Fraction A numeric value between 0 and 1. \code{NA} is treated as -#' if \code{fix_C3grasses} is \code{FALSE}. -#' @param fix_shrubs A logical value. If \code{TRUE}, then value for the shrub -#' component is fixed at \code{Shrubs_Fraction} instead of calculated from -#' climatic relationships. -#' @param Shrubs_Fraction A numeric value between 0 and 1. \code{NA} is treated -#' as if \code{fix_shrubs} is \code{FALSE}. -#' @param fix_forbs A logical value. If \code{TRUE}, then value for the forb -#' component is fixed at \code{Forbs_Fraction}. -#' @param Forbs_Fraction A numeric value. Default value is 0. A value between 0 -#' and 1. -#' @param fix_trees A logical value. If \code{TRUE}, then value for the -#' tree component is fixed at \code{Trees_Fraction}. -#' @param Trees_Fraction A numeric value between 0 and 1. \code{NA} is treated as -#' if \code{fix_trees} is \code{FALSE}. -#' @param fix_BareGround A logical value. If \code{TRUE}, then value for the -#' bare ground component is fixed at \code{BareGround_Fraction}. -#' @param BareGround_Fraction A numeric value. Default value is 0. A value -#' between 0 and 1. -#' -#' @return A list with two named numeric vectors. \describe{ -#' \item{Composition}{Relative composition [0-1] of the vegetation for -#' \code{Grasses}, \code{Shrubs}, \code{Trees}, \code{Forbs}, and -#' \code{BareGround}. \code{Grasses} are the sum of C3-grasses, C4-grasses, -#' and annuals functional groups. The sum of -#' \code{Composition} is 1.} -#' \item{grasses.c3c4ann.fractions}{Relative contribution [0-1] of the -#' C3-grasses, C4-grasses, and annuals functional groups. The sum of -#' \code{grasses.c3c4ann.fractions} is 1.} } -#' -#' @references Paruelo J.M., Lauenroth W.K. (1996) Relative abundance of plant -#' functional types in grasslands and shrublands of North America. Ecological -#' Applications, 6, 1212-1224. -#' @references Teeri J.A., Stowe L.G. (1976) Climatic patterns and the -#' distribution of C4 grasses in North America. Oecologia, 23, 1-12. -#' -#' @export -estimate_PotNatVeg_composition <- function(MAP_mm, MAT_C, - mean_monthly_ppt_mm, dailyC4vars, isNorth = TRUE, shrub_limit = 0.2, - fix_annuals = TRUE, Annuals_Fraction = 0, - fix_C4grasses = FALSE, C4_Fraction = NA, - fix_C3grasses = FALSE, C3_Fraction = NA, - fix_shrubs = FALSE, Shrubs_Fraction = NA, - fix_forbs = FALSE, Forbs_Fraction = NA, - fix_trees = FALSE, Trees_Fraction = NA, - fix_BareGround = TRUE, BareGround_Fraction = 0) { - - f.digits <- 3 - tolerance <- 1.1 * 10 ^ -f.digits - - # Get the user specified fractions, if column is false set to NA - tree.fraction <- 0 - forb.fraction <- 0 - bareGround.fraction <- 0 - # Input cover fraction values: - # annual grasses, C4-grasses, C3-grasses, shrubs, forbs, bare-ground - input_cover <- rep(NA, 7) - - if (fix_annuals) { - input_cover[1] <- finite01(Annuals_Fraction) - } else { - input_cover[1] <- 0 # Annuals can not be NA - } - if (fix_C4grasses) - input_cover[2] <- C4_Fraction - if (fix_C3grasses) - input_cover[3] <- C3_Fraction - if (fix_shrubs) - input_cover[4] <- Shrubs_Fraction - - if (fix_forbs) { - input_cover[5] <- finite01(Forbs_Fraction) - } else { - input_cover[5] <- forb.fraction - } - if (fix_BareGround) { - input_cover[6] <- finite01(BareGround_Fraction) - } else { - input_cover[6] <- bareGround.fraction - } - if (fix_trees) { - # bounds Trees_Fraction to [0, 1] - input_cover[7] <- finite01(Trees_Fraction) - } else { - input_cover[7] <- tree.fraction - } - input_cover <- cut0Inf(input_cover) # treat negatives as if NA - TotalFraction <- sum(input_cover, na.rm = TRUE) - - # Decide if all fractions are sufficiently defined or if they need to be - # calculated based on climate variables - isna <- is.na(input_cover) - isone <- isTRUE(all.equal(TotalFraction, 1, tolerance = tolerance)) - if (!isone && TotalFraction < 1 && sum(isna) == 0) { - stop(" run: User defined fractions of Shrub, C3, C4, Annuals are all set, ", - "but less than 1") - } - - if (isone || TotalFraction > 1 || sum(isna) == 1) { - - if (sum(isna) == 1) { - # if only one is NA, then this can be calculated - input_cover[which(isna)] <- cut0Inf(1 - TotalFraction, val = 0) - } else { - # the composition is >= 1, so set eventually remaining NA to 0 - input_cover <- finite01(input_cover) - } - - TotalFraction <- sum(input_cover, na.rm = TRUE) - input_cover <- input_cover / TotalFraction - - } else { - # i.e., (TotalFraction < 1 && - # sum(is.na(input_cover)) > 1) is TRUE; - # thus, calculate some fractions based on climate variables - if (isNorth) { - Months_WinterTF <- c(12, 1:2) - Months_SummerTF <- c(6:8) - } else { - Months_WinterTF <- c(6:8) - Months_SummerTF <- c(12, 1:2) - } - ppt.SummerToMAP <- sum(mean_monthly_ppt_mm[Months_SummerTF]) / MAP_mm - ppt.WinterToMAP <- sum(mean_monthly_ppt_mm[Months_WinterTF]) / MAP_mm - - #---Potential natural vegetation - # 1. step: Paruelo JM, Lauenroth WK (1996) - if (MAP_mm < 1) { - shrubs.fractionNA <- NA - } else { - # if NA, then not enough winter precipitation above a given MAP - shrubs.fractionNA <- cut0Inf(1.7105 - 0.2918 * log(MAP_mm) + - 1.5451 * ppt.WinterToMAP) - } - - if (MAT_C <= 0) { - grass.c4.fractionNA <- 0 - } else { - # if NA, then either MAT < 0 or not enough summer precipitation or - # too cold below a given MAP - grass.c4.fractionNA <- cut0Inf(-0.9837 + 0.000594 * MAP_mm + - 1.3528 * ppt.SummerToMAP + 0.2710 * log(MAT_C)) - } - - if (ppt.WinterToMAP <= 0) { - c3_in_grassland <- c3_in_shrubland <- NA - } else { - # if NA, then not enough winter precipitation or too warm below a - # given MAP - c3_in_grassland <- cut0Inf(1.1905 - 0.02909 * MAT_C + - 0.1781 * log(ppt.WinterToMAP) - 0.2383 * 1) - c3_in_shrubland <- cut0Inf(1.1905 - 0.02909 * MAT_C + - 0.1781 * log(ppt.WinterToMAP) - 0.2383 * 2) - } - - temp <- shrubs.fractionNA >= shrub_limit && !is.na(shrubs.fractionNA) - grass.c3.fractionNA <- ifelse(temp, c3_in_shrubland, c3_in_grassland) - - grass.Annual.fraction <- input_cover[1] #Ann will be 0 or something <= 1 - - # 2. step: Teeri JA, Stowe LG (1976) - # This equations give percent species/vegetation -> use to limit - # Paruelo's C4 equation, i.e., where no C4 species => C4 abundance == 0 - if (dailyC4vars["LengthFreezeFreeGrowingPeriod_NSadj_Days"] <= 0) { - grass.c4.species <- 0 - } else { - x10 <- dailyC4vars["Month7th_NSadj_MinTemp_C"] * 9 / 5 + 32 - x13 <- dailyC4vars["DegreeDaysAbove65F_NSadj_DaysC"] * 9 / 5 - x18 <- log(dailyC4vars["LengthFreezeFreeGrowingPeriod_NSadj_Days"]) - grass.c4.species <- as.numeric( - (1.60 * x10 + 0.0086 * x13 - 8.98 * x18 - 22.44) / 100) - } - grass.c4.fractionNA <- ifelse(grass.c4.species >= 0, grass.c4.fractionNA, - NA) - - # 3. step: Replacing missing values: If no or only one successful equation, - # then add [these rules are made up arbitrarily by drs, Nov 2012] - # 100% C3 if MAT < 10 C, - # 100% shrubs if MAP < 600 mm, and - # 100% C4 if MAT >= 10C & MAP >= 600 mm - temp <- sum(!is.na(shrubs.fractionNA), !is.na(grass.c4.fractionNA), - !is.na(grass.c3.fractionNA)) - if (temp <= 1) { - if (MAP_mm < 600) { - shrubs.fractionNA <- 1 + ifelse(is.na(shrubs.fractionNA), 0, - shrubs.fractionNA) - } - - if (MAT_C < 10) { - grass.c3.fractionNA <- 1 + ifelse(is.na(grass.c3.fractionNA), 0, - grass.c3.fractionNA) - } - - if (MAT_C >= 10 & MAP_mm >= 600) { - grass.c4.fractionNA <- 1 + ifelse(is.na(grass.c4.fractionNA), 0, - grass.c4.fractionNA) - } - } - - # 4. step: Scale fractions to 0-1 with a sum of 1 including - # grass.Annual.fraction, but don't scale grass.Annual.fraction - # if na then use calc fraction else use the user defined fraction - shrubs.fraction <- NAto0(shrubs.fractionNA) - grass.c4.fraction <- NAto0(grass.c4.fractionNA) - grass.c3.fraction <- NAto0(grass.c3.fractionNA) - - # scale down to 1-annual fraction: - sumVegWithoutAnnuals <- shrubs.fraction + grass.c4.fraction + - grass.c3.fraction - ann_min1 <- 1 - grass.Annual.fraction - shrubs.fraction <- (shrubs.fraction / sumVegWithoutAnnuals) * ann_min1 - grass.c4.fraction <- (grass.c4.fraction / sumVegWithoutAnnuals) * ann_min1 - grass.c3.fraction <- (grass.c3.fraction / sumVegWithoutAnnuals) * ann_min1 - - calc_cover <- c(grass.Annual.fraction, grass.c4.fraction, - grass.c3.fraction, shrubs.fraction) - naIndex <- which(is.na(input_cover)) - - # replace missing values - temp <- sum(input_cover[!naIndex]) - temp1 <- isTRUE(all.equal(sum(calc_cover[naIndex]), 0)) - temp2 <- isTRUE(all.equal(temp, 0)) - if (temp1 && temp2) { - # there would be no vegetation, so force vegetation > 0 - input_cover[naIndex] <- (1 - temp) / length(naIndex) - } else { - input_cover[naIndex] <- calc_cover[naIndex] - } - - # now we need to get the sum and scale the naIndex values accordingly - input_cover[naIndex] <- sapply(input_cover[naIndex], function(x) - (x / sum(input_cover[naIndex])) * (1 - sum(input_cover[-naIndex]))) - } - - # Scale Grass components to one (or set to 0) - grass.fraction <- sum(input_cover[c(1:3)]) - - sum_temp <- sum(input_cover[4:7]) - c3c4ann <- rep(0, 3L) - if (!isTRUE(all.equal(sum_temp, 1))) { - c3c4ann[2L] <- input_cover[2] / (1 - sum_temp) - c3c4ann[1L] <- input_cover[3] / (1 - sum_temp) - c3c4ann[3L] <- input_cover[1] / (1 - sum_temp) - } - - list( - Composition = c( - Grasses = grass.fraction, - Shrubs = input_cover[4], - Trees = input_cover[7], - Forbs = input_cover[5], - BareGround = input_cover[6]), - - grasses.c3c4ann.fractions = c( - C3 = c3c4ann[1L], - C4 = c3c4ann[2L], - Annuals = c3c4ann[3L]) - ) -} - -predict_season <- function(biomass_Standard, std.season.padded, std.season.seq, - site.season.seq) { - - # length(std.season.seq) >= 3 because of padding and - # test that season duration > 0 - lcoef <- calc.loess_coeff(N = length(std.season.seq), span = 0.4) - - op <- options(c("warn", "error")) - on.exit(options(op)) - # turn off warnings because stats::loess throws many warnings: - # 'pseudoinverse used', see calc.loess_coeff(), etc. - options(warn = -1, error = traceback) - - sapply(apply(biomass_Standard, 2, function(x) { - lf <- stats::loess(x[std.season.padded] ~ std.season.seq, - span = lcoef$span, degree = lcoef$degree) - stats::predict(lf, newdata = data.frame(std.season.seq = site.season.seq)) - }), - FUN = function(x) max(0, x)) # guarantee that > 0 -} - -#' Biomass equations -#' -#' @param MAP_mm A numeric vector. Mean annual precipitation in -#' millimeters (mm). -#' @references Milchunas & Lauenroth 1993 (Fig. 2): -#' Y [g/m2/yr] = c1 * MAP [mm/yr] + c2 -#' @name biomass -NULL - -#' Estimate shrub biomass density from mean annual precipitation -#' @export -#' @rdname biomass -Shrub_ANPP <- function(MAP_mm) 0.393 * MAP_mm - 10.2 - -#' Estimate grass biomass density from mean annual precipitation -#' @export -#' @rdname biomass -Grass_ANPP <- function(MAP_mm) 0.646 * MAP_mm - 102.5 - -adjBiom_by_ppt <- function(biom_shrubs, biom_C3, biom_C4, biom_annuals, - biom_maxs, map_mm_shrubs, map_mm_std_shrubs, - map_mm_grasses, map_mm_std_grasses, - vegcomp_std_shrubs, vegcomp_std_grass) { - - # Intercepts to match outcomes of M & L 1993 equations under 'default' - # MAP with our previous default inputs for shrubs and sgs-grasslands - # Whereas these intercepts were introduced artificially, they could also be - # interpreted as perennial storage, e.g., Lauenroth & Whitman (1977) found - # "Accumulation in the standing dead was 63% of inputs, in the litter 8%, - # and belowground 37%.". Lauenroth, W.K. & Whitman, W.C. (1977) - # Dynamics of dry matter production in a mixed-grass prairie in western - # North Dakota. Oecologia, 27, 339-351. - Shrub_ANPPintercept <- (vegcomp_std_shrubs[1] * biom_maxs["Sh.Amount.Live"] + - vegcomp_std_shrubs[2] * biom_maxs["C3.Amount.Live"] + - vegcomp_std_shrubs[3] * biom_maxs["C4.Amount.Live"]) - - Shrub_ANPP(map_mm_std_shrubs) - Grasses_ANPPintercept <- (vegcomp_std_grass[1] * biom_maxs["Sh.Amount.Live"] + - vegcomp_std_grass[2] * biom_maxs["C3.Amount.Live"] + - vegcomp_std_grass[3] * biom_maxs["C4.Amount.Live"]) - - Grass_ANPP(map_mm_std_grasses) - - # Get scaling values for scaled biomass; guarantee that > minimum.totalBiomass - minimum.totalBiomass <- 0 # This is a SOILWAT2 parameter - Shrub_BiomassScaler <- max(minimum.totalBiomass, - Shrub_ANPP(map_mm_shrubs) + Shrub_ANPPintercept) - Grass_BiomassScaler <- max(minimum.totalBiomass, - Grass_ANPP(map_mm_grasses) + Grasses_ANPPintercept) - - # Scale live biomass amount by productivity; assumption: - # ANPP = peak standing live biomass - biom_shrubs$Sh.Amount.Live <- biom_shrubs$Sh.Amount.Live * Shrub_BiomassScaler - biom_C3$C3.Amount.Live <- biom_C3$C3.Amount.Live * Grass_BiomassScaler - biom_C4$C4.Amount.Live <- biom_C4$C4.Amount.Live * Grass_BiomassScaler - biom_annuals$Annual.Amount.Live <- - biom_annuals$Annual.Amount.Live * Grass_BiomassScaler - - #Scale litter amount by productivity and adjust for ratio of litter/live - biom_shrubs$Sh.Litter <- biom_shrubs$Sh.Litter * Shrub_BiomassScaler * - biom_maxs["Sh.Litter"] / biom_maxs["Sh.Amount.Live"] - biom_C3$C3.Litter <- biom_C3$C3.Litter * Grass_BiomassScaler * - biom_maxs["C3.Litter"] / biom_maxs["C3.Amount.Live"] - biom_C4$C4.Litter <- biom_C4$C4.Litter * Grass_BiomassScaler * - biom_maxs["C4.Litter"] / biom_maxs["C4.Amount.Live"] - biom_annuals$Annual.Litter <- biom_annuals$Annual.Litter * - Grass_BiomassScaler * - biom_maxs["Annual.Litter"] / biom_maxs["Annual.Amount.Live"] - - #Guarantee that live fraction = ]0, 1] - biom_shrubs$Sh.Perc.Live <- pmin(1, pmax(SFSW2_glovars[["tol"]], - biom_shrubs$Sh.Perc.Live)) - biom_C3$C3.Perc.Live <- pmin(1, pmax(SFSW2_glovars[["tol"]], - biom_C3$C3.Perc.Live)) - biom_C4$C4.Perc.Live <- pmin(1, pmax(SFSW2_glovars[["tol"]], - biom_C4$C4.Perc.Live)) - biom_annuals$Annual.Perc.Live <- pmin(1, pmax(SFSW2_glovars[["tol"]], - biom_annuals$Annual.Perc.Live)) - - #Calculate total biomass based on scaled live biomass amount - biom_shrubs$Sh.Biomass <- biom_shrubs$Sh.Amount.Live / - biom_shrubs$Sh.Perc.Live - biom_C3$C3.Biomass <- biom_C3$C3.Amount.Live / biom_C3$C3.Perc.Live - biom_C4$C4.Biomass <- biom_C4$C4.Amount.Live / biom_C4$C4.Perc.Live - biom_annuals$Annual.Biomass <- biom_annuals$Annual.Amount.Live / - biom_annuals$Annual.Perc.Live - - list(biom_shrubs = biom_shrubs, - biom_C3 = biom_C3, - biom_C4 = biom_C4, - biom_annuals = biom_annuals) -} - - -#' Adjust mean monthly biomass values of grass and shrub functional groups by -#' climate relationships -#' -#' @param tr_VegBiom A data.frame with 12 rows (one for each month) and columns -#' \code{X.Biomass}, \code{X.Amount.Live}, \code{X.Perc.Live}, and -#' \code{X.Litter} where \code{X} are for the functional groups shrubs, -#' \code{X = Sh}; C3-grasses, \code{X = C3}; C4-grasses, \code{X = C4}; and -#' annuals, \code{X = Annual} containing default input values. -#' @param do_adjBiom_by_temp A logical value. If \code{TRUE} then monthly -#' phenology is adjusted by temperature. -#' @param do_adjBiom_by_ppt A logical value. If \code{TRUE} then monthly biomass -#' is adjusted by precipitation. -#' @param fgrass_c3c4ann A numeric vector of length 3. Relative contribution -#' [0-1] of the C3-grasses, C4-grasses, and annuals functional groups. The sum -#' of \code{fgrass_c3c4ann} is 1. -#' @param growing_limit_C A numeric value. Mean monthly temperatures equal or -#' above this limit are here considered suitable for growth (growing season). -#' Default value is 4 C. -#' @param isNorth A logical value. \code{TRUE} for locations on northern -#' hemisphere. -#' @param MAP_mm A numeric value. Mean annual precipitation in millimeter of the -#' location. -#' @param mean_monthly_temp_C A numeric vector of length 12. Mean monthly -#' temperature in Celsius. The default inputs considered March-October as -#' growing season. -#' -#' @section Default inputs: \itemize{ -#' \item Shrubs are based on location \var{\sQuote{IM_USC00107648_Reynolds}} -#' which resulted in a vegetation composition of 70 \% shrubs and 30 \% -#' C3-grasses. Default monthly biomass values were estimated for -#' MAP = 450 mm yr-1. -#' \item Grasses are based on location \var{\sQuote{GP_SGSLTER}} -#' (shortgrass steppe) which resulted in 12 \% shrubs, 22 \% C3-grasses, -#' and 66 \% C4-grasses. Default biomass values were estimated for -#' MAP = 340 mm yr-1. } -#' -#' @return A list with two elements \code{grass}, \code{shrub}. Each element is -#' a matrix with 12 rows (one for each month) and columns \code{Biomass}, -#' \code{Amount.Live}, \code{Perc.Live}, and \code{Litter}. -#' -#' @references Bradford, J.B., Schlaepfer, D.R., Lauenroth, W.K. & Burke, I.C. -#' (2014). Shifts in plant functional types have time-dependent and regionally -#' variable impacts on dryland ecosystem water balance. J Ecol, 102, -#' 1408-1418. -#' -#' @export -estimate_PotNatVeg_biomass <- function(tr_VegBiom, - do_adjBiom_by_temp = FALSE, do_adjBiom_by_ppt = FALSE, - fgrass_c3c4ann = c(1, 0, 0), growing_limit_C = 4, isNorth = TRUE, - MAP_mm = 450, - mean_monthly_temp_C = c(rep(growing_limit_C - 1, 2), - rep(growing_limit_C + 1, 8), - rep(growing_limit_C - 1, 2))) { - - # Default shrub biomass input is at MAP = 450 mm/yr, and default grass - # biomass input is at MAP = 340 mm/yr - # Describe conditions for which the default vegetation biomass values are - # valid - std.winter <- c(11:12, 1:2) # Assumes that the "growing season" - # (valid for growing_limit_C == 4) in 'tr_VegetationComposition' starts in - # March and ends after October, for all functional groups. - std.growing <- SFSW2_glovars[["st_mo"]][-std.winter] # Assumes that the - # "growing season" in 'tr_VegetationComposition' starts in March and ends - # after October, for all functional groups. - - #Default site for the grass description is SGS LTER - StandardGrasses_MAP_mm <- 340 - StandardGrasses_VegComposition <- c(0.12, 0.22, 0.66) # shrubs, C3, and C4 - #Default site for the shrub description is Reynolds Creek, ID - StandardShrub_MAP_mm <- 250 - StandardShrub_VegComposition <- c(0.7, 0.3, 0) # shrubs, C3, and C4 - - #Calculate 'live biomass amount' - tr_VegBiom$Sh.Amount.Live <- tr_VegBiom$Sh.Biomass * tr_VegBiom$Sh.Perc.Live - tr_VegBiom$C3.Amount.Live <- tr_VegBiom$C3.Biomass * tr_VegBiom$C3.Perc.Live - tr_VegBiom$C4.Amount.Live <- tr_VegBiom$C4.Biomass * tr_VegBiom$C4.Perc.Live - tr_VegBiom$Annual.Amount.Live <- tr_VegBiom$Annual.Biomass * - tr_VegBiom$Annual.Perc.Live - - # Scale monthly values of litter and live biomass amount by column-max; - # total biomass will be back calculated - itemp <- grepl("Litter", names(tr_VegBiom)) | - grepl("Amount.Live", names(tr_VegBiom)) - colmax <- apply(tr_VegBiom[, itemp], MARGIN = 2, FUN = max) - tr_VegBiom[, itemp] <- sweep(tr_VegBiom[, itemp], MARGIN = 2, - STATS = colmax, FUN = "/") - - #Pull different vegetation types - biom_shrubs <- biom_std_shrubs <- tr_VegBiom[, grepl("Sh", names(tr_VegBiom))] - biom_C3 <- biom_std_C3 <- tr_VegBiom[, grepl("C3", names(tr_VegBiom))] - biom_C4 <- biom_std_C4 <- tr_VegBiom[, grepl("C4", names(tr_VegBiom))] - biom_annuals <- biom_std_annuals <- tr_VegBiom[, - grepl("Annual", names(tr_VegBiom))] - - #adjust phenology for mean monthly temperatures - if (do_adjBiom_by_temp) { - growing.season <- as.vector(mean_monthly_temp_C >= growing_limit_C) - n_nonseason <- sum(!growing.season) - n_season <- sum(growing.season) - - if (!isNorth) - # Standard growing season needs to be adjusted for southern Hemisphere - growing.season <- c(growing.season[7:12], growing.season[1:6]) - - #Adjust for timing and duration of non-growing season - if (n_nonseason > 0) { - if (n_nonseason < 12) { - temp <- c(std.winter[1] - 1, std.winter, - std.winter[length(std.winter)] + 1) - 1 - std.winter.padded <- temp %% 12 + 1 - std.winter.seq <- 0:(length(std.winter.padded) - 1) - site.winter.seq <- seq(from = 1, to = length(std.winter), - length = n_nonseason) - starts <- calc_starts(!growing.season) - # Calculate first month of winter == last start of non-growing season - site.winter.start <- starts[length(starts)] - temp <- site.winter.start + seq_len(n_nonseason) - 2 - site.winter.months <- temp %% 12 + 1 - - biom_shrubs[site.winter.months, ] <- predict_season(biom_std_shrubs, - std.winter.padded, std.winter.seq, site.winter.seq) - biom_C3[site.winter.months, ] <- predict_season(biom_std_C3, - std.winter.padded, std.winter.seq, site.winter.seq) - biom_C4[site.winter.months, ] <- predict_season(biom_std_C4, - std.winter.padded, std.winter.seq, site.winter.seq) - biom_annuals[site.winter.months, ] <- predict_season(biom_std_annuals, - std.winter.padded, std.winter.seq, site.winter.seq) - - } else { - # if winter lasts 12 months: take the mean of the winter months - temp <- apply(biom_std_shrubs[std.winter, ], 2, mean) - biom_shrubs[] <- matrix(temp, nrow = 12, ncol = ncol(biom_shrubs), - byrow = TRUE) - temp <- apply(biom_std_C3[std.winter, ], 2, mean) - biom_C3[] <- matrix(temp, nrow = 12, ncol = ncol(biom_C3), byrow = TRUE) - temp <- apply(biom_std_C4[std.winter, ], 2, mean) - biom_C4[] <- matrix(temp, nrow = 12, ncol = ncol(biom_C4), byrow = TRUE) - temp <- apply(biom_std_annuals[std.winter, ], 2, mean) - biom_annuals[] <- matrix(temp, nrow = 12, ncol = ncol(biom_annuals), - byrow = TRUE) - } - } - - #Adjust for timing and duration of growing season - if (n_season > 0) { - if (n_season < 12) { - temp <- c(std.growing[1] - 1, std.growing, - std.growing[length(std.growing)] + 1) - 1 - std.growing.padded <- temp %% 12 + 1 - std.growing.seq <- 0:(length(std.growing.padded) - 1) - site.growing.seq <- seq(from = 1, to = length(std.growing), - length = n_season) - starts <- calc_starts(growing.season) - # Calculate first month of growing season == first start of - # growing season - site.growing.start <- starts[1] - temp <- site.growing.start + seq_len(n_season) - 2 - site.growing.months <- temp %% 12 + 1 - - biom_shrubs[site.growing.months, ] <- predict_season(biom_std_shrubs, - std.growing.padded, std.growing.seq, site.growing.seq) - biom_C3[site.growing.months, ] <- predict_season(biom_std_C3, - std.growing.padded, std.growing.seq, site.growing.seq) - biom_C4[site.growing.months, ] <- predict_season(biom_std_C4, - std.growing.padded, std.growing.seq, site.growing.seq) - biom_annuals[site.growing.months, ] <- predict_season(biom_std_annuals, - std.growing.padded, std.growing.seq, site.growing.seq) - - } else { - # if growing season lasts 12 months - temp <- apply(biom_std_shrubs[std.growing, ], 2, max) - biom_shrubs[] <- matrix(temp, nrow = 12, ncol = ncol(biom_shrubs), - byrow = TRUE) - temp <- apply(biom_std_C3[std.growing, ], 2, max) - biom_C3[] <- matrix(temp, nrow = 12, ncol = ncol(biom_C3), byrow = TRUE) - temp <- apply(biom_std_C4[std.growing, ], 2, max) - biom_C4[] <- matrix(temp, nrow = 12, ncol = ncol(biom_C4), byrow = TRUE) - temp <- apply(biom_std_annuals[std.growing, ], 2, max) - biom_annuals[] <- matrix(temp, nrow = 12, ncol = ncol(biom_annuals), - byrow = TRUE) - } - } - - if (!isNorth) { - # Adjustements were done as if on northern hemisphere - biom_shrubs <- rbind(biom_shrubs[7:12, ], biom_shrubs[1:6, ]) - biom_C3 <- rbind(biom_C3[7:12, ], biom_C3[1:6, ]) - biom_C4 <- rbind(biom_C4[7:12, ], biom_C4[1:6, ]) - biom_annuals <- rbind(biom_annuals[7:12, ], biom_annuals[1:6, ]) - } - } - - # if (do_adjBiom_by_ppt) then adjust biomass amounts by productivity - # relationship with MAP - temp <- adjBiom_by_ppt(biom_shrubs, biom_C3, biom_C4, biom_annuals, - biom_maxs = colmax, - map_mm_shrubs = if (do_adjBiom_by_ppt) MAP_mm else StandardShrub_MAP_mm, - map_mm_std_shrubs = StandardShrub_MAP_mm, - map_mm_grasses = if (do_adjBiom_by_ppt) MAP_mm else StandardGrasses_MAP_mm, - map_mm_std_grasses = StandardGrasses_MAP_mm, - vegcomp_std_shrubs = StandardShrub_VegComposition, - vegcomp_std_grass = StandardGrasses_VegComposition) - - biom_grasses <- temp$biom_C3 * fgrass_c3c4ann[1] + - temp$biom_C4 * fgrass_c3c4ann[2] + - temp$biom_annuals * fgrass_c3c4ann[3] - cn <- dimnames(biom_grasses)[[2]] - cn <- sapply(strsplit(cn, split = ".", fixed = TRUE), - function(x) paste0(x[-1], collapse = ".")) - dimnames(biom_grasses)[[2]] <- cn - - biom_shrubs <- temp$biom_shrubs - dimnames(biom_shrubs)[[2]] <- cn - - list(grass = as.matrix(biom_grasses), - shrub = as.matrix(biom_shrubs)) -} - -#' Lookup transpiration coefficients -#' -#' Lookup transpiration coefficients for grasses, shrubs, and trees per soil -#' layer or per soil depth increment of 1 cm per distribution type for -#' each simulation run and copy values to \var{\sQuote{datafile.soils}} -#' -#' \itemize{ -#' \item first row of datafile is label for per soil layer -#' \var{\dQuote{Layer}} or per soil depth increment of 1 cm -#' \var{\dQuote{DepthCM}} -#' \item second row of datafile is source of data -#' \item the other rows contain the data for each distribution type = columns -#' } -#' @section Note: cannot write data from \var{\sQuote{sw_input_soils}} to -#' \var{\sQuote{datafile.soils}} -#' @export -TranspCoeffByVegType <- function(tr_input_code, tr_input_coeff, - soillayer_no, trco_type, layers_depth, - adjustType = c("positive", "inverse", "allToLast")) { - - #extract data from table by category - trco.code <- as.character(tr_input_code[, - which(colnames(tr_input_code) == trco_type)]) - trco <- rep(0, times = soillayer_no) - trco.raw <- stats::na.omit(tr_input_coeff[, - which(colnames(tr_input_coeff) == trco_type)]) - - if (trco.code == "DepthCM") { - temp <- sum(trco.raw, na.rm = TRUE) - trco_sum <- if (temp == 0 || is.na(temp)) 1L else temp - lup <- 1 - for (l in 1:soillayer_no) { - llow <- as.numeric(layers_depth[l]) - if (is.na(llow) | lup > length(trco.raw)) { - l <- l - 1 - break - } - trco[l] <- sum(trco.raw[lup:llow], na.rm = TRUE) / trco_sum - lup <- llow + 1 - } - usel <- l - - } else if (trco.code == "Layer") { - usel <- if (length(trco.raw) < soillayer_no) { - length(trco.raw) - } else soillayer_no - - ltemp <- seq_len(usel) - stemp <- sum(trco.raw[ltemp], na.rm = TRUE) - temp <- if (stemp == 0 && is.na(stemp)) 1 else stemp - trco[ltemp] <- trco.raw[ltemp] / temp - } - - if (identical(adjustType, "positive")) { - # equivalent to: trco + (1 - sum(trco)) * trco / sum(trco) - trco <- trco / sum(trco) - - } else if (identical(adjustType, "inverse")) { - irows <- 1:max(which(trco > 0)) - # equivalent to: trco + (1 - sum(trco)) * rev(trco) / sum(trco) - trco[irows] <- trco[irows] + rev(trco[irows]) * (1 / sum(trco[irows]) - 1) - - } else if (identical(adjustType, "allToLast")) { - irow <- max(which(trco > 0)) - if (irow > 1) { - # adding all the missing roots because soil is too shallow to the - # deepest available layer - trco[irow] <- 1 - sum(trco[1:(irow - 1)]) - } else { - trco[1] <- 1 - } - } - - trco -} - -#' Replace selected biomass values of a -#' \link[rSOILWAT2:swProd-class]{rSOILWAT2::swProd} object -#' -#' @param fg A character string. One of the functional groups represented by -#' \code{rSOILWAT2} -#' @param use A logical vector. -update_biomass <- function(fg = c("Grass", "Shrub", "Tree", "Forb"), use, - prod_input, prod_default) { - - fg <- match.arg(fg) - - comps <- c("_Litter", "_Biomass", "_FractionLive", "_LAIconv") - veg_ids <- lapply(comps, function(x) - grep(paste0(fg, x), names(use))) - veg_incl <- lapply(veg_ids, function(x) use[x]) - - temp <- rSOILWAT2::swProd_MonProd_veg(prod_default, fg) - if (any(unlist(veg_incl))) { - for (k in seq_along(comps)) if (any(veg_incl[[k]])) - temp[veg_incl[[k]], k] <- - as.numeric(prod_input[, veg_ids[[k]][veg_incl[[k]]]]) - } - - temp -} diff --git a/R/WeatherDB.R b/R/WeatherDB.R index a38cf2f7..97d87ab4 100644 --- a/R/WeatherDB.R +++ b/R/WeatherDB.R @@ -534,7 +534,7 @@ ExtractGriddedDailyWeatherFromMaurer2002_NorthAmerica <- function(dir_data, # no } # Check requested years - year_range <- update_requested_years(start_year, end_year, + year_range <- rSOILWAT2::update_requested_years(start_year, end_year, has_start_year = 1949, has_end_year = 2010, temp_call = temp_call, verbose = verbose) @@ -735,7 +735,7 @@ ExtractGriddedDailyWeatherFromDayMet_NorthAmerica_swWeather <- function( # nolin # Check requested years avail_end_year <- as.integer(1900 + as.POSIXlt(Sys.Date())$year - 1) - year_range <- update_requested_years(start_year, end_year, + year_range <- rSOILWAT2::update_requested_years(start_year, end_year, has_start_year = 1980, has_end_year = avail_end_year, temp_call = NULL, verbose = FALSE) @@ -795,7 +795,7 @@ ExtractGriddedDailyWeatherFromDayMet_NorthAmerica_dbW <- function(dir_data, # no # Check requested years avail_end_year <- as.integer(1900 + as.POSIXlt(Sys.Date())$year - 1) - year_range <- update_requested_years(start_year, end_year, + year_range <- rSOILWAT2::update_requested_years(start_year, end_year, has_start_year = 1980, has_end_year = avail_end_year, temp_call = temp_call, verbose = verbose) @@ -895,7 +895,7 @@ ExtractGriddedDailyWeatherFromNRCan_10km_Canada <- function(dir_data, site_ids, } # Check requested years - year_range <- update_requested_years(start_year, end_year, + year_range <- rSOILWAT2::update_requested_years(start_year, end_year, has_start_year = 1950, has_end_year = 2013, temp_call = temp_call, verbose = verbose) @@ -1307,7 +1307,7 @@ GriddedDailyWeatherFromNCEPCFSR_Global <- function(site_ids, site_ids_by_dbW, # } # Check requested years - year_range <- update_requested_years(start_year, end_year, + year_range <- rSOILWAT2::update_requested_years(start_year, end_year, has_start_year = 1979, has_end_year = 2010, temp_call = temp_call, verbose = verbose) @@ -1412,7 +1412,7 @@ extract_daily_weather_from_livneh <- function(dir_data, dir_temp, site_ids, # no } # Check requested years - year_range <- update_requested_years(start_year, end_year, + year_range <- rSOILWAT2::update_requested_years(start_year, end_year, has_start_year = 1915, has_end_year = 2011, temp_call = temp_call, verbose = verbose) diff --git a/R/WorkDatabase.R b/R/WorkDatabase.R index 9c68a458..428146bc 100644 --- a/R/WorkDatabase.R +++ b/R/WorkDatabase.R @@ -789,6 +789,12 @@ dbWork_check_design <- function(path, use_granular_control = FALSE) { #' #' @return A logical vector indicating success. #' +#' @examples +#' \dontrun{ +#' # `SFSW2_prj_meta` object as produced, e.g., for `TestPrj4` +#' recreate_dbWork(SFSW2_prj_meta = SFSW2_prj_meta) +#' } +#' #' @export recreate_dbWork <- function(path, dbOutput, use_granular_control, SFSW2_prj_meta = NULL, verbose = FALSE, print.debug = FALSE) { diff --git a/R/rSOILWAT2_DataAccess.R b/R/rSOILWAT2_DataAccess.R index 5e5a728a..dfa63822 100644 --- a/R/rSOILWAT2_DataAccess.R +++ b/R/rSOILWAT2_DataAccess.R @@ -3,7 +3,7 @@ #' @param x An object of class #' \code{\link[rSOILWAT2:swOutput-class]{rSOILWAT2::swOutput}}. #' @param st An object as returned from the function -#' \code{\link{setup_simulation_time}}. +#' \code{\link{setup_time_simulation_project}}. #' #' @name swOutput_access NULL @@ -113,25 +113,32 @@ get_Response_aggL <- function(response, get_SWPmatric_aggL <- function(vwcmatric, texture, sand, clay) { res <- list() - res[["top"]] <- VWCtoSWP(vwcmatric$top, texture$sand.top, texture$clay.top) - res[["bottom"]] <- VWCtoSWP(vwcmatric$bottom, texture$sand.bottom, - texture$clay.bottom) + if (!is.null(vwcmatric[["top"]])) { + res[["top"]] <- rSOILWAT2::VWCtoSWP(vwcmatric[["top"]], + sand = texture[["sand.top"]], clay = texture[["clay.top"]]) + } + + if (!is.null(vwcmatric$bottom)) { + res[["bottom"]] <- rSOILWAT2::VWCtoSWP(vwcmatric[["bottom"]], + sand = texture[["sand.bottom"]], clay = texture[["clay.bottom"]]) + } - if (!is.null(vwcmatric$aggMean.top)) { - res[["aggMean.top"]] <- VWCtoSWP(vwcmatric$aggMean.top, texture$sand.top, - texture$clay.top) - res[["aggMean.bottom"]] <- VWCtoSWP(vwcmatric$aggMean.bottom, - texture$sand.bottom, texture$clay.bottom) + if (!is.null(vwcmatric[["aggMean.top"]])) { + res[["aggMean.top"]] <- rSOILWAT2::VWCtoSWP(vwcmatric[["aggMean.top"]], + sand = texture[["sand.top"]], clay = texture[["clay.top"]]) + res[["aggMean.bottom"]] <- rSOILWAT2::VWCtoSWP(vwc = + vwcmatric[["aggMean.bottom"]], sand = texture[["sand.bottom"]], + clay = texture[["clay.bottom"]]) } if (!is.null(vwcmatric$val)) { if (all(as.integer(vwcmatric$val[, 2]) == vwcmatric$val[, 2])) { - index.header <- 1:2 + index.header <- 1:2 # daily, weekly, monthly } else { - index.header <- 1 + index.header <- 1 # yearly } - res[["val"]] <- cbind(vwcmatric$val[, index.header], - VWCtoSWP(vwcmatric$val[, -index.header], sand, clay)) + res[["val"]] <- cbind(vwcmatric[["val"]][, index.header], + rSOILWAT2::VWCtoSWP(vwcmatric[["val"]][, -index.header], sand, clay)) } res diff --git a/R/sysdata.rda b/R/sysdata.rda index f1b4f5b1..803d5756 100644 Binary files a/R/sysdata.rda and b/R/sysdata.rda differ diff --git a/data-raw/1_Input/SWRuns_InputData_ExperimentalDesign_v09.csv b/data-raw/1_Input/SWRuns_InputData_ExperimentalDesign_v09.csv index 9e2dbe6d..f6f0dda0 100644 --- a/data-raw/1_Input/SWRuns_InputData_ExperimentalDesign_v09.csv +++ b/data-raw/1_Input/SWRuns_InputData_ExperimentalDesign_v09.csv @@ -1,3 +1,3 @@ -Label,sw,filesin,prodin,siteparamin,soilsin,weathersetupin,cloudin,YearStart,YearEnd,LookupWeatherFolder,LookupClimateTemp,LookupClimatePPT,LookupShiftedPPT,LookupShiftedPPT,LookupSnowDensity,LookupTranspRegions,LookupEvapCoefs,LookupTranspCoefs_Grass,LookupTranspCoefs_Shrub,LookupTranspCoefs_Tree,LookupTranspCoefs_Forb,LookupCO2data,PotentialNaturalVegetation_CompositionShrubsC3C4_Paruelo1996,PotentialNaturalVegetation_CompositionShrubs_Fraction,PotentialNaturalVegetation_CompositionC3_Fraction,PotentialNaturalVegetation_CompositionC4_Fraction,PotentialNaturalVegetation_CompositionAnnuals_Fraction,PotentialNaturalVegetation_CompositionForb_Fraction,PotentialNaturalVegetation_CompositionBareGround_Fraction,PotentialNaturalVegetation_CompositionTrees_Fraction,AdjMonthlyBioMass_Precipitation,AdjMonthlyBioMass_Temperature,AdjRootProfile,RootProfile_C3,RootProfile_C4,RootProfile_Annuals,RootProfile_Shrubs,RootProfile_Forb,Shrub_TotalBiomass_ScalingFactor,Shrub_LiveBiomass_ScalingFactor,Shrub_Litter_ScalingFactor,Grass_TotalBiomass_ScalingFactor,Grass_LiveBiomass_ScalingFactor,Grass_Litter_ScalingFactor,Tree_TotalBiomass_ScalingFactor,Tree_LiveBiomass_ScalingFactor,Tree_Litter_ScalingFactor,Forb_TotalBiomass_ScalingFactor,Forb_LiveBiomass_ScalingFactor,Forb_Litter_ScalingFactor,Vegetation_Biomass_ScalingSeason_AllGrowingORNongrowing,Vegetation_Height_ScalingFactor,PotentialNaturalVegetation_Composition_basedOnReferenceOrScenarioClimate,ClimateScenario_Temp_PerturbationInMeanSeasonalityBothOrNone,ClimateScenario_PPT_PerturbationInMeanSeasonalityBothOrNone,RunoffPercent_fromPondedWater,RunonPercent_fromPondedWater,Imperm_L1,Exclude_ClimateAmbient,Grass_HydRed_OnOff,Shrub_HydRed_OnOff,Tree_HydRed_OnOff,Forb_HydRed_OnOff,SoilTemp_deltaX_cm,SoilTemp_MaxDepth_cm,PET_multiplier,Grass_SWPcrit_MPa,Shrub_SWPcrit_MPa,Tree_SWPcrit_MPa,Forb_SWPcrit_MPa,UseCO2BiomassMultiplier,UseCO2WUEMultiplier,SoilTemp_Flag -UseInformationToCreateSoilWatRuns,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,1,1,1,1,1,1,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1 -DefaultSettings,,,,,,,,,,,,,,,Prairie,CONUSSOIL_BSE_EVERY10cm,,SchenkJackson2003_PCdry_grasses,SchenkJackson2003_PCdry_shrubs,FILL,SchenkJackson2003_PCdry_forbs,FILL,1,,,,,,0.5,0.2,1,1,1,1,1,1,1,1,,,,,,,,,,,,,,,,,,,,,,,,,,15,990,1,-3.5,-3.9,-2,-2,1,1,0 +Label,filesin,prodin,siteparamin,soilsin,weathersetupin,cloudin,YearStart,YearEnd,LookupWeatherFolder,LookupClimateTemp,LookupClimatePPT,LookupShiftedPPT,LookupShiftedPPTCategory,LookupSnowDensity,LookupTranspRegions,LookupEvapCoefs,LookupTranspCoefs_Grass,LookupTranspCoefs_Shrub,LookupTranspCoefs_Tree,LookupTranspCoefs_Forb,LookupCO2data,PotentialNaturalVegetation_CompositionShrubsC3C4_Paruelo1996,PotentialNaturalVegetation_CompositionShrubs_Fraction,PotentialNaturalVegetation_CompositionC3_Fraction,PotentialNaturalVegetation_CompositionC4_Fraction,PotentialNaturalVegetation_CompositionAnnuals_Fraction,PotentialNaturalVegetation_CompositionForb_Fraction,PotentialNaturalVegetation_CompositionBareGround_Fraction,PotentialNaturalVegetation_CompositionTrees_Fraction,AdjMonthlyBioMass_Precipitation,AdjMonthlyBioMass_Temperature,AdjRootProfile,RootProfile_C3,RootProfile_C4,RootProfile_Annuals,RootProfile_Shrubs,RootProfile_Forb,Shrub_TotalBiomass_ScalingFactor,Shrub_LiveBiomass_ScalingFactor,Shrub_Litter_ScalingFactor,Grass_TotalBiomass_ScalingFactor,Grass_LiveBiomass_ScalingFactor,Grass_Litter_ScalingFactor,Tree_TotalBiomass_ScalingFactor,Tree_LiveBiomass_ScalingFactor,Tree_Litter_ScalingFactor,Forb_TotalBiomass_ScalingFactor,Forb_LiveBiomass_ScalingFactor,Forb_Litter_ScalingFactor,Vegetation_Biomass_ScalingSeason_AllGrowingORNongrowing,Vegetation_Height_ScalingFactor,PotentialNaturalVegetation_Composition_basedOnReferenceOrScenarioClimate,ClimateScenario_Temp_PerturbationInMeanSeasonalityBothOrNone,ClimateScenario_PPT_PerturbationInMeanSeasonalityBothOrNone,RunoffPercent_fromPondedWater,RunonPercent_fromPondedWater,Imperm_L1,Exclude_ClimateAmbient,Grass_HydRed_OnOff,Shrub_HydRed_OnOff,Tree_HydRed_OnOff,Forb_HydRed_OnOff,SoilTemp_deltaX_cm,SoilTemp_MaxDepth_cm,PET_multiplier,Grass_SWPcrit_MPa,Shrub_SWPcrit_MPa,Tree_SWPcrit_MPa,Forb_SWPcrit_MPa,UseCO2BiomassMultiplier,UseCO2WUEMultiplier,SoilTemp_Flag +UseInformationToCreateSoilWatRuns,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,1,1,1,1,1,1,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1 +DefaultSettings,,,,,,,,,,,,,,Prairie,CONUSSOIL_BSE_EVERY10cm,,SchenkJackson2003_PCdry_grasses,SchenkJackson2003_PCdry_shrubs,FILL,SchenkJackson2003_PCdry_forbs,FILL,1,,,,,,,,1,1,1,1,1,1,1,1,,,,,,,,,,,,,,,,,,,,,,,,,,15,990,1,-3.5,-3.9,-2,-2,1,1,1 diff --git a/data-raw/1_Input/SWRuns_InputData_TreatmentDesign_v17.csv b/data-raw/1_Input/SWRuns_InputData_TreatmentDesign_v17.csv index 011a1257..4604f017 100644 --- a/data-raw/1_Input/SWRuns_InputData_TreatmentDesign_v17.csv +++ b/data-raw/1_Input/SWRuns_InputData_TreatmentDesign_v17.csv @@ -1,2 +1,2 @@ -Label,sw,filesin,prodin,siteparamin,soilsin,weathersetupin,cloudin,YearStart,YearEnd,LookupWeatherFolder,LookupClimateTemp,LookupClimatePPT,LookupShiftedPPT,LookupShiftedPPT,LookupSnowDensity,LookupTranspRegions,LookupEvapCoefs,LookupTranspCoefs_Grass,LookupTranspCoefs_Shrub,LookupTranspCoefs_Tree,LookupTranspCoefs_Forb,LookupCO2data,PotentialNaturalVegetation_CompositionShrubsC3C4_Paruelo1996,PotentialNaturalVegetation_CompositionShrubs_Fraction,PotentialNaturalVegetation_CompositionC3_Fraction,PotentialNaturalVegetation_CompositionC4_Fraction,PotentialNaturalVegetation_CompositionAnnuals_Fraction,PotentialNaturalVegetation_CompositionForb_Fraction,PotentialNaturalVegetation_CompositionBareGround_Fraction,PotentialNaturalVegetation_CompositionTrees_Fraction,AdjMonthlyBioMass_Precipitation,AdjMonthlyBioMass_Temperature,AdjRootProfile,RootProfile_C3,RootProfile_C4,RootProfile_Annuals,RootProfile_Shrubs,RootProfile_Forbs,Shrub_TotalBiomass_ScalingFactor,Shrub_LiveBiomass_ScalingFactor,Shrub_Litter_ScalingFactor,Grass_TotalBiomass_ScalingFactor,Grass_LiveBiomass_ScalingFactor,Grass_Litter_ScalingFactor,Tree_TotalBiomass_ScalingFactor,Tree_LiveBiomass_ScalingFactor,Tree_Litter_ScalingFactor,Forb_TotalBiomass_ScalingFactor,Forb_LiveBiomass_ScalingFactor,Forb_Litter_ScalingFactor,Vegetation_Biomass_ScalingSeason_AllGrowingORNongrowing,Vegetation_Height_ScalingFactor,PotentialNaturalVegetation_Composition_basedOnReferenceOrScenarioClimate,ClimateScenario_Temp_PerturbationInMeanSeasonalityBothOrNone,ClimateScenario_PPT_PerturbationInMeanSeasonalityBothOrNone,Exclude_ClimateAmbient,MaxTempDepth,UseCO2BiomassMultiplier,UseCO2WUEMultiplier -UseInformationToCreateSoilWatRuns,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 +Label,filesin,prodin,siteparamin,soilsin,weathersetupin,cloudin,YearStart,YearEnd,LookupWeatherFolder,LookupClimateTemp,LookupClimatePPT,LookupShiftedPPT,LookupShiftedPPTCategory,LookupSnowDensity,LookupTranspRegions,LookupEvapCoefs,LookupTranspCoefs_Grass,LookupTranspCoefs_Shrub,LookupTranspCoefs_Tree,LookupTranspCoefs_Forb,LookupCO2data,PotentialNaturalVegetation_CompositionShrubsC3C4_Paruelo1996,PotentialNaturalVegetation_CompositionShrubs_Fraction,PotentialNaturalVegetation_CompositionC3_Fraction,PotentialNaturalVegetation_CompositionC4_Fraction,PotentialNaturalVegetation_CompositionAnnuals_Fraction,PotentialNaturalVegetation_CompositionForb_Fraction,PotentialNaturalVegetation_CompositionBareGround_Fraction,PotentialNaturalVegetation_CompositionTrees_Fraction,AdjMonthlyBioMass_Precipitation,AdjMonthlyBioMass_Temperature,AdjRootProfile,RootProfile_C3,RootProfile_C4,RootProfile_Annuals,RootProfile_Shrubs,RootProfile_Forbs,Shrub_TotalBiomass_ScalingFactor,Shrub_LiveBiomass_ScalingFactor,Shrub_Litter_ScalingFactor,Grass_TotalBiomass_ScalingFactor,Grass_LiveBiomass_ScalingFactor,Grass_Litter_ScalingFactor,Tree_TotalBiomass_ScalingFactor,Tree_LiveBiomass_ScalingFactor,Tree_Litter_ScalingFactor,Forb_TotalBiomass_ScalingFactor,Forb_LiveBiomass_ScalingFactor,Forb_Litter_ScalingFactor,Vegetation_Biomass_ScalingSeason_AllGrowingORNongrowing,Vegetation_Height_ScalingFactor,PotentialNaturalVegetation_Composition_basedOnReferenceOrScenarioClimate,ClimateScenario_Temp_PerturbationInMeanSeasonalityBothOrNone,ClimateScenario_PPT_PerturbationInMeanSeasonalityBothOrNone,Exclude_ClimateAmbient,MaxTempDepth,UseCO2BiomassMultiplier,UseCO2WUEMultiplier +UseInformationToCreateSoilWatRuns,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 diff --git a/data-raw/1_Input/treatments/LookupClimateTemp/climate.temp.csv b/data-raw/1_Input/treatments/LookupClimateTemp/climate_temp.csv similarity index 100% rename from data-raw/1_Input/treatments/LookupClimateTemp/climate.temp.csv rename to data-raw/1_Input/treatments/LookupClimateTemp/climate_temp.csv diff --git a/data-raw/1_Input/treatments/tr_cloudin/climate.in b/data-raw/1_Input/treatments/tr_cloudin/climate.in new file mode 100644 index 00000000..5e050207 --- /dev/null +++ b/data-raw/1_Input/treatments/tr_cloudin/climate.in @@ -0,0 +1,6 @@ +71.0 61.0 61.0 51.0 41.0 31.0 23.0 23.0 31.0 41.0 61.0 61.0 # (site: testing), sky cover (sunrise-sunset),%,Climate Atlas of the US,http://cdo.ncdc.noaa.gov/cgi-bin/climaps/climaps.pl +1.3 2.9 3.3 3.8 3.8 3.8 3.3 3.3 2.9 1.3 1.3 1.3 # Wind speed (m/s),Climate Atlas of the US,http://cdo.ncdc.noaa.gov/cgi-bin/climaps/climaps.pl +61.0 61.0 61.0 51.0 51.0 51.0 41.0 41.0 51.0 51.0 61.0 61.0 # rel. Humidity (%),Climate Atlas of the US,http://cdo.ncdc.noaa.gov/cgi-bin/climaps/climaps.pl +1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 # transmissivity (rel), only used in petfunc, but falls out of the equations (a = trans * b, c = a / trans) +213.7 241.6 261.0 308.0 398.1 464.5 0.0 0.0 0.0 140.0 161.6 185.1 # snow density (kg/m3): Brown, R. D. and P. W. Mote. 2009. The response of Northern Hemisphere snow cover to a changing climate. Journal of Climate 22:2124-2145. +1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 # m = number of precipitation events per day diff --git a/data-raw/1_Input/treatments/tr_cloudin/cloud.in b/data-raw/1_Input/treatments/tr_cloudin/cloud.in deleted file mode 100644 index cfd44a31..00000000 --- a/data-raw/1_Input/treatments/tr_cloudin/cloud.in +++ /dev/null @@ -1,5 +0,0 @@ -71.0 61.0 61.0 51.0 41.0 31.0 23.0 23.0 31.0 41.0 61.0 61.0 # (site: 002_-119.415_39.046 ), sky cover (sunrise-sunset),%,Climate Atlas of the US,http://cdo.ncdc.noaa.gov/cgi-bin/climaps/climaps.pl -1.3 2.9 3.3 3.8 3.8 3.8 3.3 3.3 2.9 1.3 1.3 1.3 # Wind speed (m/s),Climate Atlas of the US,http://cdo.ncdc.noaa.gov/cgi-bin/climaps/climaps.pl -61.0 61.0 61.0 51.0 51.0 51.0 41.0 41.0 51.0 51.0 61.0 61.0 # rel. Humidity (%),Climate Atlas of the US,http://cdo.ncdc.noaa.gov/cgi-bin/climaps/climaps.pl -1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 # transmissivity (rel), only used in petfunc, but falls out of the equations (a = trans * b, c = a / trans) -213.7 241.6 261.0 308.0 398.1 464.5 0.0 0.0 0.0 140.0 161.6 185.1 # snow density (kg/m3): Brown, R. D. and P. W. Mote. 2009. The response of Northern Hemisphere snow cover to a changing climate. Journal of Climate 22:2124-2145. diff --git a/data-raw/1_Input/treatments/tr_prodin/prod.in b/data-raw/1_Input/treatments/tr_prodin/prod.in deleted file mode 100755 index 6814ebe4..00000000 --- a/data-raw/1_Input/treatments/tr_prodin/prod.in +++ /dev/null @@ -1,143 +0,0 @@ -# Plant production data file for SOILWAT -# Location: - -# ---- Composition of vegetation type components (0-1; must add up to 1) -# Grasses Shrubs Trees Forbs Bare Ground -0.0 0.0 0.0 1.0 0.0 - - -# ---- Albedo -# Grasses Shrubs Trees Forbs Bare Ground -0.167 0.143 0.106 0.167 0.15 # albedo: (Houldcroft et al. 2009) MODIS snowfree 'grassland', 'open shrub', ‘evergreen needle forest’ with MODIS albedo aggregated over pure IGBP cells where NDVI is greater than the 98th percentile NDVI - - -# ---- % Cover: divide standing LAI by this to get % cover -# Grasses Shrubs Trees Forbs -3.0 2.22 5. 3.0 - - -# -- Canopy height (cm) parameters either constant through season or as tanfunc with respect to biomass (g/m^2) -# Grasses Shrubs Trees Forbs -300.0 0.0 0.0 300.0 # xinflec -29.5 5.0 5.0 29.5 # yinflec -85. 100. 3000. 85. # range -0.002 0.003 0.00008 0.002 # slope -0. 50. 1200. 0. # if > 0 then constant canopy height (cm) - - -# --- Vegetation interception parameters for equation: intercepted rain = (a + b*veg) + (c+d*veg) * ppt; Grasses+Shrubs: veg=vegcov, Trees: veg=LAI -# Grasses Shrubs Trees Forbs -0.0182 0. 0.00461 0.0182 # a -0.0065 0.0026 0.01405 0.0065 # b -0.0019 0. 0.0383 0.0019 # c -0.0054 0.0033 0.0337 0.0054 # d - - -# --- Litter interception parameters for equation: intercepted rain = (a + b*litter) + (c+d*litter) * ppt -# Grass-Litter Shrub-Litter Tree-Litter Forbs-Litter -0.0151 0.0151 0.0151 0.0151 # a -0.00005 0.00005 0.00005 0.00005 # b -0.0116 0.0116 0.0116 0.0116 # c -0.00002 0.00002 0.00002 0.00002 # d - - -# ---- Parameter for partitioning of bare-soil evaporation and transpiration as in Es = exp(-param*LAI) -# Grasses Shrubs Trees Forbs -1. 1. 0.41 1. # Trees: According to a regression based on a review by Daikoku, K., S. Hattori, A. Deguchi, Y. Aoki, M. Miyashita, K. Matsumoto, J. Akiyama, S. Iida, T. Toba, Y. Fujita, and T. Ohta. 2008. Influence of evaporation from the forest floor on evapotranspiration from the dry canopy. Hydrological Processes 22:4083-4096. - - -# ---- Parameter for scaling and limiting bare soil evaporation rate: if totagb (g/m2) > param then no bare-soil evaporation -# Grasses Shrubs Trees Forbs -999. 999. 2099. 999. # - - -# --- Shade effects on transpiration based on live and dead biomass -# Grasses Shrubs Trees Forbs -0.3 0.3 0.3 0.3 # shade scale -150. 150. 150. 150. # shade maximal dead biomass -300. 300. 0. 300. # tanfunc: xinflec -12. 12. 0. 12. # yinflec -34. 34. 2. 34. # range -0.002 0.002 0.0002 0.002 # slope - - -# ---- Hydraulic redistribution: Ryel, Ryel R, Caldwell, Caldwell M, Yoder, Yoder C, Or, Or D, Leffler, Leffler A. 2002. Hydraulic redistribution in a stand of Artemisia tridentata: evaluation of benefits to transpiration assessed with a simulation model. Oecologia 130: 173-184. -# Grasses Shrubs Trees Forbs -1 1 1 1 # flag to turn on/off (1/0) hydraulic redistribution --0.2328 -0.2328 -0.2328 -0.2328 # maxCondroot - maximum radial soil-root conductance of the entire active root system for water (cm/-bar/day) = 0.097 cm/MPa/h -10. 10. 10. 10. # swp50 - soil water potential (-bar) where conductance is reduced by 50% = -1. MPa -3.22 3.22 3.22 3.22 # shapeCond - shaping parameter for the empirical relationship from van Genuchten to model relative soil-root conductance for water - - -# ---- Critical soil water potential (MPa), i.e., when transpiration rates cannot sustained anymore, for instance, for many crop species -1.5 MPa is assumed and called wilting point -# Grasses Shrubs Trees Forbs --3.5 -3.9 -2.0 -2.0 - - -# Grasslands component: -# -------------- Monthly production values ------------ -# Litter - dead leafy material on the ground (g/m^2 ). -# Biomass - living and dead/woody aboveground standing biomass (g/m^2). -# %Live - proportion of Biomass that is actually living (0-1.0). -# LAI_conv - monthly amount of biomass needed to produce LAI=1.0 (g/m^2). -# There should be 12 rows, one for each month, starting with January. -# -#Litter Biomass %Live LAI_conv - 75.0 150.0 0.00 300. # January - 80.0 150.0 0.00 300. # February - 85.0 150.0 0.10 300. # March - 90.0 170.0 0.20 300. # April - 50.0 190.0 0.40 300. # May - 50.0 220.0 0.60 300. # June - 50.0 250.0 0.40 300. # July - 55.0 220.0 0.60 300. # August - 60.0 190.0 0.40 300. # September - 65.0 180.0 0.20 300. # October - 70.0 170.0 0.10 300. # November - 75.0 160.0 0.00 300. # December - -# Shrublands component: -#Litter Biomass %Live LAI_conv -85.4 210.0 0.06 372 # January -88.2 212.0 0.08 372 # February -95.3 228.0 0.20 372 # March -100.5 272.0 0.33 372 # April -166.4 400.0 0.57 372 # May -186.0 404.0 0.55 372 # June -177.1 381.0 0.50 372 # July -212.2 352.0 0.46 372 # August -157.4 286.0 0.32 372 # September -124.9 235.0 0.15 372 # October -110.4 218.0 0.08 372 # November -104.3 214.0 0.06 372 # December - -# Forest component: -#Litter Biomass %Live LAI_conv -2000 15000 0.083 500 # January -2000 15000 0.083 500 # February -2000 15000 0.083 500 # March -2000 15000 0.083 500 # April -2000 15000 0.083 500 # May -2000 15000 0.083 500 # June -2000 15000 0.083 500 # July -2000 15000 0.083 500 # August -2000 15000 0.083 500 # September -2000 15000 0.083 500 # October -2000 15000 0.083 500 # November -2000 15000 0.083 500 # December - -# FORB component: -#Litter Biomass %Live LAI_conv - 75.0 150.0 0.00 300. # January - 80.0 150.0 0.00 300. # February - 85.0 150.0 0.10 300. # March - 90.0 170.0 0.20 300. # April - 50.0 190.0 0.40 300. # May - 50.0 220.0 0.60 300. # June - 50.0 250.0 0.40 300. # July - 55.0 220.0 0.60 300. # August - 60.0 190.0 0.40 300. # September - 65.0 180.0 0.20 300. # October - 70.0 170.0 0.10 300. # November - 75.0 160.0 0.00 300. # December - diff --git a/data-raw/1_Input/treatments/tr_prodin/veg.in b/data-raw/1_Input/treatments/tr_prodin/veg.in new file mode 100755 index 00000000..82783a4a --- /dev/null +++ b/data-raw/1_Input/treatments/tr_prodin/veg.in @@ -0,0 +1,142 @@ +# Plant production data file for SOILWAT2 +# Location: + +# ---- Composition of vegetation type components (0-1; must add up to 1) +# Grasses Shrubs Trees Forbs BareGround + 0.2 0.2 0.2 0.2 0.2 + + +# ---- Albedo +# Grasses Shrubs Trees Forbs BareGround + 0.167 0.143 0.106 0.167 0.15 # albedo: (Houldcroft et al. 2009) MODIS snowfree 'grassland', 'open shrub', ‘evergreen needle forest’ with MODIS albedo aggregated over pure IGBP cells where NDVI is greater than the 98th percentile NDVI + + +# -- Canopy height (cm) parameters either constant through season or as tanfunc with respect to biomass (g/m^2) +# Grasses Shrubs Trees Forbs + 300.0 0.0 0.0 300.0 # xinflec + 29.5 5.0 5.0 29.5 # yinflec + 85. 100. 3000. 85. # range + 0.002 0.003 0.00008 0.002 # slope + 0.0 50. 1200. 0.0 # if > 0 then constant canopy height (cm) + + +# --- Vegetation interception parameters: kSmax * log10(1 + LAI_live + kdead * LAI_dead) +# Grasses Shrubs Trees Forbs + 1.0 2.6 2.0 1.0 # kSmax (mm) + 1.0 0.1 0.01 0.5 # kdead (0-1 fraction) + + +# --- Litter interception parameters: kSmax * log10(1 + litter_density) +# Grasses Shrubs Trees Forbs + 0.113 0.113 0.290 0.113 # kSmax (mm) + + +# ---- Parameter for partitioning of bare-soil evaporation and transpiration as in Es = exp(-param*LAI) +# Grasses Shrubs Trees Forbs + 1. 1. 0.41 1. # Trees: According to a regression based on a review by Daikoku, K., S. Hattori, A. Deguchi, Y. Aoki, M. Miyashita, K. Matsumoto, J. Akiyama, S. Iida, T. Toba, Y. Fujita, and T. Ohta. 2008. Influence of evaporation from the forest floor on evapotranspiration from the dry canopy. Hydrological Processes 22:4083-4096. + + +# ---- Parameter for scaling and limiting bare soil evaporation rate: if totagb (g/m2) > param then no bare-soil evaporation +# Grasses Shrubs Trees Forbs + 999. 999. 2099. 999. # + + +# --- Shade effects on transpiration based on live and dead biomass +# Grasses Shrubs Trees Forbs + 0.3 0.3 0.3 0.3 # shade scale + 150. 150. 150. 150. # shade maximal dead biomass + 300. 300. 0. 300. # tanfunc: xinflec + 12. 12. 0. 12. # yinflec + 34. 34. 2. 34. # range + 0.002 0.002 0.0002 0.002 # slope + + +# ---- Hydraulic redistribution: Ryel, Ryel R, Caldwell, Caldwell M, Yoder, Yoder C, Or, Or D, Leffler, Leffler A. 2002. Hydraulic redistribution in a stand of Artemisia tridentata: evaluation of benefits to transpiration assessed with a simulation model. Oecologia 130: 173-184. +# Grasses Shrubs Trees Forbs + 1 1 1 1 # flag to turn on/off (1/0) hydraulic redistribution + -0.2328 -0.2328 -0.2328 -0.2328 # maxCondroot - maximum radial soil-root conductance of the entire active root system for water (cm/-bar/day) = 0.097 cm/MPa/h + 10. 10. 10. 10. # swp50 - soil water potential (-bar) where conductance is reduced by 50% = -1. MPa + 3.22 3.22 3.22 3.22 # shapeCond - shaping parameter for the empirical relationship from van Genuchten to model relative soil-root conductance for water + + +# ---- Critical soil water potential (MPa), i.e., when transpiration rates cannot sustained anymore, for instance, for many crop species -1.5 MPa is assumed and called wilting point +# Grasses Shrubs Trees Forbs + -3.5 -3.9 -2.0 -2.0 + + +# ---- CO2 Coefficients: multiplier = Coeff1 * x^Coeff2 +# Coefficients assume that monthly biomass inputs reflect values for conditions at +# 360 ppm CO2, i.e., multiplier = 1 for x = 360 ppm CO2 +# Grasses Shrubs Trees Forbs + 0.1319 0.1319 0.1319 0.1319 # Biomass Coeff1 + 0.3442 0.3442 0.3442 0.3442 # Biomass Coeff2 + 25.158 25.158 25.158 25.158 # WUE Coeff1 + -0.548 -0.548 -0.548 -0.548 # WUE Coeff2 + + +# Grasslands component: +# -------------- Monthly production values ------------ +# Litter - dead leafy material on the ground (g/m^2 ). +# Biomass - living and dead/woody aboveground standing biomass (g/m^2). +# %Live - proportion of Biomass that is actually living (0-1.0). +# LAI_conv - monthly amount of biomass needed to produce LAI=1.0 (g/m^2). +# There should be 12 rows, one for each month, starting with January. +# +#Litter Biomass %Live LAI_conv + 75.0 150.0 0.00 300. # January + 80.0 150.0 0.00 300. # February + 85.0 150.0 0.10 300. # March + 90.0 170.0 0.20 300. # April + 50.0 190.0 0.40 300. # May + 50.0 220.0 0.60 300. # June + 50.0 250.0 0.40 300. # July + 55.0 220.0 0.60 300. # August + 60.0 190.0 0.40 300. # September + 65.0 180.0 0.20 300. # October + 70.0 170.0 0.10 300. # November + 75.0 160.0 0.00 300. # December + +# Shrublands component: +#Litter Biomass %Live LAI_conv +85.4 210.0 0.06 372 # January +88.2 212.0 0.08 372 # February +95.3 228.0 0.20 372 # March +100.5 272.0 0.33 372 # April +166.4 400.0 0.57 372 # May +186.0 404.0 0.55 372 # June +177.1 381.0 0.50 372 # July +212.2 352.0 0.46 372 # August +157.4 286.0 0.32 372 # September +124.9 235.0 0.15 372 # October +110.4 218.0 0.08 372 # November +104.3 214.0 0.06 372 # December + +# Forest component: +#Litter Biomass %Live LAI_conv +2000 15000 0.083 500 # January +2000 15000 0.083 500 # February +2000 15000 0.083 500 # March +2000 15000 0.083 500 # April +2000 15000 0.083 500 # May +2000 15000 0.083 500 # June +2000 15000 0.083 500 # July +2000 15000 0.083 500 # August +2000 15000 0.083 500 # September +2000 15000 0.083 500 # October +2000 15000 0.083 500 # November +2000 15000 0.083 500 # December + +# Forb component: +#Litter Biomass %Live LAI_conv + 75.0 150.0 0.00 300. # January + 80.0 150.0 0.00 300. # February + 85.0 150.0 0.10 300. # March + 90.0 170.0 0.20 300. # April + 50.0 190.0 0.40 300. # May + 50.0 220.0 0.60 300. # June + 50.0 250.0 0.40 300. # July + 55.0 220.0 0.60 300. # August + 60.0 190.0 0.40 300. # September + 65.0 180.0 0.20 300. # October + 70.0 170.0 0.10 300. # November + 75.0 160.0 0.00 300. # December diff --git a/data-raw/1_Input/treatments/tr_siteparamin/siteparam.in b/data-raw/1_Input/treatments/tr_siteparamin/siteparam.in old mode 100755 new mode 100644 index 97cc3c8b..a933074b --- a/data-raw/1_Input/treatments/tr_siteparamin/siteparam.in +++ b/data-raw/1_Input/treatments/tr_siteparamin/siteparam.in @@ -1,74 +1,82 @@ -# ---- SWC limits ---- --1 # swc_min : cm/cm if 0 - <1.0, -bars if >= 1.0.; if < 0. then estimate residual water content for each layer -15. # swc_init: cm/cm if < 1.0, -bars if >= 1.0. -15. # swc_wet : cm/cm if < 1.0, -bars if >= 1.0. - -# ---- Model flags and coefficients ---- -0 # reset (1/0): reset/don't reset swc each new year -1 # deepdrain (1/0): allow/disallow deep drainage function. - # if deepdrain == 1, model expects extra layer in soils file. -1 # multiplier for PET (eg for climate change). -0 #proportion of ponded surface water removed as runoff daily (value ranges between 0 and 1; 0=no loss of surface water, 1=all ponded water lost via runoff) - -# ---- Snow simulation parameters (SWAT2K model): Neitsch S, Arnold J, Kiniry J, Williams J. 2005. Soil and water assessment tool (SWAT) theoretical documentation. version 2005. Blackland Research Center, Texas Agricultural Experiment Station: Temple, TX. -# these parameters are RMSE optimized values for 10 random SNOTEL sites for western US -0.61 # TminAccu2 = Avg. air temp below which ppt is snow ( C) -1.54 # TmaxCrit = Snow temperature at which snow melt starts ( C) -0.10 # lambdasnow = Relative contribution of avg. air temperature to todays snow temperture vs. yesterday's snow temperature (0-1) -0.0 # RmeltMin = Minimum snow melt rate on winter solstice (cm/day/C) -0.27 # RmeltMax = Maximum snow melt rate on summer solstice (cm/day/C) - -# ---- Drainage coefficient ---- -0.02 # slow-drain coefficient per layer (cm/day). See Eqn 2.9 in ELM doc. - # ELM shows this as a value for each layer, but this way it's applied to all. - # (Q=.02 in ELM doc, .06 in FORTRAN version). - -# ---- Evaporation coefficients ---- -# These control the tangent function (tanfunc) which affects the amount of soil -# water extractable by evaporation and transpiration. -# These constants aren't documented by the ELM doc. -45. # rate shift (x value of inflection point). lower value shifts curve - # leftward, meaning less water lost to evap at a given swp. effectively - # shortens/extends high rate. -.1 # rate slope: lower value (eg .01) straightens S shape meaning more gradual - # reduction effect; higher value (.5) makes abrupt transition -.25 # inflection point (y-value of inflection point) -0.5 # range: diff btw upper and lower rates at the limits - -# ---- Transpiration Coefficients ---- -# comments from Evap constants apply. -45. # rate shift -.1 # rate shape -.5 # inflection point -1.1 # range - -# ---- Intrinsic site params: -0.681 # latitude of the site in radians -1651 # altitude of site (m a.s.l.) -0 # slope at site (degrees): no slope = 0 --1 # aspect at site (degrees): N=0, E=90, S=180, W=270, no slope:-1 - -# ---- Soil Temperature Constants ---- -# from Parton 1978, ch. 2.2.2 Temperature-profile Submodel -300. # biomass limiter, 300 g/m^2 in Parton's equation for T1(avg daily temperature at the top of the soil) -15. # constant for T1 equation (used if biomass <= biomass limiter), 15 in Parton's equation --4. # constant for T1 equation (used if biomass > biomass limiter), -4 in Parton's equation -600. # constant for T1 equation (used if biomass > biomass limiter), 600 in Parton's equation -0.00070 # constant for cs (soil-thermal conductivity) equation, 0.00070 in Parton's equation -0.00030 # constant for cs equation, 0.00030 in Parton's equation -0.18 # constant for sh (specific heat capacity) equation, 0.18 in Parton's equation -6.69 # constant mean air temperature (the soil temperature at the lower boundary, 180 cm) in celsius -15. # deltaX parameter for soil_temperature function, default is 15. (distance between profile points in cm) max depth (the next number) should be evenly divisible by this number -990. # max depth for the soil_temperature function equation, default is 180. this number should be evenly divisible by deltaX -1 # flag, 1 to calculate soil_temperature, 0 to not calculate soil_temperature - - -# ---- Transpiration regions ---- -# ndx : 1=shallow, 2=medium, 3=deep, 4=very deep -# layer: deepest layer number of the region. -# Layers are defined in soils.in. -# ndx layer - 1 6 - 2 9 - 3 11 -# 4 8 +# ---- SWC limits ---- +-1.0 # swc_min : cm/cm if 0 - <1.0, -bars if >= 1.0.; if < 0. then estimate residual water content for each layer +15.0 # swc_init: cm/cm if < 1.0, -bars if >= 1.0. +15.0 # swc_wet : cm/cm if < 1.0, -bars if >= 1.0. + +# ---- Model flags and coefficients ---- +0 # reset (1/0): reset/don't reset swc each new year +1 # deepdrain (1/0): allow/disallow deep drainage function. + # if deepdrain == 1, model expects extra layer in soils file. +1.0 # multiplier for PET (eg for climate change). +0.0 #proportion of ponded surface water removed as daily runoff (value ranges between 0 and 1; 0=no loss of surface water, 1=all ponded water lost via runoff) +0.0 #proportion of water that arrives at surface added as daily runon [from a hypothetical identical neighboring site] (value ranges between 0 and +inf; 0=no runon, >0: runon is occuring) + +# ---- Snow simulation parameters (SWAT2K model): Neitsch S, Arnold J, Kiniry J, Williams J. 2005. Soil and water assessment tool (SWAT) theoretical documentation. version 2005. Blackland Research Center, Texas Agricultural Experiment Station: Temple, TX. +# these parameters are RMSE optimized values for 10 random SNOTEL sites for western US +0.61 # TminAccu2 = Avg. air temp below which ppt is snow ( C) +1.54 # TmaxCrit = Snow temperature at which snow melt starts ( C) +0.1 # lambdasnow = Relative contribution of avg. air temperature to todays snow temperture vs. yesterday's snow temperature (0-1) +0.0 # RmeltMin = Minimum snow melt rate on winter solstice (cm/day/C) +0.27 # RmeltMax = Maximum snow melt rate on summer solstice (cm/day/C) + +# ---- Drainage coefficient ---- +0.02 # slow-drain coefficient per layer (cm/day). See Eqn 2.9 in ELM doc. + # ELM shows this as a value for each layer, but this way it's applied to all. + # (Q=.02 in ELM doc, .06 in FORTRAN version). + +# ---- Evaporation coefficients ---- +# These control the tangent function (tanfunc) which affects the amount of soil +# water extractable by evaporation and transpiration. +# These constants aren't documented by the ELM doc. +45. # rate shift (x value of inflection point). lower value shifts curve + # leftward, meaning less water lost to evap at a given swp. effectively + # shortens/extends high rate. +.1 # rate slope: lower value (eg .01) straightens S shape meaning more gradual + # reduction effect; higher value (.5) makes abrupt transition +.25 # inflection point (y-value of inflection point) +0.5 # range: diff btw upper and lower rates at the limits + +# ---- Transpiration Coefficients ---- +# comments from Evap constants apply. +45. # rate shift +.1 # rate shape +.5 # inflection point +1.1 # range + +# ---- Intrinsic site params: +0.681 # latitude of the site in radians +1000 # elevation of site (m a.s.l.) +0 # slope at site (degrees): no slope = 0 +-1 # aspect at site (degrees): N=0, E=90, S=180, W=270, no slope:-1 + +# ---- Soil Temperature Constants ---- +# from Parton 1978, ch. 2.2.2 Temperature-profile Submodel +300. # biomass limiter, 300 g/m^2 in Parton's equation for T1(avg daily temperature at the top of the soil) +15. # constant for T1 equation (used if biomass <= biomass limiter), 15 in Parton's equation +-4. # constant for T1 equation (used if biomass > biomass limiter), -4 in Parton's equation +600. # constant for T1 equation (used if biomass > biomass limiter), 600 in Parton's equation +0.00070 # constant for cs (soil-thermal conductivity) equation, 0.00070 in Parton's equation +0.00030 # constant for cs equation, 0.00030 in Parton's equation +0.18 # constant for sh (specific heat capacity) equation, 0.18 in Parton's equation +4.15 # constant soil temperature (Celsius) at the lower boundary (max depth); approximate by mean annual air temperature of site +15. # deltaX parameter for soil_temperature function, default is 15. (distance between profile points in cm) max depth (the next number) should be evenly divisible by this number +990. # max depth for the soil_temperature function equation, default is 990. this number should be evenly divisible by deltaX +1 # flag, 1 to calculate soil_temperature, 0 to not calculate soil_temperature + +# ---- CO2 Settings ---- +# Use biomass multiplier +1 +# Use water-usage efficiency multiplier +1 +# Scenario +RCP85 + +# ---- Transpiration regions ---- +# ndx : 1=shallow, 2=medium, 3=deep, 4=very deep +# layer: deepest layer number of the region. +# Layers are defined in soils.in. +# ndx layer + 1 3 + 2 5 + 3 8 +# 4 20 diff --git a/data-raw/1_Input/treatments/tr_soilsin/soils.in b/data-raw/1_Input/treatments/tr_soilsin/soils.in index cbe2f759..088f502d 100644 --- a/data-raw/1_Input/treatments/tr_soilsin/soils.in +++ b/data-raw/1_Input/treatments/tr_soilsin/soils.in @@ -1,5 +1,5 @@ # Soil layer definitions -# Location: +# Location: # # depth = (cm) lower limit of layer; layers must be in order of depth. # matricd = (g/cm^3) bulk density of soil in this layer. @@ -14,11 +14,11 @@ # be normalized. # # depth matricd gravel_content evco trco_grass trco_shrub trco_tree trco_forb %sand %clay imperm soiltemp - 5.000 1.430 0.000 0.812 0.033 0.134 0.033 0.134 0.510 0.150 0.000 0.186 - 10.000 1.410 0.000 0.153 0.033 0.094 0.033 0.094 0.440 0.260 0.000 0.372 - 20.000 1.390 0.000 0.034 0.067 0.176 0.067 0.176 0.350 0.410 0.000 0.744 - 30.000 1.390 0.000 0.000 0.067 0.175 0.067 0.175 0.320 0.450 0.000 1.116 - 40.000 1.380 0.000 0.000 0.067 0.110 0.067 0.110 0.310 0.470 0.000 1.488 - 60.000 1.150 0.000 0.000 0.133 0.179 0.133 0.179 0.320 0.470 0.000 2.232 - 80.000 1.310 0.000 0.000 0.133 0.101 0.133 0.101 0.570 0.280 0.000 2.975 - 85.000 1.310 0.000 0.000 0.133 0.101 0.133 0.101 0.570 0.280 0.000 2.975 + 5.000 1.430 0.100 0.813 0.0496 0.134 0.0496 0.134 0.510 0.150 0.000 -1.000 + 10.000 1.410 0.100 0.153 0.0495 0.094 0.0495 0.094 0.440 0.260 0.000 -1.000 + 20.000 1.390 0.100 0.034 0.1006 0.176 0.1006 0.176 0.350 0.410 0.000 -1.000 + 30.000 1.390 0.100 0.000 0.1006 0.175 0.1006 0.175 0.320 0.450 0.000 -1.000 + 40.000 1.380 0.200 0.000 0.1006 0.110 0.1006 0.110 0.310 0.470 0.000 0.000 + 60.000 1.150 0.200 0.000 0.1997 0.109 0.1997 0.109 0.320 0.470 0.000 0.000 + 80.000 1.310 0.200 0.000 0.1997 0.101 0.1997 0.101 0.570 0.280 0.000 1.000 +100.000 1.310 0.200 0.000 0.1997 0.101 0.1997 0.101 0.570 0.280 0.000 1.000 diff --git a/data-raw/1_Input/treatments/tr_weathersetupin/weathsetup.in b/data-raw/1_Input/treatments/tr_weathersetupin/weathsetup.in old mode 100644 new mode 100755 index 2c65d632..1d74f9f6 --- a/data-raw/1_Input/treatments/tr_weathersetupin/weathsetup.in +++ b/data-raw/1_Input/treatments/tr_weathersetupin/weathsetup.in @@ -1,32 +1,31 @@ # Weather setup parameters -# Location: Chimney Park, WY (41.068° N, 106.1195° W, 2740 m elevation) # -1 # 1=allow snow accumulation, 0=no snow effects. -0.0 # % of snow drift per snow event (+ indicates snow addition, - indicates snow taken away from site) -0.0 # % of snowmelt water as runoff/on per event (>0 indicates runoff, <0 indicates runon) -0 # 0=use historical data only, 1=use markov process for missing weather. -1979 # first year to begin historical weather. -5 # number of days to use in the running average of temperature. +1 # 1 = simulate snow processes; 0 = no snow effects +0.0 # % of snow drift per snow event (+ indicates snow addition, - indicates snow taken away from site) +0.0 # % of snowmelt water as runoff/on per event (>0 indicates runoff, <0 indicates runon) +0 # 0 = use historical data only; 1 = use markov process for missing weather +1980 # first year to begin historical weather. +5 # number of days to use in the running average of temperature. -# Monthly scaling parameters. +# Monthly scaling parameters: # Month 1 = January, Month 2 = February, etc. -# PPT = multiplicative for PPT (scale*ppt). -# MaxT = additive for max temp (scale+maxtemp). -# MinT = additive for min temp (scale+mintemp). +# PPT = multiplicative for daily PPT; max(0, scale * ppt) +# MaxT = additive for daily max temperature [C]; scale + maxtemp +# MinT = additive for daily min temperature [C]; scale + mintemp # SkyCover = additive for mean monthly sky cover [%]; min(100, max(0, scale + sky cover)) # Wind = multiplicative for mean monthly wind speed; max(0, scale * wind speed) # rH = additive for mean monthly relative humidity [%]; min(100, max(0, scale + rel. Humidity)) # Transmissivity = multiplicative for mean monthly relative transmissivity; min(1, max(0, scale * transmissivity)) -#Mon PPT MaxT MinT SkyCover Wind rH Transmissivity - 1 1.000000 0.000000 0.000000 0.000000 1.000000 0.000000 1.000000 - 2 1.000000 0.000000 0.000000 0.000000 1.000000 0.000000 1.000000 - 3 1.000000 0.000000 0.000000 0.000000 1.000000 0.000000 1.000000 - 4 1.000000 0.000000 0.000000 0.000000 1.000000 0.000000 1.000000 - 5 1.000000 0.000000 0.000000 0.000000 1.000000 0.000000 1.000000 - 6 1.000000 0.000000 0.000000 0.000000 1.000000 0.000000 1.000000 - 7 1.000000 0.000000 0.000000 0.000000 1.000000 0.000000 1.000000 - 8 1.000000 0.000000 0.000000 0.000000 1.000000 0.000000 1.000000 - 9 1.000000 0.000000 0.000000 0.000000 1.000000 0.000000 1.000000 - 10 1.000000 0.000000 0.000000 0.000000 1.000000 0.000000 1.000000 - 11 1.000000 0.000000 0.000000 0.000000 1.000000 0.000000 1.000000 - 12 1.000000 0.000000 0.000000 0.000000 1.000000 0.000000 1.000000 +#Mon PPT MaxT MinT SkyCover Wind rH Transmissivity +1 1.000 0.00 0.00 0.0 1.0 0.0 1.0 +2 1.000 0.00 0.00 0.0 1.0 0.0 1.0 +3 1.000 0.00 0.00 0.0 1.0 0.0 1.0 +4 1.000 0.00 0.00 0.0 1.0 0.0 1.0 +5 1.000 0.00 0.00 0.0 1.0 0.0 1.0 +6 1.000 0.00 0.00 0.0 1.0 0.0 1.0 +7 1.000 0.00 0.00 0.0 1.0 0.0 1.0 +8 1.000 0.00 0.00 0.0 1.0 0.0 1.0 +9 1.000 0.00 0.00 0.0 1.0 0.0 1.0 +10 1.000 0.00 0.00 0.0 1.0 0.0 1.0 +11 1.000 0.00 0.00 0.0 1.0 0.0 1.0 +12 1.000 0.00 0.00 0.0 1.0 0.0 1.0 diff --git a/data-raw/prepare_default_project_infrastructure.R b/data-raw/prepare_default_project_infrastructure.R index 8235c45f..ad79f0cd 100755 --- a/data-raw/prepare_default_project_infrastructure.R +++ b/data-raw/prepare_default_project_infrastructure.R @@ -1,10 +1,46 @@ #!/usr/bin/env Rscript +stopifnot(requireNamespace("usethis")) + # default (input) infrastructure of a rSFSW2 simulation project dir_definf <- file.path("data-raw", "1_Input") +# update example treatment input files from (installed) rSOILWAT2 defaults +sw_in <- rSOILWAT2::sw_exampleData + +tr_update <- list( + tr_cloudin = basename(rSOILWAT2::swFiles_Cloud(sw_in)), + tr_prodin = basename(rSOILWAT2::swFiles_Prod(sw_in)), + tr_siteparamin = basename(rSOILWAT2::swFiles_SiteParams(sw_in)), + tr_soilsin = basename(rSOILWAT2::swFiles_Soils(sw_in)), + tr_weathersetupin = basename(rSOILWAT2::swFiles_WeatherSetup(sw_in))) + +path_demo <- system.file("extdata", "example1", "Input", package = "rSOILWAT2") + +for (k in seq_along(tr_update)) { + tr_dir <- file.path(dir_definf, "treatments", names(tr_update)[k]) + files_has <- list.files(tr_dir, full.names = TRUE) + + file_should <- file.path(path_demo, tr_update[[k]]) + file_new <- file.path(tr_dir, tr_update[[k]]) + + # Check whether existing file is up-to-date and the only one + do_update <- length(files_has) != 1 || + basename(files_has) != tr_update[[k]] || + !isTRUE(all.equal(readLines(file_should), readLines(files_has))) + + if (do_update) { + unlink(files_has) + file.copy(from = file_should, to = file_new) + } +} + + + +# create an internal package data object + ftemp <- list.files(dir_definf, recursive = TRUE, full.names = TRUE) definf <- list() @@ -29,4 +65,4 @@ for (k in seq_along(ftemp)) { ) } -devtools::use_data(definf, internal = TRUE) +usethis::use_data(definf, internal = TRUE, overwrite = TRUE) diff --git a/demo/SFSW2_project_descriptions.R b/demo/SFSW2_project_descriptions.R index 5ab1abc1..f5aa6537 100644 --- a/demo/SFSW2_project_descriptions.R +++ b/demo/SFSW2_project_descriptions.R @@ -152,6 +152,10 @@ opt_input <- list( # Interpolate and add soil layers if not available if 'AddRequestedSoilLayers' requested_soil_layers = c(5, 10, 20, 30, 40, 50, 60, 70, 80, 90, 100, 150), + # Approach existing soil depth is less than 'requested_soil_layers' + # - [TRUE] keep input soil depth + # - [FALSE] adjust soil depth to 'max(requested_soil_layers)' + keep_old_depth = TRUE, # Request data from datasets ('external' to a rSFSW2-project) req_data = c( diff --git a/man/SMR_logic.Rd b/man/SMR_logic.Rd deleted file mode 100644 index 92a5b6d4..00000000 --- a/man/SMR_logic.Rd +++ /dev/null @@ -1,14 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/SoilMTRegimes.R -\name{SMR_logic} -\alias{SMR_logic} -\title{Soil moisture regime: Soil Survey Staff 2014 (Key to Soil Taxonomy): p.28-31} -\usage{ -SMR_logic(ACS_COND1, ACS_COND2, ACS_COND3, MCS_COND0, MCS_COND1, MCS_COND2, - MCS_COND2_1, MCS_COND2_2, MCS_COND2_3, MCS_COND3, MCS_COND3_1, MCS_COND4, - MCS_COND5, MCS_COND6, MCS_COND6_1, MCS_COND7, MCS_COND8, MCS_COND9, - MCS_COND10, has_permafrost) -} -\description{ -Soil moisture regime: Soil Survey Staff 2014 (Key to Soil Taxonomy): p.28-31 -} diff --git a/man/STMR.Rd b/man/STMR.Rd deleted file mode 100644 index 1cf275b4..00000000 --- a/man/STMR.Rd +++ /dev/null @@ -1,37 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/SoilMTRegimes.R -\name{STMR} -\alias{STMR} -\alias{STR_names} -\alias{SMR_names} -\alias{SMRq_names} -\title{Categories of soil temperature regimes and soil moisture regimes} -\usage{ -STR_names() - -SMR_names() - -SMRq_names() -} -\description{ -Categories of soil temperature regimes and soil moisture regimes - -Soil temperature regime categories - -Soil moisture regime categories - -Soil moisture regime categories including qualifiers -} -\section{Definitions}{ - Soil temperature and moisture regimes are defined in - SSS 2014. Our operationalization is explained in the vignette - \var{SoilMoistureRegimes_SoilTemperatureRegimes}. -} - -\examples{ - vignette("SoilMoistureRegimes_SoilTemperatureRegimes", package = "rSFSW2") -} -\references{ -Soil Survey Staff. 2014. Keys to soil taxonomy, 12th ed., USDA - Natural Resources Conservation Service, Washington, DC. -} diff --git a/man/STR_logic.Rd b/man/STR_logic.Rd deleted file mode 100644 index 7b020961..00000000 --- a/man/STR_logic.Rd +++ /dev/null @@ -1,13 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/SoilMTRegimes.R -\name{STR_logic} -\alias{STR_logic} -\title{Soil temperature regime: based on Soil Survey Staff 2014 (Key to Soil -Taxonomy): p.31 we ignore distinction between iso- and not iso-} -\usage{ -STR_logic(MAST, MSST, SatSoilSummer_days, has_permafrost, has_Ohorizon) -} -\description{ -Soil temperature regime: based on Soil Survey Staff 2014 (Key to Soil -Taxonomy): p.31 we ignore distinction between iso- and not iso- -} diff --git a/man/TranspCoeffByVegType.Rd b/man/TranspCoeffByVegType.Rd deleted file mode 100644 index 8ef6bb43..00000000 --- a/man/TranspCoeffByVegType.Rd +++ /dev/null @@ -1,29 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Vegetation.R -\name{TranspCoeffByVegType} -\alias{TranspCoeffByVegType} -\title{Lookup transpiration coefficients} -\usage{ -TranspCoeffByVegType(tr_input_code, tr_input_coeff, soillayer_no, - trco_type, layers_depth, adjustType = c("positive", "inverse", - "allToLast")) -} -\description{ -Lookup transpiration coefficients for grasses, shrubs, and trees per soil -layer or per soil depth increment of 1 cm per distribution type for -each simulation run and copy values to \var{\sQuote{datafile.soils}} -} -\details{ -\itemize{ - \item first row of datafile is label for per soil layer - \var{\dQuote{Layer}} or per soil depth increment of 1 cm - \var{\dQuote{DepthCM}} - \item second row of datafile is source of data - \item the other rows contain the data for each distribution type = columns -} -} -\section{Note}{ - cannot write data from \var{\sQuote{sw_input_soils}} to - \var{\sQuote{datafile.soils}} -} - diff --git a/man/add_layer_to_soil.Rd b/man/add_layer_to_soil.Rd deleted file mode 100644 index 2075fe33..00000000 --- a/man/add_layer_to_soil.Rd +++ /dev/null @@ -1,42 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Soils_Functions.R -\name{add_layer_to_soil} -\alias{add_layer_to_soil} -\title{Split soil layer in two layers} -\usage{ -add_layer_to_soil(x, il, w, method = c("interpolate", "exhaust")) -} -\arguments{ -\item{x}{A numeric data.frame or matrix. Columns are soil layers.} - -\item{il}{An integer value. The column/soil layer number after which a new -layer is added.} - -\item{w}{A numeric vector of length one or two. The weights used to calculate -the values of the new layer.} - -\item{method}{A character string. See \code{Details}.} -} -\value{ -An object like x with one column more at position \code{il + 1}. -} -\description{ -Split soil layer in two layers -} -\section{Details}{ - If the weight vector is of length one and \code{x} contains - a row with name 'depth_cm', then it is assumed that the value of \code{w} - corresponds to the weight of the first layer and the weight of the second - layer is calculated as \code{(depth of first layer of x) - (first value of - w)}. If this is case and if the added layer is either more shallow or - deeper than any input layers, then the depth of the added layer is - calculated proportionally if \code{sum(w) <= 1} otherwise additively. - - The method \code{interpolate} calculates the weighted mean - of the columns/layers \code{il} and \code{il + 1}. If \code{il == 0}, i.e., - add layer at a more shallow depth than any existing layer, then values from - the previously first layer are copied to the newly created layer. The - method \code{exhaust} distributes the value of \code{il + 1} according to - the weights. -} - diff --git a/man/biomass.Rd b/man/biomass.Rd deleted file mode 100644 index 67547d55..00000000 --- a/man/biomass.Rd +++ /dev/null @@ -1,27 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Vegetation.R -\name{biomass} -\alias{biomass} -\alias{Shrub_ANPP} -\alias{Grass_ANPP} -\title{Biomass equations} -\usage{ -Shrub_ANPP(MAP_mm) - -Grass_ANPP(MAP_mm) -} -\arguments{ -\item{MAP_mm}{A numeric vector. Mean annual precipitation in -millimeters (mm).} -} -\description{ -Biomass equations - -Estimate shrub biomass density from mean annual precipitation - -Estimate grass biomass density from mean annual precipitation -} -\references{ -Milchunas & Lauenroth 1993 (Fig. 2): - Y [g/m2/yr] = c1 * MAP [mm/yr] + c2 -} diff --git a/man/calc_SiteClimate.Rd b/man/calc_SiteClimate.Rd deleted file mode 100644 index fa28336c..00000000 --- a/man/calc_SiteClimate.Rd +++ /dev/null @@ -1,55 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Miscellaneous_Functions.R -\name{calc_SiteClimate} -\alias{calc_SiteClimate} -\title{Calculate climate variables from daily weather} -\usage{ -calc_SiteClimate(weatherList, year.start, year.end, do.C4vars = FALSE, - simTime2 = NULL) -} -\arguments{ -\item{weatherList}{A list. Each element is an object of class -\code{\link[rSOILWAT2:swWeatherData-class]{rSOILWAT2::swWeatherData}} -containing daily weather data of a specific year.} - -\item{year.start}{An integer value. The first year of the range of years for -which climate variables should be calculated.} - -\item{year.end}{An integer value. The last year of the range of years for -which climate variables should be calculated.} - -\item{do.C4vars}{A logical value. If \code{TRUE} then additional output is -returned.} - -\item{simTime2}{An object as returned from function -\code{\link{simTiming_ForEachUsedTimeUnit}}. Only needed if -\code{isTRUE(do.C4vars)}.} -} -\value{ -A list with named elements \itemize{ - \item{\var{\dQuote{meanMonthlyTempC}}} {A numeric vector of length 12. - Mean monthly mean daily air temperature in degree Celsius.} - \item{\var{\dQuote{minMonthlyTempC}}} {A numeric vector of length 12. - Mean monthly minimum daily air temperature in degree Celsius.} - \item{\var{\dQuote{maxMonthlyTempC}}} {A numeric vector of length 12. - Mean monthly maximum daily air temperature in degree Celsius.} - \item{\var{\dQuote{meanMonthlyPPTcm}}} {A numeric vector of length 12. - Mean monthly precipitation in centimeters.} - \item{\var{\dQuote{MAP_cm}}} {A numeric value. Mean annual precipitation - in centimeters.} - \item{\var{\dQuote{MAT_C}}} {A numeric value. Mean annual air temperature - in degree Celsius.} - \item{\var{\dQuote{dailyTempMin}}} {A numeric vector. If - \code{isTRUE(do.C4vars)}, then minimum daily air temperature in degree - Celsius for each day of time period between \code{year.start} and - \code{year.end}. If \code{!isTRUE(do.C4vars)}, then \code{NA}.} - \item{\var{\dQuote{dailyTempMean}}} {A numeric vector. Similar as for - \code{dailyTempMin} but for mean daily air temperature.} - \item{\var{\dQuote{dailyC4vars}}} {If \code{isTRUE(do.C4vars)}, then a - named numeric vector containing the output of - \code{\link{sw_dailyC4_TempVar}}, else \code{NA}.} -} -} -\description{ -Calculate climate variables from daily weather -} diff --git a/man/compare_test_output.Rd b/man/compare_test_output.Rd index 8878687f..cec048ea 100644 --- a/man/compare_test_output.Rd +++ b/man/compare_test_output.Rd @@ -20,6 +20,17 @@ A list with at least one element:\enumerate{ \description{ Reference database is identified by containing \code{basename(dir_test)} in the file name. +} +\examples{ +\dontrun{ + # Run test project 4 inside development version of package + # Assume that working directory is `tests/test_data/TestPrj4/` + source("SFSW2_project_code.R") + + # Compare output database with reference database + comp <- compare_test_output(".", dir_ref = "../0_ReferenceOutput/") +} + } \seealso{ \code{\link{compare_two_dbOutput}} diff --git a/man/estimate_PotNatVeg_biomass.Rd b/man/estimate_PotNatVeg_biomass.Rd deleted file mode 100644 index ad02b668..00000000 --- a/man/estimate_PotNatVeg_biomass.Rd +++ /dev/null @@ -1,71 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Vegetation.R -\name{estimate_PotNatVeg_biomass} -\alias{estimate_PotNatVeg_biomass} -\title{Adjust mean monthly biomass values of grass and shrub functional groups by -climate relationships} -\usage{ -estimate_PotNatVeg_biomass(tr_VegBiom, do_adjBiom_by_temp = FALSE, - do_adjBiom_by_ppt = FALSE, fgrass_c3c4ann = c(1, 0, 0), - growing_limit_C = 4, isNorth = TRUE, MAP_mm = 450, - mean_monthly_temp_C = c(rep(growing_limit_C - 1, 2), - rep(growing_limit_C + 1, 8), rep(growing_limit_C - 1, 2))) -} -\arguments{ -\item{tr_VegBiom}{A data.frame with 12 rows (one for each month) and columns -\code{X.Biomass}, \code{X.Amount.Live}, \code{X.Perc.Live}, and -\code{X.Litter} where \code{X} are for the functional groups shrubs, -\code{X = Sh}; C3-grasses, \code{X = C3}; C4-grasses, \code{X = C4}; and -annuals, \code{X = Annual} containing default input values.} - -\item{do_adjBiom_by_temp}{A logical value. If \code{TRUE} then monthly -phenology is adjusted by temperature.} - -\item{do_adjBiom_by_ppt}{A logical value. If \code{TRUE} then monthly biomass -is adjusted by precipitation.} - -\item{fgrass_c3c4ann}{A numeric vector of length 3. Relative contribution -[0-1] of the C3-grasses, C4-grasses, and annuals functional groups. The sum -of \code{fgrass_c3c4ann} is 1.} - -\item{growing_limit_C}{A numeric value. Mean monthly temperatures equal or -above this limit are here considered suitable for growth (growing season). -Default value is 4 C.} - -\item{isNorth}{A logical value. \code{TRUE} for locations on northern -hemisphere.} - -\item{MAP_mm}{A numeric value. Mean annual precipitation in millimeter of the -location.} - -\item{mean_monthly_temp_C}{A numeric vector of length 12. Mean monthly -temperature in Celsius. The default inputs considered March-October as -growing season.} -} -\value{ -A list with two elements \code{grass}, \code{shrub}. Each element is - a matrix with 12 rows (one for each month) and columns \code{Biomass}, - \code{Amount.Live}, \code{Perc.Live}, and \code{Litter}. -} -\description{ -Adjust mean monthly biomass values of grass and shrub functional groups by -climate relationships -} -\section{Default inputs}{ - \itemize{ - \item Shrubs are based on location \var{\sQuote{IM_USC00107648_Reynolds}} - which resulted in a vegetation composition of 70 \% shrubs and 30 \% - C3-grasses. Default monthly biomass values were estimated for - MAP = 450 mm yr-1. - \item Grasses are based on location \var{\sQuote{GP_SGSLTER}} - (shortgrass steppe) which resulted in 12 \% shrubs, 22 \% C3-grasses, - and 66 \% C4-grasses. Default biomass values were estimated for - MAP = 340 mm yr-1. } -} - -\references{ -Bradford, J.B., Schlaepfer, D.R., Lauenroth, W.K. & Burke, I.C. - (2014). Shifts in plant functional types have time-dependent and regionally - variable impacts on dryland ecosystem water balance. J Ecol, 102, - 1408-1418. -} diff --git a/man/estimate_PotNatVeg_composition.Rd b/man/estimate_PotNatVeg_composition.Rd deleted file mode 100644 index 4d006c49..00000000 --- a/man/estimate_PotNatVeg_composition.Rd +++ /dev/null @@ -1,107 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Vegetation.R -\name{estimate_PotNatVeg_composition} -\alias{estimate_PotNatVeg_composition} -\title{Calculate the composition of a potential natural vegetation based of shrub, -C3 grass, and C4 grass functional group components using climate -relationships} -\usage{ -estimate_PotNatVeg_composition(MAP_mm, MAT_C, mean_monthly_ppt_mm, - dailyC4vars, isNorth = TRUE, shrub_limit = 0.2, fix_annuals = TRUE, - Annuals_Fraction = 0, fix_C4grasses = FALSE, C4_Fraction = NA, - fix_C3grasses = FALSE, C3_Fraction = NA, fix_shrubs = FALSE, - Shrubs_Fraction = NA, fix_forbs = FALSE, Forbs_Fraction = NA, - fix_BareGround = TRUE, BareGround_Fraction = 0) -} -\arguments{ -\item{MAP_mm}{A numeric value. Mean annual precipitation in millimeter of the -location.} - -\item{MAT_C}{A numeric value. Mean annual temperature in degree Celsius.} - -\item{mean_monthly_ppt_mm}{A numeric vector of length 12. Mean monthly -precipitation in millimeter.} - -\item{dailyC4vars}{A named numeric vector of length 3. \describe{ -\item{\code{Month7th_NSadj_MinTemp_C}}{Mean minimum temperature of July on - the northern hemisphere and January on the southern hemisphere} -\item{\code{DegreeDaysAbove65F_NSadj_DaysC}}{Degree days above 65 F = 18.33 - C in units of days x degree Celsius} -\item{\code{LengthFreezeFreeGrowingPeriod_NSadj_Days}}{Mean annual number - of days of the longest continuous period where minimum daily temperature - remain above freezing} }} - -\item{isNorth}{A logical value. \code{TRUE} for locations on northern -hemisphere.} - -\item{shrub_limit}{A numeric value. Default value is 0.2 based on page 1213 -of Paruelo & Lauenroth 1996.} - -\item{fix_annuals}{A logical value. If \code{TRUE}, then value for the annual -component is fixed at \code{Annuals_Fraction}.} - -\item{Annuals_Fraction}{A numeric value. Default value is 0. A value between -0 and 1.} - -\item{fix_C4grasses}{A logical value. If \code{TRUE}, then value for the -C4-grass component is fixed at \code{C4_Fraction} instead of calculated -from climatic relationships.} - -\item{C4_Fraction}{A numeric value between 0 and 1. \code{NA} is treated as -if \code{fix_C4grasses} is \code{FALSE}.} - -\item{fix_C3grasses}{A logical value. If \code{TRUE}, then value for the -C3-grass component is fixed at \code{C3_Fraction} instead of calculated -from climatic relationships.} - -\item{C3_Fraction}{A numeric value between 0 and 1. \code{NA} is treated as -if \code{fix_C3grasses} is \code{FALSE}.} - -\item{fix_shrubs}{A logical value. If \code{TRUE}, then value for the shrub -component is fixed at \code{Shrubs_Fraction} instead of calculated from -climatic relationships.} - -\item{Shrubs_Fraction}{A numeric value between 0 and 1. \code{NA} is treated -as if \code{fix_shrubs} is \code{FALSE}.} - -\item{fix_forbs}{A logical value. If \code{TRUE}, then value for the forb -component is fixed at \code{Forbs_Fraction}.} - -\item{Forbs_Fraction}{A numeric value. Default value is 0. A value between 0 -and 1.} - -\item{fix_BareGround}{A logical value. If \code{TRUE}, then value for the -bare ground component is fixed at \code{BareGround_Fraction}.} - -\item{BareGround_Fraction}{A numeric value. Default value is 0. A value -between 0 and 1.} -} -\value{ -A list with two named numeric vectors. \describe{ - \item{Composition}{Relative composition [0-1] of the vegetation for - \code{Grasses}, \code{Shrubs}, \code{Trees}, \code{Forbs}, and - \code{BareGround}. \code{Grasses} are the sum of C3-grasses, C4-grasses, - and annuals functional groups. \code{Trees} is set to zero. The sum of - \code{Composition} is 1.} - \item{grasses.c3c4ann.fractions}{Relative contribution [0-1] of the - C3-grasses, C4-grasses, and annuals functional groups. The sum of - \code{grasses.c3c4ann.fractions} is 1.} } -} -\description{ -Equations by Paruelo & Lauenroth 1996 are used to estimate shrub, C3 grass, -and C3 grass components. Equations by Teeri & Stowe 1976 are used to limit -occurrence of C4 grasses. -} -\section{Note}{ - This function does not estimate cover of the tree, forb, - and bare-ground components; instead, these are set to 0. -} - -\references{ -Paruelo J.M., Lauenroth W.K. (1996) Relative abundance of plant - functional types in grasslands and shrublands of North America. Ecological - Applications, 6, 1212-1224. - -Teeri J.A., Stowe L.G. (1976) Climatic patterns and the - distribution of C4 grasses in North America. Oecologia, 23, 1-12. -} diff --git a/man/get_simulation_time.Rd b/man/get_simulation_time.Rd index 4b37f13a..0e4e2fb4 100644 --- a/man/get_simulation_time.Rd +++ b/man/get_simulation_time.Rd @@ -9,7 +9,7 @@ get_simulation_time(st, SFSW2_prj_inputs) } \arguments{ \item{st}{An object as returned from the function -\code{\link{setup_simulation_time}}.} +\code{\link{setup_time_simulation_project}}.} \item{SFSW2_prj_inputs}{An object as returned from function \code{\link{process_inputs}}.} diff --git a/man/pedotransfer.Rd b/man/pedotransfer.Rd deleted file mode 100644 index 7b52ce48..00000000 --- a/man/pedotransfer.Rd +++ /dev/null @@ -1,119 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Pedotransfer_Functions.R -\name{pedotransfer} -\alias{pedotransfer} -\alias{pdf_to_vwc} -\alias{pdf_to_swp} -\alias{SWPtoVWC} -\alias{VWCtoSWP} -\title{Pedotransfer functions to convert between soil moisture (volumetric water -content, \var{VWC}) and soil water potential (\var{SWP})} -\usage{ -pdf_to_vwc(swp, sand, clay, thetas, psis, b, MPa_toBar = -10, - bar_conversion = 1024) - -pdf_to_swp(vwc, sand, clay, thetas, psis, b, bar_toMPa = -0.1, - bar_conversion = 1024) - -SWPtoVWC(swp, sand, clay) - -VWCtoSWP(vwc, sand, clay) -} -\arguments{ -\item{swp}{A numeric value, vector, or 2-dimensional object -(matrix or data.frame). The soil water potential (of the soil matrix) in -units of \var{MPa}, i.e., the soil without the volume of rock and gravel.} - -\item{sand}{A numeric value or vector. Sand content of the soil layer(s) as -fractional value in \code{[0,1]}.} - -\item{clay}{A numeric value or vector. Clay content of the soil layer(s) as -fractional value in \code{[0,1]}.} - -\item{vwc}{A numeric value, vector, or 2-dimensional object -(matrix or data.frame). The matric soil moisture, i.e., reduced by the -volume of rock and gravel.} -} -\value{ -Volumetric water content in units of m^3 (of water) / m^3 (of soil) - \code{[0, 1]}. There are six use cases:\enumerate{ - \item 1) \itemize{ - \item Input: \code{SWP} [single value]; \code{sand} and \code{clay} - [single values] - \item Output: \code{VWC} [single value]} - \item 2) \itemize{ - \item Input: \code{SWP} [single value]; \code{sand} and \code{clay} - [vectors of length d] - \item Output: \code{VWC} [vector of length d]} - \item 3) \itemize{ - \item Input: \code{SWP} [vector of length l]; \code{sand} and - \code{clay} infraction [single values] - \item Output: \code{VWC} [vector of length l]} - \item 4) \itemize{ - \item Input: \code{SWP} [vector of length l]; \code{sand} and - \code{clay} [vectors of length d] - \item Output: \code{VWC} [l x d matrix] where \code{SWP} is - repeated for each column} - \item 5) \itemize{ - \item Input: \code{SWP} [l x d matrix]; \code{sand} and \code{clay} - [single values] - \item Output: \code{VWC} [l x d matrix]} - \item 6) \itemize{ - \item Input: \code{SWP} [l x d matrix]; \code{sand} and \code{clay} - [vectors of length d] - \item Output: \code{VWC} [l x d matrix], \code{sand} and \code{clay} - vectors are repeated for each row} - } - -Soil water potential in units of \var{MPa} \code{[-Inf, 0]}. - There are six use cases: \enumerate{ - \item 1) \itemize{ - \item Input: \code{VWC} [single value]; \code{sand} and \code{clay} - [single values] - \item Output: \code{SWP} [single value]} - \item 2) \itemize{ - \item Input: \code{VWC} [single value]; \code{sand} and \code{clay} - [vectors of length d] - \item Output: \code{SWP} [vector of length d]} - \item 3) \itemize{ - \item Input: \code{VWC} [vector of length l]; \code{sand} and - \code{clay} in fraction [single values] - \item Output: \code{SWP} [vector of length l]} - \item 4) \itemize{ - \item Input: \code{VWC} [vector of length l]; \code{sand} and - \code{clay} [vectors of length d] - \item Output: \code{SWP} [l x d matrix] where \code{VWC} is repeated for - each column} - \item 5) \itemize{ - \item Input: \code{VWC} [l x d matrix]; \code{sand} and \code{clay} - [single values] - \item Output: \code{SWP} [l x d matrix]} - \item 6) \itemize{ - \item Input: \code{VWC} [l x d matrix]; \code{sand} and \code{clay} - [vectors of length d] - \item Output: \code{SWP} [l x d matrix], \code{sand} and \code{clay} - vectors are repeated for each row} - } -} -\description{ -Pedotransfer functions to convert between soil moisture (volumetric water -content, \var{VWC}) and soil water potential (\var{SWP}) - -Calculate volumetric water content from soil water potential and soil texture - -Calculate soil water potential from volumetric water content and soil texture -} -\section{Note}{ - either \code{swp} or \code{sand}/\code{clay} needs be a - single value - - either \code{vwc} or \code{sand}/\code{clay} needs be a - single value -} - -\references{ -Cosby, B. J., G. M. Hornberger, R. B. Clapp, and T. R. Ginn. -1984. A statistical exploration of the relationships of soil moisture -characteristics to the physical properties of soils. Water Resources Research -20:682-690. -} diff --git a/man/recreate_dbWork.Rd b/man/recreate_dbWork.Rd index c34cf590..52943c36 100644 --- a/man/recreate_dbWork.Rd +++ b/man/recreate_dbWork.Rd @@ -28,3 +28,10 @@ A logical vector indicating success. \description{ Re-create or update \var{\sQuote{dbWork}} based on \var{\sQuote{dbOutput}} } +\examples{ +\dontrun{ +# `SFSW2_prj_meta` object as produced, e.g., for `TestPrj4` +recreate_dbWork(SFSW2_prj_meta = SFSW2_prj_meta) +} + +} diff --git a/man/run_test_projects.Rd b/man/run_test_projects.Rd index 54ffb988..40c80cf8 100644 --- a/man/run_test_projects.Rd +++ b/man/run_test_projects.Rd @@ -47,7 +47,9 @@ A list with two elements: \describe{ one character string \code{referenceDB} of the reference database name against which this run of the test project was compared.} \item{report}{A character vector describing differences between - test and reference databases} } + test and reference databases including the output of a call to + \code{\link{compare_test_output}}} + } } \description{ Run test projects diff --git a/man/seq_month_ofeach_day.Rd b/man/seq_month_ofeach_day.Rd deleted file mode 100644 index f64140bd..00000000 --- a/man/seq_month_ofeach_day.Rd +++ /dev/null @@ -1,24 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Time_SimulationWorld.R -\name{seq_month_ofeach_day} -\alias{seq_month_ofeach_day} -\title{The sequence of month numbers for each day in the period from - to} -\usage{ -seq_month_ofeach_day(from = list(year = 1900, month = 1, day = 1), - to = list(year = 1900, month = 12, day = 31), tz = "UTC") -} -\description{ -The sequence of month numbers for each day in the period from - to -} -\examples{ - month1 <- function() as.POSIXlt(seq(from = ISOdate(1980, 1, 1, tz = "UTC"), - to = ISOdate(2010, 12, 31, tz = "UTC"), by = "1 day"))$mon + 1 - month2 <- function() seq_month_ofeach_day(list(1980, 1, 1), - list(2010, 12, 31), tz = "UTC") - -\dontrun{ - if (requireNamespace("microbenchmark", quietly = TRUE)) - # barely any difference - microbenchmark::microbenchmark(month1(), month2()) - } -} diff --git a/man/setup_simulation_time.Rd b/man/setup_time_simulation_project.Rd similarity index 60% rename from man/setup_simulation_time.Rd rename to man/setup_time_simulation_project.Rd index f99c1a87..704afbb2 100644 --- a/man/setup_simulation_time.Rd +++ b/man/setup_time_simulation_project.Rd @@ -1,20 +1,21 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/Time_SimulationWorld.R -\name{setup_simulation_time} -\alias{setup_simulation_time} +\name{setup_time_simulation_project} +\alias{setup_time_simulation_project} \title{Describe the time of a simulation project} \usage{ -setup_simulation_time(sim_time, add_st2 = FALSE, adjust_NS = FALSE, - use_doy_range = FALSE, doy_ranges = list()) +setup_time_simulation_project(sim_time, add_st2 = FALSE, + adjust_NS = FALSE, use_doy_range = FALSE, doy_ranges = list()) } \arguments{ -\item{sim_time}{A list with at least values for three named elements: -\var{\dQuote{simstartyr}} and \var{\dQuote{endyr}} and one of the following -two: \var{\dQuote{startyr}} or \var{\dQuote{spinup_N}}.} +\item{sim_time}{A list with at least values for four named elements: +\var{\dQuote{simstartyr}} and \var{\dQuote{endyr}}, one of the following +two: \var{\dQuote{startyr}} or \var{\dQuote{spinup_N}}, and +\var{dQuote{future_yrs}}.} \item{add_st2}{A logical value. If \code{TRUE}, the output of calling the -function \code{\link{simTiming_ForEachUsedTimeUnit}} is appended to the -returned list.} +function \code{\link[rSOILWAT2]{simTiming_ForEachUsedTimeUnit}} +is appended to the returned list.} \item{adjust_NS}{A logical value. If \code{TRUE}, then the result is corrected for locations on the southern vs. northern hemisphere. Only used @@ -32,3 +33,6 @@ days indicated in the \code{doy_ranges}.} \description{ Describe the time of a simulation project } +\seealso{ +\code{\link[rSOILWAT2]{setup_time_simulation_run}} +} diff --git a/man/simTiming_ForEachUsedTimeUnit.Rd b/man/simTiming_ForEachUsedTimeUnit.Rd deleted file mode 100644 index d46b41df..00000000 --- a/man/simTiming_ForEachUsedTimeUnit.Rd +++ /dev/null @@ -1,38 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Time_SimulationWorld.R -\name{simTiming_ForEachUsedTimeUnit} -\alias{simTiming_ForEachUsedTimeUnit} -\title{Calculate indices along different time steps for simulation time} -\usage{ -simTiming_ForEachUsedTimeUnit(st, sim_tscales = c("daily", "weekly", - "monthly", "yearly"), use_doy_range = FALSE, doy_ranges = list(), - latitude = 90, account_NorthSouth = TRUE) -} -\arguments{ -\item{st}{An object as returned from the function -\code{\link{setup_simulation_time}}.} - -\item{sim_tscales}{A vector of character strings. One or multiple of -\code{c("daily", "weekly", "monthly", "yearly")}.} - -\item{use_doy_range}{A logical value. If \code{TRUE}, then the result is -additional daily indices indicating whether the \var{DOY} is within the -days indicated in the \code{doy_ranges}.} - -\item{doy_ranges}{A named list. Aggregation output variables and the daily -\code{c(min, max)} of days you wish to calculate the aggregation over.} - -\item{latitude}{A numeric value. The latitude in decimal degrees for which a -hemispheric adjustment is requested; however, the code extracts only the -sign. Positive values are interpreted as from the northern hemisphere; -negative latitudes as from the southern hemisphere.} - -\item{account_NorthSouth}{A logical value. If \code{TRUE}, then the result is -corrected for locations on the southern vs. northern hemisphere.} -} -\value{ -A named list. -} -\description{ -Calculate indices along different time steps for simulation time -} diff --git a/man/swOutput_access.Rd b/man/swOutput_access.Rd index 870de082..0a2e961b 100644 --- a/man/swOutput_access.Rd +++ b/man/swOutput_access.Rd @@ -92,7 +92,7 @@ get_CO2effects_yr(x, st) \code{\link[rSOILWAT2:swOutput-class]{rSOILWAT2::swOutput}}.} \item{st}{An object as returned from the function -\code{\link{setup_simulation_time}}.} +\code{\link{setup_time_simulation_project}}.} } \description{ \pkg{rSOILWAT2} data access functions diff --git a/man/sw_dailyC4_TempVar.Rd b/man/sw_dailyC4_TempVar.Rd deleted file mode 100644 index ae342435..00000000 --- a/man/sw_dailyC4_TempVar.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Miscellaneous_Functions.R -\name{sw_dailyC4_TempVar} -\alias{sw_dailyC4_TempVar} -\title{Calculate variables required to estimate percent C4 species in North America} -\usage{ -sw_dailyC4_TempVar(dailyTempMin, dailyTempMean, simTime2) -} -\value{ -A named numeric vector of length 6. -} -\description{ -Calculate variables required to estimate percent C4 species in North America -} -\references{ -Teeri J.A., Stowe L.G. (1976) Climatic patterns and the - distribution of C4 grasses in North America. Oecologia, 23, 1-12. -} diff --git a/man/update_biomass.Rd b/man/update_biomass.Rd deleted file mode 100644 index d433d6e0..00000000 --- a/man/update_biomass.Rd +++ /dev/null @@ -1,20 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Vegetation.R -\name{update_biomass} -\alias{update_biomass} -\title{Replace selected biomass values of a -\link[rSOILWAT2:swProd-class]{rSOILWAT2::swProd} object} -\usage{ -update_biomass(fg = c("Grass", "Shrub", "Tree", "Forb"), use, prod_input, - prod_default) -} -\arguments{ -\item{fg}{A character string. One of the functional groups represented by -\code{rSOILWAT2}} - -\item{use}{A logical vector.} -} -\description{ -Replace selected biomass values of a -\link[rSOILWAT2:swProd-class]{rSOILWAT2::swProd} object -} diff --git a/man/update_requested_years.Rd b/man/update_requested_years.Rd deleted file mode 100644 index ea1b1bdc..00000000 --- a/man/update_requested_years.Rd +++ /dev/null @@ -1,36 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Time_SimulationWorld.R -\name{update_requested_years} -\alias{update_requested_years} -\title{Check requested years} -\usage{ -update_requested_years(start_year, end_year, has_start_year, has_end_year, - temp_call = NULL, verbose = FALSE) -} -\arguments{ -\item{start_year}{An integer value. The requested first year to extract -weather data.} - -\item{end_year}{An integer value. The requested last year to extract weather -data.} - -\item{has_start_year}{An integer value. The available first year of the -weather data.} - -\item{has_end_year}{An integer value. The available last year of the weather -data.} - -\item{temp_call}{A character string. An identifier of the calling function -used for printing.} - -\item{verbose}{A logical value. If \code{TRUE} prints statements if first or -last year were updated.} -} -\value{ -A list with two named elements \itemize{ \item \code{start_year} to - updated first year no smaller than \code{has_start_year} \item - \code{end_year} to updated last year no larger than \code{has_end_year} } -} -\description{ -Check requested years -} diff --git a/tests/test_data/0_ReferenceOutput/dbOutput_TestPrj4_v2.7.4.sqlite3 b/tests/test_data/0_ReferenceOutput/dbOutput_TestPrj4_v2.7.4.sqlite3 deleted file mode 100644 index c9eb2daf..00000000 Binary files a/tests/test_data/0_ReferenceOutput/dbOutput_TestPrj4_v2.7.4.sqlite3 and /dev/null differ diff --git a/tests/test_data/0_ReferenceOutput/dbOutput_TestPrj4_v3.2.0.sqlite3 b/tests/test_data/0_ReferenceOutput/dbOutput_TestPrj4_v3.2.0.sqlite3 new file mode 100644 index 00000000..a602f44f --- /dev/null +++ b/tests/test_data/0_ReferenceOutput/dbOutput_TestPrj4_v3.2.0.sqlite3 @@ -0,0 +1,3 @@ +version https://git-lfs.github.com/spec/v1 +oid sha256:4a377e562321b4990106a308334f8173655a3ed4c7ca383d37aa9e8ebc130460 +size 4980736 diff --git a/tests/test_data/TestPrj4/1_Input/SWRuns_InputData_ExperimentalDesign_v09.csv b/tests/test_data/TestPrj4/1_Input/SWRuns_InputData_ExperimentalDesign_v09.csv index c60bf251..0df6b0b4 100644 --- a/tests/test_data/TestPrj4/1_Input/SWRuns_InputData_ExperimentalDesign_v09.csv +++ b/tests/test_data/TestPrj4/1_Input/SWRuns_InputData_ExperimentalDesign_v09.csv @@ -1,4 +1,4 @@ -Label,sw,filesin,prodin,siteparamin,soilsin,weathersetupin,cloudin,YearStart,YearEnd,LookupWeatherFolder,LookupClimateTemp,LookupClimatePPT,LookupShiftedPPT,LookupShiftedPPT,LookupSnowDensity,LookupTranspRegions,LookupEvapCoefs,LookupTranspCoefs_Grass,LookupTranspCoefs_Shrub,LookupTranspCoefs_Tree,LookupTranspCoefs_Forb,LookupCO2data,PotentialNaturalVegetation_CompositionShrubsC3C4_Paruelo1996,PotentialNaturalVegetation_CompositionShrubs_Fraction,PotentialNaturalVegetation_CompositionC3_Fraction,PotentialNaturalVegetation_CompositionC4_Fraction,PotentialNaturalVegetation_CompositionAnnuals_Fraction,PotentialNaturalVegetation_CompositionForb_Fraction,PotentialNaturalVegetation_CompositionBareGround_Fraction,PotentialNaturalVegetation_CompositionTrees_Fraction,AdjMonthlyBioMass_Precipitation,AdjMonthlyBioMass_Temperature,AdjRootProfile,RootProfile_C3,RootProfile_C4,RootProfile_Annuals,RootProfile_Shrubs,RootProfile_Forb,Shrub_TotalBiomass_ScalingFactor,Shrub_LiveBiomass_ScalingFactor,Shrub_Litter_ScalingFactor,Grass_TotalBiomass_ScalingFactor,Grass_LiveBiomass_ScalingFactor,Grass_Litter_ScalingFactor,Tree_TotalBiomass_ScalingFactor,Tree_LiveBiomass_ScalingFactor,Tree_Litter_ScalingFactor,Forb_TotalBiomass_ScalingFactor,Forb_LiveBiomass_ScalingFactor,Forb_Litter_ScalingFactor,Vegetation_Biomass_ScalingSeason_AllGrowingORNongrowing,Vegetation_Height_ScalingFactor,PotentialNaturalVegetation_Composition_basedOnReferenceOrScenarioClimate,ClimateScenario_Temp_PerturbationInMeanSeasonalityBothOrNone,ClimateScenario_PPT_PerturbationInMeanSeasonalityBothOrNone,RunoffPercent_fromPondedWater,RunonPercent_fromPondedWater,Imperm_L1,Exclude_ClimateAmbient,Grass_HydRed_OnOff,Shrub_HydRed_OnOff,Tree_HydRed_OnOff,Forb_HydRed_OnOff,SoilTemp_deltaX_cm,SoilTemp_MaxDepth_cm,PET_multiplier,Grass_SWPcrit_MPa,Shrub_SWPcrit_MPa,Tree_SWPcrit_MPa,Forb_SWPcrit_MPa,UseCO2BiomassMultiplier,UseCO2WUEMultiplier,SoilTemp_Flag -UseInformationToCreateSoilWatRuns,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,1,1,1,1,1,1,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1 -DefaultSettings,,,,,,,,,,,,,,,Prairie,CONUSSOIL_BSE_EVERY10cm,,SchenkJackson2003_PCdry_grasses,SchenkJackson2003_PCdry_shrubs,FILL,SchenkJackson2003_PCdry_forbs,FILL,1,,,,,,,,1,1,1,1,1,1,1,1,,,,,,,,,,,,,,,,,,,,,,,,,,15,990,1,-3.5,-3.9,-2,-2,1,1,1 -noCO2effects,,,,,,,,,,,,,,,Prairie,CONUSSOIL_BSE_EVERY10cm,,SchenkJackson2003_PCdry_grasses,SchenkJackson2003_PCdry_shrubs,FILL,SchenkJackson2003_PCdry_forbs,FILL,1,,,,,,,,1,1,1,1,1,1,1,1,,,,,,,,,,,,,,,,,,,,,,,,,,15,990,1,-3.5,-3.9,-2,-2,0,0,1 +Label,filesin,prodin,siteparamin,soilsin,weathersetupin,cloudin,YearStart,YearEnd,LookupWeatherFolder,LookupClimateTemp,LookupClimatePPT,LookupShiftedPPT,LookupShiftedPPTCategory,LookupSnowDensity,LookupTranspRegions,LookupEvapCoefs,LookupTranspCoefs_Grass,LookupTranspCoefs_Shrub,LookupTranspCoefs_Tree,LookupTranspCoefs_Forb,LookupCO2data,PotentialNaturalVegetation_CompositionShrubsC3C4_Paruelo1996,PotentialNaturalVegetation_CompositionShrubs_Fraction,PotentialNaturalVegetation_CompositionC3_Fraction,PotentialNaturalVegetation_CompositionC4_Fraction,PotentialNaturalVegetation_CompositionAnnuals_Fraction,PotentialNaturalVegetation_CompositionForb_Fraction,PotentialNaturalVegetation_CompositionBareGround_Fraction,PotentialNaturalVegetation_CompositionTrees_Fraction,AdjMonthlyBioMass_Precipitation,AdjMonthlyBioMass_Temperature,AdjRootProfile,RootProfile_C3,RootProfile_C4,RootProfile_Annuals,RootProfile_Shrubs,RootProfile_Forb,Shrub_TotalBiomass_ScalingFactor,Shrub_LiveBiomass_ScalingFactor,Shrub_Litter_ScalingFactor,Grass_TotalBiomass_ScalingFactor,Grass_LiveBiomass_ScalingFactor,Grass_Litter_ScalingFactor,Tree_TotalBiomass_ScalingFactor,Tree_LiveBiomass_ScalingFactor,Tree_Litter_ScalingFactor,Forb_TotalBiomass_ScalingFactor,Forb_LiveBiomass_ScalingFactor,Forb_Litter_ScalingFactor,Vegetation_Biomass_ScalingSeason_AllGrowingORNongrowing,Vegetation_Height_ScalingFactor,PotentialNaturalVegetation_Composition_basedOnReferenceOrScenarioClimate,ClimateScenario_Temp_PerturbationInMeanSeasonalityBothOrNone,ClimateScenario_PPT_PerturbationInMeanSeasonalityBothOrNone,RunoffPercent_fromPondedWater,RunonPercent_fromPondedWater,Imperm_L1,Exclude_ClimateAmbient,Grass_HydRed_OnOff,Shrub_HydRed_OnOff,Tree_HydRed_OnOff,Forb_HydRed_OnOff,SoilTemp_deltaX_cm,SoilTemp_MaxDepth_cm,PET_multiplier,Grass_SWPcrit_MPa,Shrub_SWPcrit_MPa,Tree_SWPcrit_MPa,Forb_SWPcrit_MPa,UseCO2BiomassMultiplier,UseCO2WUEMultiplier,SoilTemp_Flag +UseInformationToCreateSoilWatRuns,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,1,1,1,1,1,1,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1 +DefaultSettings,,,,,,,,,,,,,,Prairie,CONUSSOIL_BSE_EVERY10cm,,SchenkJackson2003_PCdry_grasses,SchenkJackson2003_PCdry_shrubs,FILL,SchenkJackson2003_PCdry_forbs,FILL,1,,,,,,,,1,1,1,1,1,1,1,1,,,,,,,,,,,,,,,,,,,,,,,,,,15,990,1,-3.5,-3.9,-2,-2,1,1,1 +noCO2effects,,,,,,,,,,,,,,Prairie,CONUSSOIL_BSE_EVERY10cm,,SchenkJackson2003_PCdry_grasses,SchenkJackson2003_PCdry_shrubs,FILL,SchenkJackson2003_PCdry_forbs,FILL,1,,,,,,,,1,1,1,1,1,1,1,1,,,,,,,,,,,,,,,,,,,,,,,,,,15,990,1,-3.5,-3.9,-2,-2,0,0,1 diff --git a/tests/test_data/TestPrj4/1_Input/SWRuns_InputData_TreatmentDesign_v17.csv b/tests/test_data/TestPrj4/1_Input/SWRuns_InputData_TreatmentDesign_v17.csv index 011a1257..4604f017 100644 --- a/tests/test_data/TestPrj4/1_Input/SWRuns_InputData_TreatmentDesign_v17.csv +++ b/tests/test_data/TestPrj4/1_Input/SWRuns_InputData_TreatmentDesign_v17.csv @@ -1,2 +1,2 @@ -Label,sw,filesin,prodin,siteparamin,soilsin,weathersetupin,cloudin,YearStart,YearEnd,LookupWeatherFolder,LookupClimateTemp,LookupClimatePPT,LookupShiftedPPT,LookupShiftedPPT,LookupSnowDensity,LookupTranspRegions,LookupEvapCoefs,LookupTranspCoefs_Grass,LookupTranspCoefs_Shrub,LookupTranspCoefs_Tree,LookupTranspCoefs_Forb,LookupCO2data,PotentialNaturalVegetation_CompositionShrubsC3C4_Paruelo1996,PotentialNaturalVegetation_CompositionShrubs_Fraction,PotentialNaturalVegetation_CompositionC3_Fraction,PotentialNaturalVegetation_CompositionC4_Fraction,PotentialNaturalVegetation_CompositionAnnuals_Fraction,PotentialNaturalVegetation_CompositionForb_Fraction,PotentialNaturalVegetation_CompositionBareGround_Fraction,PotentialNaturalVegetation_CompositionTrees_Fraction,AdjMonthlyBioMass_Precipitation,AdjMonthlyBioMass_Temperature,AdjRootProfile,RootProfile_C3,RootProfile_C4,RootProfile_Annuals,RootProfile_Shrubs,RootProfile_Forbs,Shrub_TotalBiomass_ScalingFactor,Shrub_LiveBiomass_ScalingFactor,Shrub_Litter_ScalingFactor,Grass_TotalBiomass_ScalingFactor,Grass_LiveBiomass_ScalingFactor,Grass_Litter_ScalingFactor,Tree_TotalBiomass_ScalingFactor,Tree_LiveBiomass_ScalingFactor,Tree_Litter_ScalingFactor,Forb_TotalBiomass_ScalingFactor,Forb_LiveBiomass_ScalingFactor,Forb_Litter_ScalingFactor,Vegetation_Biomass_ScalingSeason_AllGrowingORNongrowing,Vegetation_Height_ScalingFactor,PotentialNaturalVegetation_Composition_basedOnReferenceOrScenarioClimate,ClimateScenario_Temp_PerturbationInMeanSeasonalityBothOrNone,ClimateScenario_PPT_PerturbationInMeanSeasonalityBothOrNone,Exclude_ClimateAmbient,MaxTempDepth,UseCO2BiomassMultiplier,UseCO2WUEMultiplier -UseInformationToCreateSoilWatRuns,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 +Label,filesin,prodin,siteparamin,soilsin,weathersetupin,cloudin,YearStart,YearEnd,LookupWeatherFolder,LookupClimateTemp,LookupClimatePPT,LookupShiftedPPT,LookupShiftedPPTCategory,LookupSnowDensity,LookupTranspRegions,LookupEvapCoefs,LookupTranspCoefs_Grass,LookupTranspCoefs_Shrub,LookupTranspCoefs_Tree,LookupTranspCoefs_Forb,LookupCO2data,PotentialNaturalVegetation_CompositionShrubsC3C4_Paruelo1996,PotentialNaturalVegetation_CompositionShrubs_Fraction,PotentialNaturalVegetation_CompositionC3_Fraction,PotentialNaturalVegetation_CompositionC4_Fraction,PotentialNaturalVegetation_CompositionAnnuals_Fraction,PotentialNaturalVegetation_CompositionForb_Fraction,PotentialNaturalVegetation_CompositionBareGround_Fraction,PotentialNaturalVegetation_CompositionTrees_Fraction,AdjMonthlyBioMass_Precipitation,AdjMonthlyBioMass_Temperature,AdjRootProfile,RootProfile_C3,RootProfile_C4,RootProfile_Annuals,RootProfile_Shrubs,RootProfile_Forbs,Shrub_TotalBiomass_ScalingFactor,Shrub_LiveBiomass_ScalingFactor,Shrub_Litter_ScalingFactor,Grass_TotalBiomass_ScalingFactor,Grass_LiveBiomass_ScalingFactor,Grass_Litter_ScalingFactor,Tree_TotalBiomass_ScalingFactor,Tree_LiveBiomass_ScalingFactor,Tree_Litter_ScalingFactor,Forb_TotalBiomass_ScalingFactor,Forb_LiveBiomass_ScalingFactor,Forb_Litter_ScalingFactor,Vegetation_Biomass_ScalingSeason_AllGrowingORNongrowing,Vegetation_Height_ScalingFactor,PotentialNaturalVegetation_Composition_basedOnReferenceOrScenarioClimate,ClimateScenario_Temp_PerturbationInMeanSeasonalityBothOrNone,ClimateScenario_PPT_PerturbationInMeanSeasonalityBothOrNone,Exclude_ClimateAmbient,MaxTempDepth,UseCO2BiomassMultiplier,UseCO2WUEMultiplier +UseInformationToCreateSoilWatRuns,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 diff --git a/tests/test_data/TestPrj4/1_Input/dbWeatherData3.sqlite3 b/tests/test_data/TestPrj4/1_Input/dbWeatherData3.sqlite3 index 35e756f7..1cd7f835 100644 Binary files a/tests/test_data/TestPrj4/1_Input/dbWeatherData3.sqlite3 and b/tests/test_data/TestPrj4/1_Input/dbWeatherData3.sqlite3 differ diff --git a/tests/test_data/TestPrj4/1_Input/treatments/LookupClimateTemp/climate_temp.csv b/tests/test_data/TestPrj4/1_Input/treatments/LookupClimateTemp/climate_temp.csv new file mode 100644 index 00000000..17bd73a7 --- /dev/null +++ b/tests/test_data/TestPrj4/1_Input/treatments/LookupClimateTemp/climate_temp.csv @@ -0,0 +1 @@ +Month,Current,B1monthly.SnowCat1,B1monthly.SnowCat2,B1monthly.SnowCat3,B1monthly.SnowCat4,A2monthly.SnowCat1,A2monthly.SnowCat2,A2monthly.SnowCat3,A2monthly.SnowCat4 1,0,2.31,2.46,2.35,2.48,3.61,3.78,3.74,3.76 2,0,2.24,2.17,2.06,2.09,3.83,4.17,4.00,4.02 3,0,2.39,2.76,2.52,2.72,3.26,3.72,3.41,3.61 4,0,2.26,2.24,2.26,2.20,3.17,3.48,3.44,3.52 5,0,2.28,2.31,2.41,2.35,3.89,4.09,4.19,4.15 6,0,3.54,3.72,3.70,3.74,5.09,5.44,5.54,5.54 7,0,3.81,3.85,3.83,3.89,6.50,6.59,6.52,6.59 8,0,4.28,4.35,4.26,4.28,6.94,6.89,6.70,6.81 9,0,4.04,4.02,3.94,3.91,6.56,6.48,6.46,6.44 10,0,2.85,2.80,2.91,2.89,4.50,4.48,4.52,4.52 11,0,2.87,2.74,2.83,2.74,3.44,3.41,3.52,3.43 12,0,3.30,3.13,3.09,3.09,3.39,3.50,3.52,3.46 \ No newline at end of file diff --git a/tests/test_data/TestPrj4/1_Input/treatments/tr_cloudin/climate.in b/tests/test_data/TestPrj4/1_Input/treatments/tr_cloudin/climate.in new file mode 100644 index 00000000..5e050207 --- /dev/null +++ b/tests/test_data/TestPrj4/1_Input/treatments/tr_cloudin/climate.in @@ -0,0 +1,6 @@ +71.0 61.0 61.0 51.0 41.0 31.0 23.0 23.0 31.0 41.0 61.0 61.0 # (site: testing), sky cover (sunrise-sunset),%,Climate Atlas of the US,http://cdo.ncdc.noaa.gov/cgi-bin/climaps/climaps.pl +1.3 2.9 3.3 3.8 3.8 3.8 3.3 3.3 2.9 1.3 1.3 1.3 # Wind speed (m/s),Climate Atlas of the US,http://cdo.ncdc.noaa.gov/cgi-bin/climaps/climaps.pl +61.0 61.0 61.0 51.0 51.0 51.0 41.0 41.0 51.0 51.0 61.0 61.0 # rel. Humidity (%),Climate Atlas of the US,http://cdo.ncdc.noaa.gov/cgi-bin/climaps/climaps.pl +1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 # transmissivity (rel), only used in petfunc, but falls out of the equations (a = trans * b, c = a / trans) +213.7 241.6 261.0 308.0 398.1 464.5 0.0 0.0 0.0 140.0 161.6 185.1 # snow density (kg/m3): Brown, R. D. and P. W. Mote. 2009. The response of Northern Hemisphere snow cover to a changing climate. Journal of Climate 22:2124-2145. +1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 # m = number of precipitation events per day diff --git a/tests/test_data/TestPrj4/1_Input/treatments/tr_prodin/veg.in b/tests/test_data/TestPrj4/1_Input/treatments/tr_prodin/veg.in new file mode 100755 index 00000000..82783a4a --- /dev/null +++ b/tests/test_data/TestPrj4/1_Input/treatments/tr_prodin/veg.in @@ -0,0 +1,142 @@ +# Plant production data file for SOILWAT2 +# Location: + +# ---- Composition of vegetation type components (0-1; must add up to 1) +# Grasses Shrubs Trees Forbs BareGround + 0.2 0.2 0.2 0.2 0.2 + + +# ---- Albedo +# Grasses Shrubs Trees Forbs BareGround + 0.167 0.143 0.106 0.167 0.15 # albedo: (Houldcroft et al. 2009) MODIS snowfree 'grassland', 'open shrub', ‘evergreen needle forest’ with MODIS albedo aggregated over pure IGBP cells where NDVI is greater than the 98th percentile NDVI + + +# -- Canopy height (cm) parameters either constant through season or as tanfunc with respect to biomass (g/m^2) +# Grasses Shrubs Trees Forbs + 300.0 0.0 0.0 300.0 # xinflec + 29.5 5.0 5.0 29.5 # yinflec + 85. 100. 3000. 85. # range + 0.002 0.003 0.00008 0.002 # slope + 0.0 50. 1200. 0.0 # if > 0 then constant canopy height (cm) + + +# --- Vegetation interception parameters: kSmax * log10(1 + LAI_live + kdead * LAI_dead) +# Grasses Shrubs Trees Forbs + 1.0 2.6 2.0 1.0 # kSmax (mm) + 1.0 0.1 0.01 0.5 # kdead (0-1 fraction) + + +# --- Litter interception parameters: kSmax * log10(1 + litter_density) +# Grasses Shrubs Trees Forbs + 0.113 0.113 0.290 0.113 # kSmax (mm) + + +# ---- Parameter for partitioning of bare-soil evaporation and transpiration as in Es = exp(-param*LAI) +# Grasses Shrubs Trees Forbs + 1. 1. 0.41 1. # Trees: According to a regression based on a review by Daikoku, K., S. Hattori, A. Deguchi, Y. Aoki, M. Miyashita, K. Matsumoto, J. Akiyama, S. Iida, T. Toba, Y. Fujita, and T. Ohta. 2008. Influence of evaporation from the forest floor on evapotranspiration from the dry canopy. Hydrological Processes 22:4083-4096. + + +# ---- Parameter for scaling and limiting bare soil evaporation rate: if totagb (g/m2) > param then no bare-soil evaporation +# Grasses Shrubs Trees Forbs + 999. 999. 2099. 999. # + + +# --- Shade effects on transpiration based on live and dead biomass +# Grasses Shrubs Trees Forbs + 0.3 0.3 0.3 0.3 # shade scale + 150. 150. 150. 150. # shade maximal dead biomass + 300. 300. 0. 300. # tanfunc: xinflec + 12. 12. 0. 12. # yinflec + 34. 34. 2. 34. # range + 0.002 0.002 0.0002 0.002 # slope + + +# ---- Hydraulic redistribution: Ryel, Ryel R, Caldwell, Caldwell M, Yoder, Yoder C, Or, Or D, Leffler, Leffler A. 2002. Hydraulic redistribution in a stand of Artemisia tridentata: evaluation of benefits to transpiration assessed with a simulation model. Oecologia 130: 173-184. +# Grasses Shrubs Trees Forbs + 1 1 1 1 # flag to turn on/off (1/0) hydraulic redistribution + -0.2328 -0.2328 -0.2328 -0.2328 # maxCondroot - maximum radial soil-root conductance of the entire active root system for water (cm/-bar/day) = 0.097 cm/MPa/h + 10. 10. 10. 10. # swp50 - soil water potential (-bar) where conductance is reduced by 50% = -1. MPa + 3.22 3.22 3.22 3.22 # shapeCond - shaping parameter for the empirical relationship from van Genuchten to model relative soil-root conductance for water + + +# ---- Critical soil water potential (MPa), i.e., when transpiration rates cannot sustained anymore, for instance, for many crop species -1.5 MPa is assumed and called wilting point +# Grasses Shrubs Trees Forbs + -3.5 -3.9 -2.0 -2.0 + + +# ---- CO2 Coefficients: multiplier = Coeff1 * x^Coeff2 +# Coefficients assume that monthly biomass inputs reflect values for conditions at +# 360 ppm CO2, i.e., multiplier = 1 for x = 360 ppm CO2 +# Grasses Shrubs Trees Forbs + 0.1319 0.1319 0.1319 0.1319 # Biomass Coeff1 + 0.3442 0.3442 0.3442 0.3442 # Biomass Coeff2 + 25.158 25.158 25.158 25.158 # WUE Coeff1 + -0.548 -0.548 -0.548 -0.548 # WUE Coeff2 + + +# Grasslands component: +# -------------- Monthly production values ------------ +# Litter - dead leafy material on the ground (g/m^2 ). +# Biomass - living and dead/woody aboveground standing biomass (g/m^2). +# %Live - proportion of Biomass that is actually living (0-1.0). +# LAI_conv - monthly amount of biomass needed to produce LAI=1.0 (g/m^2). +# There should be 12 rows, one for each month, starting with January. +# +#Litter Biomass %Live LAI_conv + 75.0 150.0 0.00 300. # January + 80.0 150.0 0.00 300. # February + 85.0 150.0 0.10 300. # March + 90.0 170.0 0.20 300. # April + 50.0 190.0 0.40 300. # May + 50.0 220.0 0.60 300. # June + 50.0 250.0 0.40 300. # July + 55.0 220.0 0.60 300. # August + 60.0 190.0 0.40 300. # September + 65.0 180.0 0.20 300. # October + 70.0 170.0 0.10 300. # November + 75.0 160.0 0.00 300. # December + +# Shrublands component: +#Litter Biomass %Live LAI_conv +85.4 210.0 0.06 372 # January +88.2 212.0 0.08 372 # February +95.3 228.0 0.20 372 # March +100.5 272.0 0.33 372 # April +166.4 400.0 0.57 372 # May +186.0 404.0 0.55 372 # June +177.1 381.0 0.50 372 # July +212.2 352.0 0.46 372 # August +157.4 286.0 0.32 372 # September +124.9 235.0 0.15 372 # October +110.4 218.0 0.08 372 # November +104.3 214.0 0.06 372 # December + +# Forest component: +#Litter Biomass %Live LAI_conv +2000 15000 0.083 500 # January +2000 15000 0.083 500 # February +2000 15000 0.083 500 # March +2000 15000 0.083 500 # April +2000 15000 0.083 500 # May +2000 15000 0.083 500 # June +2000 15000 0.083 500 # July +2000 15000 0.083 500 # August +2000 15000 0.083 500 # September +2000 15000 0.083 500 # October +2000 15000 0.083 500 # November +2000 15000 0.083 500 # December + +# Forb component: +#Litter Biomass %Live LAI_conv + 75.0 150.0 0.00 300. # January + 80.0 150.0 0.00 300. # February + 85.0 150.0 0.10 300. # March + 90.0 170.0 0.20 300. # April + 50.0 190.0 0.40 300. # May + 50.0 220.0 0.60 300. # June + 50.0 250.0 0.40 300. # July + 55.0 220.0 0.60 300. # August + 60.0 190.0 0.40 300. # September + 65.0 180.0 0.20 300. # October + 70.0 170.0 0.10 300. # November + 75.0 160.0 0.00 300. # December diff --git a/tests/test_data/TestPrj4/SFSW2_project_descriptions.R b/tests/test_data/TestPrj4/SFSW2_project_descriptions.R index cf8eef4e..7cf90add 100644 --- a/tests/test_data/TestPrj4/SFSW2_project_descriptions.R +++ b/tests/test_data/TestPrj4/SFSW2_project_descriptions.R @@ -132,6 +132,10 @@ opt_input <- list( # Interpolate and add soil layers if not available if 'AddRequestedSoilLayers' requested_soil_layers = c(5, 10, 20, 30, 40, 50, 60, 70, 80, 90, 100, 150), + # Approach existing soil depth is less than 'requested_soil_layers' + # - [TRUE] keep input soil depth + # - [FALSE] adjust soil depth to 'max(requested_soil_layers)' + keep_old_depth = TRUE, # Request data from datasets ('external' to a rSFSW2-project) req_data = c( diff --git a/tests/test_data/simTime2_year1980.rds b/tests/test_data/simTime2_year1980.rds deleted file mode 100644 index 38d2ac95..00000000 Binary files a/tests/test_data/simTime2_year1980.rds and /dev/null differ diff --git a/tests/test_data/swp_values.rds b/tests/test_data/swp_values.rds deleted file mode 100644 index ffe76c49..00000000 Binary files a/tests/test_data/swp_values.rds and /dev/null differ diff --git a/tests/test_data/weatherList_year1980.rds b/tests/test_data/weatherList_year1980.rds deleted file mode 100644 index 57f36f74..00000000 Binary files a/tests/test_data/weatherList_year1980.rds and /dev/null differ diff --git a/tests/testthat/test_ExtractData_ClimateDownscaling.R b/tests/testthat/test_ExtractData_ClimateDownscaling.R index dad5e114..776f7667 100644 --- a/tests/testthat/test_ExtractData_ClimateDownscaling.R +++ b/tests/testthat/test_ExtractData_ClimateDownscaling.R @@ -111,9 +111,9 @@ doy_ranges <- list( defaultWateryear_S = c(92, 180) ) -sim_time <- setup_simulation_time(sim_time, add_st2 = TRUE, adjust_NS = TRUE, - use_doy_range = TRUE, -doy_ranges = doy_ranges) +sim_time <- setup_time_simulation_project(sim_time, add_st2 = TRUE, + adjust_NS = TRUE, use_doy_range = TRUE, doy_ranges = doy_ranges) + names_sim_time <- c("Run", "Slice", "Time", "Year") names_getYears <- c("n_first", "first", "n_second", "second", "first_dates", "second_dates", "first_dpm", "second_dpm") diff --git a/tests/testthat/test_Time_SimulationWorld.R b/tests/testthat/test_Time_SimulationWorld.R index 8ebdb857..54f9e342 100644 --- a/tests/testthat/test_Time_SimulationWorld.R +++ b/tests/testthat/test_Time_SimulationWorld.R @@ -63,35 +63,16 @@ input_sim_timeE[["future_yrs"]] <- list( #--- TESTS test_that("Obtain time information", { - # Spinup of simulation - expect_equal(getStartYear(1980), 1981L) - expect_equal(getStartYear(0), 1L) - expect_equal(getStartYear(0, 10), 10L) - - - # Leap years - expect_true(isLeapYear(2000)) - expect_true(isLeapYear(2016)) - expect_false(isLeapYear(2100)) - expect_false(isLeapYear(2003)) - - - # Sequence of month numbers for each day in the period - expect_equal( - seq_month_ofeach_day(list(1980, 1, 1), list(2010, 12, 31), tz = "UTC"), - as.POSIXlt(seq( - from = ISOdate(1980, 1, 1, tz = "UTC"), - to = ISOdate(2010, 12, 31, tz = "UTC"), by = "1 day"))$mon + 1) - # Setup simulation time - expect_error(setup_simulation_time(input_sim_timeE), + expect_error(setup_time_simulation_project(input_sim_timeE), regexp = "incorrect format of 'future_yrs'") + sim_time <- list() for (k in seq_along(input_sim_time)) { info <- names(input_sim_time)[k] - expect_silent(sim_time[[k]] <- setup_simulation_time(input_sim_time[[k]], - use_doy_range = TRUE, doy_ranges = doy_ranges, + expect_silent(sim_time[[k]] <- setup_time_simulation_project( + input_sim_time[[k]], use_doy_range = TRUE, doy_ranges = doy_ranges, add_st2 = TRUE, adjust_NS = TRUE)) N_names <- names(doy_ranges)[!grepl("_S", names(doy_ranges))] @@ -113,8 +94,8 @@ test_that("Obtain time information", { expect_true(all(req_simtime_elems %in% names(sim_time[[k]])), info = info) - expect_silent(sim_time[[k]] <- setup_simulation_time(input_sim_time[[k]], - use_doy_range = FALSE, doy_ranges = doy_ranges, + expect_silent(sim_time[[k]] <- setup_time_simulation_project( + input_sim_time[[k]], use_doy_range = FALSE, doy_ranges = doy_ranges, add_st2 = TRUE, adjust_NS = TRUE)) # test if doy_range names were NOT created when use_doy_range = FALSE @@ -130,49 +111,4 @@ test_that("Obtain time information", { sim_time[[k]][["simstartyr"]]) expect_equal(sim_time[[k]][["overall_endyr"]], sim_time[[k]][["endyr"]]) } - - # Simulation time aggregation lists - st2 <- list(N = list(), S = list()) - for (k in seq_along(sim_time)) { - expect_silent(st2[["N"]] <- simTiming_ForEachUsedTimeUnit(sim_time[[k]], - latitude = 90)) - expect_silent(st2[["S"]] <- simTiming_ForEachUsedTimeUnit(sim_time[[k]], - latitude = -90)) - n_days <- sim_time[[k]][["no.usedy"]] - n_months <- sim_time[[k]][["no.usemo"]] - - for (h in seq_along(st2)) { - for (d in grep("ForEachUsedDay", names(st2[["N"]]), value = TRUE)) { - info <- paste("For test =", names(input_sim_time)[k], "/ d =", - shQuote(d), "/ hemisphere =", names(st2)[[h]]) - expect_equal(length(st2[[h]][[d]]), n_days, info = info) - } - for (d in grep("ForEachUsedMonth", names(st2[["N"]]), value = TRUE)) { - info <- paste("For test =", names(input_sim_time)[k], "/ d =", - shQuote(d), "/ hemisphere =", names(st2)[[h]]) - expect_equal(length(st2[[h]][[d]]), n_months, info = info) - } - } - } - -}) - - -test_that("Check years", { - expect_silent(x <- update_requested_years(2000, 2010, 1950, 2010, - verbose = FALSE)) - expect_equal(x[["start_year"]], 2000L) - expect_equal(x[["end_year"]], 2010L) - - expect_output(x <- update_requested_years(1940, 2010, 1950, 2010, - verbose = TRUE), - regexp = "requested start year") - expect_equal(x[["start_year"]], 1950L) - expect_equal(x[["end_year"]], 2010L) - - expect_output(x <- update_requested_years(2000, 2020, 1950, 2010, - verbose = TRUE), - regexp = "requested end year") - expect_equal(x[["start_year"]], 2000L) - expect_equal(x[["end_year"]], 2010L) }) diff --git a/tests/testthat/test_climate_functions.R b/tests/testthat/test_climate_functions.R deleted file mode 100644 index 1e74fbf4..00000000 --- a/tests/testthat/test_climate_functions.R +++ /dev/null @@ -1,46 +0,0 @@ -context("Calculations of climate variables") - -# Inputs -weatherList_year1980 <- readRDS(file.path("..", "test_data", - "weatherList_year1980.rds")) -simTime2_year1980 <- readRDS(file.path("..", "test_data", - "simTime2_year1980.rds")) - -names_calc_SiteClimate <- c("meanMonthlyTempC", "minMonthlyTempC", - "maxMonthlyTempC", "meanMonthlyPPTcm", "MAP_cm", "MAT_C", "dailyTempMin", - "dailyTempMean", "dailyC4vars") -lengths_calc_SiteClimate <- c(12L, 12L, 12L, 12L, 1L, 1L, NA, NA, NA) - -names_sw_dailyC4_TempVar <- c("Month7th_NSadj_MinTemp_C", - "LengthFreezeFreeGrowingPeriod_NSadj_Days", "DegreeDaysAbove65F_NSadj_DaysC", - "Month7th_NSadj_MinTemp_C.sd", "LengthFreezeFreeGrowingPeriod_NSadj_Days.sd", - "DegreeDaysAbove65F_NSadj_DaysC.sd") - - -# Tests -test_that("Climate variables: calc_SiteClimate", { - # Calculate climate variables for a one-year time period - expect_silent(x <- calc_SiteClimate(weatherList_year1980, year.start = 1980, - year.end = 1980, do.C4vars = FALSE, simTime2 = NULL)) - expect_named(x, names_calc_SiteClimate) - itemp <- !is.na(lengths_calc_SiteClimate) - expect_equal(unname(lengths(x))[itemp], lengths_calc_SiteClimate[itemp]) - expect_true(anyNA(x)) - - # Include C4-relevant climate variables - expect_silent(x <- calc_SiteClimate(weatherList_year1980, year.start = 1980, - year.end = 1980, do.C4vars = TRUE, simTime2 = simTime2_year1980)) - expect_named(x, names_calc_SiteClimate) - itemp <- !is.na(lengths_calc_SiteClimate) - expect_equal(unname(lengths(x))[itemp], lengths_calc_SiteClimate[itemp]) - expect_true(!anyNA(x)) - expect_named(x[["dailyC4vars"]], names_sw_dailyC4_TempVar) - - # Error because time period does not match with available weather data - expect_error(calc_SiteClimate(weatherList_year1980, year.start = 2000, - year.end = 2010, do.C4vars = FALSE, simTime2 = NULL)) - - # Error because 'simTime2' argument is missing - expect_error(calc_SiteClimate(weatherList_year1980, year.start = 1980, - year.end = 1980, do.C4vars = TRUE, simTime2 = NULL)) -}) diff --git a/tests/testthat/test_netCDF_functions.R b/tests/testthat/test_netCDF_functions.R index ad6c75f5..ac02a20d 100644 --- a/tests/testthat/test_netCDF_functions.R +++ b/tests/testthat/test_netCDF_functions.R @@ -53,10 +53,11 @@ if (!any(do_skip) && is_online) { .Names = c("calendar", "unit", "N", "base", "start", "end"))), list(filename = file.path(dir_temp, - "pr_Amon_CSIRO-Mk3L-1-2_G1_r1i1p1_000101-007012.nc"), - url = paste("http://esgf.nci.org.au/thredds/fileServer/geomip/output", - "UNSW/CSIRO-Mk3L-1-2/G1/mon/atmos/Amon/r1i1p1/v20170728/pr", - "pr_Amon_CSIRO-Mk3L-1-2_G1_r1i1p1_000101-007012.nc", sep = "/"), + ftemp <- "pr_Amon_CSIRO-Mk3L-1-2_G1_r1i1p1_000101-007012.nc"), + url = paste("http://esgf.nci.org.au/thredds/fileServer", + "master/GeoMIP/output/UNSW", + "CSIRO-Mk3L-1-2/G1/mon/atmos/Amon/r1i1p1/v20170728/pr", + ftemp, sep = "/"), expect = structure(list(calendar = "365_day", unit = 1, N = 840L, base = structure(-719162, class = "Date"), start = structure(c(1, 1), .Names = c("year", "month")), end = structure(c(70, 12), @@ -64,11 +65,11 @@ if (!any(do_skip) && is_online) { .Names = c("calendar", "unit", "N", "base", "start", "end"))), list(filename = file.path(dir_temp, - "tasmin_Amon_NorESM1-M_rcp45_r1i1p1_200601-210012.nc"), - url = paste("http://noresg.norstore.no/thredds/fileServer/esg_dataroot", - "cmor/CMIP5/output1/NCC/NorESM1-M/rcp45/mon/atmos/Amon/r1i1p1", - "v20120412/tasmin/tasmin_Amon_NorESM1-M_rcp45_r1i1p1_200601-210012.nc", - sep = "/"), + ftemp <- "tasmin_Amon_NorESM1-M_rcp45_r1i1p1_200601-210012.nc"), + url = paste("http://noresg.nird.sigma2.no/thredds/fileServer", + "esg_dataroot/cmor/CMIP5/output1/NCC", + "NorESM1-M/rcp45/mon/atmos/Amon/r1i1p1/v20120412/tasmin", + ftemp, sep = "/"), expect = structure(list(calendar = "noleap", unit = 1, N = 1140L, base = structure(13149, class = "Date"), start = structure(c(2006, 1), .Names = c("year", "month")), diff --git a/tests/testthat/test_pedotransferfunctions.R b/tests/testthat/test_pedotransferfunctions.R deleted file mode 100644 index 30dd7b8c..00000000 --- a/tests/testthat/test_pedotransferfunctions.R +++ /dev/null @@ -1,150 +0,0 @@ -context("Pedotransfer functions: SWP <-> VWC") - -# How the functions are applied in rSFSW2 -# section: aggregation -# - dailyRechargeExtremes -# - case 1: SWPtoVWC(-0.033, texture$sand.top, texture$clay.top) -# - dailySuitablePeriodsAvailableWater, dailySWPdrynessIntensity, -# monthlySWAbulk -# - case 1: SWPtoVWC(SWPcrit_MPa[icrit], texture$sand.top, texture$clay.top) -# - mean doy: SWAbulk -# - case 2: SWPtoVWC(index.SWPcrit, sand, clay) -# - mean doy: SWPmatric -# - case 3: VWCtoSWP(res.dailyMean[ir], textureDAgg$sand[al], -# textureDAgg$clay[al]) # ir is vector; al is value -# section: functions -# - get_SWPmatric_aggL -# - case 3: VWCtoSWP(vwcmatric$top, texture$sand.top, texture$clay.top) -# - case 3: VWCtoSWP(vwcmatric$aggMean.top, texture$sand.top, -# texture$clay.top) -# - case 6: VWCtoSWP(vwcmatric$val[, -index.header], sand, clay) - - -# Inputs -# Table 2 from Cosby, B.J., Hornberger, G.M., Clapp, R.B. & Ginn, T.R. (1984). -# A statistical exploration of the relationships of soil moisture -# characteristics to the physical properties of soils. Water Resour Res, 20, -# 682-690. -texture <- data.frame( - sand = c(0.92, 0.82, 0.58, 0.43, 0.17, 0.58, 0.32, 0.10, 0.52, 0.06, 0.22), - clay = c(0.03, 0.06, 0.10, 0.18, 0.13, 0.27, 0.34, 0.34, 0.42, 0.47, 0.58) -) -row.names(texture) <- c("Sand", "Loamy sand", "Sandy loam", "Loam", - "Silty loam", "Sandy clay loam", "Clay loam", "Silty clay loam", "Sandy clay", - "Silty clay", "Clay") - -# Field capacity and agricultural permanent wilting point -swp_fix <- c(fc = -0.0333, pwp = -1.5) # MPa -vwc_fix <- data.frame( - fc = c(0.103519295200457, 0.138084712513314, 0.210684319180335, - 0.276327910591054, 0.344767253784927, 0.259008902122202, 0.331526118930414, - 0.391036796958834, 0.292943352979446, 0.4058577839142, 0.368820489547312), - pwp = c(0.0325953572147933, 0.05064269086372, 0.0903291990594713, - 0.143273427070284, 0.163171562436244, 0.152236773973314, 0.210032386550814, - 0.248623511289573, 0.196521033130402, 0.282030801991246, 0.269525768616734) -) -row.names(vwc_fix) <- row.names(texture) - -ftemp <- file.path("..", "test_data", "swp_values.rds") -if (FALSE) { - swp_vals <- unlist(lapply(row.names(texture), function(itext) - VWCtoSWP(vwc_fix, texture[itext, "sand"], texture[itext, "clay"]))) - dim(swp_vals) <- c(nrow(vwc_fix), ncol(vwc_fix), nrow(texture)) - dimnames(swp_vals) <- list(row.names(texture), names(swp_fix), - row.names(texture)) - saveRDS(swp_vals, file = ftemp) - -} else { - swp_vals <- readRDS(ftemp) -} - -#--- Tests -test_that("To SWP", { - # 1. VWC in fraction [single value] + sand and clay in fraction [single vals] - # --> SWP in MPa [single value] - for (ifix in names(swp_fix)) for (itext in row.names(texture)) - expect_equivalent(swp_fix[ifix], - VWCtoSWP(vwc_fix[itext, ifix], texture[itext, "sand"], - texture[itext, "clay"])) - - # 2. VWC in fraction [single value] + sand and clay in fraction - # [vectors of length d] - # --> SWP in MPa [vector of length d] - for (ifix in names(swp_fix)) for (itext in row.names(texture)) - expect_equivalent(swp_vals[itext, ifix, ], - VWCtoSWP(vwc_fix[itext, ifix], texture[, "sand"], texture[, "clay"])) - - # 3. VWC in fraction [vector of length l] + sand and clay in fraction - # [single values] - # --> SWP in MPa [vector of length l] - for (ifix in names(swp_fix)) for (itext in row.names(texture)) - expect_equivalent(swp_vals[, ifix, itext], - VWCtoSWP(vwc_fix[, ifix], texture[itext, "sand"], texture[itext, "clay"])) - - # 4. VWC in fraction [vector of length l] + sand and clay in fraction - # [vectors of length d] - # --> SWP in MPa [matrix with nrow = l and ncol = d, VWC vector repeated - # for each column]: probably not used - for (ifix in names(swp_fix)) - expect_equivalent(swp_vals[, ifix, ], - VWCtoSWP(vwc_fix[, ifix], texture[, "sand"], texture[, "clay"])) - - # 5. VWC in fraction [matrix with nrow = l and ncol = d] + sand and clay in - # fraction [single values] - # --> SWP in MPa [matrix with nrow = l and ncol = d] - for (itext in row.names(texture)) - expect_equivalent(swp_vals[, , itext], - VWCtoSWP(vwc_fix, texture[itext, "sand"], texture[itext, "clay"])) - - # 6. VWC in fraction [matrix with nrow = l and ncol = d] + sand and clay in - # fraction [vectors of length d] - # --> SWP in MPa [matrix with nrow = l and ncol = d, sand/clay vector - # repeated for each row] - for (ifix in names(swp_fix)) { - xin <- matrix(vwc_fix[, ifix], nrow = nrow(vwc_fix), ncol = nrow(texture), - byrow = TRUE) - xout <- matrix(swp_fix[ifix], nrow = nrow(vwc_fix), ncol = nrow(texture)) - expect_equivalent(xout, - VWCtoSWP(xin, texture[, "sand"], texture[, "clay"])) - } -}) - - -test_that("To VWC", { - # 1. SWP in MPa [single value] + sand and clay in fraction [single values] - # --> VWC in fraction [single value] - for (ifix in names(swp_fix)) for (itext in row.names(texture)) - expect_equivalent(vwc_fix[itext, ifix], - SWPtoVWC(swp_fix[ifix], texture[itext, "sand"], texture[itext, "clay"])) - - # 2. SWP in MPa [single value] + sand and clay in fraction - # [vectors of length d] - # --> VWC in fraction [vector of length d] - for (ifix in names(swp_fix)) for (itext in row.names(texture)) - expect_equivalent(vwc_fix[, ifix], - SWPtoVWC(swp_fix[ifix], texture[, "sand"], texture[, "clay"])) - - # 3. SWP in MPa [vector of length l] + sand and clay in fraction - # [single values] - # --> VWC in fraction [vector of length l] - for (ifix in names(swp_fix)) for (itext in row.names(texture)) - expect_equivalent( - SWPtoVWC(rep(swp_fix[ifix], nrow(texture)), texture[itext, "sand"], - texture[itext, "clay"]), - rep(vwc_fix[itext, ifix], nrow(texture))) - - # 4. SWP in MPa [vector of length l] + sand and clay in fraction - # [vectors of length d] - # --> VWC in fraction [matrix with nrow = l and ncol = d, SWP vector - # repeated for each column]: probably not used - - # 5. SWP in MPa [matrix with nrow = l and ncol = d] + sand and clay in - # fraction [single values] - # --> VWC in fraction [matrix with nrow = l and ncol = d] - - # 6. SWP in MPa [matrix with nrow = l and ncol = d] + sand and clay in - # fraction [vectors of length d] - # --> VWC in fraction [matrix with nrow = l and ncol = d, sand/clay vector - # repeated for each row] - -}) diff --git a/tests/testthat/test_soillayers.R b/tests/testthat/test_soillayers.R deleted file mode 100644 index 40736412..00000000 --- a/tests/testthat/test_soillayers.R +++ /dev/null @@ -1,89 +0,0 @@ -context("Manipulate soil layers") - -#---INPUTS -if (FALSE) { - set.seed(1234L) -} - -nrows <- 10L -test_space <- 1000L - -make_test_x <- function(ncol, nrow = nrows, space = test_space) { - as.data.frame(matrix(sample(space, nrow * ncol), nrow = nrow, ncol = ncol, - dimnames = list(NULL, paste0("L", seq_len(ncol))))) -} - -test_data <- list( - make_test_x(1), - make_test_x(2), - make_test_x(3), - make_test_x(4), - make_test_x(10) -) - -test_weights <- list(c(NA, 1), c(0, 1), c(0.5, 0.5), c(1, 0), c(1, NA), - c(NA, NA)) - - -#---TESTS -test_that("add_layer_to_soil", { - - #--- Loop through test data set, layers, weight options, and methods - for (k in seq_along(test_data)) - for (il in c(0, seq_len(ncol(test_data[[k]])))) - for (iw in seq_along(test_weights)) - for (im in c("interpolate", "exhaust")) { - loop_info <- paste("test", k, "/ layer", il, "/ w", iw, - "/ method", im) - - res <- add_layer_to_soil(x = test_data[[k]], il = il, - w = test_weights[[iw]], method = im) - - # Test dimensions - expect_equal(ncol(res), ncol(test_data[[k]]) + 1L, info = loop_info) - expect_equal(nrow(res), nrow(test_data[[k]]), info = loop_info) - - # Test data consistency of new layer - lnew <- res[, il + 1] - ilo <- if (isTRUE(all.equal(il, 0L))) il + 1L else il - weights_not_used <- im == "interpolate" && - (isTRUE(all.equal(il, 0)) || - isTRUE(all.equal(il, ncol(test_data[[k]])))) - - expect_equal(all(is.finite(lnew)), - all(is.finite(test_data[[k]][, ilo])) && - if (weights_not_used) TRUE else all(is.finite(test_weights[[iw]])), - info = loop_info) - } - - - #--- Test cases that fail - # weights vector 'w' is not of length 2 - expect_error(add_layer_to_soil(x = test_data[[1]], il = 1, w = c(0, 1, 0), - method = "interpolate")) - expect_error(add_layer_to_soil(x = test_data[[1]], il = 1, w = 1, - method = "interpolate")) - # but doesn't fail if a row is named 'depth_cm' - # Add a deeper layer - x <- test_data[[1]] - dimnames(x)[[1]][1] <- "depth_cm" - res <- add_layer_to_soil(x = x, il = 1, w = 5, method = "interpolate") - expect_equal(res[-1, 1], res[-1, 2]) - expect_equal(res[1, 2], 2 * res[1, 1] - 5) - # Add a more shallow layer - res <- add_layer_to_soil(x = x, il = 0, w = 5, method = "interpolate") - expect_equal(res[-1, 1], res[-1, 2]) - expect_equal(res[1, 1], 5) - - - # data matrix has no columns - expect_error(add_layer_to_soil(x = matrix(NA, nrow = nrows, ncol = 0), il = 1, - w = c(0.5, 0.5), method = "interpolate")) - - # requested layer cannot be added - expect_error(add_layer_to_soil(x = test_data[[3]], il = -1, w = c(0.5, 0.5), - method = "interpolate")) - expect_error(add_layer_to_soil(x = test_data[[3]], il = test_data[[3]] + 1L, - w = c(0.5, 0.5), method = "interpolate")) - -}) diff --git a/vignettes/SoilMoistureRegimes_SoilTemperatureRegimes.Rmd b/vignettes/SoilMoistureRegimes_SoilTemperatureRegimes.Rmd deleted file mode 100644 index bb796c64..00000000 --- a/vignettes/SoilMoistureRegimes_SoilTemperatureRegimes.Rmd +++ /dev/null @@ -1,459 +0,0 @@ ---- -title: "rSFSW2 calculations of NCRS soil moisture regimes (SMR) and soil temperature regimes (STR)" -author: "Daniel R Schlaepfer" -date: "`r Sys.Date()`" -output: - rmarkdown::html_document: - toc: true - toc_depth: 3 - toc_float: true - collapsed: false - smooth_scroll: false - theme: united - highlight: tango - smart: false -vignette: > - %\VignetteIndexEntry{SoilMoistureRegimes_SoilTemperatureRegimes} - %\VignetteEngine{knitr::rmarkdown} - %\VignetteEncoding{UTF-8} ---- - - -This vignette explains how rSFSW2 has implemented the calculations of soil moisture regime (SMR) and soil temperature regime (STR) and compares the logic with the Java Newhall Simulation Model and with the Keys to Soil Taxonomy. - -## Notes -* Quoted text is directly from [SSS 2014](#SSS2014). So direction of a logic may be opposite of a condition, which will be indicated by \! before the condition. -* jNSM calculations can be found at end of this document. Line numbers refer to file 'BASICSimulationModel.java' - -## Soil Moisture Regimes - -### Undefined -* rSFSW2 - * not one of {[perudic](#perudic), [aridic](#aridic), [xeric](#xeric), [ustic](#ustic), [udic](#udic), [anhydrous](#anhydrous)} -* [jNSM 2016](#jNSM2016) (line 3060) - * not one of {[perudic](#perudic), [aridic](#aridic), [xeric](#xeric), [ustic](#ustic), [udic](#udic)} - - -### Perudic -* Regime characteristic of areas where precipitation exceeds evapotranspiration every month -* rSFSW2 - * [COND0](#COND0) -* [jNSM 2016](#jNSM2016) (lines 2977ff) - * perudic: [[COND0](#COND0)] swt != 0 -* Characteristics ([SSS 2014](#SSS2014)) - * [[COND0](#COND0)] precipitation exceeds evapotranspiration in all months of normal years - * the moisture tension rarely reaches 100 kPa in the soil moisture control section -* Generalized Characteristics ([SSS 2015](#SSS2015)) - * The soil is almost always moist; soil tension is rarely > 100 kPa (about >1 bar) - * Precipitation exceeds evapotranspiration by plants in every month. -* Remarks - * Somewhat unclear if PET or AET should be compared with PPT. "evapotranspiration by plants" sounds like AET, but jNSM uses PET. rSFSW2 follows jNSM and uses PET. - - -### Udic -* Regime characteristic of humid regions with seasonally well distributed precipitation -* rSFSW2 - * [COND3](#COND3) & {{\![COND4](#COND4) & [COND5](#COND5) & [COND6](#COND6)} | \!{\![COND4](#COND4) & [COND5](#COND5)}} -* [jNSM 2016](#jNSM2016) (lines 3011ff) - * not one of {[perudic](#perudic), [aridic](#aridic), [xeric](#xeric)} - * udic: [[COND3](#COND3)] (nd[1] + nd[2]) < 90 - * qualifier: - + __IF__ ([[COND3_1](#COND3_1)] (nd[1] + nd[2]) < 30) __THEN__ "typic" - + __ELSEIF__ ([\![COND5](#COND5)] dif < 5) __THEN__ "dry-tropudic" - + __ELSE__ "dry-tempudic" -* Characteristics ([SSS 2014](#SSS2014)) - + [[COND3](#COND3)] "not dry in any part for as long as 90 cumulative days in normal years" - + __AND__ - + __IF__ - + [\![COND4](#COND4)] "mean annual soil temperature is lower than 22 C" - + __AND__ - + [[COND5](#COND5)] "mean winter and mean summer soil temperatures at a depth of 50 cm below the soil surface differ by 6 C or more" - + __THEN__ - + __IF__ [[COND6](#COND6)] "dry in all parts for less than 45 consecutive days in the 4 months following the summer solstice" - + __THEN__ UDIC - + __ELSE__ not UDIC - + __ELSE__ UDIC - + __AND__ - + "except for short periods, a three- phase system, solid-liquid-gas, in part or all of the soil moisture control section when the soil temperature is above 5 C" -* Generalized Characteristics ([SSS 2015](#SSS2015)) - * Soil is dry < 90 cumulative days in most years - * Soil is dry < 45 consecutive days in summer and early fall (except in very warm areas and locations where there is little difference between summer and winter soil temperatures). -* Remarks - * jNSM ignores [COND4](#COND4), [COND5](#COND5), and [COND6](#COND6) - * rSFSW2 and jNSM ignore "except for short periods, a three- phase system, solid-liquid-gas, in part or all of the soil moisture control section when the soil temperature is above 5 C" - - -### Ustic -* Regime characteristic of semiarid climates where moisture is limited but available for portions of the growing season -* rSFSW2 - * \!permafrost & \![COND3](#COND3) & - ([([COND4](#COND4) | \![COND5](#COND5)) & ([COND7](#COND7) | [COND8](#COND8))] | - [(\!([COND4](#COND4) | \![COND5](#COND5)) & \![COND1](#COND1) & - {[COND9](#COND9) & [COND6](#COND6) | \![COND9](#COND9)})]) -* [jNSM 2016](#jNSM2016) (lines 3032ff) - * not one of {[perudic](#perudic), [aridic](#aridic), [xeric](#xeric), [udic](#udic)} - * ustic: not pergelic && not cryic - * qualifier: - + __IF__ ([[COND5](#COND5)] dif >= 5) { - + __IF__ ([\![COND9](#COND9)] nccm <= 45) __THEN__ "typic-tempustic" - + __ELSEIF__ ([\![COND6](#COND6)] nccd > 45) __THEN__ "xerix-tempustic" - + __ELSE__ "wet-tempustic" - + } __ELSE__ { - + __IF__ ([[COND2_1](#COND2_1)] ncpm[2]) < 180) __THEN__ "aridic-tropustic" - + __ELSEIF__ ([[COND2_2](#COND2_2)] ncpm[2] < 270) __THEN__ "typic-tropustic" - + __ELSE__ "udic" - + } -* Characteristics ([SSS 2014](#SSS2014)) - + "not applied to soils that have permafrost" - __AND__ - + __IF__ - + [[COND4](#COND4)] "mean annual soil temperature is 22 C or higher" - + __OR__ - + [\![COND5](#COND5)] "mean summer and winter soil temperatures differ by less than 6 C at a depth of 50 cm below the soil surface" - + __THEN__ - + [\![COND3](#COND3)] "dry in some or all parts for 90 or more cumulative days in normal years" - + __AND__ - + __IF__ - + [[COND7](#COND7)] "moist in some part either for more than 180 cumulative days per year" - + __OR__ - + [[COND8](#COND8)] "moist for 90 or more consecutive days" - + __THEN__ USTIC - + __ELSE__ not USTIC - + __ELSE__ - + [\![COND3](#COND3)] "dry in some or all parts for 90 or more cumulative days" - + __AND__ - + [\![COND1](#COND1)] "not dry in all parts for more than half of the cumulative days when the soil temperature at a depth of 50 cm is higher than 5 C" - + __AND__ - + __IF__ - + [[COND9](#COND9)] "moist in all parts for 45 or more consecutive days in the 4 months following the winter solstice" - + __THEN__ - + __IF__ [[COND6](#COND6)] "dry in all parts for less than 45 consecutive days in the 4 months following the summer solstice" - + __THEN__ USTIC - + __ELSE__ not USTIC - + __ELSE__ USTIC -* Generalized Characteristics ([SSS 2015](#SSS2015)) - * In areas that have very warm average annual soil temperature (> 22 C) or that have little difference (< 6 C) between winter and summer soil temperatures - * The soil is dry for > 90 cumulative days during the year, but - * The soil is moist during the year for > 90 consecutive days or > 180 
cumulative days - Or: - * In other areas with cold to warm soil temperatures (< 22 C): - * The soil is dry for > 90 cumulative days, but
 - * The soil is moist for > 50% of the growing season (when soil 
temperature > 5 C). 
 - Or: - * In other areas where the soil is moist for > 45 consecutive days in winter 
and early spring, the soil is dry for < 45 consecutive days in summer and early fall. -* Remarks - * jNSM does not explicitly calculate ustic, instead it represents the "other" category (except for the very cold areas) - - -### Xeric -* Regime characteristic of a Mediterranean-type climate with cool, moist winters and warm, dry summers -* rSFSW2 - * \![COND6](#COND6) & [COND9](#COND9) & \![COND4](#COND4) & [COND5](#COND5) -* [jNSM 2016](#jNSM2016) (lines 3000ff) - * not one of {[perudic](#perudic), [aridic](#aridic)} - * xeric: tma < 22 && dif >= 5 && nccd >= 45 && nccm >= 45 - * equivalent to \![COND4](#COND4) && [COND5](#COND5) && \![COND6](#COND6) && [COND9](#COND9) - * qualifier: - + __IF__ ([[COND6_1](#COND6_1)] nccd > 90) __THEN__ "dry" - + __ELSE__ "typic" -* Characteristics ([SSS 2014](#SSS2014)) - + [[COND9](#COND9)] "moist in all parts for 45 or MORE consecutive days in the 4 months following the winter solstice" - + __AND__ - + [\![[[COND6](#COND6)] "Dry in all parts for 45 or MORE consecutive days in the 4 months following the summer solstice" -* Generalized Characteristics ([SSS 2015](#SSS2015)) - * The soil is moist for > 45 consecutive days in winter and early spring and dry for > 45 consecutive days in summer and early fall. - * The soil is moist is for > 50% of the growing season (when soil temp is > 5 C). -* Remarks - * [SSS 2014](#SSS2014) does not mention [COND4](#COND4) and [COND5](#COND5) except maybe indirectly by "Mediterranean-type climate with cool, moist winters and warm, dry summers" - -### Aridic -* Regime characteristic of arid and semiarid climates that are unsuitable for cultivation without irrigation -* rSFSW2 - * [COND1](#COND1) & [COND2](#COND2) -* jNSM (lines 2988ff) - * not [perudic](#perudic) - * aridic: [[COND1](#COND1)] nsd[1] > (lt5c / 2) && [[COND2](#COND2)] ncpm[2] < 90 - * qualifier: - + __IF__ ([[COND10](#COND10)] nd[1] == 360) __THEN__ "extreme" - + __ELSEIF__ ([[COND2_3](#COND2_3)] ncpm[2] <= 45) __THEN__ "typic" - + __ELSE__ "weak" -* Characteristics ([SSS 2014](#SSS2014)) - + [[COND1](#COND1)] "Dry in all parts for more than half of the cumulative days per year when the soil temperature at a depth of 50 cm below the soil surface is above 5 C" - + __AND__ - + [[COND2](#COND2)] "Moist in some or all parts for less than 90 consecutive days when the soil temperature at a depth of 50 cm below the soil surface is above 8 C." -* Generalized Characteristics ([SSS 2015](#SSS2015)) - * During the growing season: - * The soil is dry more than half of the total days. - * The soil is moist < ~90 consecutive days. - - -### Anhydrous -* Very cold and very dry soil conditions -* rSFSW2 - * [AnhCOND1](#AnhCOND1) & [AnhCOND2](#AnhCOND2) & [AnhCOND3](#AnhCOND3) -* [jNSM 2016](#jNSM2016): not considered -* Characteristics ([p. 18-19 in SSS 2014](#SSS2014)) - + [[AnhCOND1](#AnhCOND1)] "Mean annual soil temperature of 0C or colder" - + __AND__ - + At a depth of 10 to 70 cm: - + [[AnhCOND2](#AnhCOND2)] "has a soil temperature of less than 5 C throughout the year" - + __AND__ - + "Includes no ice-impregnated permafrost" - + __AND__ - + [[AnhCOND3](#AnhCOND3)] "Is dry (water held at 1500 kPa or more) in one-half or more of the soil for one-half or more of the time the layer has a soil temperature above 0 C", - + __OR__ - + "Has a rupture-resistance class of loose to slightly hard throughout when the soil temperature is 0 C or colder, except where a cemented pedogenic horizon occurs." -* Generalized Characteristics ([SSS 2015](#SSS2015)) - * Mean annual soil temperature is < 0 C - * At a depth of 10 to 70 cm: - * Temperature is < 5 C all year, and - * Soil has no ice-impregnated permafrost, and - * When temperature is > 0 C (> 1500 kPa tension), soil is very dry, - or - * When temperature is < 0 C, soil is loose to just slightly hard (unless there is pedogenic cementation). -* Remarks - * rSFSW2 ignores "Includes no ice-impregnated permafrost" and "Has a rupture-resistance class of loose to slightly hard throughout when the soil temperature is 0 C or colder, except where a cemented pedogenic horizon occurs." - - - - -## Soil Temperature Regimes -We currently ignore the 'iso-' prefix, i.e., "the mean summer and mean winter soil temperatures differ by less than 6 oC at a depth of 50 cm or at a densic, lithic, or paralithic contact, whichever is shallower", which is applicable to [frigid](#Frigid), [mesic](#Mesic), [thermic](#Thermic), and [hyperthermic](#Hyperthermic) regimes ([SSS 2014](#SSS2014)) - -### Permafrost -* Permanently frozen layers -* "Permafrost may be impregnated by ice or, in the case of insufficient interstitial water, may be dry." ([SSS 2014](#SSS2014)) -* rSFSW2 - * [stCOND0](#stCOND0) -* [jNSM 2016](#jNSM2016): not considered -* Characteristics ([p. 28 in SSS 2014](#SSS2014)) - + [[stCOND0](#stCOND0)] "a thermal condition in which a material (including soil material) remains below 0 C for 2 or more years in succession" -* Generalized Characteristics ([SSS 2015](#SSS2015)) - * p. 3-101: "Layer has temperature of < 0 C for 2 or more consecutive years." - - -### Gelic -* "Gelic materials are [mineral](#MSM) or [organic soil materials](#OSM) that show evidence of cryoturbation (frost churning) and/or ice segregation in the active layer (seasonal thaw layer) and/or the upper part of the permafrost" ([SSS 2014](#SSS2014)) -* "The gelic soil temperature regime has not been documented in soils of the continental U.S. but occurs in the soils of Alaska." ([SSS 2015](#SSS2015)) -* rSFSW2 - * [stCOND1](#stCOND1) | [stCOND0](#stCOND0) -* [jNSM 2016](#jNSM2016): calls this regime "pergelic" - + [[stCOND1](#stCOND1)] tma < 0 -* Characteristics ([SSS 2014](#SSS2014)) - + [[stCOND1](#stCOND1)] "mean annual soil temperature at or below 0 C (in Gelic suborders and Gelic great groups) or 1 C or lower (in Gelisols)" -* Generalized Characteristics ([SSS 2015](#SSS2015)) - * "Soil is <= 0 C" - - -### Cryic -* Cryic soils are cold but have no permafrost and they are cold also during summer. -* "Too cold for virtually all crops" ([SSS 2015](#SSS2015)) -* rSFSW2 - + \![stCOND0](#stCOND0) & \![stCOND1](#stCOND1) & [stCOND2](#stCOND2) & (\![[stCOND5](#stCOND5) & - {\![O-horizon](#Ohorizon) & [stCOND8](#stCOND8)} | - {[O-horizon](#Ohorizon) & [stCOND9](#stCOND9)}] | - [[stCOND5](#stCOND5) & - {\![O-horizon](#Ohorizon) & [stCOND6](#stCOND6)} | - {[O-horizon](#Ohorizon) & [stCOND7](#stCOND7)}]) -* [jNSM 2016](#jNSM2016): - + [\![[stCOND1](#stCOND1)]] tma >= 0 && [[stCOND2](#stCOND2)] tma < 8 && [[stCOND8](#stCOND8)] ((st - cs) < 15) -* Characteristics ([SSS 2014](#SSS2014)) - + [\![stCOND0](#stCOND0)] "not have permafrost" - + __AND__ - * __IF__ "[mineral soils](#MSM)" - + __IF__ [\![stCOND5](#stCOND5)] "not saturated with water during some part of the summer" "(June, July, and August in the Northern Hemisphere and December, January, and February in the Southern Hemisphere)" - + __IF__ "no [O-horizon](#Ohorizon)" - + __IF__ [[stCOND8](#stCOND8)] mean summer soil temperature "between 0 C to 15 C" __THEN__ cryic - + __ELSE__ "[O-horizon](#Ohorizon)" - + __IF__ [[stCOND9](#stCOND9)] mean summer soil temperature "between 0 C to 8 C" __THEN__ cryic - + __ELSE__ "soil is saturated with water during some part of the summer" - + __IF__ "no [O-horizon](#Ohorizon)" - + __IF__ [[stCOND6](#stCOND6)] mean summer soil temperature "between 0 C to 13 C" __THEN__ cryic - + __ELSE__ "[O-horizon](#Ohorizon) __OR__ "[histic epipedon](#histic_epipedon)" - + __IF__ [[stCOND7](#stCOND7)] mean summer soil temperature "between 0 C to 6 C" __THEN__ cryic - + __ELSE__ "[organic soils](#OSM)" - + __IF__ [[stCOND7](#stCOND7)] mean summer soil temperature "between 0 C to 6 C" __THEN__ cryic -* Generalized Characteristics ([SSS 2015](#SSS2015)) - * "Soil is > 0 to < 8 C but has no permafrost and summer temperatures are also cold" -* Remarks - * [jNSM 2016](#jNSM2016) does not distinguish between [mineral](#MSM) and [organic material](#OSM). Thus, it ignores conditions [stCOND5](#stCOND5), [stCOND6](#stCOND6), [stCOND7](#stCOND7), and [stCOND9](#stCOND9). It assumes that soils are "not saturated with water during some part of the summer" ([\![stCOND5](#stCOND5)]) and have "no [O-horizon](#Ohorizon)", when testing for the [cryic](#Cryic) regime with [[stCOND8](#stCOND8)]. - * rSFSW2 ignores "[organic soils](#OSM)", but consideres the presence of [O-horizons](#Ohorizon). - - -### Frigid -* "Too cold for all but cold weather crops, such as wheat, oats, or -barley" ([SSS 2015](#SSS2015)) -* rSFSW2 - * \![stCOND0](#stCOND0) & \![stCOND1](#stCOND1) & [stCOND2](#stCOND2) & \![cryic](#cryic) -* [jNSM 2016](#jNSM2016): - + [[stCOND2](#stCOND2)] tma < 8 && [\![stCOND8](#stCOND8)] ((st - cs) >= 15) && [scaled [COND5](#COND5)?] (dif * fcd) > 5 -* Characteristics ([SSS 2014](#SSS2014)) - + "A soil with a frigid soil temperature regime is warmer in summer than a soil with a cryic regime, but its mean annual temperature is between 0 and 8 C" -* Generalized Characteristics ([SSS 2015](#SSS2015)) - * "Soil is > 0 to < 8 C (but warmer than cryic soils in summer)" -* Remarks - * Unclear why [jNSM 2016](#jNSM2016) appears to apply a scaled version of [COND5](#COND5) - - -### Mesic -* "Suited to crops such as corn, wheat, and soybeans" ([SSS 2015](#SSS2015)) -* rSFSW2 - * \![stCOND2](#stCOND2) & [stCOND3](#stCOND3) -* [jNSM 2016](#jNSM2016): - + [\![stCOND2](#stCOND2)] tma >= 8 && [[stCOND3](#stCOND3)] tma < 15 -* Characteristics ([SSS 2014](#SSS2014)) - + "mean annual soil temperature is 8 C or higher [\![stCOND2](#stCOND2)] but lower than 15 C [[stCOND3](#stCOND3)]" -* Generalized Characteristics ([SSS 2015](#SSS2015)) - * "Soil is 8 to < 15 C" - - -### Thermic -* "Suited to warm weather crops such as cotton" ([SSS 2015](#SSS2015)) -* rSFSW2 - * \![stCOND3](#stCOND3) & [stCOND4](#stCOND4) -* [jNSM 2016](#jNSM2016): - + [\![stCOND3](#stCOND3)] tma >= 15 && [[stCOND4](#stCOND4)] tma < 22 -* Characteristics ([SSS 2014](#SSS2014)) - + "mean annual soil temperature is 15 C or higher [\![stCOND3](#stCOND3)] but lower than 22 C [[stCOND4](#stCOND4)]" -* Generalized Characteristics ([SSS 2015](#SSS2015)) - * "Soil is 15 to < 22 C" - - -### Hyperthermic -* "Suited to citrus and other freeze-intolerant crops" ([SSS 2015](#SSS2015)) -* rSFSW2 - * \![stCOND4](#stCOND4) -* [jNSM 2016](#jNSM2016): - + [\![stCOND4](#stCOND4)] tma >= 22 -* Characteristics ([SSS 2014](#SSS2014)) - + [\![stCOND4](#stCOND4)] "mean annual soil temperature is 22 C or higher" -* Generalized Characteristics ([SSS 2015](#SSS2015)) - * "Soil is >= 22 C" - - - - -## Definitions of conditions -Our interpretations from [SSS 2014](#SSS2014) -- language refers to layers, not parts - -* __dry__ := soil water potential < -1.5 MPa "the moisture tension is 1500 kPa or more" ([p. 29, SSS 2014](#SSS2014)) -* __moist/wet__ := soil water potential >= -1.5 MPa "water is held at a tension of less than 1500 kPa but more than zero" ([p. 29, SSS 2014](#SSS2014)) -* __saturated__ := soil water potential >= -0.033 MPa - -* __histic epipedon__ := a horizon that is periodically saturated with water and that has sufficiently high amounts of organic carbon (O.C. 12 to 18%, by weight, depending on clay content) to be considered organic soil material. Typically, it is at (or near) the surface and is peat or muck at least 20 cm thick." ([p.3-10, SSS 2015](#SSS2015)) -* __O horizon__ := "Horizons [...] dominated by organic soil materials. [...] Some O horizons [...] consist of slightly decomposed to highly decomposed litter, such as leaves, needles, twigs, moss, and lichens, that has been deposited on the surface of either mineral or organic soils." ([p. 335, SSS 2014](#SSS2014)) -* __organic soil material__ := "Soil material that contains more than the amounts of organic carbon described above for mineral soil material is considered organic soil material" ([p. 3, SSS 2014](#SSS2014)) -* __mineral soil material__ := "(less than 2.0 mm in diameter) _either_: - 1) Is saturated with water for less than 30 days (cumulative) per year in normal years and contains less than 20 percent (by weight) organic carbon; _or_ - 2) Is saturated with water for 30 days or more (cumulative) in normal years (or is artificially drained) and, excluding live roots, has an organic carbon content (by weight) of: - * Less than 18 percent if the mineral fraction contains 60 percent or more clay; _or_ - * Less than 12 percent if the mineral fraction contains no clay; _or_ - * Less than 12 + (clay percentage multiplied by 0.1) percent if the mineral fraction contains less than 60 percent clay." ([p. 3, SSS 2014](#SSS2014)) - - - -### Conditions for Soil Moisture Regimes - -* __COND0__: precipitation exceeds AET in all months -* __COND1__: Dry in ALL layers for more than half of the CUMULATIVE days per year when the soil temperature at a depth of 50cm is above 5C -* __COND2__: Moist in ANY layer for less than 90 CONSECUTIVE days when the soil temperature at a depth of 50cm is above 8C -* __COND2_1__: Moist in ANY layer for less than 180 CONSECUTIVE days when the soil temperature at a depth of 50cm is above 8C -* __COND2_2__: Moist in ANY layer for less than 270 CONSECUTIVE days when the soil temperature at a depth of 50cm is above 8C -* __COND2_3__: Moist in ANY layer for less or equal than 45 CONSECUTIVE days when the soil temperature at a depth of 50cm is above 8C -* __COND3__: MCS is dry in ANY layer for < 90 CUMULATIVE days -- sum of days with any dry layer < 90 -* __COND3_1__: MCS is dry in ANY layer for < 30 CUMULATIVE days -- sum of days with any dry layer < 30 -* __COND4__: The means annual soil temperature at 50cm is >= 22C -* __COND5__: The absolute difference between the temperature in winter @ 50cm and the temperature in summer @ 50cm is >= 6C -* __COND6__: Dry in ALL layers LESS than 45 CONSECUTIVE days in the 4 months following the summer solstice -* __COND6_1__: Dry in ALL layers MORE than 90 CONSECUTIVE days in the 4 months following the summer solstice -* __COND7__: MCS is moist in ANY layer for more than 180 CUMULATIVE days -* __COND8__: MCS is moist in ANY layer for more than 90 CONSECUTIVE days -* __COND9__: Moist in ALL layers MORE than 45 CONSECUTIVE days in the 4 months following the winter solstice -* __COND10__: Dry in ALL layers for more or equal to 360 days - - -### Conditions for Anhydrous Soils - -* __AnhCOND1__: Mean Annual soil temperature at 50 cm depth is less than or equal to 0C -* __AnhCOND2__: Daily soil temperature of all soil layers in 10-70 cm < 5 C -* __AnhCOND3__: In the Lahn Depth, 1/2 of soil dry > 1/2 CUMULATIVE days when Mean Annual ST > 0C - - -### Conditions for Soil Temperature Regimes - -* __st_depth__: "The control section for soil temperature is either at a depth of 50 cm below the soil surface or at the upper boundary of a root-limiting layer, whichever is shallower." ([p. 329, SSS 2014](#SSS2014)) -* __stCOND0__: Annual mean soil temperature of the same layer is less than 0 C for at least two consecutive years for at least one layer -* __stCOND1__: Mean annual soil temperature at [st_depth](#st_depth) is <= 0 C -* __stCOND2__: Mean annual soil temperature at [st_depth](#st_depth) is < 8 C -* __stCOND3__: Mean annual soil temperature at [st_depth](#st_depth) is < 15 C -* __stCOND4__: Mean annual soil temperature at [st_depth](#st_depth) is < 22 C -* __stCOND5__: Any layer of soil is saturated with water during some part of the summer, e.g., for the northern hemisphere, June 1 (doy 244) - Aug31 (doy 335) -* __stCOND6__: Mean summer soil temperature at [st_depth](#st_depth) is < 13 C -* __stCOND7__: Mean summer soil temperature at [st_depth](#st_depth) is < 6 C -* __stCOND8__: Mean summer soil temperature at [st_depth](#st_depth) is < 15 C -* __stCOND9__: Mean summer soil temperature at [st_depth](#st_depth) is < 8 C - - - -## jNSM variables -#### Code interpretation based on 'BASICSimulationModel.java' and ' NewhallResults.java' - -* swt = comparison monthly PET vs. PPT - * [lines 363-369] noMpeGreaterThanPrecip = \!all(mpe[1:12] > precip[1:12]) - * [lines 370-373] swt = __IF__ (noMpeGreaterThanPrecip) -1 __ELSE__ 0 -* nd with - * nd[1] = numCumulativeDaysDry = [assumption] MCS is dry in ALL layers (cf. COND10) - * nd[2] = numCumulativeDaysMoistDry - * nd[3] = numCumulativeDaysMoist - * nd[1] + nd[2]: test variable for [[COND3](#COND3)] - * [lines ...] -* dif = absolute difference between mean summer and mean winter soil temperature (cf. [COND5](#COND5)) - * [lines 199-212] - * st = mean(temperature[6:8]) + fc - * wt = mean(temperature[c(1:2, 12)]) + fc - * __IF__ (southern hemisphere) swap st and wt - * [lines 241-215] cs = abs(st - wt) * (1 - fcd) / 2 - * [lines 246-248] dif = (st - cs) - (wt + cs) - * st - cs = mean summer soil temperature - * wt - cs = mean winter soil temperature -* nccm = moistDaysAfterWinterSolstice = [assumption] CONSECUTIVE days in the 4 months following the winter solstice when MCS is moist in ALL layers (cf. [COND9](#COND9)) - * [lines 2147, 2171, 2173, 2209, 2211, 2246, 2247] - * [line 2252] nccm = max -* nccd = dryDaysAfterSummerSolstice = [assumption] CONSECUTIVE days in the 4 months following the summer solstice when MCS is dry in ALL layers (cf. [COND6](#COND6)) - * [lines 2029, 2053, 2055, 2091, 2093, 2128, 2129] - * [line 2134] nccd = max -* ncpm with - * ncpm[1] = numConsecutiveDaysMoistInSomeParts - * ncpm[2] = numConsecutiveDaysMoistInSomePartsOver8C [assumption] CONSECUTIVE days when the soil temperature at a depth of 50cm is above 8C and MCS is moist in ANY layers (cf. [COND2](#COND2)) - * [lines ...] -* nsd with - * nsd[1] = numCumulativeDaysDryOver5C [assumption] cumulative days when MCS is dry in all parts and the soil temperature at a depth of 50cm is above 5C (cf. [COND1](#COND1)) - * nsd[2] = numCumulativeDaysMoistDryOver5C - * nsd[3] = numCumulativeDaysMoistOver5C - * [lines 1487, 1536, 1563] -* tma = mean annual soil temperature - * [lines 193-196] sumt = sum(temperature[1:12]) - * [line 198] tma = mean(sumt) + fc -* lt5c = [assumption] cumulative days when the soil temperature at a depth of 50 cm below the soil surface is above 5 C (cf. [COND1](#COND1)) - * [lines 1483, 1451, 1565] -* Remarks - * dif - * jNSM is using the old limit of 5 C instead of the new limit of 6 C - * "in 1999 the Iso- definitions were refined from < 5 degrees C to < 6 degrees C" [slide 3 of ' jNSM_Background_Use_Tutorial.pptx'] - * rSFSW2 is using new limit of 6 C - - -#### jNSM inputs - -* precip[1:12] = monthly precipitation in mm -* temperature[1:12] = mean monthly air temperature in C -* mpe[1:12] = monthly potential evaporation in mm based on Thornthwaite 1948 -* fc = 2.5 = Degree offset between soil and air temperature in Celsius [Comment: this value is being applied in the code to both monthly and annual data] -* fcd = 0.66 = Soil-Air Relationship Amplitude - - - -## References -* Soil Survey Staff (2015). Illustrated guide to soil taxonomy. USDA Natural Resources Conservation Service, National Soil Survey Center, Lincoln, Nebraska. -* Soil Survey Staff (2014). Keys to soil taxonomy, 12th ed. USDA Natural Resources Conservation Service, Washington, DC. -* jNSM (2016) Java Newhall Simulation Model, version 1.6.1. https://github.com/drww/newhall (accessed Oct 26, 2016).