diff --git a/.buildlibrary b/.buildlibrary index e7e1e924..2d740c58 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '28581092' +ValidationKey: '28603775' AutocreateReadme: yes AcceptedWarnings: - 'Warning: package ''.*'' was built under R version' diff --git a/CITATION.cff b/CITATION.cff index 242e4a5f..745d8178 100644 --- a/CITATION.cff +++ b/CITATION.cff @@ -2,8 +2,8 @@ cff-version: 1.2.0 message: If you use this software, please cite it using the metadata from this file. type: software title: 'mrmagpie: madrat based MAgPIE Input Data Library' -version: 1.44.4 -date-released: '2024-03-11' +version: 1.44.5 +date-released: '2024-03-13' abstract: Provides functions for MAgPIE country and cellular input data generation. authors: - family-names: Karstens diff --git a/DESCRIPTION b/DESCRIPTION index 2733a034..60950464 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Type: Package Package: mrmagpie Title: madrat based MAgPIE Input Data Library -Version: 1.44.4 -Date: 2024-03-11 +Version: 1.44.5 +Date: 2024-03-13 Authors@R: c( person("Kristine", "Karstens", , "karstens@pik-potsdam.de", role = c("aut", "cre")), person("Jan Philipp", "Dietrich", , "dietrich@pik-potsdam.de", role = "aut"), diff --git a/NAMESPACE b/NAMESPACE index e469606e..60fbaf1a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -113,6 +113,7 @@ importFrom(terra,crds) importFrom(terra,crs) importFrom(terra,ext) importFrom(terra,focal) +importFrom(terra,global) importFrom(terra,project) importFrom(terra,rast) importFrom(terra,values) diff --git a/R/calcEFRRockstroem.R b/R/calcEFRRockstroem.R new file mode 100644 index 00000000..77736e7c --- /dev/null +++ b/R/calcEFRRockstroem.R @@ -0,0 +1,175 @@ +#' @title calcEFRRockstroem +#' @description This function calculates environmental flow requirements (EFR) for MAgPIE +#' retrieved from LPJmL monthly discharge and water availability +#' following the definition of the planetary boundary in Rockström et al. 2023 +#' +#' @param lpjml Defines LPJmL version for crop/grass and natveg specific inputs +#' @param climatetype Switch between different climate scenarios +#' @param stage Degree of processing: raw, smoothed, harmonized, harmonized2020 +#' @param seasonality grper (default): EFR in growing period per year; +#' total: EFR throughout the year; +#' monthly: monthly EFRs +#' +#' @import magclass +#' @import madrat +#' @importFrom stats quantile +#' @importFrom mrcommons toolHarmonize2Baseline toolLPJmLVersion +#' +#' @return magpie object in cellular resolution +#' @author Felicitas Beier, Jens Heinke +#' +#' @examples +#' \dontrun{ +#' calcOutput("EFRRockstroem", aggregate = FALSE) +#' } +#' +calcEFRRockstroem <- function(lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", + crop = "ggcmi_phase3_nchecks_9ca735cb"), + climatetype = "GSWP3-W5E5:historical", stage = "harmonized2020", + seasonality = "grper") { + # Create settings for LPJmL from version and climatetype argument + cfgNatveg <- toolLPJmLVersion(version = lpjml["natveg"], climatetype = climatetype) + cfgCrop <- toolLPJmLVersion(version = lpjml["crop"], climatetype = climatetype) + + lpjmlReadin <- c(natveg = unname(cfgNatveg$readin_version), + crop = unname(cfgCrop$readin_version)) + + lpjmlBaseline <- c(natveg = unname(cfgNatveg$baseline_version), + crop = unname(cfgCrop$baseline_version)) + + ############################################################################# + # Definition of planetary boundary (PB) according to Rockström et al. 2023: # + # less than 20% magnitude monthly surface flow alteration # + # in all grid cells # + # Translation to EFR: # + # only 20% of monthly water flow can be withdrawn, # + # i.e. 80% need to stay in the river in each grid cell # + ############################################################################# + + if (stage %in% c("raw", "smoothed")) { + # Available water per month (smoothed) + avlWaterMonth <- calcOutput("AvlWater", lpjml = lpjmlReadin, climatetype = climatetype, + seasonality = "monthly", stage = "smoothed", + aggregate = FALSE, cells = "lpjcell") + + # Monthly EFR: 80% of monthly available water + efr <- 0.8 * avlWaterMonth + + ### aggregation to grper, total + ### efr per cell per month + if (seasonality == "monthly") { + # Check for NAs + if (any(is.na(efr))) { + stop("calcEFRRockstroem produced NA monthly EFR") + } + out <- efr + + ### Total water available per cell per year + } else if (seasonality == "total") { + # Sum up over all month: + efrTotal <- dimSums(efr, dim = 3) + + # Read in available water (for Smakthin calculation) + avlWaterTotal <- calcOutput("AvlWater", lpjml = lpjmlReadin, climatetype = climatetype, + seasonality = "total", stage = "smoothed", + aggregate = FALSE, cells = "lpjcell") + + # Reduce EFR to 80% of available water where it exceeds this threshold + efrTotal[which(efrTotal / avlWaterTotal > 0.8)] <- + 0.8 * avlWaterTotal[which(efrTotal / avlWaterTotal > 0.8)] + + # Check for NAs + if (any(is.na(efrTotal))) { + stop("calcEFRRockstroem produced NA efrTotal") + } + out <- efrTotal + + ### Water available in growing period per cell per year + } else if (seasonality == "grper") { + # magpie object with days per month with same dimension as EFR + tmp <- c(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31) + monthDays <- new.magpie(names = dimnames(efr)[[3]]) + monthDays[, , ] <- tmp + monthDayMagpie <- as.magpie(efr) + monthDayMagpie[, , ] <- 1 + monthDayMagpie <- monthDayMagpie * monthDays + + # Daily environmental flow requirements + efrDay <- efr / monthDayMagpie + + # Growing days per month + growDays <- calcOutput("GrowingPeriod", lpjml = lpjmlReadin, climatetype = climatetype, + stage = "smoothed", yield_ratio = 0.1, + aggregate = FALSE, cells = "lpjcell") + + # Available water in growing period + efrGrper <- efrDay * growDays + # Available water in growing period per year + efrGrper <- dimSums(efrGrper, dim = 3) + # Read in available water (for Smakthin calculation) + avlWaterGrper <- calcOutput("AvlWater", lpjml = lpjmlReadin, climatetype = climatetype, + seasonality = "grper", stage = "smoothed", + aggregate = FALSE, cells = "lpjcell") + + # Reduce EFR to 80% of available water where it exceeds this threshold + efrGrper[which(efrGrper / avlWaterGrper > 0.8)] <- + 0.8 * avlWaterGrper[which(efrGrper / avlWaterGrper > 0.8)] + + # Check for NAs + if (any(is.na(efrGrper))) { + stop("calcEFRRockstroem produced NA efrGrper") + } + out <- efrGrper + } else { + stop("Specify seasonality: monthly, grper or total") + } + + } else if (stage == "harmonized") { + # Load baseline and climate EFR: + baseline <- calcOutput("EFRRockstroem", lpjml = lpjmlBaseline, climatetype = cfgNatveg$baseline_hist, + seasonality = seasonality, stage = "smoothed", + aggregate = FALSE, cells = "lpjcell") + + if (climatetype == cfgNatveg$baseline_hist) { + + out <- baseline + + } else { + + x <- calcOutput("EFRRockstroem", lpjml = lpjmlReadin, climatetype = climatetype, + seasonality = seasonality, stage = "smoothed", + aggregate = FALSE, cells = "lpjcell") + # Harmonize to baseline + out <- toolHarmonize2Baseline(x = x, base = baseline, ref_year = cfgNatveg$ref_year_hist) + } + + } else if (stage == "harmonized2020") { + + baseline2020 <- calcOutput("EFRRockstroem", lpjml = lpjmlBaseline, climatetype = cfgNatveg$baseline_gcm, + seasonality = seasonality, stage = "harmonized", + aggregate = FALSE, cells = "lpjcell") + + if (climatetype == cfgNatveg$baseline_gcm) { + + out <- baseline2020 + + } else { + + x <- calcOutput("EFRRockstroem", lpjml = lpjmlReadin, climatetype = climatetype, + seasonality = seasonality, stage = "smoothed", + aggregate = FALSE, cells = "lpjcell") + out <- toolHarmonize2Baseline(x, baseline2020, ref_year = cfgNatveg$ref_year_gcm) + } + + } else { + stop("Stage argument not supported!") + } + + description <- paste0("EFRs according to water planetary boundary in ", seasonality) + + return(list(x = out, + weight = NULL, + unit = "mio. m^3", + description = description, + isocountries = FALSE)) +} diff --git a/R/calcEFRSmakthin.R b/R/calcEFRSmakthin.R new file mode 100644 index 00000000..803a9d89 --- /dev/null +++ b/R/calcEFRSmakthin.R @@ -0,0 +1,278 @@ +#' @title calcEFRSmakthin +#' @description This function calculates environmental flow requirements (EFR) for MAgPIE +#' retrieved from LPJmL monthly discharge and water availability using the +#' method of Smakthin et al. (2004) +#' +#' @param lpjml Defines LPJmL version for crop/grass and natveg specific inputs +#' @param climatetype Switch between different climate scenarios +#' @param stage Degree of processing: raw, smoothed, harmonized, harmonized2020 +#' @param LFR_val Strictness of environmental flow requirements +#' @param HFR_LFR_less10 High flow requirements (share of total water for cells) +#' with LFR<10percent of total water +#' @param HFR_LFR_10_20 High flow requirements (share of total water for cells) +#' with 10percent < LFR < 20percent of total water +#' @param HFR_LFR_20_30 High flow requirements (share of total water for cells) +#' with 20percent < LFR < 30percent of total water +#' @param HFR_LFR_more30 High flow requirements (share of total water for cells) +#' with LFR>30percent of total water +#' @param seasonality grper (default): EFR in growing period per year; total: +#' EFR throughout the year; monthly: monthly EFRs +#' @param cells lpjcell for 67420 cells or magpiecell for 59199 cells +#' +#' @import magclass +#' @import madrat +#' @importFrom stats quantile +#' @importFrom mrcommons toolHarmonize2Baseline toolLPJmLVersion +#' +#' @return magpie object in cellular resolution +#' @author Felicitas Beier, Abhijeet Mishra +#' +#' @examples +#' \dontrun{ +#' calcOutput("EFRSmakthin", aggregate = FALSE) +#' } +#' +calcEFRSmakthin <- function(lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", + crop = "ggcmi_phase3_nchecks_9ca735cb"), + climatetype = "GSWP3-W5E5:historical", stage = "harmonized2020", + LFR_val = 0.1, HFR_LFR_less10 = 0.2, HFR_LFR_10_20 = 0.15, # nolint + HFR_LFR_20_30 = 0.07, HFR_LFR_more30 = 0.00, # nolint + seasonality = "grper", cells = "lpjcell") { + # Create settings for LPJmL from version and climatetype argument + cfgNatveg <- toolLPJmLVersion(version = lpjml["natveg"], climatetype = climatetype) + cfgCrop <- toolLPJmLVersion(version = lpjml["crop"], climatetype = climatetype) + + lpjmlReadin <- c(natveg = unname(cfgNatveg$readin_version), + crop = unname(cfgCrop$readin_version)) + + lpjmlBaseline <- c(natveg = unname(cfgNatveg$baseline_version), + crop = unname(cfgCrop$baseline_version)) + + if (stage %in% c("raw", "smoothed")) { + ############################################################ + # Step 1 Determine monthly discharge low flow requirements # + # (lfrMonthlyDischarge) # + ############################################################ + + ### Monthly Discharge + monthlyDischargeMagpie <- calcOutput("LPJmL_new", version = lpjmlReadin["natveg"], + climatetype = climatetype, subtype = "mdischarge", + aggregate = FALSE, stage = "raw") + # Extract years for quantile calculation + years <- getYears(monthlyDischargeMagpie, as.integer = TRUE) + years <- seq(years[1] + 7, years[length(years)], by = 1) + # Transform to array (faster calculation) + monthlyDischargeMagpie <- as.array(collapseNames(monthlyDischargeMagpie)) + # Empty array with magpie object names + lfrQuant <- array(NA, dim = c(dim(monthlyDischargeMagpie)[1], length(years)), + dimnames = list(dimnames(monthlyDischargeMagpie)[[1]], paste("y", years, sep = ""))) + + ### Calculate lfrQuant + ## Note: LFRs correspond to the Q90-value (fair condition) + ## (i.e. to the discharge that is exceeded in nine out of ten months) + ## Q75-value (good condition), or Q50 (natural condition) (Bonsch et al. 2015). + ## This is calculated via the 10%- (25%-, 50%-) quantile of monthly discharge. + + # Quantile calculation: Yearly LFR quantile value + for (year in years) { + # get the LFR_val quantile in range of 8 years for each year for all cells + neededYears <- seq(year - 7, year, by = 1) + lfrQuant[, paste("y", year, sep = "")] <- + apply(monthlyDischargeMagpie[, paste("y", neededYears, sep = ""), ], + MARGIN = c(1), quantile, probs = LFR_val) + } + # Time-smooth lfrQuant + lfrQuant <- as.magpie(lfrQuant, spatial = 1) + lfrQuant <- toolFillYears(lfrQuant, getYears(monthlyDischargeMagpie, as.integer = TRUE)) + + if (stage == "smoothed") lfrQuant <- toolSmooth(lfrQuant) + + # Raw monthly discharge no longer needed at this point + rm(monthlyDischargeMagpie) + + ### Read in smoothed monthly discharge + monthlyDischargeMagpie <- calcOutput("LPJmL_new", version = lpjmlReadin["natveg"], + climatetype = climatetype, subtype = "mdischarge", + aggregate = FALSE, stage = "smoothed") + + # Transform to array (faster calculation) + lfrQuant <- as.array(collapseNames(lfrQuant)) + monthlyDischargeMagpie <- as.array(collapseNames(monthlyDischargeMagpie)) + + ### Calculate LFR discharge values for each month + # If lfrQuant < magpie_discharge: take lfrQuant + # Else: take magpie_discharge + lfrMonthlyDischarge <- monthlyDischargeMagpie + for (month in 1:12) { + tmp1 <- as.vector(lfrQuant) + tmp2 <- as.vector(monthlyDischargeMagpie[, , month]) + lfrMonthlyDischarge[, , month] <- pmin(tmp1, tmp2) + } + # Remove no longer needed objects + rm(lfrQuant) + + + ################################################ + # Step 2 Determine low flow requirements (LFR) # + # from available water per month # + ################################################ + ### Available water per month (smoothed) + avlWaterMonth <- calcOutput("AvlWater", lpjml = lpjmlReadin, climatetype = climatetype, + seasonality = "monthly", stage = "smoothed", + aggregate = FALSE, cells = "lpjcell") + + # Transform to array for faster calculation + avlWaterMonth <- as.array(collapseNames(avlWaterMonth)) + + # Empty array + lfr <- avlWaterMonth + lfr[, , ] <- NA + + ### Calculate LFRs + lfr <- avlWaterMonth * (lfrMonthlyDischarge / monthlyDischargeMagpie) + # There are NA's where monthlyDischargeMagpie was 0, replace with 0: + lfr[is.nan(lfr)] <- 0 + + ################################################################### + # Step 3 Determine monthly high flow requirements (HFR) # + # based on the ratio between LFR_month and avlWaterMonth # + ################################################################### + ## Note: "For rivers with low Q90 values, high-flow events are important + ## for river channel maintenance, wetland flooding, and riparian vegetation. + ## HFRs of 20% of available water are therefore assigned to rivers with a + ## low fraction of Q90 in total discharge. Rivers with a more stable flow + ## regime receive a lower HFR." (Bonsch et al. 2015) + hfr <- lfr + hfr[, , ] <- NA + + hfr[lfr < 0.1 * avlWaterMonth] <- HFR_LFR_less10 * avlWaterMonth[lfr < 0.1 * avlWaterMonth] + hfr[lfr >= 0.1 * avlWaterMonth] <- HFR_LFR_10_20 * avlWaterMonth[lfr >= 0.1 * avlWaterMonth] + hfr[lfr >= 0.2 * avlWaterMonth] <- HFR_LFR_20_30 * avlWaterMonth[lfr >= 0.2 * avlWaterMonth] + hfr[lfr >= 0.3 * avlWaterMonth] <- HFR_LFR_more30 * avlWaterMonth[lfr >= 0.3 * avlWaterMonth] + hfr[avlWaterMonth <= 0] <- 0 + + efr <- lfr + hfr + efr <- as.magpie(efr, spatial = 1) + + ### aggregation to grper, total + ### efr per cell per month + if (seasonality == "monthly") { + # Check for NAs + if (any(is.na(efr))) { + stop("calcEFRSmakthin produced NA efr") + } + out <- efr + + ### Total water available per cell per year + } else if (seasonality == "total") { + # Sum up over all month: + efrTotal <- dimSums(efr, dim = 3) + + # Read in available water (for Smakthin calculation) + avlWaterTotal <- calcOutput("AvlWater", lpjml = lpjmlReadin, climatetype = climatetype, + seasonality = "total", stage = "smoothed", + aggregate = FALSE, cells = "lpjcell") + + # Reduce EFR to 50% of available water where it exceeds this threshold (according to Smakhtin 2004) + efrTotal[which(efrTotal / avlWaterTotal > 0.5)] <- + 0.5 * avlWaterTotal[which(efrTotal / avlWaterTotal > 0.5)] + + # Check for NAs + if (any(is.na(efrTotal))) { + stop("calcEFRSmakthin produced NA efrTotal") + } + out <- efrTotal + + ### Water available in growing period per cell per year + } else if (seasonality == "grper") { + # magpie object with days per month with same dimension as EFR + tmp <- c(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31) + monthDays <- new.magpie(names = dimnames(efr)[[3]]) + monthDays[, , ] <- tmp + monthDayMagpie <- as.magpie(efr) + monthDayMagpie[, , ] <- 1 + monthDayMagpie <- monthDayMagpie * monthDays + + # Daily environmental flow requirements + efrDay <- efr / monthDayMagpie + + # Growing days per month + growDays <- calcOutput("GrowingPeriod", lpjml = lpjmlReadin, climatetype = climatetype, + stage = "smoothed", yield_ratio = 0.1, + aggregate = FALSE, cells = "lpjcell") + + # Available water in growing period + efrGrper <- efrDay * growDays + # Available water in growing period per year + efrGrper <- dimSums(efrGrper, dim = 3) + # Read in available water (for Smakthin calculation) + avlWaterGrper <- calcOutput("AvlWater", lpjml = lpjmlReadin, climatetype = climatetype, + seasonality = "grper", stage = "smoothed", + aggregate = FALSE, cells = "lpjcell") + + # Reduce EFR to 50% of available water where it exceeds this threshold (according to Smakhtin 2004) + efrGrper[which(efrGrper / avlWaterGrper > 0.5)] <- + 0.5 * avlWaterGrper[which(efrGrper / avlWaterGrper > 0.5)] + + # Check for NAs + if (any(is.na(efrGrper))) { + stop("calcEFRSmakthin produced NA efrGrper") + } + out <- efrGrper + } else { + stop("Specify seasonality: monthly, grper or total") + } + + } else if (stage == "harmonized") { + # Load baseline and climate EFR: + baseline <- calcOutput("EFRSmakthin", lpjml = lpjmlBaseline, climatetype = cfgNatveg$baseline_hist, + seasonality = seasonality, stage = "smoothed", + aggregate = FALSE, cells = "lpjcell") + + if (climatetype == cfgNatveg$baseline_hist) { + + out <- baseline + + } else { + + x <- calcOutput("EFRSmakthin", lpjml = lpjmlReadin, climatetype = climatetype, + seasonality = seasonality, stage = "smoothed", + aggregate = FALSE, cells = "lpjcell") + # Harmonize to baseline + out <- toolHarmonize2Baseline(x = x, base = baseline, ref_year = cfgNatveg$ref_year_hist) + } + + } else if (stage == "harmonized2020") { + + baseline2020 <- calcOutput("EFRSmakthin", lpjml = lpjmlBaseline, climatetype = cfgNatveg$baseline_gcm, + seasonality = seasonality, stage = "harmonized", + aggregate = FALSE, cells = "lpjcell") + + if (climatetype == cfgNatveg$baseline_gcm) { + + out <- baseline2020 + + } else { + + x <- calcOutput("EFRSmakthin", lpjml = lpjmlReadin, climatetype = climatetype, + seasonality = seasonality, stage = "smoothed", + aggregate = FALSE, cells = "lpjcell") + out <- toolHarmonize2Baseline(x, baseline2020, ref_year = cfgNatveg$ref_year_gcm) + } + + } else { + stop("Stage argument not supported!") + } + + description <- paste0("EFR according to Smakthin method in ", seasonality) + + if (cells == "magpiecell") { + out <- toolCoord2Isocell(out, cells = cells) + } + + return(list(x = out, + weight = NULL, + unit = "mio. m^3", + description = description, + isocountries = FALSE)) +} diff --git a/R/calcEnvmtlFlow.R b/R/calcEnvmtlFlow.R index e6a94183..c1677e75 100644 --- a/R/calcEnvmtlFlow.R +++ b/R/calcEnvmtlFlow.R @@ -5,18 +5,8 @@ #' @param lpjml Defines LPJmL version for crop/grass and natveg specific inputs #' @param climatetype Switch between different climate scenarios #' @param stage Degree of processing: raw, smoothed, harmonized, harmonized2020 -#' @param LFR_val Strictness of environmental flow requirements -#' @param HFR_LFR_less10 High flow requirements (share of total water for cells) -#' with LFR<10percent of total water -#' @param HFR_LFR_10_20 High flow requirements (share of total water for cells) -#' with 10percent < LFR < 20percent of total water -#' @param HFR_LFR_20_30 High flow requirements (share of total water for cells) -#' with 20percent < LFR < 30percent of total water -#' @param HFR_LFR_more30 High flow requirements (share of total water for cells) -#' with LFR>30percent of total water #' @param seasonality grper (default): EFR in growing period per year; total: #' EFR throughout the year; monthly: monthly EFRs -#' @param cells lpjcell for 67420 cells or magpiecell for 59199 cells #' #' @import magclass #' @import madrat @@ -24,7 +14,7 @@ #' @importFrom mrcommons toolHarmonize2Baseline toolLPJmLVersion #' #' @return magpie object in cellular resolution -#' @author Felicitas Beier, Abhijeet Mishra +#' @author Felicitas Beier #' #' @examples #' \dontrun{ @@ -32,246 +22,36 @@ #' } #' calcEnvmtlFlow <- function(lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", - crop = "ggcmi_phase3_nchecks_9ca735cb"), + crop = "ggcmi_phase3_nchecks_9ca735cb"), climatetype = "GSWP3-W5E5:historical", stage = "harmonized2020", - LFR_val = 0.1, HFR_LFR_less10 = 0.2, HFR_LFR_10_20 = 0.15, #nolint - HFR_LFR_20_30 = 0.07, HFR_LFR_more30 = 0.00, #nolint - seasonality = "grper", cells = "lpjcell") { - - # Create settings for LPJmL from version and climatetype argument - cfgNatveg <- toolLPJmLVersion(version = lpjml["natveg"], climatetype = climatetype) - cfgCrop <- toolLPJmLVersion(version = lpjml["crop"], climatetype = climatetype) - - lpjmlReadin <- c(natveg = unname(cfgNatveg$readin_version), - crop = unname(cfgCrop$readin_version)) - - lpjmlBaseline <- c(natveg = unname(cfgNatveg$baseline_version), - crop = unname(cfgCrop$baseline_version)) - - if (stage %in% c("raw", "smoothed")) { - ############################################################ - # Step 1 Determine monthly discharge low flow requirements # - # (lfrMonthlyDischarge) # - ############################################################ - - ### Monthly Discharge - monthlyDischargeMagpie <- calcOutput("LPJmL_new", version = lpjmlReadin["natveg"], - climatetype = climatetype, subtype = "mdischarge", - aggregate = FALSE, stage = "raw") - # Extract years for quantile calculation - years <- getYears(monthlyDischargeMagpie, as.integer = TRUE) - years <- seq(years[1] + 7, years[length(years)], by = 1) - # Transform to array (faster calculation) - monthlyDischargeMagpie <- as.array(collapseNames(monthlyDischargeMagpie)) - # Empty array with magpie object names - lfrQuant <- array(NA, dim = c(dim(monthlyDischargeMagpie)[1], length(years)), - dimnames = list(dimnames(monthlyDischargeMagpie)[[1]], paste("y", years, sep = ""))) - - ### Calculate lfrQuant - ## Note: LFRs correspond to the Q90-value (i.e. to the discharge that is exceeded in nine out of ten months) - ## (Bonsch et al. 2015). This is calculated via the 10%-quantile of monthly discharge. - - # Quantile calculation: Yearly LFR quantile value - for (year in years) { - # get the LFR_val quantile in range of 8 years for each year for all cells - neededYears <- seq(year - 7, year, by = 1) - lfrQuant[, paste("y", year, sep = "")] <- - apply(monthlyDischargeMagpie[, paste("y", neededYears, sep = ""), ], - MARGIN = c(1), quantile, probs = LFR_val) - } - # Time-smooth lfrQuant - lfrQuant <- as.magpie(lfrQuant, spatial = 1) - lfrQuant <- toolFillYears(lfrQuant, getYears(monthlyDischargeMagpie, as.integer = TRUE)) - - if (stage == "smoothed") lfrQuant <- toolSmooth(lfrQuant) - - # Raw monthly discharge no longer needed at this point - rm(monthlyDischargeMagpie) - - ### Read in smoothed monthly discharge - monthlyDischargeMagpie <- calcOutput("LPJmL_new", version = lpjmlReadin["natveg"], - climatetype = climatetype, subtype = "mdischarge", - aggregate = FALSE, stage = "smoothed") - - # Transform to array (faster calculation) - lfrQuant <- as.array(collapseNames(lfrQuant)) - monthlyDischargeMagpie <- as.array(collapseNames(monthlyDischargeMagpie)) - - ### Calculate LFR discharge values for each month - # If lfrQuant < magpie_discharge: take lfrQuant - # Else: take magpie_discharge - lfrMonthlyDischarge <- monthlyDischargeMagpie - for (month in 1:12) { - tmp1 <- as.vector(lfrQuant) - tmp2 <- as.vector(monthlyDischargeMagpie[, , month]) - lfrMonthlyDischarge[, , month] <- pmin(tmp1, tmp2) - } - # Remove no longer needed objects - rm(lfrQuant) - - - ################################################ - # Step 2 Determine low flow requirements (LFR) # - # from available water per month # - ################################################ - ### Available water per month (smoothed) - avlWaterMonth <- calcOutput("AvlWater", lpjml = lpjmlReadin, climatetype = climatetype, - seasonality = "monthly", stage = "smoothed", - aggregate = FALSE, cells = "lpjcell") - - # Transform to array for faster calculation - avlWaterMonth <- as.array(collapseNames(avlWaterMonth)) - - # Empty array - lfr <- avlWaterMonth - lfr[, , ] <- NA - - ### Calculate lfrs - lfr <- avlWaterMonth * (lfrMonthlyDischarge / monthlyDischargeMagpie) - # There are NA's where monthlyDischargeMagpie was 0, replace with 0: - lfr[is.nan(lfr)] <- 0 - - ################################################################### - # Step 3 Determie monthly high flow requirements (hfr) # - # based on the ratio between LFR_month and avlWaterMonth # - ################################################################### - ## Note: "For rivers with low Q90 values, high-flow events are important - ## for river channel maintenance, wetland flooding, and riparian vegetation. - ## hfrs of 20% of available water are therefore assigned to rivers with a - ## low fraction of Q90 in total discharge. Rivers with a more stable flow - ## regime receive a lower hfr." (Bonsch et al. 2015) - hfr <- lfr - hfr[, , ] <- NA - - hfr[lfr < 0.1 * avlWaterMonth] <- HFR_LFR_less10 * avlWaterMonth[lfr < 0.1 * avlWaterMonth] - hfr[lfr >= 0.1 * avlWaterMonth] <- HFR_LFR_10_20 * avlWaterMonth[lfr >= 0.1 * avlWaterMonth] - hfr[lfr >= 0.2 * avlWaterMonth] <- HFR_LFR_20_30 * avlWaterMonth[lfr >= 0.2 * avlWaterMonth] - hfr[lfr >= 0.3 * avlWaterMonth] <- HFR_LFR_more30 * avlWaterMonth[lfr >= 0.3 * avlWaterMonth] - hfr[avlWaterMonth <= 0] <- 0 - - efr <- lfr + hfr - efr <- as.magpie(efr, spatial = 1) - - ### aggregation to grper, total - ### efr per cell per month - if (seasonality == "monthly") { - # Check for NAs - if (any(is.na(efr))) { - stop("produced NA efr") - } - out <- efr - - ### Total water available per cell per year - } else if (seasonality == "total") { - # Sum up over all month: - efrTotal <- dimSums(efr, dim = 3) - - # Read in available water (for Smakthin calculation) - avlWaterTotal <- calcOutput("AvlWater", lpjml = lpjmlReadin, climatetype = climatetype, - seasonality = "total", stage = "smoothed", - aggregate = FALSE, cells = "lpjcell") - - # Reduce EFR to 50% of available water where it exceeds this threshold (according to Smakhtin 2004) - efrTotal[which(efrTotal / avlWaterTotal > 0.5)] <- - 0.5 * avlWaterTotal[which(efrTotal / avlWaterTotal > 0.5)] - - # Check for NAs - if (any(is.na(efrTotal))) { - stop("produced NA efrTotal") - } - out <- efrTotal - - ### Water available in growing period per cell per year - } else if (seasonality == "grper") { - # magpie object with days per month with same dimension as EFR - tmp <- c(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31) - monthDays <- new.magpie(names = dimnames(efr)[[3]]) - monthDays[, , ] <- tmp - monthDayMagpie <- as.magpie(efr) - monthDayMagpie[, , ] <- 1 - monthDayMagpie <- monthDayMagpie * monthDays - - # Daily water availability - efrDay <- efr / monthDayMagpie - - # Growing days per month - growDays <- calcOutput("GrowingPeriod", lpjml = lpjmlReadin, climatetype = climatetype, - stage = "smoothed", yield_ratio = 0.1, - aggregate = FALSE, cells = "lpjcell") - - # Available water in growing period - efrGrper <- efrDay * growDays - # Available water in growing period per year - efrGrper <- dimSums(efrGrper, dim = 3) - # Read in available water (for Smakthin calculation) - avlWaterGrper <- calcOutput("AvlWater", lpjml = lpjmlReadin, climatetype = climatetype, - seasonality = "grper", stage = "smoothed", - aggregate = FALSE, cells = "lpjcell") - - # Reduce EFR to 50% of available water where it exceeds this threshold (according to Smakhtin 2004) - efrGrper[which(efrGrper / avlWaterGrper > 0.5)] <- - 0.5 * avlWaterGrper[which(efrGrper / avlWaterGrper > 0.5)] - - # Check for NAs - if (any(is.na(efrGrper))) { - stop("produced NA efrGrper") - } - out <- efrGrper - } else { - stop("Specify seasonality: monthly, grper or total") - } - - } else if (stage == "harmonized") { - # Load baseline and climate EFR: - baseline <- calcOutput("EnvmtlFlow", lpjml = lpjmlBaseline, climatetype = cfgNatveg$baseline_hist, - seasonality = seasonality, stage = "smoothed", - aggregate = FALSE, cells = "lpjcell") - - if (climatetype == cfgNatveg$baseline_hist) { - - out <- baseline - - } else { - - x <- calcOutput("EnvmtlFlow", lpjml = lpjmlReadin, climatetype = climatetype, - seasonality = seasonality, stage = "smoothed", - aggregate = FALSE, cells = "lpjcell") - # Harmonize to baseline - out <- toolHarmonize2Baseline(x = x, base = baseline, ref_year = cfgNatveg$ref_year_hist) - } - - } else if (stage == "harmonized2020") { - - baseline2020 <- calcOutput("EnvmtlFlow", lpjml = lpjmlBaseline, climatetype = cfgNatveg$baseline_gcm, - seasonality = seasonality, stage = "harmonized", - aggregate = FALSE, cells = "lpjcell") - - if (climatetype == cfgNatveg$baseline_gcm) { - - out <- baseline2020 - - } else { - - x <- calcOutput("EnvmtlFlow", lpjml = lpjmlReadin, climatetype = climatetype, - seasonality = seasonality, stage = "smoothed", - aggregate = FALSE, cells = "lpjcell") - out <- toolHarmonize2Baseline(x, baseline2020, ref_year = cfgNatveg$ref_year_gcm) - } - - } else { - stop("Stage argument not supported!") - } + seasonality = "grper") { + ### Environemtal flow requirements (EFR) based on Smakthin (2004) method ### + # EFRs that maintain a "fair ecosystem status", i.e. with Q90 low flow requirements (LFR) + fair <- calcOutput("EFRSmakthin", lpjml = lpjml, climatetype = climatetype, stage = stage, + seasonality = seasonality, LFR_val = 0.1, aggregate = FALSE) + getItems(fair, dim = 3) <- "fair" + + # EFRs that maintain a "good ecosystem status", i.e. with Q75 low flow requirements (LFR) + # Note: High flow requirements (HFRs) are the same across different conservation statuses. + # Only LFRs vary. + good <- calcOutput("EFRSmakthin", lpjml = lpjml, climatetype = climatetype, stage = stage, + seasonality = seasonality, LFR_val = 0.25, aggregate = FALSE) + getItems(good, dim = 3) <- "good" + + out <- mbind(fair, good) + + ### EFRs according to planetary boundary (PB) as of Rockström et al. (2023) ### + # 80% of monthly flow is reserved for environment + pb <- calcOutput("EFRRockstroem", lpjml = lpjml, climatetype = climatetype, stage = stage, + seasonality = seasonality, aggregate = FALSE) + getItems(pb, dim = 3) <- "pb" + out <- mbind(out, pb) description <- paste0("EFR in ", seasonality) - if (cells == "magpiecell") { - out <- toolCoord2Isocell(out, cells = cells) - } - - return(list( - x = out, - weight = NULL, - unit = "mio. m^3", - description = description, - isocountries = FALSE)) + return(list(x = out, + weight = NULL, + unit = "mio. m^3", + description = description, + isocountries = FALSE)) } diff --git a/R/fullCELLULARMAGPIE.R b/R/fullCELLULARMAGPIE.R index 9d8cea91..38fd4384 100644 --- a/R/fullCELLULARMAGPIE.R +++ b/R/fullCELLULARMAGPIE.R @@ -378,15 +378,26 @@ fullCELLULARMAGPIE <- function(rev = numeric_version("0.1"), dev = "", aggregate = "cluster", cells = cells, round = 6, file = paste0("lpj_watavail_total_", ctype, ".mz")) - calcOutput("EnvmtlFlow", lpjml = lpjml, years = lpjYears, climatetype = climatetype, + calcOutput("EFRSmakthin", lpjml = lpjml, years = lpjYears, climatetype = climatetype, aggregate = "cluster", cells = cells, round = 6, seasonality = "grper", file = paste0("lpj_envflow_grper_", ctype, ".mz")) - calcOutput("EnvmtlFlow", lpjml = lpjml, years = lpjYears, climatetype = climatetype, + calcOutput("EFRSmakthin", lpjml = lpjml, years = lpjYears, climatetype = climatetype, aggregate = "cluster", cells = cells, round = 6, seasonality = "total", file = paste0("lpj_envflow_total_", ctype, ".mz")) + if (dev == "EFRtest") { + calcOutput("EnvmtlFlow", lpjml = lpjml, years = lpjYears, climatetype = climatetype, + aggregate = "cluster", cells = cells, + round = 6, seasonality = "grper", + file = paste0("envflow_grper_", ctype, ".cs3")) + calcOutput("EnvmtlFlow", lpjml = lpjml, years = lpjYears, climatetype = climatetype, + aggregate = "cluster", cells = cells, + round = 6, seasonality = "total", + file = paste0("envflow_total_", ctype, ".cs3")) + } + calcOutput("WaterUseNonAg", datasource = "WATERGAP_ISIMIP", usetype = "all:withdrawal", selectyears = lpjYears, seasonality = "grper", lpjml = lpjml, climatetype = climatetype, aggregate = "cluster", cells = cells, diff --git a/R/readMehta2022.R b/R/readMehta2022.R index 6f61d6de..78fee720 100644 --- a/R/readMehta2022.R +++ b/R/readMehta2022.R @@ -7,10 +7,9 @@ #' #' \dontrun{ a <- readSource("Mehta2022") #' } - -#' @importFrom raster brick -#' @importFrom terra aggregate project rast +#' @importFrom terra aggregate project rast global #' @importFrom magclass as.magpie +#' @importFrom mrcommons toolGetMappingCoord2Country readMehta2022 <- function() { @@ -34,7 +33,6 @@ readMehta2022 <- function() { stop("There is an issue with the aggregation. Please check mrmagpie::readMehta") } x <- suppressWarnings(terra::project(x, resolution)) - x <- suppressWarnings(raster::brick(x)) x <- as.magpie(x) return(x) diff --git a/README.md b/README.md index 86f8454c..f8b77e83 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # madrat based MAgPIE Input Data Library -R package **mrmagpie**, version **1.44.4** +R package **mrmagpie**, version **1.44.5** [![CRAN status](https://www.r-pkg.org/badges/version/mrmagpie)](https://cran.r-project.org/package=mrmagpie) [![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.4319612.svg)](https://doi.org/10.5281/zenodo.4319612) [![R build status](https://github.com/pik-piam/mrmagpie/workflows/check/badge.svg)](https://github.com/pik-piam/mrmagpie/actions) [![codecov](https://codecov.io/gh/pik-piam/mrmagpie/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/mrmagpie) [![r-universe](https://pik-piam.r-universe.dev/badges/mrmagpie)](https://pik-piam.r-universe.dev/builds) @@ -39,7 +39,7 @@ In case of questions / problems please contact Kristine Karstens . +Karstens K, Dietrich J, Chen D, Windisch M, Alves M, Beier F, Köberle A, v. Jeetze P, Mishra A, Humpenoeder F, Sauer P (2024). _mrmagpie: madrat based MAgPIE Input Data Library_. doi:10.5281/zenodo.4319612 , R package version 1.44.5, . A BibTeX entry for LaTeX users is @@ -48,7 +48,7 @@ A BibTeX entry for LaTeX users is title = {mrmagpie: madrat based MAgPIE Input Data Library}, author = {Kristine Karstens and Jan Philipp Dietrich and David Chen and Michael Windisch and Marcos Alves and Felicitas Beier and Alexandre Köberle and Patrick {v. Jeetze} and Abhijeet Mishra and Florian Humpenoeder and Pascal Sauer}, year = {2024}, - note = {R package version 1.44.4}, + note = {R package version 1.44.5}, doi = {10.5281/zenodo.4319612}, url = {https://github.com/pik-piam/mrmagpie}, } diff --git a/man/calcEFRRockstroem.Rd b/man/calcEFRRockstroem.Rd new file mode 100644 index 00000000..108f1f63 --- /dev/null +++ b/man/calcEFRRockstroem.Rd @@ -0,0 +1,42 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/calcEFRRockstroem.R +\name{calcEFRRockstroem} +\alias{calcEFRRockstroem} +\title{calcEFRRockstroem} +\usage{ +calcEFRRockstroem( + lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", crop = + "ggcmi_phase3_nchecks_9ca735cb"), + climatetype = "GSWP3-W5E5:historical", + stage = "harmonized2020", + seasonality = "grper" +) +} +\arguments{ +\item{lpjml}{Defines LPJmL version for crop/grass and natveg specific inputs} + +\item{climatetype}{Switch between different climate scenarios} + +\item{stage}{Degree of processing: raw, smoothed, harmonized, harmonized2020} + +\item{seasonality}{grper (default): EFR in growing period per year; +total: EFR throughout the year; +monthly: monthly EFRs} +} +\value{ +magpie object in cellular resolution +} +\description{ +This function calculates environmental flow requirements (EFR) for MAgPIE + retrieved from LPJmL monthly discharge and water availability + following the definition of the planetary boundary in Rockström et al. 2023 +} +\examples{ +\dontrun{ +calcOutput("EFRRockstroem", aggregate = FALSE) +} + +} +\author{ +Felicitas Beier, Jens Heinke +} diff --git a/man/calcEFRSmakthin.Rd b/man/calcEFRSmakthin.Rd new file mode 100644 index 00000000..6b533338 --- /dev/null +++ b/man/calcEFRSmakthin.Rd @@ -0,0 +1,63 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/calcEFRSmakthin.R +\name{calcEFRSmakthin} +\alias{calcEFRSmakthin} +\title{calcEFRSmakthin} +\usage{ +calcEFRSmakthin( + lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", crop = + "ggcmi_phase3_nchecks_9ca735cb"), + climatetype = "GSWP3-W5E5:historical", + stage = "harmonized2020", + LFR_val = 0.1, + HFR_LFR_less10 = 0.2, + HFR_LFR_10_20 = 0.15, + HFR_LFR_20_30 = 0.07, + HFR_LFR_more30 = 0, + seasonality = "grper", + cells = "lpjcell" +) +} +\arguments{ +\item{lpjml}{Defines LPJmL version for crop/grass and natveg specific inputs} + +\item{climatetype}{Switch between different climate scenarios} + +\item{stage}{Degree of processing: raw, smoothed, harmonized, harmonized2020} + +\item{LFR_val}{Strictness of environmental flow requirements} + +\item{HFR_LFR_less10}{High flow requirements (share of total water for cells) +with LFR<10percent of total water} + +\item{HFR_LFR_10_20}{High flow requirements (share of total water for cells) +with 10percent < LFR < 20percent of total water} + +\item{HFR_LFR_20_30}{High flow requirements (share of total water for cells) +with 20percent < LFR < 30percent of total water} + +\item{HFR_LFR_more30}{High flow requirements (share of total water for cells) +with LFR>30percent of total water} + +\item{seasonality}{grper (default): EFR in growing period per year; total: +EFR throughout the year; monthly: monthly EFRs} + +\item{cells}{lpjcell for 67420 cells or magpiecell for 59199 cells} +} +\value{ +magpie object in cellular resolution +} +\description{ +This function calculates environmental flow requirements (EFR) for MAgPIE + retrieved from LPJmL monthly discharge and water availability using the + method of Smakthin et al. (2004) +} +\examples{ +\dontrun{ +calcOutput("EFRSmakthin", aggregate = FALSE) +} + +} +\author{ +Felicitas Beier, Abhijeet Mishra +} diff --git a/man/calcEnvmtlFlow.Rd b/man/calcEnvmtlFlow.Rd index c5800c55..94367e8b 100644 --- a/man/calcEnvmtlFlow.Rd +++ b/man/calcEnvmtlFlow.Rd @@ -9,13 +9,7 @@ calcEnvmtlFlow( "ggcmi_phase3_nchecks_9ca735cb"), climatetype = "GSWP3-W5E5:historical", stage = "harmonized2020", - LFR_val = 0.1, - HFR_LFR_less10 = 0.2, - HFR_LFR_10_20 = 0.15, - HFR_LFR_20_30 = 0.07, - HFR_LFR_more30 = 0, - seasonality = "grper", - cells = "lpjcell" + seasonality = "grper" ) } \arguments{ @@ -25,24 +19,8 @@ calcEnvmtlFlow( \item{stage}{Degree of processing: raw, smoothed, harmonized, harmonized2020} -\item{LFR_val}{Strictness of environmental flow requirements} - -\item{HFR_LFR_less10}{High flow requirements (share of total water for cells) -with LFR<10percent of total water} - -\item{HFR_LFR_10_20}{High flow requirements (share of total water for cells) -with 10percent < LFR < 20percent of total water} - -\item{HFR_LFR_20_30}{High flow requirements (share of total water for cells) -with 20percent < LFR < 30percent of total water} - -\item{HFR_LFR_more30}{High flow requirements (share of total water for cells) -with LFR>30percent of total water} - \item{seasonality}{grper (default): EFR in growing period per year; total: EFR throughout the year; monthly: monthly EFRs} - -\item{cells}{lpjcell for 67420 cells or magpiecell for 59199 cells} } \value{ magpie object in cellular resolution @@ -58,5 +36,5 @@ calcOutput("EnvmtlFlow", aggregate = FALSE) } \author{ -Felicitas Beier, Abhijeet Mishra +Felicitas Beier }