From fe07ae2f27afe4d9ad60b443d184b92cb52e2427 Mon Sep 17 00:00:00 2001 From: Felicitas Beier Date: Tue, 21 Mar 2023 11:57:45 +0100 Subject: [PATCH 01/14] updated calcLUH2v2 to lpjcells --- R/calcGrowingPeriod.R | 191 ++++++++++++++++++++------------------- README.md | 2 +- man/calcGrowingPeriod.Rd | 10 +- 3 files changed, 108 insertions(+), 95 deletions(-) diff --git a/R/calcGrowingPeriod.R b/R/calcGrowingPeriod.R index d4b87512..22127a9c 100644 --- a/R/calcGrowingPeriod.R +++ b/R/calcGrowingPeriod.R @@ -1,11 +1,13 @@ #' @title calcGrowingPeriod -#' @description This function determines a mean sowing date and a mean growing period for each cell -#' in order to determine when irrigation can take place. +#' @description This function determines a mean sowing date and a mean growing period +#' for each cell in order to determine when irrigation can take place. #' -#' @param lpjml Defines LPJmL version for crop/grass and natveg specific inputs +#' @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 stage Degree of processing: raw, smoothed, harmonized, harmonized2020 #' @param yield_ratio threshold for cell yield over global average. crops in cells below threshold will be ignored +#' @param cells Number of cells to be returned +#' (select "magpiecell" for 59199 cells or "lpjcell" for 67420 cells) #' #' @return magpie object in cellular resolution #' @author Kristine Karstens, Felicitas Beier @@ -22,7 +24,8 @@ #' @export calcGrowingPeriod <- function(lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", crop = "ggcmi_phase3_nchecks_9ca735cb"), - climatetype = "GSWP3-W5E5:historical", stage = "harmonized2020", yield_ratio = 0.1) { + climatetype = "GSWP3-W5E5:historical", stage = "harmonized2020", yield_ratio = 0.1, + cells = "magpiecell") { cfg <- toolLPJmLVersion(version = lpjml["natveg"], climatetype = climatetype) @@ -48,38 +51,40 @@ calcGrowingPeriod <- function(lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", c # Read sowing and harvest date input (new for LPJmL5) #################################################################################### - LPJ2MAG <- toolGetMapping("MAgPIE_LPJmL.csv", - type = "sectoral", - where = "mappingfolder") + lpj2mag <- toolGetMapping("MAgPIE_LPJmL.csv", + type = "sectoral", + where = "mappingfolder") # Read yields first - yields <- toolCoord2Isocell(collapseNames(calcOutput("LPJmL_new", version = lpjml["crop"], - climatetype = climatetype, subtype = "harvest", - stage = "raw", aggregate = FALSE)[, , "irrigated"])) + yields <- collapseNames(calcOutput("LPJmL_new", version = lpjml["crop"], + climatetype = climatetype, subtype = "harvest", + stage = "raw", aggregate = FALSE)[, , "irrigated"]) # Load Sowing dates from LPJmL (use just rainfed dates since they do not differ for irrigated and rainfed) - sowd <- toolCoord2Isocell(collapseNames(calcOutput("LPJmL_new", version = lpjml["crop"], - climatetype = climatetype, subtype = "sdate", - stage = "raw", aggregate = FALSE)[, , "rainfed"])) - hard <- toolCoord2Isocell(collapseNames(calcOutput("LPJmL_new", version = lpjml["crop"], - climatetype = climatetype, subtype = "hdate", - stage = "raw", aggregate = FALSE)[, , "rainfed"])) + sowd <- collapseNames(calcOutput("LPJmL_new", version = lpjml["crop"], + climatetype = climatetype, subtype = "sdate", + stage = "raw", aggregate = FALSE)[, , "rainfed"]) + hard <- collapseNames(calcOutput("LPJmL_new", version = lpjml["crop"], + climatetype = climatetype, subtype = "hdate", + stage = "raw", aggregate = FALSE)[, , "rainfed"]) - goodCrops <- LPJ2MAG$MAgPIE[which(LPJ2MAG$LPJmL %in% getItems(sowd, dim = 3))] - badCrops <- LPJ2MAG$MAgPIE[which(!LPJ2MAG$LPJmL %in% getItems(sowd, dim = 3))] + goodCrops <- lpj2mag$MAgPIE[which(lpj2mag$LPJmL %in% getItems(sowd, dim = 3))] + badCrops <- lpj2mag$MAgPIE[which(!lpj2mag$LPJmL %in% getItems(sowd, dim = 3))] - sowd <- toolAggregate(sowd, rel = LPJ2MAG, + sowd <- toolAggregate(sowd, rel = lpj2mag, from = "LPJmL", to = "MAgPIE", dim = 3.1, partrel = TRUE) - hard <- toolAggregate(hard, rel = LPJ2MAG, + hard <- toolAggregate(hard, rel = lpj2mag, from = "LPJmL", to = "MAgPIE", dim = 3.1, partrel = TRUE) - yields <- toolAggregate(yields, rel = LPJ2MAG, + yields <- toolAggregate(yields, rel = lpj2mag, from = "LPJmL", to = "MAgPIE", dim = 3.1, partrel = TRUE) - if (length(badCrops) > 0) vcat(2, "No information on the growing period found for those crops: ", - paste(unique(badCrops), collapse = ", ")) + if (length(badCrops) > 0) { + vcat(2, "No information on the growing period found for those crops: ", + paste(unique(badCrops), collapse = ", ")) + } ##################################################################################### @@ -102,21 +107,21 @@ calcGrowingPeriod <- function(lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", c # (total cell area as aggregation weight) #################################################################################### - area <- dimSums(calcOutput("LUH2v2", cellular = TRUE, + area <- dimSums(calcOutput("LUH2v2", cellular = TRUE, cells = "lpjcell", aggregate = FALSE, years = "y1995"), dim = 3) yields <- collapseNames(yields[, , goodCrops]) cell2GLO <- array(c(getItems(yields, dim = 1), rep("GLO", 59199)), dim = c(59199, 2)) - glo_yields <- toolAggregate(yields, cell2GLO, weight = setYears(area, NULL)) - ratio_yields <- yields / glo_yields + gloYields <- toolAggregate(yields, cell2GLO, weight = setYears(area, NULL)) + yieldsRatio <- yields / gloYields - rm_lowyield <- yields - rm_lowyield[] <- 1 - rm_lowyield[ratio_yields < 0.1] <- NA + rmLowYield <- yields + rmLowYield[, , ] <- 1 + rmLowYield[yieldsRatio < 0.1] <- NA - rm(ratio_yields, yields, area, glo_yields) + rm(yieldsRatio, yields, area, gloYields) #################################################################################### @@ -124,18 +129,18 @@ calcGrowingPeriod <- function(lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", c # Step 3 remove wintercrops from both calculations for the northern hemisphere: sowd>180, hard>365 #################################################################################### - cells_northern_hemisphere <- which(magpie_coord[, 2] > 0) - rm_wintercrops <- new.magpie(cells_and_regions = getCells(sowd), + cellsNrthnHem <- which(magpie_coord[, 2] > 0) + rmWintercrops <- new.magpie(cells_and_regions = getCells(sowd), years = getYears(sowd), names = getNames(sowd), sets = c("region", "year", "crop"), fill = 1) # define all crops sowed after 180 days and where sowing date is after harvest date as wintercrops - rm_wintercrops[cells_northern_hemisphere, , ] <- - ifelse(sowd[cells_northern_hemisphere, , ] > 180 & - hard[cells_northern_hemisphere, , ] < sowd[cells_northern_hemisphere, , ], - NA, 1) + rmWintercrops[cellsNrthnHem, , ] <- ifelse(sowd[cellsNrthnHem, , ] > 180 & + hard[cellsNrthnHem, , ] < sowd[cellsNrthnHem, , ], + NA, + 1) #################################################################################### @@ -144,17 +149,12 @@ calcGrowingPeriod <- function(lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", c #################################################################################### # calculate growing period as difference of sowing date to harvest date - # sowd <- sowd[,years,] - # hard <- hard[,years,] - grow_period <- hard - sowd - grow_period[which(hard < sowd)] <- 365 + grow_period[which(hard < sowd)] + growPeriod <- hard - sowd + growPeriod[which(hard < sowd)] <- 365 + growPeriod[which(hard < sowd)] # calculate the mean after removing the before determined winter- and low yielding crops - # rm_wintercrops <- rm_wintercrops[,years,] - # rm_lowyield <- rm_lowyield[,years,] - - n_crops <- dimSums(rm_wintercrops * rm_lowyield, dim = 3, na.rm = TRUE) - meanGrper <- dimSums(grow_period * rm_wintercrops * rm_lowyield, dim = 3, na.rm = TRUE) / n_crops + nCrops <- dimSums(rmWintercrops * rmLowYield, dim = 3, na.rm = TRUE) + meanGrper <- dimSums(growPeriod * rmWintercrops * rmLowYield, dim = 3, na.rm = TRUE) / nCrops meanGrper[is.infinite(meanGrper)] <- NA ############################################################################# @@ -163,9 +163,9 @@ calcGrowingPeriod <- function(lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", c # Step 5 remove sowd1 for sowing date calculation #################################################################################### - rm_sowd1 <- sowd - rm_sowd1[] <- 1 - rm_sowd1[sowd == 1] <- NA + rmSOWD1 <- sowd + rmSOWD1[, , ] <- 1 + rmSOWD1[sowd == 1] <- NA #################################################################################### @@ -173,12 +173,12 @@ calcGrowingPeriod <- function(lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", c # Step 6 Calculate mean sowing date #################################################################################### - n_crops <- dimSums(rm_wintercrops * rm_lowyield * rm_sowd1, dim = 3, na.rm = TRUE) - meanSowd <- dimSums(grow_period * rm_wintercrops * rm_lowyield * rm_sowd1, dim = 3, na.rm = TRUE) / n_crops + nCrops <- dimSums(rmWintercrops * rmLowYield * rmSOWD1, dim = 3, na.rm = TRUE) + meanSowd <- dimSums(growPeriod * rmWintercrops * rmLowYield * rmSOWD1, dim = 3, na.rm = TRUE) / nCrops meanSowd[is.infinite(meanSowd)] <- NA - rm(rm_wintercrops, rm_lowyield, rm_sowd1) - rm(sowd, hard, grow_period) + rm(rmWintercrops, rmLowYield, rmSOWD1) + rm(sowd, hard, growPeriod) #################################################################################### #################################################################################### @@ -189,11 +189,11 @@ calcGrowingPeriod <- function(lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", c dams <- readSource("Dams", convert = "onlycorrect") for (t in getYears(meanSowd)) { - meanSowd[which(dams == 1), t] <- 1 + meanSowd[which(dams == 1), t] <- 1 meanGrper[which(dams == 1), t] <- 365 } - meanSowd[is.na(meanSowd)] <- 1 + meanSowd[is.na(meanSowd)] <- 1 meanGrper[is.na(meanGrper)] <- 365 meanSowd <- round(meanSowd) meanGrper <- round(meanGrper) @@ -209,18 +209,18 @@ calcGrowingPeriod <- function(lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", c names(monthLength) <- month # Determine which day belongs to which month - days_months <- 1:365 - names(days_months) <- 1:365 + daysOfmonth <- 1:365 + names(daysOfmonth) <- 1:365 before <- 0 - for (i in 1:length(monthLength)) { - days_months[(before + 1):(before + monthLength[i])] <- i - names(days_months)[(before + 1):(before + monthLength[i])] <- names(monthLength)[i] + for (i in seq_along(monthLength)) { + daysOfmonth[(before + 1):(before + monthLength[i])] <- i + names(daysOfmonth)[(before + 1):(before + monthLength[i])] <- names(monthLength)[i] before <- before + monthLength[i] } # mag object for the growing days per month - grow_days_per_month <- new.magpie(cells_and_regions = getCells(meanSowd), + growdaysPERmonth <- new.magpie(cells_and_regions = getCells(meanSowd), years = getYears(meanSowd), names = month, fill = 0) @@ -231,7 +231,7 @@ calcGrowingPeriod <- function(lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", c meanHard <- as.array(meanHard) meanSowd <- as.array(meanSowd) - grow_days_per_month <- as.array(grow_days_per_month) + growdaysPERmonth <- as.array(growdaysPERmonth) # Loop over the months to set the number of days that the growing period lasts in each month for (t in getYears(meanSowd)) { @@ -242,28 +242,29 @@ calcGrowingPeriod <- function(lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", c badcells <- ifelse(meanHard[, t, ] >= meanSowd[, t, ], 0, 1) for (month in 1:12) { - lastMonthday <- which(days_months == month)[length(which(days_months == month))] - firstMonthday <- which(days_months == month)[1] - test_harvest_goodcells <- as.array(meanHard[, t, ] - firstMonthday + 1) - days_in_this_month_goodcells <- as.array(lastMonthday - meanSowd[, t, ] + 1) - days_in_this_month_goodcells[days_in_this_month_goodcells < 0] <- 0 # Month before sowing date - days_in_this_month_goodcells[days_in_this_month_goodcells > monthLength[month]] <- monthLength[month] # Month is completely after sowing date - days_in_this_month_goodcells[test_harvest_goodcells < 0] <- 0 # Month lies after harvest date - days_in_this_month_goodcells[test_harvest_goodcells > 0 & test_harvest_goodcells < monthLength[month]] <- days_in_this_month_goodcells[test_harvest_goodcells > 0 & test_harvest_goodcells < monthLength[month]] - (lastMonthday - meanHard[test_harvest_goodcells > 0 & test_harvest_goodcells < monthLength[month], t, ]) # Harvest date lies in the month. cut off the end of the month after harvest date - days_in_this_month_goodcells <- days_in_this_month_goodcells <- days_in_this_month_goodcells * goodcells - days_in_this_month_badcells_firstyear <- as.array(lastMonthday - meanSowd[, t, ] + 1) - days_in_this_month_badcells_firstyear[days_in_this_month_badcells_firstyear < 0] <- 0 # Month before sowing date - days_in_this_month_badcells_firstyear[days_in_this_month_badcells_firstyear > monthLength[month]] <- monthLength[month] # Month is completely after sowing date - days_in_this_month_badcells_secondyear <- as.array(meanHard[, t, ] - firstMonthday + 1) - days_in_this_month_badcells_secondyear[days_in_this_month_badcells_secondyear < 0] <- 0 # Month lies completely after harvest day - days_in_this_month_badcells_secondyear[days_in_this_month_badcells_secondyear > monthLength[month]] <- monthLength[month] # Month lies completely before harvest day - days_in_this_month_badcells <- (days_in_this_month_badcells_firstyear + days_in_this_month_badcells_secondyear) * badcells - - grow_days_per_month[, t, month] <- days_in_this_month_goodcells + days_in_this_month_badcells + lastMonthday <- which(daysOfmonth == month)[length(which(daysOfmonth == month))] + firstMonthday <- which(daysOfmonth == month)[1] + testHarvestGoodcells <- as.array(meanHard[, t, ] - firstMonthday + 1) + daysGoodcells <- as.array(lastMonthday - meanSowd[, t, ] + 1) + daysGoodcells[daysGoodcells < 0] <- 0 # Month before sowing date + daysGoodcells[daysGoodcells > monthLength[month]] <- monthLength[month] # Month is completely after sowing date + daysGoodcells[testHarvestGoodcells < 0] <- 0 # Month lies after harvest date + daysGoodcells[testHarvestGoodcells > 0 & + testHarvestGoodcells < monthLength[month]] <- daysGoodcells[testHarvestGoodcells > 0 & testHarvestGoodcells < monthLength[month]] - (lastMonthday - meanHard[testHarvestGoodcells > 0 & testHarvestGoodcells < monthLength[month], t, ]) # Harvest date lies in the month. cut off the end of the month after harvest date + daysGoodcells <- daysGoodcells <- daysGoodcells * goodcells + daysBadcellsFirstyear <- as.array(lastMonthday - meanSowd[, t, ] + 1) + daysBadcellsFirstyear[daysBadcellsFirstyear < 0] <- 0 # Month before sowing date + daysBadcellsFirstyear[daysBadcellsFirstyear > monthLength[month]] <- monthLength[month] # Month is completely after sowing date + daysBadcellsScdyear <- as.array(meanHard[, t, ] - firstMonthday + 1) + daysBadcellsScdyear[daysBadcellsScdyear < 0] <- 0 # Month lies completely after harvest day + daysBadcellsScdyear[daysBadcellsScdyear > monthLength[month]] <- monthLength[month] # Month lies completely before harvest day + daysBadcells <- (daysBadcellsFirstyear + daysBadcellsScdyear) * badcells + + growdaysPERmonth[, t, month] <- daysGoodcells + daysBadcells } } - out <- as.magpie(grow_days_per_month) + out <- as.magpie(growdaysPERmonth, spatial = 1) if (any(is.na(out))) { stop("calcGrowingPeriod produced NAs") @@ -276,7 +277,7 @@ calcGrowingPeriod <- function(lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", c month <- c("jan", "feb", "mar", "apr", "may", "jun", "jul", "aug", "sep", "oct", "nov", "dec") monthLength <- c(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31) names(monthLength) <- month - out[out > as.magpie(monthLength)] <- magpie_expand(as.magpie(monthLength), out)[out > as.magpie(monthLength)] + out[out > as.magpie(monthLength, spatial = 1)] <- magpie_expand(as.magpie(monthLength, spatial = 1), out)[out > as.magpie(monthLength, spatial = 1)] out[out < 0] <- 0 } @@ -285,7 +286,8 @@ calcGrowingPeriod <- function(lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", c # load smoothed data baseline <- calcOutput("GrowingPeriod", lpjml = lpjml, climatetype = cfg$baseline_hist, - stage = "smoothed", yield_ratio = yield_ratio, aggregate = FALSE) + stage = "smoothed", yield_ratio = yield_ratio, + cells = "lpjcell", aggregate = FALSE) if (climatetype == cfg$baseline_hist) { @@ -293,8 +295,9 @@ calcGrowingPeriod <- function(lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", c } else { - x <- calcOutput("GrowingPeriod", lpjml = lpjml, climatetype = climatetype, - stage = "smoothed", yield_ratio = yield_ratio, aggregate = FALSE) + x <- calcOutput("GrowingPeriod", lpjml = lpjml, climatetype = climatetype, + stage = "smoothed", yield_ratio = yield_ratio, + cells = "lpjcell", aggregate = FALSE) # Harmonize to baseline out <- toolHarmonize2Baseline(x = x, base = baseline, ref_year = cfg$ref_year_hist) } @@ -302,30 +305,36 @@ calcGrowingPeriod <- function(lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", c } else if (stage == "harmonized2020") { # read in historical data for subtype - baseline2020 <- calcOutput("GrowingPeriod", lpjml = lpjml, climatetype = cfg$baseline_gcm, - stage = "harmonized", yield_ratio = yield_ratio, aggregate = FALSE) + baseline2020 <- calcOutput("GrowingPeriod", lpjml = lpjml, climatetype = cfg$baseline_gcm, + stage = "harmonized", yield_ratio = yield_ratio, + cells = "lpjcell", aggregate = FALSE) if (climatetype == cfg$baseline_gcm) { out <- baseline2020 } else { - x <- calcOutput("GrowingPeriod", lpjml = lpjml, climatetype = climatetype, - stage = "smoothed", yield_ratio = yield_ratio, aggregate = FALSE) + x <- calcOutput("GrowingPeriod", lpjml = lpjml, climatetype = climatetype, + stage = "smoothed", yield_ratio = yield_ratio, + cells = "lpjcell", aggregate = FALSE) out <- toolHarmonize2Baseline(x, baseline2020, ref_year = cfg$ref_year_gcm) } } else { stop("Stage argument not supported!") - } + } # replace values above days of a month with days of the month & negative values with 0 month <- c("jan", "feb", "mar", "apr", "may", "jun", "jul", "aug", "sep", "oct", "nov", "dec") monthLength <- c(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31) names(monthLength) <- month - out[out > as.magpie(monthLength)] <- magpie_expand(as.magpie(monthLength), out)[out > as.magpie(monthLength)] + out[out > as.magpie(monthLength, spatial = 1)] <- magpie_expand(as.magpie(monthLength, spatial = 1), out)[out > as.magpie(monthLength, spatial = 1)] out[out < 0] <- 0 + if (cells == "magpiecell") { + out <- toolCoord2Isocell(out) + } + return(list(x = out, weight = NULL, unit = "days", diff --git a/README.md b/README.md index b5e75b9c..fde613ac 100644 --- a/README.md +++ b/README.md @@ -48,7 +48,7 @@ In case of questions / problems please contact Felicitas Beier . +Beier F, Heinke J, Karstens K, Bodirsky B, Dietrich J (2023). _mrwater: madrat based MAgPIE water Input Data Library_. R package version 1.5.22, . A BibTeX entry for LaTeX users is diff --git a/man/calcGrowingPeriod.Rd b/man/calcGrowingPeriod.Rd index dffd44a2..f96e4ea8 100644 --- a/man/calcGrowingPeriod.Rd +++ b/man/calcGrowingPeriod.Rd @@ -9,7 +9,8 @@ calcGrowingPeriod( "ggcmi_phase3_nchecks_9ca735cb"), climatetype = "GSWP3-W5E5:historical", stage = "harmonized2020", - yield_ratio = 0.1 + yield_ratio = 0.1, + cells = "magpiecell" ) } \arguments{ @@ -20,13 +21,16 @@ calcGrowingPeriod( \item{stage}{Degree of processing: raw, smoothed, harmonized, harmonized2020} \item{yield_ratio}{threshold for cell yield over global average. crops in cells below threshold will be ignored} + +\item{cells}{Number of cells to be returned +(select "magpiecell" for 59199 cells or "lpjcell" for 67420 cells)} } \value{ magpie object in cellular resolution } \description{ -This function determines a mean sowing date and a mean growing period for each cell -in order to determine when irrigation can take place. +This function determines a mean sowing date and a mean growing period + for each cell in order to determine when irrigation can take place. } \examples{ \dontrun{ From 97c15fc16595a3e4897b7492982f6fb03a2aa77e Mon Sep 17 00:00:00 2001 From: Felicitas Date: Tue, 21 Mar 2023 12:35:38 +0100 Subject: [PATCH 02/14] solved merge conflicts with master --- .buildlibrary | 2 +- .zenodo.json | 2 +- DESCRIPTION | 4 +-- R/calcEnvmtlFlowRequirementsShare.R | 2 +- R/calcGrowingPeriod.R | 50 +++++++++++++++++------------ README.md | 6 ++-- 6 files changed, 37 insertions(+), 29 deletions(-) diff --git a/.buildlibrary b/.buildlibrary index fbbc3288..42d02337 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '29566372' +ValidationKey: '3128391' AcceptedWarnings: - 'Warning: package ''.*'' was built under R version' - 'Warning: namespace ''.*'' is not available and has been replaced' diff --git a/.zenodo.json b/.zenodo.json index 62320d96..e16edef0 100644 --- a/.zenodo.json +++ b/.zenodo.json @@ -1,6 +1,6 @@ { "title": "mrwater: madrat based MAgPIE water Input Data Library", - "version": "1.5.22", + "version": "1.6.1", "description": "

Provides functions for MAgPIE cellular input data generation \n and stand-alone water calculations.<\/p>", "creators": [ { diff --git a/DESCRIPTION b/DESCRIPTION index 923ccdb6..bb91b6af 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,11 +1,11 @@ Type: Package Package: mrwater Title: madrat based MAgPIE water Input Data Library -Version: 1.5.22 +Version: 1.6.1 URL: https://github.com/pik-piam/mrwater, https: //doi.org/10.5281/zenodo.5801680 License: LGPL-3 | file LICENSE -Date: 2023-03-10 +Date: 2023-03-15 Authors@R: c(person("Felicitas", "Beier", email = "beier@pik-potsdam.de", role = c("aut","cre")), person("Jens", "Heinke", email = "heinke@pik-potsdam.de", role = "aut"), person("Kristine", "Karstens", email = "karstens@pik-potsdam.de", role = "aut"), diff --git a/R/calcEnvmtlFlowRequirementsShare.R b/R/calcEnvmtlFlowRequirementsShare.R index 3ec0bb6e..95b00bbe 100644 --- a/R/calcEnvmtlFlowRequirementsShare.R +++ b/R/calcEnvmtlFlowRequirementsShare.R @@ -35,7 +35,7 @@ calcEnvmtlFlowRequirementsShare <- function(lpjml, preservationstatus <- strsplit(efrMethod, ":")[[1]][2] # Monthly Discharge from LPJmL based on historical baseline (raw: including variation) - monthlyDischarge <- setYears(calcOutput("LPJmL_new", version = lpjml[["natveg"]], + monthlyDischarge <- setYears(calcOutput("LPJmL_new", version = cfg$readin_version, subtype = "mdischarge", climatetype = cfg$baseline_hist, stage = "raw", years = refYears, aggregate = FALSE), refYears) diff --git a/R/calcGrowingPeriod.R b/R/calcGrowingPeriod.R index 22127a9c..61913acb 100644 --- a/R/calcGrowingPeriod.R +++ b/R/calcGrowingPeriod.R @@ -27,7 +27,14 @@ calcGrowingPeriod <- function(lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", c climatetype = "GSWP3-W5E5:historical", stage = "harmonized2020", yield_ratio = 0.1, cells = "magpiecell") { - cfg <- toolLPJmLVersion(version = lpjml["natveg"], climatetype = climatetype) + 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")) { @@ -51,22 +58,22 @@ calcGrowingPeriod <- function(lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", c # Read sowing and harvest date input (new for LPJmL5) #################################################################################### - lpj2mag <- toolGetMapping("MAgPIE_LPJmL.csv", - type = "sectoral", - where = "mappingfolder") + lpj2mag <- toolGetMapping("MAgPIE_LPJmL.csv", + type = "sectoral", + where = "mappingfolder") # Read yields first - yields <- collapseNames(calcOutput("LPJmL_new", version = lpjml["crop"], - climatetype = climatetype, subtype = "harvest", - stage = "raw", aggregate = FALSE)[, , "irrigated"]) + yields <- collapseNames(calcOutput("LPJmL_new", version = lpjmlReadin["crop"], + climatetype = climatetype, subtype = "harvest", + stage = "raw", aggregate = FALSE)[, , "irrigated"]) # Load Sowing dates from LPJmL (use just rainfed dates since they do not differ for irrigated and rainfed) - sowd <- collapseNames(calcOutput("LPJmL_new", version = lpjml["crop"], - climatetype = climatetype, subtype = "sdate", - stage = "raw", aggregate = FALSE)[, , "rainfed"]) - hard <- collapseNames(calcOutput("LPJmL_new", version = lpjml["crop"], - climatetype = climatetype, subtype = "hdate", - stage = "raw", aggregate = FALSE)[, , "rainfed"]) + sowd <- collapseNames(calcOutput("LPJmL_new", version = lpjmlReadin["crop"], + climatetype = climatetype, subtype = "sdate", + stage = "raw", aggregate = FALSE)[, , "rainfed"]) + hard <- collapseNames(calcOutput("LPJmL_new", version = lpjmlReadin["crop"], + climatetype = climatetype, subtype = "hdate", + stage = "raw", aggregate = FALSE)[, , "rainfed"]) goodCrops <- lpj2mag$MAgPIE[which(lpj2mag$LPJmL %in% getItems(sowd, dim = 3))] badCrops <- lpj2mag$MAgPIE[which(!lpj2mag$LPJmL %in% getItems(sowd, dim = 3))] @@ -241,6 +248,7 @@ calcGrowingPeriod <- function(lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", c goodcells <- ifelse(meanHard[, t, ] >= meanSowd[, t, ], 1, 0) badcells <- ifelse(meanHard[, t, ] >= meanSowd[, t, ], 0, 1) + #nolint start for (month in 1:12) { lastMonthday <- which(daysOfmonth == month)[length(which(daysOfmonth == month))] firstMonthday <- which(daysOfmonth == month)[1] @@ -262,7 +270,7 @@ calcGrowingPeriod <- function(lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", c growdaysPERmonth[, t, month] <- daysGoodcells + daysBadcells } - } + } #nolint end out <- as.magpie(growdaysPERmonth, spatial = 1) @@ -285,11 +293,11 @@ calcGrowingPeriod <- function(lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", c } else if (stage == "harmonized") { # load smoothed data - baseline <- calcOutput("GrowingPeriod", lpjml = lpjml, climatetype = cfg$baseline_hist, + baseline <- calcOutput("GrowingPeriod", lpjml = lpjmlBaseline, climatetype = cfgNatveg$baseline_hist, stage = "smoothed", yield_ratio = yield_ratio, cells = "lpjcell", aggregate = FALSE) - if (climatetype == cfg$baseline_hist) { + if (climatetype == cfgNatveg$baseline_hist) { out <- baseline @@ -299,25 +307,25 @@ calcGrowingPeriod <- function(lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", c stage = "smoothed", yield_ratio = yield_ratio, cells = "lpjcell", aggregate = FALSE) # Harmonize to baseline - out <- toolHarmonize2Baseline(x = x, base = baseline, ref_year = cfg$ref_year_hist) + out <- toolHarmonize2Baseline(x = x, base = baseline, ref_year = cfgNatveg$ref_year_hist) } } else if (stage == "harmonized2020") { # read in historical data for subtype - baseline2020 <- calcOutput("GrowingPeriod", lpjml = lpjml, climatetype = cfg$baseline_gcm, + baseline2020 <- calcOutput("GrowingPeriod", lpjml = lpjmlBaseline, climatetype = cfgNatveg$baseline_gcm, stage = "harmonized", yield_ratio = yield_ratio, cells = "lpjcell", aggregate = FALSE) - if (climatetype == cfg$baseline_gcm) { + if (climatetype == cfgNatveg$baseline_gcm) { out <- baseline2020 } else { - x <- calcOutput("GrowingPeriod", lpjml = lpjml, climatetype = climatetype, + x <- calcOutput("GrowingPeriod", lpjml = lpjmlReadin, climatetype = climatetype, stage = "smoothed", yield_ratio = yield_ratio, cells = "lpjcell", aggregate = FALSE) - out <- toolHarmonize2Baseline(x, baseline2020, ref_year = cfg$ref_year_gcm) + out <- toolHarmonize2Baseline(x, baseline2020, ref_year = cfgNatveg$ref_year_gcm) } } else { diff --git a/README.md b/README.md index fde613ac..4ecf97ef 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # madrat based MAgPIE water Input Data Library -R package **mrwater**, version **1.5.22** +R package **mrwater**, version **1.6.1** [![CRAN status](https://www.r-pkg.org/badges/version/mrwater)](https://cran.r-project.org/package=mrwater) [![R build status](https://github.com/pik-piam/mrwater/workflows/check/badge.svg)](https://github.com/pik-piam/mrwater/actions) [![codecov](https://codecov.io/gh/pik-piam/mrwater/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/mrwater) [![r-universe](https://pik-piam.r-universe.dev/badges/mrwater)](https://pik-piam.r-universe.dev/builds) @@ -48,7 +48,7 @@ In case of questions / problems please contact Felicitas Beier . +Beier F, Heinke J, Karstens K, Bodirsky B, Dietrich J (2023). _mrwater: madrat based MAgPIE water Input Data Library_. R package version 1.6.1, . A BibTeX entry for LaTeX users is @@ -57,7 +57,7 @@ A BibTeX entry for LaTeX users is title = {mrwater: madrat based MAgPIE water Input Data Library}, author = {Felicitas Beier and Jens Heinke and Kristine Karstens and Benjamin Leon Bodirsky and Jan Philipp Dietrich}, year = {2023}, - note = {R package version 1.5.22}, + note = {R package version 1.6.1}, url = {https://github.com/pik-piam/mrwater}, } ``` From fad1c1a3698b4475781962b143474cabb5dfa5b1 Mon Sep 17 00:00:00 2001 From: Felicitas Date: Fri, 24 Mar 2023 14:58:14 +0100 Subject: [PATCH 03/14] development flag --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index bb91b6af..4d014784 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: mrwater Title: madrat based MAgPIE water Input Data Library -Version: 1.6.1 +Version: 1.6.1.9001 URL: https://github.com/pik-piam/mrwater, https: //doi.org/10.5281/zenodo.5801680 License: LGPL-3 | file LICENSE From 45b7ffe6390162ed4877f54eac03cb6922afed5c Mon Sep 17 00:00:00 2001 From: Felicitas Beier Date: Thu, 30 Mar 2023 17:24:01 +0200 Subject: [PATCH 04/14] adjusted to 67420 cells --- DESCRIPTION | 2 +- R/calcGrowingPeriod.R | 55 +++++++++++++++++++++++++++++-------------- 2 files changed, 38 insertions(+), 19 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index bb91b6af..4d014784 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: mrwater Title: madrat based MAgPIE water Input Data Library -Version: 1.6.1 +Version: 1.6.1.9001 URL: https://github.com/pik-piam/mrwater, https: //doi.org/10.5281/zenodo.5801680 License: LGPL-3 | file LICENSE diff --git a/R/calcGrowingPeriod.R b/R/calcGrowingPeriod.R index 61913acb..fd8aa9bf 100644 --- a/R/calcGrowingPeriod.R +++ b/R/calcGrowingPeriod.R @@ -19,12 +19,13 @@ #' #' @importFrom madrat toolGetMapping toolAggregate #' @importFrom magclass collapseNames getItems new.magpie getYears dimSums magpie_expand -#' @importFrom mrcommons toolHarmonize2Baseline toolSmooth toolLPJmLVersion +#' @importFrom mrcommons toolHarmonize2Baseline toolSmooth toolLPJmLVersion toolGetMappingCoord2Country #' #' @export calcGrowingPeriod <- function(lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", crop = "ggcmi_phase3_nchecks_9ca735cb"), - climatetype = "GSWP3-W5E5:historical", stage = "harmonized2020", yield_ratio = 0.1, + climatetype = "GSWP3-W5E5:historical", stage = "harmonized2020", + yield_ratio = 0.1, # nolint cells = "magpiecell") { cfgNatveg <- toolLPJmLVersion(version = lpjml["natveg"], climatetype = climatetype) @@ -119,8 +120,9 @@ calcGrowingPeriod <- function(lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", c dim = 3) yields <- collapseNames(yields[, , goodCrops]) - cell2GLO <- array(c(getItems(yields, dim = 1), - rep("GLO", 59199)), dim = c(59199, 2)) + cell2GLO <- array(c(getItems(yields, dim = 1), + rep("GLO", length(getItems(yields, dim = 1)))), + dim = c(length(getItems(yields, dim = 1)), 2)) gloYields <- toolAggregate(yields, cell2GLO, weight = setYears(area, NULL)) yieldsRatio <- yields / gloYields @@ -135,13 +137,16 @@ calcGrowingPeriod <- function(lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", c #################################################################################### # Step 3 remove wintercrops from both calculations for the northern hemisphere: sowd>180, hard>365 #################################################################################### + # get northern hemisphere cells (where lat > 0) + mapping <- toolGetMappingCoord2Country() + mapping$lat <- as.numeric(gsub("p", ".", gsub(".*\\.", "", mapping$coords))) + cellsNrthnHem <- which(mapping$lat > 0) - cellsNrthnHem <- which(magpie_coord[, 2] > 0) - rmWintercrops <- new.magpie(cells_and_regions = getCells(sowd), - years = getYears(sowd), - names = getNames(sowd), - sets = c("region", "year", "crop"), - fill = 1) + rmWintercrops <- new.magpie(cells_and_regions = getItems(sowd, dim = 1), + years = getItems(sowd, dim = 2), + names = getItems(sowd, dim = 3), + sets = c("x", "y", "iso", "year", "crop"), + fill = 1) # define all crops sowed after 180 days and where sowing date is after harvest date as wintercrops rmWintercrops[cellsNrthnHem, , ] <- ifelse(sowd[cellsNrthnHem, , ] > 180 & @@ -193,7 +198,18 @@ calcGrowingPeriod <- function(lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", c # (reflecting that all crops have been eliminated). #################################################################################### - dams <- readSource("Dams", convert = "onlycorrect") + tmp <- readSource("Dams", convert = "onlycorrect") + tmp <- collapseDim(addLocation(tmp), dim = c("region", "region1")) + + dams <- new.magpie(cells_and_regions = paste(getItems(meanSowd, dim = "x", full = TRUE), + getItems(meanSowd, dim = "y", full = TRUE), + sep = "."), + years = getItems(tmp, dim = 2), + names = getItems(tmp, dim = 3), + sets = c("x", "y", "year", "data"), + fill = 0) + dams[getItems(tmp, dim = 1), , ] <- tmp + getItems(dams, dim = 1, raw = TRUE) <- getItems(meanSowd, dim = 1) for (t in getYears(meanSowd)) { meanSowd[which(dams == 1), t] <- 1 @@ -202,8 +218,8 @@ calcGrowingPeriod <- function(lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", c meanSowd[is.na(meanSowd)] <- 1 meanGrper[is.na(meanGrper)] <- 365 - meanSowd <- round(meanSowd) - meanGrper <- round(meanGrper) + meanSowd <- round(meanSowd) + meanGrper <- round(meanGrper) #################################################################################### @@ -227,8 +243,8 @@ calcGrowingPeriod <- function(lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", c } # mag object for the growing days per month - growdaysPERmonth <- new.magpie(cells_and_regions = getCells(meanSowd), - years = getYears(meanSowd), + growdaysPERmonth <- new.magpie(cells_and_regions = getItems(meanSowd, dim = 1), + years = getItems(meanSowd, dim = 2), names = month, fill = 0) @@ -241,7 +257,7 @@ calcGrowingPeriod <- function(lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", c growdaysPERmonth <- as.array(growdaysPERmonth) # Loop over the months to set the number of days that the growing period lasts in each month - for (t in getYears(meanSowd)) { + for (t in getItems(meanSowd, dim = 2)) { # goodcells are cells in which harvest date is after sowing date, # i.e. the cropping period does not cross the beginning of the year @@ -273,6 +289,7 @@ calcGrowingPeriod <- function(lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", c } #nolint end out <- as.magpie(growdaysPERmonth, spatial = 1) + getSets(out) <- c("x", "y", "iso", "year", "data") if (any(is.na(out))) { stop("calcGrowingPeriod produced NAs") @@ -285,7 +302,8 @@ calcGrowingPeriod <- function(lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", c month <- c("jan", "feb", "mar", "apr", "may", "jun", "jul", "aug", "sep", "oct", "nov", "dec") monthLength <- c(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31) names(monthLength) <- month - out[out > as.magpie(monthLength, spatial = 1)] <- magpie_expand(as.magpie(monthLength, spatial = 1), out)[out > as.magpie(monthLength, spatial = 1)] + out[out > as.magpie(monthLength, spatial = 1)] <- magpie_expand(as.magpie(monthLength, spatial = 1), + out)[out > as.magpie(monthLength, spatial = 1)] out[out < 0] <- 0 } @@ -336,7 +354,8 @@ calcGrowingPeriod <- function(lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", c month <- c("jan", "feb", "mar", "apr", "may", "jun", "jul", "aug", "sep", "oct", "nov", "dec") monthLength <- c(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31) names(monthLength) <- month - out[out > as.magpie(monthLength, spatial = 1)] <- magpie_expand(as.magpie(monthLength, spatial = 1), out)[out > as.magpie(monthLength, spatial = 1)] + out[out > as.magpie(monthLength, spatial = 1)] <- magpie_expand(as.magpie(monthLength, spatial = 1), + out)[out > as.magpie(monthLength, spatial = 1)] out[out < 0] <- 0 if (cells == "magpiecell") { From 0f10216d87299ad7f472aa0adfbd14b7db3b1d5e Mon Sep 17 00:00:00 2001 From: Felicitas Beier Date: Thu, 30 Mar 2023 17:24:23 +0200 Subject: [PATCH 05/14] adjusted calcAvlWater to 67420 cells --- R/calcAvlWater.R | 215 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 215 insertions(+) create mode 100755 R/calcAvlWater.R diff --git a/R/calcAvlWater.R b/R/calcAvlWater.R new file mode 100755 index 00000000..84eab2fc --- /dev/null +++ b/R/calcAvlWater.R @@ -0,0 +1,215 @@ +#' @title calcAvlWater +#' @description This function calculates water availability for MAgPIE retrieved from LPJmL +#' +#' @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): water available in growing period per year; +#' total: total water available throughout the year; +#' monthly: monthly water availability (for further processing, e.g. in calcEnvmtlFlow) +#' @param cells Number of cells to be returned +#' (select "magpiecell" for 59199 cells or "lpjcell" for 67420 cells) +#' +#' @import magclass +#' @import madrat +#' @importFrom mrcommons toolHarmonize2Baseline toolLPJmLVersion +#' +#' @return magpie object in cellular resolution +#' @author Felicitas Beier, Kristine Karstens, Abhijeet Mishra +#' +#' @examples +#' \dontrun{ +#' calcOutput("AvlWater", aggregate = FALSE) +#' } + +calcAvlWater <- function(lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", crop = "ggcmi_phase3_nchecks_9ca735cb"), + climatetype = "GSWP3-W5E5:historical", cells = "magpiecell", + stage = "harmonized2020", seasonality = "grper") { + + 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)) + + ###################################################### + ############ Water availability per cell ############# + # Runoff is distributed across the river basin cells # + # based on discharge-weighted algorithm # + ###################################################### + if (stage %in% c("raw", "smoothed")) { + ### Monthly Discharge (unit (after calcLPJmL): mio. m^3/month) + monthDischargeMAG <- calcOutput("LPJmL_new", subtype = "mdischarge", + stage = "raw", + version = lpjmlReadin["natveg"], + climatetype = climatetype, + aggregate = FALSE) + + ### Monthly Runoff (unit (after calcLPJmL): mio. m^3/month) + monthRunoffMAG <- calcOutput("LPJmL_new", subtype = "mrunoff", + stage = "raw", + version = lpjmlReadin["natveg"], + climatetype = climatetype, + aggregate = FALSE) + + ### Calculate available water per month (monthAvlWat) + # Empty array + monthAvlWat <- monthRunoffMAG + monthAvlWat[, , ] <- NA + + ## River basin water allocation algorithm: + # Read in river structure + rs <- readRDS(system.file("extdata/riverstructure_stn_coord.rds", + package = "mrwater")) + basinCode <- rs$endcell + + if (any(paste(getItems(monthRunoffMAG, dim = "x", full = TRUE), + getItems(monthRunoffMAG, dim = "y", full = TRUE), + sep = ".") != rs$coordinates)) { + stop("Wrong cell ordering of basin in calcAvlWater.R") + } + + # Transform to array (faster calculation) + monthDischargeMAG <- as.array(collapseNames(monthDischargeMAG)) + monthRunoffMAG <- as.array(collapseNames(monthRunoffMAG)) + + # Sum the runoff in all basins and allocate it to the basin cells with discharge as weight + for (basin in unique(basinCode)) { + basinCells <- which(basinCode == basin) + basinRunoff <- colSums(monthRunoffMAG[basinCells, , , drop = FALSE]) + basinDischarge <- colSums(monthDischargeMAG[basinCells, , , drop = FALSE]) + for (month in dimnames(monthAvlWat)[[3]]) { + monthAvlWat[basinCells, , month] <- t(basinRunoff[, month] * + t(monthDischargeMAG[basinCells, , month]) / basinDischarge[, month]) + } + } + # Remove no longer needed objects + rm(basinDischarge, basinRunoff) + + # monthAvlWat contain NA's wherever basinDischarge was 0 -> Replace NA's by 0 + monthAvlWat[is.nan(monthAvlWat)] <- 0 + monthAvlWat <- as.magpie(monthAvlWat, spatial = 1) + + if (stage == "smoothed") { + monthAvlWat <- toolSmooth(monthAvlWat) + } + + ####################### + ##### Aggregation ##### + ####################### + ### Available water per cell per month + if (seasonality == "monthly") { + # Check for NAs + if (any(is.na(monthAvlWat))) { + stop("produced NA water availability") + } + out <- monthAvlWat + + ### Total water available per cell per year + } else if (seasonality == "total") { + # Sum up over all month: + totalAvlWat <- dimSums(monthAvlWat, dim = 3) + # Check for NAs + if (any(is.na(totalAvlWat))) { + stop("produced NA water availability") + } + out <- totalAvlWat + + ### Water available in growing period per cell per year + } else if (seasonality == "grper") { + # magpie object with days per month with same dimension as monthAvlWat + tmp <- c(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31) + monthDAYS <- new.magpie(names = dimnames(monthAvlWat)[[3]]) + monthDAYS[, , ] <- tmp + monthDayMAG <- as.magpie(monthAvlWat) + monthDayMAG[, , ] <- 1 + monthDayMAG <- monthDayMAG * monthDAYS + + # Daily water availability + dailyAvlWat <- monthAvlWat / monthDayMAG + + # Growing days per month + growDAYS <- calcOutput("GrowingPeriod", cells = "lpjcell", + lpjml = lpjmlReadin, climatetype = climatetype, + stage = stage, yield_ratio = 0.1, aggregate = FALSE) + + # Adjust years + yearsWAT <- getYears(dailyAvlWat) + yearsGRPER <- getYears(growDAYS) + if (length(yearsWAT) >= length(yearsGRPER)) { + years <- yearsGRPER + } else { + years <- yearsWAT + } + rm(yearsGRPER, yearsWAT) + + # Available water in growing period per month + grperAvlWat <- dailyAvlWat[, years, ] * growDAYS[, years, ] + # Available water in growing period per year + grperAvlWat <- dimSums(grperAvlWat, dim = 3) + + # Check for NAs + if (any(is.na(grperAvlWat))) { + stop("produced NA water availability") + } + out <- grperAvlWat + } else { + stop("Please specify seasonality: monthly, total or grper") + } + + } else if (stage == "harmonized") { + # load smoothed data + baseline <- calcOutput("AvlWater", cells = "lpjcell", + lpjml = lpjmlBaseline, climatetype = cfgNatveg$baseline_hist, + seasonality = seasonality, aggregate = FALSE, stage = "smoothed") + + if (climatetype == cfgNatveg$baseline_hist) { + + out <- baseline + + } else { + + x <- calcOutput("AvlWater", cells = "lpjcell", + lpjml = lpjmlReadin, climatetype = climatetype, + seasonality = seasonality, aggregate = FALSE, stage = "smoothed") + # Harmonize to baseline + out <- toolHarmonize2Baseline(x = x, base = baseline, ref_year = cfgNatveg$ref_year_hist) + } + + } else if (stage == "harmonized2020") { + # read in historical data for subtype + baseline2020 <- calcOutput("AvlWater", cells = "lpjcell", + lpjml = lpjmlBaseline, climatetype = cfgNatveg$baseline_gcm, + seasonality = seasonality, aggregate = FALSE, stage = "harmonized") + + if (climatetype == cfgNatveg$baseline_gcm) { + out <- baseline2020 + + } else { + + x <- calcOutput("AvlWater", stage = "smoothed", cells = "lpjcell", + lpjml = lpjmlReadin, climatetype = climatetype, + seasonality = seasonality, + aggregate = FALSE) + out <- toolHarmonize2Baseline(x, baseline2020, ref_year = cfgNatveg$ref_year_gcm) + } + + } else { + stop("Stage argument not supported!") + } + + description <- paste0("Available water in ", seasonality) + + if (cells == "magpiecell") { + out <- toolCoord2Isocell(out) + } + + return(list(x = out, + weight = NULL, + unit = "mio. m^3", + description = description, + isocountries = FALSE)) +} From c26a6cc59063820d1701120dfb963a43dac275c7 Mon Sep 17 00:00:00 2001 From: Felicitas Beier Date: Thu, 30 Mar 2023 17:37:00 +0200 Subject: [PATCH 06/14] updated dev flag --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 4d014784..7bb695e0 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: mrwater Title: madrat based MAgPIE water Input Data Library -Version: 1.6.1.9001 +Version: 1.6.1.9002 URL: https://github.com/pik-piam/mrwater, https: //doi.org/10.5281/zenodo.5801680 License: LGPL-3 | file LICENSE From 0c1168cd3fd39bf8a733dbed3e57b27a332d583c Mon Sep 17 00:00:00 2001 From: Felicitas Date: Fri, 31 Mar 2023 09:48:24 +0200 Subject: [PATCH 07/14] buildLibrary and dev version increment --- .Rbuildignore | 1 + .buildlibrary | 2 +- .zenodo.json | 22 ---------------------- CITATION.cff | 27 +++++++++++++++++++++++++++ DESCRIPTION | 4 ++-- README.md | 6 +++--- man/calcAvlWater.Rd | 43 +++++++++++++++++++++++++++++++++++++++++++ 7 files changed, 77 insertions(+), 28 deletions(-) delete mode 100644 .zenodo.json create mode 100644 CITATION.cff create mode 100644 man/calcAvlWater.Rd diff --git a/.Rbuildignore b/.Rbuildignore index 4f751c22..56ef0af5 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -10,3 +10,4 @@ ^tests/.lintr$ ^vignettes/.lintr$ ^Makefile$ +^.*CITATION.cff$ diff --git a/.buildlibrary b/.buildlibrary index 42d02337..f04dea3f 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '3128391' +ValidationKey: '31484751341' AcceptedWarnings: - 'Warning: package ''.*'' was built under R version' - 'Warning: namespace ''.*'' is not available and has been replaced' diff --git a/.zenodo.json b/.zenodo.json deleted file mode 100644 index e16edef0..00000000 --- a/.zenodo.json +++ /dev/null @@ -1,22 +0,0 @@ -{ - "title": "mrwater: madrat based MAgPIE water Input Data Library", - "version": "1.6.1", - "description": "

Provides functions for MAgPIE cellular input data generation \n and stand-alone water calculations.<\/p>", - "creators": [ - { - "name": "Beier, Felicitas" - }, - { - "name": "Heinke, Jens" - }, - { - "name": "Karstens, Kristine" - }, - { - "name": "Bodirsky, Benjamin Leon" - }, - { - "name": "Dietrich, Jan Philipp" - } - ] -} diff --git a/CITATION.cff b/CITATION.cff new file mode 100644 index 00000000..1afa5a27 --- /dev/null +++ b/CITATION.cff @@ -0,0 +1,27 @@ +cff-version: 1.2.0 +message: If you use this software, please cite it using the metadata from this file. +type: software +title: 'mrwater: madrat based MAgPIE water Input Data Library' +version: 1.6.1.9003 +date-released: '2023-03-31' +abstract: Provides functions for MAgPIE cellular input data generation and stand-alone + water calculations. +authors: +- family-names: Beier + given-names: Felicitas + email: beier@pik-potsdam.de +- family-names: Heinke + given-names: Jens + email: heinke@pik-potsdam.de +- family-names: Karstens + given-names: Kristine + email: karstens@pik-potsdam.de +- family-names: Bodirsky + given-names: Benjamin Leon + email: bodirsky@pik-potsdam.de +- family-names: Dietrich + given-names: Jan Philipp + email: dietrich@pik-potsdam.de +license: LGPL-3.0 +repository-code: https://github.com/pik-piam/mrwater + diff --git a/DESCRIPTION b/DESCRIPTION index 7bb695e0..e4ef22f8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,11 +1,11 @@ Type: Package Package: mrwater Title: madrat based MAgPIE water Input Data Library -Version: 1.6.1.9002 +Version: 1.6.1.9003 URL: https://github.com/pik-piam/mrwater, https: //doi.org/10.5281/zenodo.5801680 License: LGPL-3 | file LICENSE -Date: 2023-03-15 +Date: 2023-03-31 Authors@R: c(person("Felicitas", "Beier", email = "beier@pik-potsdam.de", role = c("aut","cre")), person("Jens", "Heinke", email = "heinke@pik-potsdam.de", role = "aut"), person("Kristine", "Karstens", email = "karstens@pik-potsdam.de", role = "aut"), diff --git a/README.md b/README.md index 4ecf97ef..0617ad34 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # madrat based MAgPIE water Input Data Library -R package **mrwater**, version **1.6.1** +R package **mrwater**, version **1.6.1.9003** [![CRAN status](https://www.r-pkg.org/badges/version/mrwater)](https://cran.r-project.org/package=mrwater) [![R build status](https://github.com/pik-piam/mrwater/workflows/check/badge.svg)](https://github.com/pik-piam/mrwater/actions) [![codecov](https://codecov.io/gh/pik-piam/mrwater/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/mrwater) [![r-universe](https://pik-piam.r-universe.dev/badges/mrwater)](https://pik-piam.r-universe.dev/builds) @@ -48,7 +48,7 @@ In case of questions / problems please contact Felicitas Beier . +Beier F, Heinke J, Karstens K, Bodirsky B, Dietrich J (2023). _mrwater: madrat based MAgPIE water Input Data Library_. R package version 1.6.1.9003, . A BibTeX entry for LaTeX users is @@ -57,7 +57,7 @@ A BibTeX entry for LaTeX users is title = {mrwater: madrat based MAgPIE water Input Data Library}, author = {Felicitas Beier and Jens Heinke and Kristine Karstens and Benjamin Leon Bodirsky and Jan Philipp Dietrich}, year = {2023}, - note = {R package version 1.6.1}, + note = {R package version 1.6.1.9003}, url = {https://github.com/pik-piam/mrwater}, } ``` diff --git a/man/calcAvlWater.Rd b/man/calcAvlWater.Rd new file mode 100644 index 00000000..158d3a4e --- /dev/null +++ b/man/calcAvlWater.Rd @@ -0,0 +1,43 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/calcAvlWater.R +\name{calcAvlWater} +\alias{calcAvlWater} +\title{calcAvlWater} +\usage{ +calcAvlWater( + lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", crop = + "ggcmi_phase3_nchecks_9ca735cb"), + climatetype = "GSWP3-W5E5:historical", + cells = "magpiecell", + 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{cells}{Number of cells to be returned +(select "magpiecell" for 59199 cells or "lpjcell" for 67420 cells)} + +\item{stage}{Degree of processing: raw, smoothed, harmonized, harmonized2020} + +\item{seasonality}{grper (default): water available in growing period per year; +total: total water available throughout the year; +monthly: monthly water availability (for further processing, e.g. in calcEnvmtlFlow)} +} +\value{ +magpie object in cellular resolution +} +\description{ +This function calculates water availability for MAgPIE retrieved from LPJmL +} +\examples{ +\dontrun{ +calcOutput("AvlWater", aggregate = FALSE) +} +} +\author{ +Felicitas Beier, Kristine Karstens, Abhijeet Mishra +} From c535ea2c74ac1cd436bf3045b0377f9febb3961b Mon Sep 17 00:00:00 2001 From: Felicitas Beier Date: Fri, 31 Mar 2023 15:48:16 +0200 Subject: [PATCH 08/14] bugfixes in calcGrowingPeriod --- .buildlibrary | 2 +- CITATION.cff | 2 +- DESCRIPTION | 2 +- R/calcGrowingPeriod.R | 21 ++++++++++----------- README.md | 6 +++--- 5 files changed, 16 insertions(+), 17 deletions(-) diff --git a/.buildlibrary b/.buildlibrary index f04dea3f..e017f1e7 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '31484751341' +ValidationKey: '31484770788' AcceptedWarnings: - 'Warning: package ''.*'' was built under R version' - 'Warning: namespace ''.*'' is not available and has been replaced' diff --git a/CITATION.cff b/CITATION.cff index 1afa5a27..381083d4 100644 --- a/CITATION.cff +++ b/CITATION.cff @@ -2,7 +2,7 @@ cff-version: 1.2.0 message: If you use this software, please cite it using the metadata from this file. type: software title: 'mrwater: madrat based MAgPIE water Input Data Library' -version: 1.6.1.9003 +version: 1.6.1.9004 date-released: '2023-03-31' abstract: Provides functions for MAgPIE cellular input data generation and stand-alone water calculations. diff --git a/DESCRIPTION b/DESCRIPTION index e4ef22f8..9ab06646 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: mrwater Title: madrat based MAgPIE water Input Data Library -Version: 1.6.1.9003 +Version: 1.6.1.9004 URL: https://github.com/pik-piam/mrwater, https: //doi.org/10.5281/zenodo.5801680 License: LGPL-3 | file LICENSE diff --git a/R/calcGrowingPeriod.R b/R/calcGrowingPeriod.R index 97f14bec..2c42200d 100644 --- a/R/calcGrowingPeriod.R +++ b/R/calcGrowingPeriod.R @@ -299,8 +299,8 @@ calcGrowingPeriod <- function(lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", month <- c("jan", "feb", "mar", "apr", "may", "jun", "jul", "aug", "sep", "oct", "nov", "dec") monthLength <- c(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31) names(monthLength) <- month - out[out > as.magpie(monthLength, spatial = 1)] <- magpie_expand(as.magpie(monthLength, spatial = 1), - out)[out > as.magpie(monthLength, spatial = 1)] + out[out > as.magpie(monthLength)] <- magpie_expand(as.magpie(monthLength), + out)[out > as.magpie(monthLength)] out[out < 0] <- 0 } @@ -328,19 +328,18 @@ calcGrowingPeriod <- function(lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", } else if (stage == "harmonized2020") { # read in historical data for subtype - baseline2020 <- calcOutput("GrowingPeriod", lpjml = lpjmlBaseline, climatetype = cfgNatveg$baseline_gcm, + baseline2020 <- calcOutput("GrowingPeriod", lpjml = lpjmlBaseline, climatetype = cfgNatveg$baseline_gcm, stage = "harmonized", yield_ratio = yield_ratio, - cells = "lpjcell", aggregate = FALSE) + cells = "lpjcell", aggregate = FALSE) if (climatetype == cfgNatveg$baseline_gcm) { out <- baseline2020 - } else { - x <- calcOutput("GrowingPeriod", lpjml = lpjmlReadin, climatetype = climatetype, - stage = "smoothed", yield_ratio = yield_ratio, - cells = "lpjcell", aggregate = FALSE) + x <- calcOutput("GrowingPeriod", lpjml = lpjmlReadin, climatetype = climatetype, + stage = "smoothed", yield_ratio = yield_ratio, + cells = "lpjcell", aggregate = FALSE) out <- toolHarmonize2Baseline(x, baseline2020, ref_year = cfgNatveg$ref_year_gcm) } @@ -352,12 +351,12 @@ calcGrowingPeriod <- function(lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", month <- c("jan", "feb", "mar", "apr", "may", "jun", "jul", "aug", "sep", "oct", "nov", "dec") monthLength <- c(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31) names(monthLength) <- month - out[out > as.magpie(monthLength, spatial = 1)] <- magpie_expand(as.magpie(monthLength, spatial = 1), - out)[out > as.magpie(monthLength, spatial = 1)] + out[out > as.magpie(monthLength)] <- magpie_expand(as.magpie(monthLength), + out)[out > as.magpie(monthLength)] out[out < 0] <- 0 if (cells == "magpiecell") { - out <- toolCoord2Isocell(out) + out <- toolCoord2Isocell(out, cells = cells) } return(list(x = out, diff --git a/README.md b/README.md index 0617ad34..ea4af8a2 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # madrat based MAgPIE water Input Data Library -R package **mrwater**, version **1.6.1.9003** +R package **mrwater**, version **1.6.1.9004** [![CRAN status](https://www.r-pkg.org/badges/version/mrwater)](https://cran.r-project.org/package=mrwater) [![R build status](https://github.com/pik-piam/mrwater/workflows/check/badge.svg)](https://github.com/pik-piam/mrwater/actions) [![codecov](https://codecov.io/gh/pik-piam/mrwater/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/mrwater) [![r-universe](https://pik-piam.r-universe.dev/badges/mrwater)](https://pik-piam.r-universe.dev/builds) @@ -48,7 +48,7 @@ In case of questions / problems please contact Felicitas Beier . +Beier F, Heinke J, Karstens K, Bodirsky B, Dietrich J (2023). _mrwater: madrat based MAgPIE water Input Data Library_. R package version 1.6.1.9004, . A BibTeX entry for LaTeX users is @@ -57,7 +57,7 @@ A BibTeX entry for LaTeX users is title = {mrwater: madrat based MAgPIE water Input Data Library}, author = {Felicitas Beier and Jens Heinke and Kristine Karstens and Benjamin Leon Bodirsky and Jan Philipp Dietrich}, year = {2023}, - note = {R package version 1.6.1.9003}, + note = {R package version 1.6.1.9004}, url = {https://github.com/pik-piam/mrwater}, } ``` From c9832800169e8aa2268a2c7816006f948b8cff0f Mon Sep 17 00:00:00 2001 From: Felicitas Beier Date: Mon, 3 Apr 2023 13:47:54 +0200 Subject: [PATCH 09/14] bugfix in calcAvlWater related to arrays and magpie objects --- .buildlibrary | 2 +- CITATION.cff | 4 ++-- DESCRIPTION | 4 ++-- R/calcAvlWater.R | 10 +++++----- README.md | 6 +++--- 5 files changed, 13 insertions(+), 13 deletions(-) diff --git a/.buildlibrary b/.buildlibrary index e017f1e7..b6097f60 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '31484770788' +ValidationKey: '31489647250' AcceptedWarnings: - 'Warning: package ''.*'' was built under R version' - 'Warning: namespace ''.*'' is not available and has been replaced' diff --git a/CITATION.cff b/CITATION.cff index 381083d4..3f4862ae 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: 'mrwater: madrat based MAgPIE water Input Data Library' -version: 1.6.1.9004 -date-released: '2023-03-31' +version: 1.6.1.9005 +date-released: '2023-04-03' abstract: Provides functions for MAgPIE cellular input data generation and stand-alone water calculations. authors: diff --git a/DESCRIPTION b/DESCRIPTION index 9ab06646..0a18aa15 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,11 +1,11 @@ Type: Package Package: mrwater Title: madrat based MAgPIE water Input Data Library -Version: 1.6.1.9004 +Version: 1.6.1.9005 URL: https://github.com/pik-piam/mrwater, https: //doi.org/10.5281/zenodo.5801680 License: LGPL-3 | file LICENSE -Date: 2023-03-31 +Date: 2023-04-03 Authors@R: c(person("Felicitas", "Beier", email = "beier@pik-potsdam.de", role = c("aut","cre")), person("Jens", "Heinke", email = "heinke@pik-potsdam.de", role = "aut"), person("Kristine", "Karstens", email = "karstens@pik-potsdam.de", role = "aut"), diff --git a/R/calcAvlWater.R b/R/calcAvlWater.R index 84eab2fc..0f30ef06 100755 --- a/R/calcAvlWater.R +++ b/R/calcAvlWater.R @@ -55,11 +55,6 @@ calcAvlWater <- function(lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", crop = climatetype = climatetype, aggregate = FALSE) - ### Calculate available water per month (monthAvlWat) - # Empty array - monthAvlWat <- monthRunoffMAG - monthAvlWat[, , ] <- NA - ## River basin water allocation algorithm: # Read in river structure rs <- readRDS(system.file("extdata/riverstructure_stn_coord.rds", @@ -76,6 +71,11 @@ calcAvlWater <- function(lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", crop = monthDischargeMAG <- as.array(collapseNames(monthDischargeMAG)) monthRunoffMAG <- as.array(collapseNames(monthRunoffMAG)) + ### Calculate available water per month (monthAvlWat) + # Empty array + monthAvlWat <- monthRunoffMAG + monthAvlWat[, , ] <- NA + # Sum the runoff in all basins and allocate it to the basin cells with discharge as weight for (basin in unique(basinCode)) { basinCells <- which(basinCode == basin) diff --git a/README.md b/README.md index ea4af8a2..683aa518 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # madrat based MAgPIE water Input Data Library -R package **mrwater**, version **1.6.1.9004** +R package **mrwater**, version **1.6.1.9005** [![CRAN status](https://www.r-pkg.org/badges/version/mrwater)](https://cran.r-project.org/package=mrwater) [![R build status](https://github.com/pik-piam/mrwater/workflows/check/badge.svg)](https://github.com/pik-piam/mrwater/actions) [![codecov](https://codecov.io/gh/pik-piam/mrwater/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/mrwater) [![r-universe](https://pik-piam.r-universe.dev/badges/mrwater)](https://pik-piam.r-universe.dev/builds) @@ -48,7 +48,7 @@ In case of questions / problems please contact Felicitas Beier . +Beier F, Heinke J, Karstens K, Bodirsky B, Dietrich J (2023). _mrwater: madrat based MAgPIE water Input Data Library_. R package version 1.6.1.9005, . A BibTeX entry for LaTeX users is @@ -57,7 +57,7 @@ A BibTeX entry for LaTeX users is title = {mrwater: madrat based MAgPIE water Input Data Library}, author = {Felicitas Beier and Jens Heinke and Kristine Karstens and Benjamin Leon Bodirsky and Jan Philipp Dietrich}, year = {2023}, - note = {R package version 1.6.1.9004}, + note = {R package version 1.6.1.9005}, url = {https://github.com/pik-piam/mrwater}, } ``` From f62e6d523850d429cd7da025ea4b9b2a759aaa5b Mon Sep 17 00:00:00 2001 From: Felicitas Beier Date: Mon, 3 Apr 2023 20:46:12 +0200 Subject: [PATCH 10/14] bugfix related to 67k cells in calWaterUseNonAg for grper --- .buildlibrary | 2 +- CITATION.cff | 2 +- DESCRIPTION | 2 +- R/calcWaterUseNonAg.R | 2 +- README.md | 6 +++--- 5 files changed, 7 insertions(+), 7 deletions(-) diff --git a/.buildlibrary b/.buildlibrary index b6097f60..7b145ddd 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '31489647250' +ValidationKey: '31489666700' AcceptedWarnings: - 'Warning: package ''.*'' was built under R version' - 'Warning: namespace ''.*'' is not available and has been replaced' diff --git a/CITATION.cff b/CITATION.cff index 3f4862ae..0cdd478c 100644 --- a/CITATION.cff +++ b/CITATION.cff @@ -2,7 +2,7 @@ cff-version: 1.2.0 message: If you use this software, please cite it using the metadata from this file. type: software title: 'mrwater: madrat based MAgPIE water Input Data Library' -version: 1.6.1.9005 +version: 1.6.1.9006 date-released: '2023-04-03' abstract: Provides functions for MAgPIE cellular input data generation and stand-alone water calculations. diff --git a/DESCRIPTION b/DESCRIPTION index 0a18aa15..6441623f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: mrwater Title: madrat based MAgPIE water Input Data Library -Version: 1.6.1.9005 +Version: 1.6.1.9006 URL: https://github.com/pik-piam/mrwater, https: //doi.org/10.5281/zenodo.5801680 License: LGPL-3 | file LICENSE diff --git a/R/calcWaterUseNonAg.R b/R/calcWaterUseNonAg.R index cc2d0bc7..960a8b7b 100644 --- a/R/calcWaterUseNonAg.R +++ b/R/calcWaterUseNonAg.R @@ -316,7 +316,7 @@ calcWaterUseNonAg <- function(selectyears = seq(1995, 2100, by = 5), cells = "ma ### Note: Seasonality "grper" will be deleted when we switch to new mrwater preprocessing # Get growing days per month - growDays <- calcOutput("GrowingPeriod", aggregate = FALSE, + growDays <- calcOutput("GrowingPeriod", aggregate = FALSE, cells = "lpjcell", lpjml = lpjml, climatetype = climatetype, yield_ratio = 0.1) # Growing days per year diff --git a/README.md b/README.md index 683aa518..88ff9439 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # madrat based MAgPIE water Input Data Library -R package **mrwater**, version **1.6.1.9005** +R package **mrwater**, version **1.6.1.9006** [![CRAN status](https://www.r-pkg.org/badges/version/mrwater)](https://cran.r-project.org/package=mrwater) [![R build status](https://github.com/pik-piam/mrwater/workflows/check/badge.svg)](https://github.com/pik-piam/mrwater/actions) [![codecov](https://codecov.io/gh/pik-piam/mrwater/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/mrwater) [![r-universe](https://pik-piam.r-universe.dev/badges/mrwater)](https://pik-piam.r-universe.dev/builds) @@ -48,7 +48,7 @@ In case of questions / problems please contact Felicitas Beier . +Beier F, Heinke J, Karstens K, Bodirsky B, Dietrich J (2023). _mrwater: madrat based MAgPIE water Input Data Library_. R package version 1.6.1.9006, . A BibTeX entry for LaTeX users is @@ -57,7 +57,7 @@ A BibTeX entry for LaTeX users is title = {mrwater: madrat based MAgPIE water Input Data Library}, author = {Felicitas Beier and Jens Heinke and Kristine Karstens and Benjamin Leon Bodirsky and Jan Philipp Dietrich}, year = {2023}, - note = {R package version 1.6.1.9005}, + note = {R package version 1.6.1.9006}, url = {https://github.com/pik-piam/mrwater}, } ``` From 35be310c63915d2ceb055bd01a16850a28f3283e Mon Sep 17 00:00:00 2001 From: Felicitas Date: Fri, 21 Apr 2023 12:40:45 +0200 Subject: [PATCH 11/14] development version number added --- .buildlibrary | 2 +- CITATION.cff | 4 ++-- DESCRIPTION | 4 ++-- README.md | 6 +++--- 4 files changed, 8 insertions(+), 8 deletions(-) diff --git a/.buildlibrary b/.buildlibrary index bf1ded7c..3438a178 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '3173121' +ValidationKey: '31908071468' AcceptedWarnings: - 'Warning: package ''.*'' was built under R version' - 'Warning: namespace ''.*'' is not available and has been replaced' diff --git a/CITATION.cff b/CITATION.cff index 93126a6d..e266a327 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: 'mrwater: madrat based MAgPIE water Input Data Library' -version: 1.6.3 -date-released: '2023-04-20' +version: 1.6.3.9001 +date-released: '2023-04-21' abstract: Provides functions for MAgPIE cellular input data generation and stand-alone water calculations. authors: diff --git a/DESCRIPTION b/DESCRIPTION index e39397da..b321343e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,11 +1,11 @@ Type: Package Package: mrwater Title: madrat based MAgPIE water Input Data Library -Version: 1.6.3 +Version: 1.6.3.9001 URL: https://github.com/pik-piam/mrwater, https: //doi.org/10.5281/zenodo.5801680 License: LGPL-3 | file LICENSE -Date: 2023-04-20 +Date: 2023-04-21 Authors@R: c(person("Felicitas", "Beier", email = "beier@pik-potsdam.de", role = c("aut","cre")), person("Jens", "Heinke", email = "heinke@pik-potsdam.de", role = "aut"), person("Kristine", "Karstens", email = "karstens@pik-potsdam.de", role = "aut"), diff --git a/README.md b/README.md index cb666c5d..d1660a0d 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # madrat based MAgPIE water Input Data Library -R package **mrwater**, version **1.6.3** +R package **mrwater**, version **1.6.3.9001** [![CRAN status](https://www.r-pkg.org/badges/version/mrwater)](https://cran.r-project.org/package=mrwater) [![R build status](https://github.com/pik-piam/mrwater/workflows/check/badge.svg)](https://github.com/pik-piam/mrwater/actions) [![codecov](https://codecov.io/gh/pik-piam/mrwater/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/mrwater) [![r-universe](https://pik-piam.r-universe.dev/badges/mrwater)](https://pik-piam.r-universe.dev/builds) @@ -48,7 +48,7 @@ In case of questions / problems please contact Felicitas Beier . +Beier F, Heinke J, Karstens K, Bodirsky B, Dietrich J (2023). _mrwater: madrat based MAgPIE water Input Data Library_. R package version 1.6.3.9001, . A BibTeX entry for LaTeX users is @@ -57,7 +57,7 @@ A BibTeX entry for LaTeX users is title = {mrwater: madrat based MAgPIE water Input Data Library}, author = {Felicitas Beier and Jens Heinke and Kristine Karstens and Benjamin Leon Bodirsky and Jan Philipp Dietrich}, year = {2023}, - note = {R package version 1.6.3}, + note = {R package version 1.6.3.9001}, url = {https://github.com/pik-piam/mrwater}, } ``` From 2605ad7a574885c2e562863695465534e75b0161 Mon Sep 17 00:00:00 2001 From: Felicitas Beier Date: Thu, 27 Apr 2023 16:56:25 +0200 Subject: [PATCH 12/14] bugfix in treatment of 59k cells --- .buildlibrary | 2 +- CITATION.cff | 4 ++-- DESCRIPTION | 4 ++-- R/calcWaterUseNonAg.R | 22 ++++++++++------------ README.md | 6 +++--- 5 files changed, 18 insertions(+), 20 deletions(-) diff --git a/.buildlibrary b/.buildlibrary index 3438a178..fea54ae7 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '31908071468' +ValidationKey: '31917924948' AcceptedWarnings: - 'Warning: package ''.*'' was built under R version' - 'Warning: namespace ''.*'' is not available and has been replaced' diff --git a/CITATION.cff b/CITATION.cff index e266a327..4ea0fdaa 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: 'mrwater: madrat based MAgPIE water Input Data Library' -version: 1.6.3.9001 -date-released: '2023-04-21' +version: 1.6.3.9002 +date-released: '2023-04-27' abstract: Provides functions for MAgPIE cellular input data generation and stand-alone water calculations. authors: diff --git a/DESCRIPTION b/DESCRIPTION index b321343e..f5fd96e7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,11 +1,11 @@ Type: Package Package: mrwater Title: madrat based MAgPIE water Input Data Library -Version: 1.6.3.9001 +Version: 1.6.3.9002 URL: https://github.com/pik-piam/mrwater, https: //doi.org/10.5281/zenodo.5801680 License: LGPL-3 | file LICENSE -Date: 2023-04-21 +Date: 2023-04-27 Authors@R: c(person("Felicitas", "Beier", email = "beier@pik-potsdam.de", role = c("aut","cre")), person("Jens", "Heinke", email = "heinke@pik-potsdam.de", role = "aut"), person("Kristine", "Karstens", email = "karstens@pik-potsdam.de", role = "aut"), diff --git a/R/calcWaterUseNonAg.R b/R/calcWaterUseNonAg.R index 960a8b7b..609647e4 100644 --- a/R/calcWaterUseNonAg.R +++ b/R/calcWaterUseNonAg.R @@ -297,18 +297,6 @@ calcWaterUseNonAg <- function(selectyears = seq(1995, 2100, by = 5), cells = "ma # Correct mismatches of withdrawal and consumption (withdrawals > consumption) watdemNonAg[, , "withdrawal"] <- pmax(watdemNonAg[, , "withdrawal"], watdemNonAg[, , "consumption"]) watdemNonAg[, , "consumption"] <- pmax(watdemNonAg[, , "consumption"], 0.01 * watdemNonAg[, , "withdrawal"]) - - # Number of cells to be returned - if (cells == "magpiecell") { - - watdemNonAg <- toolCoord2Isocell(watdemNonAg) - - } else if (cells == "lpjcell") { - # Correct cell naming - getCells(watdemNonAg) <- paste(map$coords, map$iso, sep = ".") - getSets(watdemNonAg, fulldim = FALSE)[1] <- "x.y.iso" - - } } ### Non-agricultural water demands in Growing Period @@ -356,6 +344,16 @@ calcWaterUseNonAg <- function(selectyears = seq(1995, 2100, by = 5), cells = "ma out <- collapseNames(out[, , abstractiontype]) } + # Number of cells to be returned + if (cells == "magpiecell") { + out <- toolCoord2Isocell(out) + } else if (cells == "lpjcell") { + # Correct cell naming + out <- out[selectcells, , ] + getItems(out, raw = TRUE) <- paste(map$coords, map$iso, sep = ".") + getSets(out, fulldim = FALSE)[1] <- "x.y.iso" + } + # Check for NAs if (any(is.na(out))) { stop("produced NA watdemNonAg") diff --git a/README.md b/README.md index d1660a0d..0db1ab03 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # madrat based MAgPIE water Input Data Library -R package **mrwater**, version **1.6.3.9001** +R package **mrwater**, version **1.6.3.9002** [![CRAN status](https://www.r-pkg.org/badges/version/mrwater)](https://cran.r-project.org/package=mrwater) [![R build status](https://github.com/pik-piam/mrwater/workflows/check/badge.svg)](https://github.com/pik-piam/mrwater/actions) [![codecov](https://codecov.io/gh/pik-piam/mrwater/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/mrwater) [![r-universe](https://pik-piam.r-universe.dev/badges/mrwater)](https://pik-piam.r-universe.dev/builds) @@ -48,7 +48,7 @@ In case of questions / problems please contact Felicitas Beier . +Beier F, Heinke J, Karstens K, Bodirsky B, Dietrich J (2023). _mrwater: madrat based MAgPIE water Input Data Library_. R package version 1.6.3.9002, . A BibTeX entry for LaTeX users is @@ -57,7 +57,7 @@ A BibTeX entry for LaTeX users is title = {mrwater: madrat based MAgPIE water Input Data Library}, author = {Felicitas Beier and Jens Heinke and Kristine Karstens and Benjamin Leon Bodirsky and Jan Philipp Dietrich}, year = {2023}, - note = {R package version 1.6.3.9001}, + note = {R package version 1.6.3.9002}, url = {https://github.com/pik-piam/mrwater}, } ``` From 4185d388a8bbbdfc5f6a8eb8eb1bcdf068ca2788 Mon Sep 17 00:00:00 2001 From: Felicitas Beier Date: Thu, 27 Apr 2023 17:13:48 +0200 Subject: [PATCH 13/14] bugfix of bugfix --- DESCRIPTION | 2 +- R/calcWaterUseNonAg.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index f5fd96e7..002e710e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: mrwater Title: madrat based MAgPIE water Input Data Library -Version: 1.6.3.9002 +Version: 1.6.3.9003 URL: https://github.com/pik-piam/mrwater, https: //doi.org/10.5281/zenodo.5801680 License: LGPL-3 | file LICENSE diff --git a/R/calcWaterUseNonAg.R b/R/calcWaterUseNonAg.R index 609647e4..d84a5114 100644 --- a/R/calcWaterUseNonAg.R +++ b/R/calcWaterUseNonAg.R @@ -350,7 +350,7 @@ calcWaterUseNonAg <- function(selectyears = seq(1995, 2100, by = 5), cells = "ma } else if (cells == "lpjcell") { # Correct cell naming out <- out[selectcells, , ] - getItems(out, raw = TRUE) <- paste(map$coords, map$iso, sep = ".") + getItems(out, dim = 1, raw = TRUE) <- paste(map$coords, map$iso, sep = ".") getSets(out, fulldim = FALSE)[1] <- "x.y.iso" } From 95330812bfed1631988d40dc9d42c89ed70a4d6d Mon Sep 17 00:00:00 2001 From: Felicitas Date: Tue, 27 Jun 2023 17:25:40 +0200 Subject: [PATCH 14/14] switched default to lpjcell --- .buildlibrary | 2 +- CITATION.cff | 2 +- DESCRIPTION | 2 +- R/calcAvlWater.R | 2 +- R/calcGrowingPeriod.R | 2 +- R/calcWaterUseNonAg.R | 2 +- README.md | 6 +++--- man/calcAvlWater.Rd | 2 +- man/calcGrowingPeriod.Rd | 2 +- man/calcWaterUseNonAg.Rd | 2 +- 10 files changed, 12 insertions(+), 12 deletions(-) diff --git a/.buildlibrary b/.buildlibrary index 7f2ddc41..1cc09c0b 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '316626625534' +ValidationKey: '316626645068' AcceptedWarnings: - 'Warning: package ''.*'' was built under R version' - 'Warning: namespace ''.*'' is not available and has been replaced' diff --git a/CITATION.cff b/CITATION.cff index 90d332b5..1087b435 100644 --- a/CITATION.cff +++ b/CITATION.cff @@ -2,7 +2,7 @@ cff-version: 1.2.0 message: If you use this software, please cite it using the metadata from this file. type: software title: 'mrwater: madrat based MAgPIE water Input Data Library' -version: 1.6.20.9001 +version: 1.6.20.9002 date-released: '2023-06-26' abstract: Provides functions for MAgPIE cellular input data generation and stand-alone water calculations. diff --git a/DESCRIPTION b/DESCRIPTION index dd0fe090..7e6ccd98 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: mrwater Title: madrat based MAgPIE water Input Data Library -Version: 1.6.20.9001 +Version: 1.6.20.9002 URL: https://github.com/pik-piam/mrwater, https: //doi.org/10.5281/zenodo.5801680 License: LGPL-3 | file LICENSE diff --git a/R/calcAvlWater.R b/R/calcAvlWater.R index 0f30ef06..f68de12a 100755 --- a/R/calcAvlWater.R +++ b/R/calcAvlWater.R @@ -23,7 +23,7 @@ #' } calcAvlWater <- function(lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", crop = "ggcmi_phase3_nchecks_9ca735cb"), - climatetype = "GSWP3-W5E5:historical", cells = "magpiecell", + climatetype = "GSWP3-W5E5:historical", cells = "lpjcell", stage = "harmonized2020", seasonality = "grper") { cfgNatveg <- toolLPJmLVersion(version = lpjml["natveg"], climatetype = climatetype) diff --git a/R/calcGrowingPeriod.R b/R/calcGrowingPeriod.R index 2c42200d..9ccd960f 100644 --- a/R/calcGrowingPeriod.R +++ b/R/calcGrowingPeriod.R @@ -28,7 +28,7 @@ calcGrowingPeriod <- function(lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", climatetype = "GSWP3-W5E5:historical", stage = "harmonized2020", yield_ratio = 0.1, # nolint - cells = "magpiecell") { + cells = "lpjcell") { cfgNatveg <- toolLPJmLVersion(version = lpjml["natveg"], climatetype = climatetype) cfgCrop <- toolLPJmLVersion(version = lpjml["crop"], climatetype = climatetype) diff --git a/R/calcWaterUseNonAg.R b/R/calcWaterUseNonAg.R index d84a5114..55aa0e55 100644 --- a/R/calcWaterUseNonAg.R +++ b/R/calcWaterUseNonAg.R @@ -37,7 +37,7 @@ #' @importFrom mrcommons toolCell2isoCell toolCoord2Isocell toolGetMappingCoord2Country toolHarmonize2Baseline #' @importFrom magpiesets addLocation findset -calcWaterUseNonAg <- function(selectyears = seq(1995, 2100, by = 5), cells = "magpiecell", +calcWaterUseNonAg <- function(selectyears = seq(1995, 2100, by = 5), cells = "lpjcell", datasource = "WATCH_ISIMIP_WATERGAP", usetype = "all", seasonality = "grper", harmonType = "average", lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", diff --git a/README.md b/README.md index 40a2c2b9..b8e6220a 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # madrat based MAgPIE water Input Data Library -R package **mrwater**, version **1.6.20.9001** +R package **mrwater**, version **1.6.20.9002** [![CRAN status](https://www.r-pkg.org/badges/version/mrwater)](https://cran.r-project.org/package=mrwater) [![R build status](https://github.com/pik-piam/mrwater/workflows/check/badge.svg)](https://github.com/pik-piam/mrwater/actions) [![codecov](https://codecov.io/gh/pik-piam/mrwater/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/mrwater) [![r-universe](https://pik-piam.r-universe.dev/badges/mrwater)](https://pik-piam.r-universe.dev/builds) @@ -48,7 +48,7 @@ In case of questions / problems please contact Felicitas Beier . +Beier F, Heinke J, Karstens K, Bodirsky B, Dietrich J (2023). _mrwater: madrat based MAgPIE water Input Data Library_. R package version 1.6.20.9002, . A BibTeX entry for LaTeX users is @@ -57,7 +57,7 @@ A BibTeX entry for LaTeX users is title = {mrwater: madrat based MAgPIE water Input Data Library}, author = {Felicitas Beier and Jens Heinke and Kristine Karstens and Benjamin Leon Bodirsky and Jan Philipp Dietrich}, year = {2023}, - note = {R package version 1.6.20.9001}, + note = {R package version 1.6.20.9002}, url = {https://github.com/pik-piam/mrwater}, } ``` diff --git a/man/calcAvlWater.Rd b/man/calcAvlWater.Rd index 158d3a4e..5f66b422 100644 --- a/man/calcAvlWater.Rd +++ b/man/calcAvlWater.Rd @@ -8,7 +8,7 @@ calcAvlWater( lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", crop = "ggcmi_phase3_nchecks_9ca735cb"), climatetype = "GSWP3-W5E5:historical", - cells = "magpiecell", + cells = "lpjcell", stage = "harmonized2020", seasonality = "grper" ) diff --git a/man/calcGrowingPeriod.Rd b/man/calcGrowingPeriod.Rd index f96e4ea8..951fe67f 100644 --- a/man/calcGrowingPeriod.Rd +++ b/man/calcGrowingPeriod.Rd @@ -10,7 +10,7 @@ calcGrowingPeriod( climatetype = "GSWP3-W5E5:historical", stage = "harmonized2020", yield_ratio = 0.1, - cells = "magpiecell" + cells = "lpjcell" ) } \arguments{ diff --git a/man/calcWaterUseNonAg.Rd b/man/calcWaterUseNonAg.Rd index 50d2da68..7097bcb8 100644 --- a/man/calcWaterUseNonAg.Rd +++ b/man/calcWaterUseNonAg.Rd @@ -6,7 +6,7 @@ \usage{ calcWaterUseNonAg( selectyears = seq(1995, 2100, by = 5), - cells = "magpiecell", + cells = "lpjcell", datasource = "WATCH_ISIMIP_WATERGAP", usetype = "all", seasonality = "grper",