diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..5b6a065 --- /dev/null +++ b/.gitignore @@ -0,0 +1,4 @@ +.Rproj.user +.Rhistory +.RData +.Ruserdata diff --git a/.lintr b/.lintr new file mode 100644 index 0000000..c02af8f --- /dev/null +++ b/.lintr @@ -0,0 +1,2 @@ +linters: lucode2::lintrRules() +encoding: "UTF-8" diff --git a/R/calcCroparea.R b/R/calcCroparea.R new file mode 100644 index 0000000..e72f9a7 --- /dev/null +++ b/R/calcCroparea.R @@ -0,0 +1,234 @@ +#' @title calcCroparea +#' @description Returns harvested areas of individual crops from FAOSTAT. +#' Total harvested areas can be lower or higher than arable +#' land because of multicropping or fallow land. +#' Rice areas are distributed to flooded LUH areas. Additional FAOSTAT +#' rice areas are distributed based on country shares. +#' +#' @param sectoral "area_harvested" returns croparea aggregated to FAO products, +#' "ProductionItem" unaggregated ProdSTAT items, +#' "FoodBalanceItem" Food Balance Sheet categories, +#' "kcr" MAgPIE items, and "lpj" LPJmL items +#' @param physical if TRUE the sum over all crops agrees with the cropland area per country +#' @param cellular if TRUE: calculates cellular MAgPIE crop area for all magpie croptypes. +#' Crop area from LUH2 crop types (c3ann, c4ann, c3per, c4per, cnfx) +#' are mapped to MAgpIE crop types using mappingLUH2cropsToMAgPIEcrops.csv. +#' Harvested areas of FAO weight area within a specific LUH crop type +#' to divide into MAgPIE crop types. +#' @param cells Switch between "magpiecell" (59199) and "lpjcell" (67420) +#' @param irrigation If true: cellular areas are returned separated +#' into irrigated and rainfed (see setup in calcLUH2v2) +#' +#' @return areas of individual crops from FAOSTAT and weight +#' +#' @author Ulrich Kreidenweis, Kristine Karstens, Felicitas Beier +#' +#' @importFrom utils read.csv +#' @importFrom magclass setNames getCells collapseDim getItems +#' @importFrom magpiesets findset addLocation +#' @importFrom madrat toolAggregate toolGetMapping +#' @importFrom withr local_options + +calcCroparea <- function(sectoral = "kcr", physical = TRUE, cellular = FALSE, + cells = "lpjcell", irrigation = FALSE) { + + local_options(magclass_sizeLimit = 1e+10) + + if (!cellular) { + + if (irrigation) stop("Irrigation levels for country based data not yet implemented!") + + ################################# + ### Croparea on country level ### + ################################# + + if (!is.null(sectoral) && !(sectoral == "lpj")) { + + cropPrim <- readSource("FAO_online", "Crop")[, , "area_harvested"] + # use linear_interpolate + fodder <- readSource("FAO", "Fodder")[, , "area_harvested"] + fodder <- toolExtrapolateFodder(fodder, endyear = max(getYears(cropPrim, as.integer = TRUE))) + data <- toolFAOcombine(cropPrim, fodder) / 10^6 # convert to Mha + + if (sectoral %in% c("FoodBalanceItem", "kcr")) { + + aggregation <- toolGetMapping("FAOitems_online.csv", type = "sectoral", + where = "mappingfolder") + remove <- setdiff(getNames(data, dim = 1), aggregation$ProductionItem) + data <- data[, , remove, invert = TRUE] + data <- toolAggregate(data, rel = aggregation, from = "ProductionItem", + to = ifelse(sectoral == "kcr", "k", sectoral), + dim = 3.1, partrel = TRUE) + + if (sectoral == "kcr") { + # add bioenergy with 0 values + data <- add_columns(x = data, addnm = c("betr", "begr"), dim = 3.1) + data[, , c("betr", "begr")] <- 0 + + # remove all non kcr items + kcr <- findset("kcr") + remove <- setdiff(getItems(data, dim = 3.1), kcr) + + if (length(remove) > 0) { + remainArea <- mean(dimSums(data[, , "remaining.area_harvested"], dim = 1) / + dimSums(dimSums(data[, , "area_harvested"], dim = 3), dim = 1)) + if (remainArea > 0.02) vcat(1, "Aggregation created a 'remaining' category. The area harvested is", + round(remainArea, digits = 3) * 100, "% of total \n") + vcat(2, paste0("Data for the following items removed: ", remove)) + data <- data[, , kcr] + } + } + + } else if (sectoral != "ProductionItem") { + stop("Sectoral aggregation not supported") + } + + } else if (sectoral == "lpj") { + + magCroparea <- calcOutput("Croparea", sectoral = "kcr", physical = physical, + cellular = FALSE, irrigation = FALSE, aggregate = FALSE) + + mag2lpj <- toolGetMapping(type = "sectoral", name = "MAgPIE_LPJmL.csv", + where = "mappingfolder") + mag2lpj <- mag2lpj[!(mag2lpj$MAgPIE == "pasture"), ] + + lpjCroparea <- toolAggregate(magCroparea, rel = mag2lpj, from = "MAgPIE", to = "LPJmL", dim = 3.1) + data <- lpjCroparea + + } else { + stop("Sectoral aggregation not supported") + } + + # use the share of the single crops to calculate their "physical" area + if (physical) { + # 6620 = (6620|Arable land and Permanent crops or 6620|Cropland) + cropland <- setNames(collapseNames(calcOutput("FAOLand", + aggregate = FALSE)[, , "6620", pmatch = TRUE]), "crop") + harvestedShare <- data / dimSums(data, dim = 3.1) + commonyears <- intersect(getYears(cropland), getYears(harvestedShare)) + data <- collapseNames(cropland[, commonyears, ] * harvestedShare[, commonyears, ]) + } + + data[is.na(data)] <- 0 + + } else { + ################################## + ### Croparea on cellular level ### + ################################## + + if (sectoral == "kcr") { + # LUH related data input on cell level + luhWeights <- calcOutput("LUH2MAgPIE", share = "MAGofLUH", + missing = "fill", rice = "non_flooded", aggregate = FALSE) + + luhCroptypes <- c("c3ann", "c4ann", "c3per", "c4per", "c3nfx") + + luhCroparea <- calcOutput("LUH2v2", landuse_types = "LUH2v2", + cells = cells, aggregate = FALSE, irrigation = irrigation, + cellular = TRUE, selectyears = "past") + if (cells == "magpiecell") { + luhCroparea <- toolCell2isoCell(luhCroparea, cells = cells) + } + + # Differentiation step that is necessary until full transition to 67k cells + if (cells == "magpiecell") { + commonCountries <- intersect(getItems(luhWeights, dim = "ISO"), getItems(luhCroparea, dim = "country")) + } else if (cells == "lpjcell") { + commonCountries <- intersect(getItems(luhWeights, dim = "ISO"), getItems(luhCroparea, dim = "iso")) + } else { + stop("Please select cellular data (mapgiecell or lpjcell) to be returned + by calcCroparea when selecting cellular = TRUE") + } + + # corrected rice area (in Mha) + ricearea <- calcOutput("Ricearea", cellular = TRUE, cells = cells, + share = FALSE, aggregate = FALSE) + + # irrigation + if (irrigation == TRUE) { + # for check + luhCropareaTotal <- dimSums(luhCroparea[, , luhCroptypes][, , "total"], dim = 3) + + # calculate irrigation share for rice area correction + irrigShr <- new.magpie(cells_and_regions = getCells(luhCroparea), + years = getYears(luhCroparea), + names = getNames(luhCroparea), fill = NA) + irrigShr <- irrigShr[, , "total", invert = TRUE] + + irrigShr[, , "irrigated"] <- collapseNames(ifelse(luhCroparea[, , "total"] > 0, + luhCroparea[, , "irrigated"] / luhCroparea[, , "total"], 0)) + irrigShr[, , "rainfed"] <- 1 - collapseNames(irrigShr[, , "irrigated"]) + + # flooded rice areas + floodedRice <- collapseNames(ricearea[, , "flooded"] * irrigShr[, , "c3ann"]) + + # reduce object size (if "total" is also reported magpie object grows too big (>1.3GB)) + luhCroparea <- luhCroparea[, , "total", invert = TRUE] + + } else { + # for check + luhCropareaTotal <- dimSums(luhCroparea[, , luhCroptypes], dim = 3) + + # flooded rice areas + floodedRice <- collapseNames(ricearea[, , "flooded"]) + + } + + # temporarily exclude flooded rice for distribution of other crops and aerobic rice areas + luhCroparea[, , "c3ann"] <- luhCroparea[, , "c3ann"] - floodedRice + + # correction of LUH cropareas with FAO country shares + luhCroparea <- luhCroparea[, , luhCroptypes] + luh2mag <- luhCroparea * luhWeights[commonCountries, , ] + magCroparea <- dimSums(luh2mag, dim = 3.1) + + # total rice area correction + magCroparea[, , "rice_pro"] <- magCroparea[, , "rice_pro"] + floodedRice + + # check sums + if (any(round(abs(dimSums(magCroparea, dim = 3) - luhCropareaTotal), digits = 6) > 1e-6)) { + stop("Sums after rice correction in calcCroparea don't match!") + } + + data <- collapseNames(magCroparea) + + } else if (sectoral == "lpj") { + + magCroparea <- calcOutput("Croparea", sectoral = "kcr", physical = physical, + cellular = TRUE, irrigation = irrigation, + cells = cells, aggregate = FALSE) + mag2lpj <- toolGetMapping(type = "sectoral", name = "MAgPIE_LPJmL.csv", + where = "mappingfolder") + mag2lpj <- mag2lpj[!(mag2lpj$MAgPIE == "pasture"), ] + lpjCroparea <- toolAggregate(magCroparea, rel = mag2lpj, from = "MAgPIE", to = "LPJmL", dim = "MAG") + data <- lpjCroparea + + } else { + stop("Not possible (for now) for the given item set (sectoral)!") + } + + if (!physical) { + + multiCropping <- calcOutput("Multicropping", aggregate = FALSE) + + if (cells == "magpiecell") { + commonCountries <- intersect(getItems(multiCropping, dim = "ISO"), getItems(data, dim = "country")) + } else if (cells == "lpjcell") { + commonCountries <- intersect(getItems(multiCropping, dim = "ISO"), getItems(data, dim = "iso")) + } + + data <- data * multiCropping[commonCountries, getYears(data), ] + } + } + + data <- collapseNames(data) + + # not more precision than 1 ha needed. very small areas can make problems in some weighting scripts + data <- round(data, 6) + + return(list(x = data, + weight = NULL, + unit = "million ha", + description = "harvested crop areas from FAOSTAT", + isocountries = !cellular)) +} diff --git a/R/calcCropareaLandInG.R b/R/calcCropareaLandInG.R new file mode 100644 index 0000000..37b0c08 --- /dev/null +++ b/R/calcCropareaLandInG.R @@ -0,0 +1,292 @@ +#' @title calcCropareaLandInG +#' @description This function uses total physical area and +#' crop-specific harvested area data from LandInG +#' to calculate crop-specific physical and harvested +#' areas considering special rules +#' for the allocation of perennial and annual crops. +#' +#' @param sectoral "kcr" MAgPIE items, and "lpj" LPJmL items +#' @param physical if TRUE the sum over all crops plus fallow land (of calcFallowLand) +#' agrees with the physical cropland of readLandInG(subtype = physical) +#' @param cellular if TRUE: calculates cellular crop area for all magpie croptypes. +#' Option FALSE is not (yet) available. +#' @param cells Switch between "magpiecell" (59199) and "lpjcell" (67420) +#' @param irrigation If true: cellular areas are returned separated +#' into irrigated and rainfed +#' @param selectyears extract certain years from the data +#' @param lpjml LPJmL version used to determine multiple cropping suitability +#' @param climatetype Climate scenario or historical baseline "GSWP3-W5E5:historical" +#' used to determine multiple cropping suitability +#' +#' @return MAgPIE object with cropareas +#' +#' @author David Hoetten, Felicitas Beier +#' +#' @importFrom madrat readSource toolConditionalReplace toolCountryFill toolAggregate +#' @importFrom magclass dimSums getItems +#' @importFrom mstools toolHoldConstant +#' +calcCropareaLandInG <- function(sectoral = "kcr", physical = TRUE, cellular = FALSE, + cells = "magpiecell", irrigation = FALSE, selectyears = "all", + lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", + crop = "ggcmi_phase3_nchecks_bft_e511ac58"), + climatetype = "GSWP3-W5E5:historical") { + + if (climatetype != "GSWP3-W5E5:historical" || + lpjml[["crop"]] != "ggcmi_phase3_nchecks_bft_e511ac58") { + warning("Error in calcCropareaLandInG: The LPJmL version has been updated + since LandInG was run for the last time. + Please consider updating the LandInG data.") + # Kristine: How to include a mapping here? + } + + withr::local_options(magclass_sizeLimit = 1e+12) + + ### Read in data ### + # total physical area from LandInG (in Mha) + physicalArea <- readSource("LandInG", subtype = "physicalArea") + # crop-specific harvested area (in Mha) + harvestedArea <- readSource("LandInG", subtype = "harvestedArea") + + ### Calculations ### + # read in fallow land (for check below) + fallow <- calcOutput("FallowLand", aggregate = FALSE) + + # year selection + if (any(selectyears == "all")) { + selectyears <- getItems(physicalArea, dim = "year") + } + if (is.numeric(selectyears)) { + selectyears <- paste0("y", selectyears) + } + + # extrapolate years + if (!all(selectyears %in% getItems(physicalArea, dim = "year"))) { + physicalArea <- toolHoldConstant(physicalArea, selectyears) + harvestedArea <- toolHoldConstant(harvestedArea, selectyears) + fallow <- toolHoldConstant(fallow, selectyears) + } + + # reduce harvested area to crop area + nonCrops <- c("pasture") + harvestedArea <- harvestedArea[, , nonCrops, invert = TRUE] + + # croplists + crops <- getItems(harvestedArea, dim = "crop") + perennials <- c("sugr_cane", "oilpalm") + annuals <- crops[!crops %in% perennials] + + # Reduce to selected number of years + # and split calculation into single years for memory reasons + cropAreaList <- vector(mode = "list", length = length(selectyears)) + names(cropAreaList) <- selectyears + for (y in selectyears) { + # select year + physicalAreaYearly <- physicalArea[, y, ] + harvestedAreaYearly <- harvestedArea[, y, ] + + ################################## + ## Crop-specific physical areas ## + ################################## + # Total physical area (in Mha) + physicalAreaSum <- dimSums(physicalAreaYearly, dim = "irrigation") + + # Calculate the total harvested areas for different crop groups + # for perennial crops no multicropping is happening, so physical area = harvested area + perennialHarvestedA <- dimSums(harvestedAreaYearly[, , perennials], dim = c("crop", "irrigation")) + annualsHarvestedA <- dimSums(harvestedAreaYearly[, , annuals], dim = c("crop", "irrigation")) + totalHarvestedA <- perennialHarvestedA + annualsHarvestedA + + # Check how much physical area is remaining for the annuals after subtracting the perennial physical area + annualsPhysicalA <- physicalAreaSum - perennialHarvestedA + + # Calculate a factor by which the annuals should be scaled down so the sum does not exceed annualsPhysicalA + factorAnnuals <- ifelse(annualsPhysicalA > 0 & annualsHarvestedA > 0, + annualsPhysicalA / annualsHarvestedA, + 1) + + # Calculate a factor by which all crops in mismatch cells (i.e. no annualPhyiscalA left) should be scaled down + factorMismatches <- ifelse(annualsPhysicalA <= 0 & totalHarvestedA > 0, + physicalAreaSum / totalHarvestedA, + 1) + + # Only scale crops down not up (i.e. keep fallow land) + factorAnnuals[factorAnnuals > 1] <- 1 + factorMismatches[factorMismatches > 1] <- 1 + + # Apply the factors + physicalAreaYearly <- harvestedAreaYearly + physicalAreaYearly[, , annuals] <- harvestedAreaYearly[, , annuals] * factorAnnuals + physicalAreaYearly <- physicalAreaYearly * factorMismatches + + # Clean up for memory reasons + rm(factorMismatches, factorAnnuals) + + ################################### + ## Correction of harvested areas ## + ################################### + # Correction of perennial harvested area required + # due to above allocation of crops distinguishing + # annuals and perennials + + # Check whether more than 5% of harvested area would be lost + if (any(dimSums(harvestedAreaYearly[, , perennials] - physicalAreaYearly[, , perennials], + dim = c(1, 3.2)) / dimSums(harvestedAreaYearly, dim = c(1, 3.2)) * 100 > 5)) { + stop("More than 5% of global harvested area is lost through perennial area correction") + } + # Check whether more than 10% of harvested area would be lost in any country + # that has more than 100 000 ha total harvested area + if (any(dimSums(harvestedAreaYearly, + dim = c(1.1, 1.2, 3)) > 0.1 & + (dimSums(harvestedAreaYearly[, , perennials] - physicalAreaYearly[, , perennials], + dim = c(1.1, 1.2, 3)) / dimSums(harvestedAreaYearly, + dim = c(1.1, 1.2, 3)) * 100) > 10, + na.rm = TRUE)) { + stop(paste0("Some countries (with more than 100 000 ha harvested area) would loose more than 10% in year ", y)) + } + + # In the allocation of perennials to physical area, some harvested area is lost and needs to be corrected + harvestedAreaYearly[, , perennials] <- physicalAreaYearly[, , perennials] + + ########################################### + ## Correction of multiple cropping cases ## + ########################################### + # In the LandInG calculations, some rainfed harvested area is allocated to irrigated land. + # This leads to cases where areas are declared as "rainfed harvested area" resulting in + # cropping intensities > 1 for rainfed crops where not multiple cropping is possible + # according to the multiple cropping suitability. + # These areas are declared irrigated in the following correction. + + ### Read in data ### + # Crop-specific and irrigation-type specific multiple cropping suitability + mcSuit <- calcOutput("MulticroppingSuitability", selectyears = y, + lpjml = lpjml, climatetype = climatetype, + suitability = "endogenous", sectoral = "kcr", + aggregate = FALSE) + mcSuit <- dimOrder(mcSuit, c(2, 1), dim = 3) + mcSuit <- mcSuit[, , getItems(harvestedAreaYearly, dim = 3)] + + # Sanity checks + if (any(harvestedAreaYearly != 0 & physicalAreaYearly == 0)) { + stop("Please check calcCropareaLandInG. The following calculations area based on the + assumption that there is no harvested area where no physical area exists.") + } + + # Crop- and irrigation-specific cropping intensity + ci <- ifelse(physicalAreaYearly > 0 + 1e-6, harvestedAreaYearly / physicalAreaYearly, 1) + # Boolean: is there multiple cropping or not? + mcCurr <- ci + mcCurr[, , ] <- 0 + mcCurr[ci > (1 + 1e-3)] <- 1 + # Multiple cropping where non-suitable for multiple cropping + violation <- mcCurr == 1 & mcSuit == 0 + # This case should only occur for areas declared as rainfed + if (any(violation[, , "irrigated"])) { + stop(paste0("Check calcCropareaLandInG. There is a violation for year ", + y, ". This should not be the case. + LandInG may distribute rainfed harvested areas on irrigated + physical land, but no irrigated harvested area on rainfed land.")) + } + rfViolation <- collapseNames(violation[, , "rainfed"]) + + # Temporary objects with correct dimensionality + harvIR <- collapseNames(harvestedAreaYearly[, , "irrigated"]) + physIR <- collapseNames(physicalAreaYearly[, , "irrigated"]) + harvRF <- collapseNames(harvestedAreaYearly[, , "rainfed"]) + physRF <- collapseNames(physicalAreaYearly[, , "rainfed"]) + + # Add multiple cropped rainfed areas to harvested irrigated areas + harvIR[rfViolation] <- harvIR[rfViolation] + harvRF[rfViolation] - physRF[rfViolation] + # Reduce harvested rainfed areas where not suitable to physical rainfed: + harvRF[rfViolation] <- physRF[rfViolation] + + # Areas where no physical irrigated area was available, but now received harvested area + # have to be re-declared to irrigated physical areas. + # (Note: this can occur due to physical area correction) + noPhysical <- (harvIR != 0 & physIR == 0) + + # Allocate areas that are declared rainfed to these irrigated areas + physIR[noPhysical] <- physIR[noPhysical] + physRF[noPhysical] + harvIR[noPhysical] <- harvIR[noPhysical] + physRF[noPhysical] + physRF[noPhysical] <- 0 + harvRF[noPhysical] <- physRF[noPhysical] + + # Overwrite original object with corrected values + harvestedAreaYearly[, , "irrigated"] <- harvIR + harvestedAreaYearly[, , "rainfed"] <- harvRF + physicalAreaYearly[, , "irrigated"] <- physIR + physicalAreaYearly[, , "rainfed"] <- physRF + + rm(harvIR, harvRF, physIR, physRF) + + ################### + ## Select output ## + ################### + if (!physical) { + cropArea <- harvestedAreaYearly + } else { + cropArea <- physicalAreaYearly + } + + if (sectoral == "kcr") { + # this is already the format of cropArea + } else if (sectoral == "lpj") { + # crop mapping + mapMagToLpj <- toolGetMapping(type = "sectoral", name = "MAgPIE_LPJmL.csv", + where = "mappingfolder") + mapMagToLpj <- mapMagToLpj[!(mapMagToLpj$MAgPIE %in% nonCrops), ] + + cropArea <- toolAggregate(cropArea, rel = mapMagToLpj, + from = "MAgPIE", to = "LPJmL", dim = "crop") + } else { + stop("This sectoral aggregation is not available in calcCropareaLandInG") + } + + if (irrigation == TRUE) { + # this is already the format of cropArea + } else { + cropArea <- dimSums(cropArea, dim = "irrigation") + } + + # Check consistency with calcFallowLand + if (physical == TRUE) { + if (irrigation == TRUE) { + physicalCropSum <- dimSums(cropArea, dim = c("crop", "irrigation")) + } else { + physicalCropSum <- dimSums(cropArea, dim = c("crop")) + } + + if (any(abs(physicalCropSum + fallow[, y, ] - physicalAreaSum) > 10^-16)) { + stop("Sum of crops + fallow land doesn't match with total physical cropland.") + } + } + + # Aggregation to iso-level + if (!cellular) { + # aggregate to countries + cropArea <- dimSums(cropArea, dim = c("x", "y")) + # fill missing countries with 0 + cropArea <- toolConditionalReplace(x = toolCountryFill(cropArea), + conditions = "is.na()", replaceby = 0) + } else { + if (cells == "magpiecell") { + cropArea <- toolCoord2Isocell(cropArea) + } else if (cells == "lpjcell") { + # this is already the format of cropArea + } else { + stop("This value for the cell parameter is not supported, + choose between \"magpiecell\" and \"lpjcell\"") + } + } + cropAreaList[[y]] <- cropArea + } + + # bind years together + out <- mbind(cropAreaList) + + return(list(x = out, + weight = NULL, + description = "Croparea for different croptypes", + unit = "Mha", + isocountries = FALSE)) +} diff --git a/R/calcFallowLand.R b/R/calcFallowLand.R new file mode 100644 index 0000000..168460e --- /dev/null +++ b/R/calcFallowLand.R @@ -0,0 +1,52 @@ +#' @title calcFallowLand +#' @description +#' Calculates fallow land on grid cell level, +#' based on physical cropland extend and harvested area output +#' of LandInG data. +#' The formula +#' "fallow land are = max( physical cropland area - harvested cropland area, 0)" +#' is used. +#' Due to multiple cropping, harvested cropland area can be greater than non-fallow land area +#' and even greater than physical cropland area. +#' Thus, the results can only be considered a rough estimate of fallow land area. +#' @param cellular TRUE for cellular outputs. +#' @return MAgPIE object containing fallow land in Mha +#' @author David Hoetten, Felicitas Beier +#' @seealso +#' \code{\link{readLandInG}} +#' @examples +#' \dontrun{ +#' calcOutput("FallowLand") +#' } +#' @importFrom magclass dimSums mbind +#' @importFrom madrat toolConditionalReplace +#' +calcFallowLand <- function(cellular = TRUE) { + + harvestedArea <- readSource("LandInG", subtype = "harvestedArea") + + harvestedAreaCrops <- harvestedArea[, , c("pasture"), invert = TRUE] + + physicalArea <- readSource("LandInG", subtype = "physicalArea") + + fallowLand <- dimSums(physicalArea, "irrigation") - + dimSums(harvestedAreaCrops, c("irrigation", "crop")) + + fallowLand <- toolConditionalReplace(fallowLand, conditions = c("<0"), replaceby = 0) + + # Aggregation to iso-level + if (!cellular) { + # aggregate to countries + fallowLand <- dimSums(fallowLand, dim = c("x", "y")) + # fill missing countries with 0 + fallowLand <- toolConditionalReplace(x = toolCountryFill(fallowLand), + conditions = "is.na()", replaceby = 0) + } + + return(list(x = fallowLand, + weight = NULL, + description = "Fallow land", + unit = "Mha", + isocountries = FALSE)) + +} diff --git a/R/calcForestArea.R b/R/calcForestArea.R new file mode 100644 index 0000000..cb89824 --- /dev/null +++ b/R/calcForestArea.R @@ -0,0 +1,126 @@ +#' @title calcForestArea +#' @description Calculates consistent forest area and its subcategories based on FAO_FRA2015 +#' and LanduseInitialisation data. +#' +#' @param selectyears defaults to past +#' @return List of magpie object with results on country level, weight, unit and description. +#' @author Kristine Karstens, Jan Philipp Dietrich +#' @examples +#' \dontrun{ +#' calcOutput("ForestArea") +#' } +#' @export + +calcForestArea <- function(selectyears = "past") { + + years <- sort(findset(selectyears, noset = "original")) + + forest <- readSource("FAO_FRA2015", "fac")[, , c("Forest", "NatFor", "PrimFor", "NatRegFor", "PlantFor")] + + # Plantation data is bit strange in FRA2015, we update this with FRA2020 data (but only till 2015) + # We do this because FRA2020 has stopped reporting separately on primf and secdf + # but we can still use data for planted forest + + ## Overall FRA 2020 data + fra2020 <- readSource("FRA2020", "forest_area") + + ## Find which year is missing in FRA2020 data (which exisits in FRA2015) + missingYears <- setdiff(getYears(forest), getYears(fra2020)) + + ## Linear interpolation to missing year + fra2020 <- time_interpolate(dataset = fra2020, + interpolated_year = missingYears, + integrate_interpolated_years = TRUE, + extrapolation_type = "linear") + + ## Replace FRA2015 planted forest data with FRA 2020 data + forest[, , "PlantFor"] <- fra2020[, getYears(forest), "plantedForest"] + + # As planted forest data is now different, we need to update overall forest area + # (sum of nat.reg.forest and planted forest) + forest[, , "Forest"] <- forest[, , "NatFor"] + forest[, , "PlantFor"] + + forest <- time_interpolate(forest, interpolated_year = years, integrate_interpolated_years = TRUE, + extrapolation_type = "constant")[, years, ] + vcat(verbosity = 3, "Forest is interpolated for missing years and held constant for the period before FAO starts") + + ### fix know issues + + forest["HND", , "PlantFor"] <- forest["HND", , "Forest"] - forest["HND", , "NatFor"] + forest["IDN", , "Forest"] <- forest["IDN", , "NatFor"] + forest["IDN", , "PlantFor"] + forest["FIN", , "NatRegFor"] <- forest["FIN", , "NatFor"] - forest["FIN", , "PrimFor"] + forest["PSE", , "PlantFor"] <- 2 / 3 * forest["PSE", , "Forest"] + forest["PSE", , "NatRegFor"] <- 1 / 3 * forest["PSE", , "Forest"] + + ### fixing inconsistencies assuming total forest areas and shares of subcategories are reported correctly + + forestSumSub <- dimSums(forest[, , c("NatFor", "PlantFor")], dim = 3) + forest[, , "PlantFor"] <- toolNAreplace(forest[, , "PlantFor"] / + forestSumSub * setNames(forest[, , "Forest"], NULL))$x + forest[, , "NatFor"] <- toolNAreplace(forest[, , "NatFor"] / + forestSumSub * setNames(forest[, , "Forest"], NULL))$x + + forestSumSubSub <- dimSums(forest[, , c("PrimFor", "NatRegFor")], dim = 3) + forest[, , "PrimFor"] <- toolNAreplace(forest[, , "PrimFor"] / + forestSumSubSub * setNames(forest[, , "NatFor"], NULL))$x + forest[, , "NatRegFor"] <- toolNAreplace(forest[, , "NatRegFor"] / + forestSumSubSub * setNames(forest[, , "NatFor"], NULL))$x + + ########################### + # fixing missing data on split between PrimFor (primforest), NatRegFor (secdforest) + # and PlantFor (forestry) with LUH data + + luh <- calcOutput("LUH2v2", landuse_types = "LUH2v2", irrigation = FALSE, selectyears = selectyears, + cells = "lpjcell", cellular = FALSE, aggregate = FALSE)[, , c("primf", "secdf")] + + secondaryForest <- luh[, , "secdf"] - setNames(forest[, getYears(luh), "PlantFor"], NULL) + if (any(secondaryForest < 0)) { + tmp <- secondaryForest + tmp[tmp > 0] <- 0 + tmp <- dimSums(tmp, dim = 1) + vcat(verbosity = 2, paste("Mismatch of FAO forestry and Hurtt secondary forest:", + paste(paste(getYears(tmp), round(tmp, 0), "Mha, "), collapse = " "), ". cut off.")) + secondaryForest[secondaryForest < 0] <- 0 + } + forestry <- luh[, , "secdf"] - secondaryForest + + luhForest <- mbind(setNames(forestry, "PlantFor"), + setNames(luh[, , c("primf")], "PrimFor"), + setNames(secondaryForest, "NatRegFor")) + 10^-10 + # 10^-10 added to allow share estimation even under missing area information + luhForestShare <- luhForest / dimSums(luhForest, dim = 3) + luhNatForestShare <- luhForest[, , c("PrimFor", "NatRegFor")] / dimSums(luhForest[, , c("PrimFor", "NatRegFor")], + dim = 3) + + miss <- where(round(dimSums(forest[, , c("NatFor", "PlantFor")], dim = 3), 6) != + round(forest[, , "Forest"], 6))$true$regions + + if (length(miss) > 0) { + forest[miss, , c("PlantFor", "PrimFor", "NatRegFor")] <- luhForestShare[miss, , ] * + setNames(forest[miss, , "Forest"], NULL) + forest[miss, , "NatFor"] <- setNames(forest[miss, , "PrimFor"] + forest[miss, , "NatRegFor"], NULL) + } + + miss <- where(round(dimSums(forest[, , c("PrimFor", "NatRegFor")], dim = 3), 6) != + round(forest[, , "NatFor"], 6))$true$regions + if (length(miss > 0)) { + forest[miss, , c("PrimFor", "NatRegFor")] <- luhNatForestShare[miss, , ] * setNames(forest[miss, , "NatFor"], NULL) + } + + #################################### + + map <- data.frame(fao = c("Forest", "NatFor", "PrimFor", "NatRegFor", "PlantFor"), + magpie = c("forest", "natrforest", "primforest", "secdforest", "forestry")) + out <- toolAggregate(forest, map, from = "fao", to = "magpie", dim = 3) + + if (max(abs(dimSums(out[, , c("natrforest", "forestry")]) - out[, , "forest"])) > 10^-6 || + max(abs(dimSums(out[, , c("secdforest", "primforest")], dim = 3) - out[, , "natrforest"])) > 10^-6) { + warning("There are inconsistencies within the forest area data set.") + } + + return(list(x = out, + weight = NULL, + unit = "Mha", + description = "Forest are and its subcategories") + ) +} diff --git a/R/calcGrassGPP.R b/R/calcGrassGPP.R new file mode 100644 index 0000000..b136714 --- /dev/null +++ b/R/calcGrassGPP.R @@ -0,0 +1,148 @@ +#' @title calcGrassGPP +#' +#' @description Calculates gross primary production (GPP) of grassland +#' under irrigated and rainfed conditions based on LPJmL inputs. +#' +#' @param selectyears Years to be returned +#' @param lpjml LPJmL version required for respective inputs: natveg or crop +#' @param climatetype Switch between different climate scenarios or historical baseline "GSWP3-W5E5:historical" +#' @param season "wholeYear": grass GPP in the entire year (main + off season) +#' "mainSeason": grass GPPP in the crop-specific growing +#' period of LPJmL (main season) +#' +#' @return magpie object in cellular resolution +#' @author Felicitas Beier +#' +#' @examples +#' \dontrun{ +#' calcOutput("GrassGPP", aggregate = FALSE) +#' } +#' +#' @importFrom madrat calcOutput +#' @importFrom magclass dimSums getItems new.magpie getSets add_dimension +#' + +calcGrassGPP <- function(selectyears, lpjml, climatetype, season) { + + if (grepl("GSWP3-W5E5", climatetype)) { + stage <- "smoothed" + } else { + stage <- "harmonized2020" + } + + #################### + ### Read in data ### + #################### + + # monthly irrigated grass GPP (in tDM/ha) + monthlyIrrigated <- calcOutput("LPJmL_new", subtype = "mgpp_grass_ir", + years = selectyears, + stage = stage, + version = lpjml[["crop"]], climatetype = climatetype, + aggregate = FALSE) + # monthly irrigated grass GPP (in tDM/ha) + monthlyRainfed <- calcOutput("LPJmL_new", subtype = "mgpp_grass_rf", + years = selectyears, + stage = stage, + version = lpjml[["crop"]], climatetype = climatetype, + aggregate = FALSE) + + # irrigated grass GPP in irrigated growing period of crop (in tDM/ha) + grperIrrigated <- calcOutput("LPJmL_new", subtype = "cft_gpp_grass_ir", + years = selectyears, + stage = stage, + version = lpjml[["crop"]], climatetype = climatetype, + aggregate = FALSE) + # rainfed grass GPP in rainfed growing period of crop (in tDM/ha) + grperRainfed <- calcOutput("LPJmL_new", subtype = "cft_gpp_grass_rf", + years = selectyears, + stage = stage, + version = lpjml[["crop"]], climatetype = climatetype, + aggregate = FALSE) + + ######################## + ### Data preparation ### + ######################## + + # Empty objects to be filled + grassGPPannual <- grassGPPgrper <- new.magpie(cells_and_regions = getItems(grperIrrigated, dim = 1), + years = getItems(grperIrrigated, dim = 2), + names = getItems(grperIrrigated, dim = 3), + fill = NA) + # Name dimensions + getSets(grassGPPannual) <- c("x", "y", "iso", "year", "crop", "irrigation") + getSets(grassGPPgrper) <- c("x", "y", "iso", "year", "crop", "irrigation") + + # Extract rainfed grass GPP in rainfed growing period of crop + grassGPPgrper[, , "rainfed"] <- grperRainfed[, , "rainfed"] + # Extract irrigated grass GPP in irrigated growing period of crop + grassGPPgrper[, , "irrigated"] <- grperIrrigated[, , "irrigated"] + + + #################### + ### Calculations ### + #################### + + # Monthly grass GPP + monthlyRainfed <- add_dimension(monthlyRainfed, + add = "irrigation", nm = "rainfed") + monthlyIrrigated <- add_dimension(monthlyIrrigated, + add = "irrigation", nm = "irrigated") + + ############## + ### Return ### + ############## + unit <- "tDM per ha" + description <- "irrigated and rainfed gross primary production of grass" + + if (season == "mainSeason") { + + out <- grassGPPgrper + description <- paste0(description, " in growing season of LPJmL") + + } else if (season == "wholeYear") { + # read in months with favorable growing conditions (boolean: 1=growing month; 0=no growing month) + grperPOT <- calcOutput("GrowingPeriodMonths", + selectyears = selectyears, + lpjml = lpjml, climatetype = climatetype, + aggregate = FALSE) + + # Calculate "annual" rainfed grass GPP for potential growing period + # (i.e., months with favorable crop growth conditions) + grassGPPannual[, , "rainfed"] <- dimSums(monthlyRainfed * grperPOT[, , "rainfed"], + dim = 3) + # Calculate "annual" irrigated grass GPP for potential growing period + # (i.e., months with favorable crop growth conditions) + grassGPPannual[, , "irrigated"] <- dimSums(monthlyIrrigated * grperPOT[, , "irrigated"], + dim = 3) + + out <- grassGPPannual + description <- paste0(description, " in the entire year (when crop growth is possible)") + + } else if (season == "monthly") { + + out <- mbind(monthlyRainfed, monthlyIrrigated) + getSets(out)["d3.2"] <- "month" + description <- paste0(description, " per month") + + } else { + stop("Please specify output to be returned by function calcGrassGPP: + mainSeason or wholeYear or monthly") + } + + ############## + ### Checks ### + ############## + if (any(is.na(out))) { + stop("calcGrassGPP produced NA values") + } + if (any(out < 0)) { + stop("calcGrassGPP produced negative values") + } + + return(list(x = out, + weight = NULL, + unit = unit, + description = description, + isocountries = FALSE)) +} diff --git a/R/calcGrowingPeriodMonths.R b/R/calcGrowingPeriodMonths.R new file mode 100644 index 0000000..b606239 --- /dev/null +++ b/R/calcGrowingPeriodMonths.R @@ -0,0 +1,85 @@ +#' @title calcGrowingPeriodMonths +#' +#' @description Calculates which gridcell-specific months in which +#' growing conditions are favorable for crop growth +#' based on monthly grass GPP +#' +#' @param selectyears Years to be returned +#' @param lpjml LPJmL version required for respective inputs: natveg or crop +#' @param climatetype Switch between different climate scenarios or +#' historical baseline "GSWP3-W5E5:historical" +#' @param minThreshold Threshold of monthly grass GPP to be classified as +#' growing period month +#' Unit of the threshold is gC/m^2. +#' Default: 100gC/m^2 +#' Note: the default value is chosen based on LPJmL version 5 +#' to reflect multiple cropping suitability as shown in GAEZ-4. +#' An update of LPJmL5 with regards to grass management may +#' require an adjustment of the threshold. +#' +#' @return magpie object in cellular resolution +#' @author Felicitas Beier, Jens Heinke +#' +#' @examples +#' \dontrun{ +#' calcOutput("GrowingPeriodMonths", aggregate = FALSE) +#' } +#' +#' @importFrom madrat calcOutput +#' @importFrom magclass setYears getSets mbind getItems new.magpie +#' + +calcGrowingPeriodMonths <- function(selectyears, lpjml, climatetype, + minThreshold = 100) { + #################### + ### Definitions ### + #################### + # Transformation factor for grass (gC/m^2 -> tDM/ha) + yieldTransform <- 0.01 / 0.45 + + #################### + ### Read in data ### + #################### + # monthly grass GPP (in tDM/ha) + grassGPPmonth <- setYears(calcOutput("GrassGPP", season = "monthly", + lpjml = lpjml, climatetype = climatetype, + selectyears = selectyears, aggregate = FALSE), + selectyears) + + #################### + ### Calculations ### + #################### + # Calculate growing period + grper <- grassGPPmonth + grper[, , ] <- 0 + # Classification as growing period month when monthly grass GPP > 100gC/m^2 + thresholdLGP <- minThreshold * yieldTransform + grper[grassGPPmonth >= thresholdLGP] <- 1 + + ############## + ### Checks ### + ############## + if (any(is.na(grper))) { + stop("mrland::calcGrowingPeriodMonths produced NA values") + } + if (any(grper < 0)) { + stop("mrland::calcGrowingPeriodMonths produced negative values") + } + if (any(grper != 1 && grper != 0)) { + stop("Problem in mrland::calcGrowingPeriodMonths: Value should be 0 or 1!") + } + + ############## + ### Return ### + ############## + unit <- "boolean" + description <- paste0("Classification of months as growing period month ", + "under irrigated and rainfed conditions. ", + "1 = suitable for crop growth, 0 = not suitable for crop growth") + + return(list(x = grper, + weight = NULL, + unit = unit, + description = description, + isocountries = FALSE)) +} diff --git a/R/calcLPJmLClimateInput.R b/R/calcLPJmLClimateInput.R new file mode 100644 index 0000000..9582253 --- /dev/null +++ b/R/calcLPJmLClimateInput.R @@ -0,0 +1,134 @@ +#' @title calcLPJmLClimateInput +#' @description Handle LPJmL climate input data and its time behaviour +#' (smoothing and harmonizing to baseline) +#' +#' @param climatetype Switch between different climate scenario +#' @param variable Switch between different climate inputs and temporal resolution +#' @param stage Degree of processing: raw, smoothed - raw or smoothed data from 1930|1951 +#' raw1901, smoothed1901 - raw or smoothed data from 1901 +#' harmonized, harmonized2020 - based on toolLPJmLVersion +#' @param lpjmlVersion LPJmL Version hand over +#' +#' @return magpie object in cellular resolution +#' @author Marcos Alves, Kristine Karstens, Felicitas Beier +#' +#' @examples +#' \dontrun{ +#' calcOutput("LPJmLClimateInput", +#' climatetype = "MRI-ESM2-0:ssp370", +#' variable = "temperature:annualMean") +#' } +#' +#' @importFrom madrat toolSplitSubtype toolTimeAverage +#' @importFrom magclass getNames +#' @importFrom magpiesets findset +#' @importFrom mstools toolHoldConstant +#' @importFrom SPEI thornthwaite +#' + +calcLPJmLClimateInput <- function(climatetype = "MRI-ESM2-0:ssp370", + variable = "temperature:annualMean", + stage = "harmonized2020", + lpjmlVersion = "LPJmL4_for_MAgPIE_44ac93de") { + # Create settings for LPJmL/GCM from version and climatetype argument + cfg <- toolClimateInputVersion(lpjmlVersion = lpjmlVersion, + climatetype = climatetype) + var <- toolSplitSubtype(variable, list(type = NULL, timeres = NULL)) + outtype <- ifelse(var$timeres != "wetDaysMonth", var$type, "wetDaysMonth") + + if (grepl("raw|smoothed", stage)) { + ########## PLUG HIST + FUTURE ########## + + if (!grepl("historical", climatetype)) { + + .subtypeScen <- paste(cfg$versionScen, cfg$climatetype, var$type, sep = ":") + .subtypeHist <- gsub("ssp[0-9]{3}", "historical", .subtypeScen) + + # For climate scenarios historical GCM data has to be read in from a different file + x <- mbind(readSource("LPJmLClimateInput", subtype = .subtypeHist, + subset = var$timeres, convert = "onlycorrect"), + readSource("LPJmLClimateInput", subtype = .subtypeScen, + subset = var$timeres, convert = "onlycorrect")) + years <- getYears(x, as.integer = TRUE) + x <- x[, years[years >= 1951], ] + + } else { + + .subtypeHist <- paste(cfg$versionHist, cfg$climatetype, var$type, sep = ":") + x <- readSource("LPJmLClimateInput", subtype = .subtypeHist, + subset = var$timeres, convert = "onlycorrect") + years <- getYears(x, as.integer = TRUE) + if (!grepl("1901", stage)) x <- x[, years[years >= 1930], ] + } + ########## PLUG HIST + FUTURE ########## + + if (grepl("smoothed", stage)) { + out <- toolSmooth(x) + } else { + out <- x + } + + } else if (grepl("harmonized", stage)) { + + harmStyle <- switch(outtype, + "temperature" = "additive", + "precipitation" = "limited", + "longWaveNet" = stop(paste0("No harmonization available for: ", var$variable)), + "shortWave" = stop(paste0("No harmonization available for: ", var$variable)), + "wetDaysMonth" = stop(paste0("No harmonization available for: ", var$variable))) + + if (stage == "harmonized") { + # read in historical data for subtype + baseline <- calcOutput("LPJmLClimateInput", climatetype = cfg$baselineHist, + variable = variable, stage = "smoothed", + lpjmlVersion = lpjmlVersion, aggregate = FALSE) + x <- calcOutput("LPJmLClimateInput", climatetype = cfg$climatetype, + variable = variable, stage = "smoothed", + lpjmlVersion = lpjmlVersion, aggregate = FALSE) + out <- toolHarmonize2Baseline(x, baseline, ref_year = cfg$refYearHist, method = harmStyle) + + } else if (stage == "harmonized2020") { + # read in historical data for subtype + baseline2020 <- calcOutput("LPJmLClimateInput", climatetype = cfg$baselineGcm, + variable = variable, stage = "harmonized", + lpjmlVersion = lpjmlVersion, aggregate = FALSE) + + if (cfg$climatetype == cfg$baselineGcm) { + + out <- baseline2020 + + } else { + + x <- calcOutput("LPJmLClimateInput", climatetype = cfg$climatetype, + variable = variable, stage = "smoothed", + lpjmlVersion = lpjmlVersion, aggregate = FALSE) + out <- toolHarmonize2Baseline(x, baseline2020, ref_year = cfg$refYearGcm, method = harmStyle) + } + + } else { + stop("Stage argument not supported!") + } + } else { + stop("Stage argument not supported!") + } + + unit <- switch(outtype, + "temperature" = "Degree Celcius", + "precipitation" = "mm/day", + "longWaveNet" = "watt per m2", + "shortWave" = "watt per m2", + "wetDaysMonth" = "number of rainy days") + + description <- switch(outtype, + "temperature" = paste0("Average ", var$timeres, " air temperature"), + "precipitation" = paste0("Average ", var$timeres, " precipitation"), + "longWaveNet" = "Long wave radiation", + "ShortWave" = "Short wave radiation", + "wetDaysMonth" = "number of rainy days") + + return(list(x = out, + weight = NULL, + unit = unit, + description = description, + isocountries = FALSE)) +} diff --git a/R/calcLPJmL_new.R b/R/calcLPJmL_new.R new file mode 100644 index 0000000..f9ad165 --- /dev/null +++ b/R/calcLPJmL_new.R @@ -0,0 +1,260 @@ +#' @title calcLPJmL_new +#' @description Handle LPJmL data and its time behaviour (smoothing and harmonizing to baseline) +#' +#' @param version Switch between LPJmL versions (including addons for further version specification) +#' @param climatetype Switch between different climate scenarios +#' @param subtype Switch between different lpjml input as specified in readLPJmL +#' @param subdata Switch between data dimension subitems +#' @param stage Degree of processing: raw, smoothed - raw or smoothed data from 1930|1951 +#' raw1901, smoothed1901 - raw or smoothed data from 1901 +#' harmonized, harmonized2020 - based on toolLPJmLVersion +#' +#' @return List of magpie objects with results on cellular level, weight, unit and description. +#' +#' @author Kristine Karstens, Felicitas Beier +#' +#' @importFrom madrat calcOutput readSource toolSubtypeSelect toolSplitSubtype +#' @importFrom magclass dimSums getYears setYears +#' +#' @seealso +#' [readLPJmL()] +#' @examples +#' \dontrun{ +#' calcOutput("LPJmL_new", subtype = "soilc", aggregate = FALSE) +#' } +#' +calcLPJmL_new <- function(version = "LPJmL4_for_MAgPIE_44ac93de", # nolint + climatetype = "MRI-ESM2-0:ssp370", + subtype = "soilc", subdata = NULL, stage = "harmonized2020") { + # Create settings for LPJmL from version and climatetype argument + cfg <- toolLPJmLVersion(version = version, climatetype = climatetype) + + if (grepl("raw|smoothed", stage)) { + + if (subtype %in% c("discharge", "runoff", "lake_evap", "input_lake")) { + # calcLPJmL subtypes (returned by calcLPJmL) that are calculated based on different original LPJmL subtypes + readinmap <- c(lake_evap = "mpet", # mpet_natveg lake_evap = pet * lake_shr * cell_area + input_lake = "aprec", # aprec_natveg input_lake = aprec * lake_shr * cell_area + discharge = "mdischarge", + runoff = "mrunoff") + + subtypeIn <- toolSubtypeSelect(subtype, readinmap) + + } else { + subtypeIn <- subtype + } + + if (grepl("\\+scen", cfg$readin_version)) { + scen <- gsub("(.+)\\+scen:([^\\+]*)(.*)", "_\\2", cfg$readin_version) + cfg$readin_version <- gsub("\\+scen:([^\\+]*)", "", cfg$readin_version) + cfg$climatetype <- paste0(cfg$climatetype, scen) + } + readinName <- paste(cfg$readin_version, cfg$climatetype, subtypeIn, sep = ":") + readinHist <- gsub("ssp[0-9]{3}", "historical", readinName) + + ########## PLUG HIST + FUTURE ########## + + if (!grepl("historical", cfg$climatetype)) { + + x <- mbind(readSource("LPJmL_new", subtype = readinHist, convert = FALSE), + readSource("LPJmL_new", subtype = readinName, convert = FALSE)) + years <- getYears(x, as.integer = TRUE) + x <- x[, years[years >= 1951], ] + + } else { + + x <- readSource("LPJmL_new", subtype = readinName, convert = FALSE) + years <- getYears(x, as.integer = TRUE) + if (!grepl("1901", stage)) x <- x[, years[years >= 1930], ] + + } + ########## PLUG HIST + FUTURE ########## + + if (!is.null(subdata)) { + if (!all(subdata %in% getNames(x))) { + stop(paste0("Subdata items '", subdata, "' are not part of selected LPJmL subtype!")) + } + x <- x[, , subdata] + } + + ########## UNIT TRANSFORMATION ############### + + if (grepl("soilc|soilc_layer|litc|vegc|alitfallc|alitter|vegc_grass|litc_grass|soilc_grass", subtype)) { + + unitTransform <- 0.01 + x <- x * unitTransform + unit <- "tC/ha" + + if (grepl("litc|soilc_layer", subtype)) x <- toolConditionalReplace(x, "<0", 0) + + } else if (grepl("*date*", subtype)) { + + unit <- "day of the year" + + } else if (grepl("aet|cft_transp_pft|discharge|runoff|lake_evap|input_lake", subtype)) { + # unit transformation + if (grepl("aet|cft_transp_pft", subtype)) { + # Annual evapotranspiration (evaporation + transpiration + interception) given in liter/m^2 + # Plant transpiration in liter/m^2 per season + # Transform units: liter/m^2 -> m^3/ha + unitTransform <- 10 + x <- x * unitTransform + + } else if (grepl("discharge", subtype)) { + # In LPJmL: (monthly) discharge given in hm3/d (= mio. m3/day) + # Transform units of discharge: mio. m^3/day -> mio. m^3/month + dayofmonths <- as.magpie(c(jan = 31, feb = 28, mar = 31, apr = 30, may = 31, jun = 30, + jul = 31, aug = 31, sep = 30, oct = 31, nov = 30, dec = 31)) + x <- x * dayofmonths + + # Annual value (total over all month) + if (!grepl("^m", subtype)) { + x <- dimSums(x, dim = 3) + } + + } else if (grepl("runoff", subtype)) { + ## In LPJmL: (monthly) runoff given in LPJmL: mm/month + # Transform units: liter/m^2 -> liter + # landarea in mio. ha + landarea <- setYears(collapseNames(dimSums(readSource("LUH2v2", subtype = "states", + convert = "onlycorrect")[, "y1995", ], + dim = 3)), NULL) + x <- x * landarea * 1e10 + # Transform units: liter -> mio. m^3 + x <- x / (1000 * 1000000) + + # Annual value (total over all month) + if (!grepl("^m", subtype)) { + x <- dimSums(x, dim = 3) + } + + } else if (grepl("lake_evap|input_lake", subtype)) { + ## In LPJmL: given in mm (=liter/m^2) + # Multiply by lake share + lakeShare <- readSource("LPJmLInputs", subtype = "lakeshare", convert = "onlycorrect") + x <- x * lakeShare + + # Transform units: liter/m^2 -> liter + cb <- toolGetMapping("LPJ_CellBelongingsToCountries.csv", + type = "cell", where = "mrcommons") + cellArea <- (111e3 * 0.5) * (111e3 * 0.5) * cos(cb$lat / 180 * pi) + x <- x * cellArea + + # Transform units: liter -> mio. m^3 + x <- x / (1000 * 1000000) + + # Annual value (total over all month) + if (grepl("lake_evap", subtype)) { + x <- dimSums(x, dim = 3) + } + } + + units <- c(aet = "m^3/ha", + cft_transp_pft = "m^3/ha", + discharge = "mio. m^3", + mdischarge = "mio. m^3", + lake_evap = "mio. m^3", + input_lake = "mio. m^3", + runoff = "mio. m^3", + mrunoff = "mio. m^3") + + unit <- toolSubtypeSelect(subtype, units) + + } else if (grepl("*harvest*|gpp_grass", subtype)) { + + yieldTransform <- 0.01 / 0.45 + x <- x * yieldTransform + unit <- "tDM/ha" + + } else if (grepl("irrig|cwater_b", subtype)) { + # Transform units: liter/m^2 (= mm) -> m^3/ha + irrigTransform <- 10 + # select only irrigated + x <- x[, , "irrigated"] * irrigTransform # units are now: m^3 per ha per year + unit <- "m^3/ha" + + } else if (grepl("et_grass", subtype)) { + # Transform units: liter/m^2 (= mm) -> m^3/ha + watTransform <- 10 + x <- x * watTransform + unit <- "m^3/ha" + + } else if (grepl("input_lake", subtype)) { + + unit <- "mio. m^3" + + } else if (grepl("cshift", subtype)) { + + unit <- "C/C" + + } else if (grepl("fpc", subtype)) { + + unit <- "ha/ha" + + } else if (grepl("mpet", subtype)) { + + unit <- "mm/month" + + } else { + stop(paste0("subtype ", subtype, " does not exist")) + } + + ########## UNIT TRANSFORMATION ############### + + if (grepl("smoothed", stage)) { + out <- toolSmooth(x) + } else { + out <- x + } + + } else if (stage == "harmonized") { + # read in historical data for subtype + baseline <- calcOutput("LPJmL_new", version = cfg$baseline_version, + climatetype = cfg$baseline_hist, subtype = subtype, + subdata = subdata, stage = "smoothed", + aggregate = FALSE, supplementary = TRUE) + + unit <- baseline$unit + baseline <- baseline$x + + x <- calcOutput("LPJmL_new", version = cfg$readin_version, + climatetype = cfg$climatetype, subtype = subtype, + subdata = subdata, stage = "smoothed", aggregate = FALSE) + out <- toolHarmonize2Baseline(x, baseline, ref_year = cfg$ref_year_hist) + + } else if (stage == "harmonized2020") { + # read in historical data for subtype + baseline2020 <- calcOutput("LPJmL_new", version = cfg$baseline_version, + climatetype = cfg$baseline_gcm, subtype = subtype, + subdata = subdata, stage = "harmonized", + aggregate = FALSE, supplementary = TRUE) + + unit <- baseline2020$unit + baseline2020 <- baseline2020$x + + if (cfg$climatetype == cfg$baseline_gcm && + cfg$readin_version == cfg$baseline_version) { + + out <- baseline2020 + + } else { + + x <- calcOutput("LPJmL_new", version = cfg$readin_version, + climatetype = cfg$climatetype, subtype = subtype, + subdata = subdata, stage = "smoothed", aggregate = FALSE) + out <- toolHarmonize2Baseline(x, baseline2020, ref_year = cfg$ref_year_gcm) + } + + } else { + stop("Stage argument not supported!") + } + + return(list( + x = out, + weight = NULL, + unit = unit, + min = 0, + description = paste0("Output from LPJmL (", subtype, ") for ", + version, " and ", climatetype, " at stage: ", stage, "."), + isocountries = FALSE)) +} diff --git a/R/calcLUH2MAgPIE.R b/R/calcLUH2MAgPIE.R new file mode 100644 index 0000000..ba743b8 --- /dev/null +++ b/R/calcLUH2MAgPIE.R @@ -0,0 +1,145 @@ +#' @title calcLUH2MAgPIE +#' @description Calculates the real aggregation of LUH croptypes to MAgPIE croptypes +#' out of LUH2FAO and FAO2MAgPIE mappings +#' +#' @param share total (for total numbers), LUHofMAG (for share of LUH within kcr types), +#' MAGofLUH (for share of kcr within LUH types) +#' @param bioenergy "ignore": 0 for share and totals, +#' "fix": fixes betr and begr shares in LUHofMAG to 1 for c3per and c4per +#' @param rice rice category: "non_flooded" or "total" +#' @param selectyears years to be returned (default: "past") +#' @param missing "ignore" will leave data as is, +#' "fill" will add proxy values for data gaps of FAO +#' @return List of magpie objects with results on country level, weight on country level, unit and description +#' @author Kristine Karstens, Felicitas Beier +#' @examples +#' \dontrun{ +#' calcOutput("LUH2MAgPIE") +#' } +#' +#' @importFrom magpiesets findset + +calcLUH2MAgPIE <- function(share = "total", bioenergy = "ignore", rice = "non_flooded", + selectyears = "past", missing = "ignore") { + past <- findset("past") + + if (share == "total") { + + if (missing == "fill") { + warning("No missing data for total numbers assumend.") + } + + FAOdata <- calcOutput("Croparea", sectoral = "ProductionItem", # nolint : object_name_linter. + physical = FALSE, aggregate = FALSE)[, past, ] + + if (rice == "non_flooded") { + # Rice areas are pre-determined by areas reported as flooded in LUH. + # All additional rice areas (according to FAO) are allocated using FAO data + nonfloodedShr <- calcOutput("Ricearea", cellular = FALSE, share = TRUE, aggregate = FALSE) + FAOdata[, , "27|Rice, paddy"] <- FAOdata[, , "27|Rice, paddy"] * nonfloodedShr # nolint : object_name_linter. + } + + kcr <- findset("kcr") + mapping <- toolGetMapping("FAO2LUH2MAG_croptypes.csv", type = "sectoral", where = "mrcommons") + + aggregation <- toolAggregate(FAOdata, rel = mapping, from = "ProductionItem", + to = "LUH2kcr", dim = 3.1, partrel = TRUE) + aggregation <- add_columns(aggregation, addnm = c("betr", "begr"), dim = 3.2) + aggregation <- aggregation[, , kcr] + aggregation <- complete_magpie(collapseNames(aggregation), fill = 0) + aggregation[which(is.na(aggregation))] <- 0 + getSets(aggregation, fulldim = FALSE) <- c("ISO", "Year", "LUH.MAG") + + x <- aggregation + unit <- "million ha" + + } else if (share == "LUHofMAG") { + + aggregation <- calcOutput("LUH2MAgPIE", aggregate = FALSE, selectyears = selectyears, rice = rice) + + MAG <- dimSums(aggregation, dim = "LUH") # nolint : object_name_linter. + x <- aggregation / MAG + x[which(is.na(x))] <- 0 + unit <- "share of area" + + if (bioenergy == "fix") { + + x[, , "c3per.betr"] <- 1 + x[, , "c4per.begr"] <- 1 + + } else if (bioenergy != "ignore") { + stop("2nd generation bioenergy setting not supported") + } + + if (missing == "fill") { + # check for countries/years where no data is reported from FAO and fill with proxy of similar country + noData <- where(dimSums(toolIso2CellCountries(x), dim = 3) == 0)$true$individual + proxyMapping <- c(ATF = "ISL", ESH = "MAR", FLK = "ISL", GRL = "ISL", + PSE = "ISR", SGS = "ISL", SJM = "NOR", + CIV = "GHA", GUF = "SUR", REU = "MUS", SSD = "CAF", SDN = "TCD") + + for (i in row(noData)[, 1]) { + x[noData[i, "ISO"], noData[i, "Year"], ] <- x[proxyMapping[noData[i, "ISO"]], noData[i, "Year"], ] + } + + # check for countries/years/croptypes where no data is reported from FAO and fill with default values + noData <- where(dimSums(x, dim = 3.1) == 0)$true$individual + meanValues <- dimSums(x * dimSums(aggregation, dim = "LUH"), dim = "ISO") / + dimSums(aggregation, dim = c("ISO", "LUH")) + meanValues[is.nan(meanValues)] <- 0 + for (i in row(noData)[, 1]) { + x[noData[i, "ISO"], noData[i, "Year"], noData[i, "MAG"]] <- meanValues[, noData[i, "Year"], noData[i, "MAG"]] + } + + # consistency check + if (any(round(dimSums(x, dim = 3.1), 4) != 1)) { + warning("Not all factors could been filled, even though 'missing' was set to 'fill'.") + } + } + + } else if (share == "MAGofLUH") { + + aggregation <- calcOutput("LUH2MAgPIE", aggregate = FALSE, selectyears = selectyears, rice = rice) + + LUH <- dimSums(aggregation, dim = "MAG") # nolint : object_name_linter. + x <- aggregation / LUH + x[which(is.na(x))] <- 0 + unit <- "share of area" + + if (bioenergy != "ignore") { + stop("2nd generation bioenergy setting not supported") + } + + if (missing == "fill") { + # check for countries/years where no data is reported from FAO and fill with proxy + noData <- where(dimSums(toolIso2CellCountries(x), dim = 3) == 0)$true$individual + proxyMapping <- c(ATF = "ISL", ESH = "MAR", FLK = "ISL", GRL = "ISL", + PSE = "ISR", SGS = "ISL", SJM = "NOR", + CIV = "GHA", GUF = "SUR", REU = "MUS", SSD = "CAF", SDN = "TCD") + for (i in row(noData)[, 1]) { + x[noData[i, "ISO"], noData[i, "Year"], ] <- x[proxyMapping[noData[i, "ISO"]], noData[i, "Year"], ] + } + + # check for countries/years/croptypes where no data is reported from FAO and fill with default values + noData <- where(dimSums(x, dim = 3.2) == 0)$true$individual + meanValues <- dimSums(x * dimSums(aggregation, dim = "MAG"), dim = "ISO") / + dimSums(aggregation, dim = c("ISO", "MAG")) + for (i in row(noData)[, 1]) { + x[noData[i, "ISO"], noData[i, "Year"], noData[i, "LUH"]] <- meanValues[, noData[i, "Year"], noData[i, "LUH"]] + } + + # consistency check + if (any(round(dimSums(x, dim = 3.2), 4) != 1)) { + warning("Not all factors could been filled, even though 'missing' was set to 'fill'.") + } + } + + } else { + stop("Share type not supported") + } + + return(list(x = x, + weight = NULL, + unit = unit, + description = "Relation matrix for LUH croptype and MAgPIE croptype areas")) +} diff --git a/R/calcLUH2v2.R b/R/calcLUH2v2.R new file mode 100644 index 0000000..f30b7c7 --- /dev/null +++ b/R/calcLUH2v2.R @@ -0,0 +1,99 @@ +#' @title calcLUH2v2 +#' @description Integrates the LUH2v2 landuse-dataset +#' +#' @param landuse_types magpie: magpie landuse classes, +#' LUH2v2: original landuse classes +#' flooded: flooded areas as reported by LUH +#' @param irrigation if true: areas are returned separated by irrigated and rainfed, +#' if false: total areas +#' @param cellular if true: dataset is returned on 0.5 degree resolution +#' @param cells Switch between "magpiecell" (59199) and "lpjcell" (67420) +#' NOTE: This setting also affects the sums on country level! +#' @param selectyears years to be returned (default: "past") +#' +#' @return List of magpie objects with results on country level, +#' weight on country level, unit and description +#' +#' @author Benjamin Leon Bodirsky, Florian Humpenoeder, Jens Heinke, Felicitas Beier +#' @seealso +#' [calcLanduseInitialisation()] +#' @examples +#' \dontrun{ +#' calcOutput("LUH2v2") +#' } +#' @importFrom magclass getNames +#' @importFrom magpiesets findset + +calcLUH2v2 <- function(landuse_types = "magpie", irrigation = FALSE, # nolint + cellular = FALSE, cells = "lpjcell", selectyears = "past") { + + selectyears <- sort(findset(selectyears, noset = "original")) + + if (!all(landuse_types %in% c("magpie", "LUH2v2", "flooded"))) { + stop("Unknown lanuses_types = \"", landuse_types, "\"") + } + + if (landuse_types == "flooded") { + x <- readSource("LUH2v2", subtype = "irrigation", convert = "onlycorrect")[, selectyears, "flood"] + } else { + x <- readSource("LUH2v2", subtype = "states", convert = "onlycorrect")[, selectyears, ] + getSets(x, fulldim = FALSE)[3] <- "landuse" + + if (isTRUE(irrigation)) { + + irrigLUH <- readSource("LUH2v2", subtype = "irrigation", convert = "onlycorrect")[, selectyears, ] + + if (is.null(selectyears)) { + vcat(verbosity = 3, "too many years may lead to memory problems if irrigation = TRUE") + } + + # irrigated areas (excluding flood) + irrigLUH <- irrigLUH[, , "flood", invert = TRUE] + getNames(irrigLUH) <- substring(getNames(irrigLUH), 7) + + x <- add_dimension(x, dim = 3.2, add = "irrigation", nm = "total") + x <- add_columns(x, dim = 3.2, addnm = c("irrigated", "rainfed")) + x[, , "irrigated"] <- 0 + + irrigLUH <- add_dimension(irrigLUH, dim = 3.2, add = "irrigation", nm = "irrigated") + x[, , paste(getNames(irrigLUH, dim = 1), "irrigated", sep = ".")] <- irrigLUH + + # rainfed areas + x[, , "rainfed"] <- collapseNames(x[, , "total"]) - collapseNames(x[, , "irrigated"]) + + if (any(x[, , "rainfed"] < 0)) { + vcat(verbosity = 2, "Flooded/irrigated area larger than rainfed area. + Irrigation limited to total cropland area.") + tmp <- collapseNames(x[, , "irrigated"]) + tmp[x[, , "rainfed"] < 0] <- collapseNames(x[, , "total"])[x[, , "rainfed"] < 0] + x[, , "irrigated"] <- tmp + x[, , "rainfed"] <- collapseNames(x[, , "total"]) - collapseNames(x[, , "irrigated"]) + } + + if (any(x[, , "rainfed"] < 0)) { + vcat(verbositiy = 1, "Flooded/irrigated area larger than rainfed area despite fix.") + } + } + if (landuse_types == "magpie") { + mapping <- toolGetMapping(type = "sectoral", name = "LUH2v2.csv", where = "mappingfolder") + x <- toolAggregate(x, mapping, dim = 3.1, from = "luh2v2", to = "land") + } + } + + # Return correct cell format for further calculations + # ATTENTION: depending on the settings this might remove some cells + # from the data set! + if (cellular) { + if (cells == "magpiecell") { + x <- toolCoord2Isocell(x, cells = cells) + } + } else { + x <- toolConv2CountryByCelltype(x, cells = cells) + } + + return(list(x = x, + weight = NULL, + unit = "Mha", + description = "land area for different land use types.", + isocountries = !cellular)) +} diff --git a/R/calcLanduseInitialisation.R b/R/calcLanduseInitialisation.R new file mode 100644 index 0000000..47173d1 --- /dev/null +++ b/R/calcLanduseInitialisation.R @@ -0,0 +1,72 @@ +#' @title calcLanduseInitialisation +#' @description Calculates the cellular MAgPIE landuse initialisation area. +#' Data from FAO on forestry is used to split the secondary forest pool +#' of the LU2v2 dataset into forestry and secd_forest. +#' +#' @param cellular cellular (TRUE) or country-level/regional (FALSE) data? +#' For country-level vs regional data: remember to set "aggregate" to FALSE. +#' @param nclasses options are either "six", "seven" or "nine". +#' \itemize{ +#' \item "six" includes the original land use classes "crop", "past", "forestry", "forest", "urban" and "other" +#' \item "seven" separates primary and secondary forest and includes "crop", "past", "forestry", "primforest", +#' "secdforest", "urban" and "other" +#' \item "nine" adds the separation of pasture and rangelands, as well as a differentiation of primary +#' and secondary non-forest vegetation and therefore returns "crop", "past", "range", "forestry", "primforest", +#' "secdforest", "urban", "primother" and "secdother" +#' } +#' @param cells if cellular is TRUE: "magpiecell" for 59199 cells or "lpjcell" for 67420 cells +#' @param input_magpie applies area fix (set cells with zero area to minimal value to +#' not disturb aggregating to clusters) +#' @param selectyears default on "past" +#' @return List of magpie object with results on country or cellular level, weight on cellular level, +#' unit and description. +#' @author Jan Philipp Dietrich, Benjamin Leon Bodirsky, Kristine Karstens, Felcitas Beier, Patrick v. Jeetze +#' @examples +#' \dontrun{ +#' calcOutput("LanduseInitialisation") +#' } +#' @importFrom magclass setNames where + + +calcLanduseInitialisation <- function(cellular = FALSE, nclasses = "seven", + cells = "lpjcell", selectyears = "past", + input_magpie = FALSE) { # nolint + + if (isFALSE(cellular)) { + out <- calcOutput("LanduseInitialisationBase", cells = "lpjcell", + selectyears = selectyears, aggregate = FALSE) + out <- toolCountryFill(dimSums(out, + dim = c("x", "y")), + fill = 0, verbosity = 2) + } else { + out <- calcOutput("LanduseInitialisationBase", cells = cells, + selectyears = selectyears, aggregate = FALSE) + } + + if (isTRUE(input_magpie)) { + # add some small area to completely empty cells to avoid + # problems in the further processing + out <- round(out, 8) + cellArea <- dimSums(out, dim = 3) + out[, , "secdother"][cellArea == 0] <- 10^-6 + } + + if (nclasses != "nine") { + map <- data.frame(nine = c("crop", "past", "range", "forestry", "primforest", "secdforest", + "urban", "primother", "secdother"), + seven = c("crop", "past", "past", "forestry", "primforest", "secdforest", + "urban", "other", "other"), + six = c("crop", "past", "past", "forestry", "forest", "forest", + "urban", "other", "other")) + if (!(nclasses %in% names(map))) stop("unknown nclasses setting \"", nclasses, "\"") + out <- toolAggregate(out, rel = map, dim = 3, from = "nine", to = nclasses) + } + + return(list(x = out, + weight = NULL, + unit = "Mha", + min = 0, + max = 14900, ### global land area + description = "Land use initialisation data for different land pools", + isocountries = !cellular)) +} diff --git a/R/calcLanduseInitialisationBase.R b/R/calcLanduseInitialisationBase.R new file mode 100644 index 0000000..8b8b485 --- /dev/null +++ b/R/calcLanduseInitialisationBase.R @@ -0,0 +1,131 @@ +#' @title calcLanduseInitialisationBase +#' @description Calculates the cellular MAgPIE landuse initialisation area. Data from FAO on forestry is used +#' to split the secondary forest pool of the LU2v2 dataset into forestry and secd_forest. This function +#' returns the data set in a basic configuration. Use \code{\link{calcLanduseInitialisation}} for +#' more settings. +#' +#' @param cells "magpiecell" for 59199 cells or "lpjcell" for 67420 cells +#' @param selectyears Years to be computed (default on "past") +#' @return Cellular landuse initialisation in its base configuration +#' @author Jan Philipp Dietrich, Benjamin Leon Bodirsky, Kristine Karstens, Felcitas Beier, Patrick v. Jeetze +#' @examples +#' \dontrun{ +#' calcOutput("LanduseInitialisationBase") +#' } +calcLanduseInitialisationBase <- function(cells = "lpjcell", selectyears = "past") { + + selectyears <- sort(findset(selectyears, noset = "original")) + + .luIni <- function(luh, forestArea) { + .shr <- function(x) { + x <- x + 10^-10 + return(x / dimSums(x, dim = 3)) + } + + .expand <- function(x, target) { + map <- data.frame(from = getItems(target, dim = "iso", full = TRUE), + to = getItems(target, dim = 1)) + return(toolAggregate(x[getItems(target, dim = "iso"), , ], map, from = "from", to = "to")) + } + map <- data.frame(luh = c("c3ann", "c4ann", "c3per", "c4per", "c3nfx", "pastr", "range", + "primf", "secdf", "secdf", "urban", "primn", "secdn"), + lu = c("crop", "crop", "crop", "crop", "crop", "past", "range", + "primforest", "secdforest", "forestry", "urban", "other", "other")) + lu <- toolAggregate(luh, map, dim = 3) + # Attention: mapping maps secdf on both: secdforest and forestry (both contain after aggregation the full secondary + # forest area)! Next step will calculate proper shares and multiply it to compute correct areas + secdf <- c("secdforest", "forestry") + forestShares <- .expand(x = .shr(forestArea[, , secdf]), target = lu) + lu[, , secdf] <- forestShares * lu[, , secdf] + return(lu) + } + + .natureTarget <- function(lu, forestArea) { + # compute target for primforest, secdforest and other (aggregate of primother and secdother) + forests <- c("primforest", "secdforest", "forestry") + nature <- c(forests, "other") + + # Correct for overflow effects (forestArea greater than forest and other land available in luInit) + overflow <- forestArea[, , "forest"] - dimSums(lu[, , nature], dim = 3) + overflow[overflow < 0] <- 0 + if (any((of <- dimSums(overflow, dim = 1)) > 0)) { + vcat(verbosity = 2, paste("Mismatch of FAO forest exceed LUH forest + other land by:", + paste0(paste(getYears(of), round(of, 0), "Mha"), collapse = ", "), + "- FAO forest data will be cut.")) + # corrected forest areas <- weight of forest subcategories * corrected total forest area + corr <- setNames((forestArea[, , "forest"] + 10e-10 - overflow) / (forestArea[, , "forest"] + 10e-10), NULL) + forestArea <- corr * forestArea + } + + # compute other land area (diff between total natural land and forest area) + otherArea <- setNames(dimSums(lu[, , nature], dim = 3) - forestArea[, , "forest"], "other") + if (any(otherArea < -10e-6)) { + warning("Other land area is partly negative. This should not be the case! values will be corrected to 0.") + } + # due to rounding there are always some very small values below 0 which is why it is always corrected to 0, but + # a warning is only triggered for values smaller than 10e-6 + otherArea[otherArea < 0] <- 0 + + return(mbind(forestArea[, , forests], otherArea)) + } + + # cellular landuse area + luh <- calcOutput("LUH2v2", landuse_types = "LUH2v2", irrigation = FALSE, cellular = TRUE, + selectyears = selectyears, cells = "lpjcell", aggregate = FALSE) + # country-level forest area + forestArea <- calcOutput("ForestArea", selectyears = selectyears, aggregate = FALSE) + # rename categories and split secondary forest into secondary forest and forestry + # based on forestArea information (area sizes kept as reported by luh) + lu <- .luIni(luh, forestArea) + + luCountry <- toolCountryFill(dimSums(lu, dim = c("x", "y")), + fill = 0, verbosity = 2) + natTarget <- .natureTarget(luCountry, forestArea) + + vegC <- calcOutput("LPJmL_new", subtype = "vegc", stage = "smoothed", + version = "LPJmL4_for_MAgPIE_44ac93de", climatetype = "GSWP3-W5E5:historical", + aggregate = FALSE)[, selectyears, ] + + lu2 <- toolForestRelocate(lu = lu, luCountry = luCountry, natTarget = natTarget, vegC = vegC) + + .splitOther <- function(lu, luh) { + # split other land in primary and secondary other land + # try to adjust only secondary other land and only touch primary other land + # if total other land is smaller than primary other land + other <- setNames(luh[, , c("primn", "secdn")], c("primother", "secdother")) + secdother <- setNames(lu[, , "other"] - other[, , "primother"], NULL) + # handle cases in which the above calculation became negative + if (any(secdother < 0)) { + remove <- -secdother + remove[remove < 0] <- 0 + secdother[secdother < 0] <- 0 + other[, , "primother"] <- other[, , "primother"] - remove + } + other[, , "secdother"] <- secdother + if (max(abs(dimSums(other, dim = 3) - lu[, , "other"])) > 10e-6) { + warning("splitted other land does not sum up to total other land!") + } + return(mbind(lu[, , "other", invert = TRUE], other)) + } + + out <- .splitOther(lu2, luh) + + if (cells == "magpiecell") { + out <- toolCoord2Isocell(out, cells = cells) + } + + if (any(out < 0)) { + if (min(out) < -10e-6) { + warning("Negative land values detected in LanduseInitialisationBase and replaced by 0.") + } + out[out < 0] <- 0 + } + + return(list(x = out, + weight = NULL, + unit = "Mha", + min = 0, + max = 14900, ### global land area + description = "Land use initialisation data for different land pools", + isocountries = FALSE)) +} diff --git a/R/calcMulticropping.R b/R/calcMulticropping.R new file mode 100644 index 0000000..a2576ad --- /dev/null +++ b/R/calcMulticropping.R @@ -0,0 +1,68 @@ +#' @title calcMulticropping +#' @description calculates a multiple cropping factor based on area harvested, +#' physical cropland area (and optionally fallow land). +#' +#' @param extend_future if TRUE +#' @param factortype CI: cropping intensity factor calculated as ratio of +#' harvested to physical area where values above one +#' indicate multicropping, below one fallow land (default) +#' MC: multiple cropping factor indicating areas that are +#' harvested more than once in one year calculated taking +#' fallow land into account explicitly: +#' harvestedArea / (physicalArea - fallowLand) +#' @return List of magpie objects with results on country level, weight on country level, unit and description. +#' @author Benjamin Leon Bodirsky, David Chen, Felicitas Beier +#' @seealso +#' [calcFAOLand()], +#' [calcCroparea()] +#' @examples +#' \dontrun{ +#' calcOutput("Multicropping") +#' } +#' +calcMulticropping <- function(extend_future = FALSE, factortype = "CI") { # nolint + + # physical cropland area ("6620|Cropland") + phys <- collapseNames(calcOutput("FAOLand", aggregate = FALSE)[, , "6620", pmatch = TRUE]) + # harvested area + harv <- collapseNames(dimSums(calcOutput("Croparea", physical = FALSE, + aggregate = FALSE, sectoral = "kcr"), + dim = 3.1)) + + # match year dimension + phys <- phys[, intersect(getYears(phys), getYears(harv)), ] + harv <- harv[, intersect(getYears(phys), getYears(harv)), ] + + if (factortype == "CI") { + # Cropping intensity (>1: mulitple cropping dominates; <1: fallow land dominates) + out <- harv / phys + description <- "cropping intensity factor with values above one indicating multicropping, below one fallow land" + + } else if (factortype == "MC") { + # fallow land ("6640|Land with temporary fallow") + fallow <- collapseNames(calcOutput("FAOLand", aggregate = FALSE)[, , "6640", pmatch = TRUE]) + + # match year dimension + fallow <- fallow[, intersect(getYears(fallow), getYears(harv)), ] + + # Multiple cropping factor accounting for land that is left fallow + out <- harv / (phys - fallow) + description <- "multiple cropping factor explicitly accounting for fallow land" + + } else { + stop("Please select calculation method via the type argument in calcMulticropping") + } + + out[is.na(out)] <- 0 + out[out == Inf] <- 0 + + if (extend_future == TRUE) { + out <- toolHoldConstantBeyondEnd(out) + phys <- toolHoldConstantBeyondEnd(phys) + } + + return(list(x = out, + weight = phys, + unit = "ratio", + description = description)) +} diff --git a/R/calcMulticroppingSuitability.R b/R/calcMulticroppingSuitability.R new file mode 100644 index 0000000..8a4fede --- /dev/null +++ b/R/calcMulticroppingSuitability.R @@ -0,0 +1,146 @@ +#' @title calcMulticroppingSuitability +#' +#' @description Calculates which grid cells are potentially suitable for +#' multiple cropping activities under rainfed and irrigated conditions. +#' Calculation is based on the length of the growing period determined by +#' monthly grassland gross primary production (GPP). +#' +#' @param selectyears Years to be returned +#' @param lpjml LPJmL version required for respective inputs: natveg or crop +#' @param climatetype Switch between different climate scenarios or +#' historical baseline "GSWP3-W5E5:historical" +#' @param suitability "endogenous": suitability for multiple cropping determined +#' by rules based on grass and crop productivity +#' "exogenous": suitability for multiple cropping given by +#' GAEZ data set +#' @param sectoral "kcr" MAgPIE crops, and "lpj" LPJmL crops +#' +#' @return magpie object in cellular resolution +#' @author Felicitas Beier, Jens Heinke +#' +#' @examples +#' \dontrun{ +#' calcOutput("MulticroppingSuitability", aggregate = FALSE) +#' } +#' +#' @importFrom madrat calcOutput +#' @importFrom magclass setYears getSets mbind getItems new.magpie +#' + +calcMulticroppingSuitability <- function(selectyears, lpjml, climatetype, + suitability = "endogenous", sectoral = "kcr") { + # mappings + lpj2mag <- toolGetMapping("MAgPIE_LPJmL.csv", + type = "sectoral", + where = "mappingfolder") + mapCell <- toolGetMappingCoord2Country() + + # crop selection + if (sectoral == "kcr") { + # MAgPIE crops selected + croplist <- unique(lpj2mag$MAgPIE) + # remove pasture from croplist + croplist <- croplist[croplist != "pasture"] + # Crops that are not suitable for multiple cropping (either because they are a perennial + # crop that's grown over several years or because the growing period is too long to + # allow for another season + cropsNoMC <- c("sugr_cane", "oilpalm", "betr", "begr") + + } else if (sectoral == "lpj") { + # LPJmL crops selected + croplist <- unique(lpj2mag$LPJmL) + # remove mgrass from croplist + croplist <- croplist[croplist != "mgrass"] + # Crops that are not suitable for multiple cropping (either because they are a perennial + # crop that's grown over several years or because the growing period is too long to + # allow for another season + cropsNoMC <- c("sugarcane", "betr", "begr") + + } + + # Prepare data structure as crop-specific object + # (While the chosen rule is not crop-specific, + # crops that are not multiple cropping suitable are marked as such. + # This is done further down in the code) + suitMC <- new.magpie(cells_and_regions = paste(mapCell$coords, mapCell$iso, sep = "."), + years = selectyears, + names = paste(croplist, + c(rep("rainfed", length(croplist)), + rep("irrigated", length(croplist))), + sep = "."), + fill = NA, + sets = c("x", "y", "iso", "year", "crop", "irrigation")) + + # Choose how multiple cropping suitability is determined + if (suitability == "endogenous") { + # Read in growing period months + grper <- calcOutput("GrowingPeriodMonths", + selectyears = selectyears, + lpjml = lpjml, climatetype = climatetype, + aggregate = FALSE) + + # Calculate length of growing period + lgp <- dimSums(grper, dim = "month") + + ### Multicropping Mask ### + ## Rule: Minimum length of growing period of 9 months + suitMC[, , "rainfed"] <- (lgp >= 9)[, , "rainfed"] + suitMC[, , "irrigated"] <- (lgp >= 9)[, , "irrigated"] + + } else if (suitability == "exogenous") { + #################### + ### Read in data ### + #################### + mcZones <- calcOutput("MultipleCroppingZones", layers = 2, aggregate = FALSE) + suitMC[, , "rainfed"] <- mcZones[, , "rainfed"] + suitMC[, , "irrigated"] <- mcZones[, , "irrigated"] + + } else { + stop("Please select whether endogenously calculated multiple cropping suitability + mask (endogenous) should be selected or whether + GAEZ Multiple Cropping Zones data set should be used (exogenous)") + } + + if (any(suitMC[, , sample(croplist, 1)] != suitMC[, , sample(croplist, 1)])) { + stop("Multiple cropping suitability is not defined as crop-specific + and should be the same for every crop. + This is not the case here. + Please double-check in mrland:calcMulticroppingSuitability") + } + + # Crops that cannot be multiple cropped have suitability of 0 + suitMC[, , cropsNoMC] <- 0 + + # If multiple cropping is possible under rainfed conditions, + # it is also possible under irrigated conditions + rfMC <- collapseNames(suitMC[, , "rainfed"]) + suitMC[, , "irrigated"][rfMC == 1] <- 1 + + ############## + ### Checks ### + ############## + if (any(is.na(suitMC))) { + stop("calcMulticroppingSuitability produced NA values") + } + if (any(suitMC < 0)) { + stop("calcMulticroppingSuitability produced negative values") + } + if (any(suitMC != 1 && suitMC != 0)) { + stop("Problem in calcMulticroppingSuitability: Value should be 0 or 1!") + } + + ############## + ### Return ### + ############## + out <- suitMC + unit <- "boolean" + description <- paste0("Suitability for multicropping ", + "under irrigated and rainfed conditions. ", + "1 = suitable, 0 = not suitable") + + return(list(x = out, + weight = NULL, + unit = unit, + description = description, + isocountries = FALSE)) +} diff --git a/R/calcMultipleCroppingZones.R b/R/calcMultipleCroppingZones.R new file mode 100644 index 0000000..03b6e6c --- /dev/null +++ b/R/calcMultipleCroppingZones.R @@ -0,0 +1,82 @@ +#' @title calcMultipleCroppingZones +#' @description This function returns multiple cropping zones at 0.5 degree resolution +#' +#' @param layers 8 for original GAEZ layers, +#' 3 for aggregated multiple cropping zones with +#' 1 = single cropping, 2 = double cropping, 3 = triple cropping +#' 2 for aggregated boolean multicropping potential with +#' 0 = no multicropping (single cropping), 1 = multiple cropping +#' +#' @return magpie object in cellular resolution +#' @author Felicitas Beier +#' +#' @examples +#' \dontrun{ +#' calcOutput("MultipleCroppingZones", layers = 3, aggregate = FALSE) +#' } +#' +#' @importFrom magclass new.magpie getYears getNames + +calcMultipleCroppingZones <- function(layers = 2) { + # Read in source + x <- readSource("GAEZv4", subtype = "MCzones", convert = "onlycorrect") + + if (layers == 8) { + + out <- x + + } else if (layers == 3) { + + mapping <- toolGetMappingCoord2Country(pretty = TRUE) + out <- new.magpie(cells_and_regions = paste(mapping$coords, mapping$iso, sep = "."), + years = getYears(x), + names = getNames(x), + sets = getSets(x), + fill = NA) + # Aggregation of multiple cropping zone categories + out[x == 0] <- 1 # where no data given single-cropping potential assumed + out[x == 1] <- 1 # where no cropping takes place yet single-cropping potential assumed + out[x == 2] <- 1 # single cropping -> single cropping + out[x == 3] <- 1 # limited double cropping -> single cropping + out[x == 4] <- 2 # double cropping -> double cropping + out[x == 5] <- 2 # double cropping with rice -> double cropping + out[x == 6] <- 2 # double rice cropping -> double cropping + out[x == 7] <- 3 # triple cropping -> triple cropping + out[x == 8] <- 3 # triple rice cropping -> triple cropping + + } else if (layers == 2) { + + mapping <- toolGetMappingCoord2Country(pretty = TRUE) + out <- new.magpie(cells_and_regions = paste(mapping$coords, mapping$iso, sep = "."), + years = getYears(x), + names = getNames(x), + sets = getSets(x), + fill = NA) + # Aggregation of multiple cropping zone categories + out[x == 0] <- 0 # where no data given single-cropping potential assumed + out[x == 1] <- 0 # where no cropping takes place yet single-cropping potential assumed + out[x == 2] <- 0 # single cropping -> single cropping + out[x == 3] <- 0 # limited double cropping -> single cropping + out[x == 4] <- 1 # double cropping -> double cropping + out[x == 5] <- 1 # double cropping with rice -> double cropping + out[x == 6] <- 1 # double rice cropping -> double cropping + out[x == 7] <- 1 # triple cropping -> triple cropping + out[x == 8] <- 1 # triple rice cropping -> triple cropping + + } else { + stop("Selected number of layers is not available. + Please select 8 for original GAEZ layers or 3 for reduced layers + or 2 for boolean whether multiple cropping is possible") + } + + # Checks + if (any(is.na(out))) { + stop("produced NA multiple cropping zones") + } + + return(list(x = out, + weight = NULL, + unit = "1", + description = "multiple cropping zones", + isocountries = FALSE)) +} diff --git a/R/calcRicearea.R b/R/calcRicearea.R new file mode 100644 index 0000000..a7daee2 --- /dev/null +++ b/R/calcRicearea.R @@ -0,0 +1,125 @@ +#' @title calcRicearea +#' @description calculates rice area based on LUH flooded areas and +#' physical rice areas reported by FAOSTAT. +#' +#' @param cellular If TRUE: calculates cellular rice area +#' @param cells Switch between "magpiecell" (59199) and "lpjcell" (67420) +#' @param share If TRUE: non-flooded share is returned. +#' If FALSE: rice area (flooded, non-flooded, total) in Mha is returned +#' +#' @return rice areas or rice area shares of flooded and non-flooded category +#' +#' @author Felicitas Beier, Kristine Karstens +#' +#' @importFrom magpiesets findset +#' @importFrom withr local_options + +calcRicearea <- function(cellular = FALSE, cells = "lpjcell", share = TRUE) { + + local_options(magclass_sizeLimit = 1e+12) + + selectyears <- findset("past") + + ############################################ + ### Ricearea and shares on country level ### + ############################################ + + # Country-level LUH flooded areas + floodedLUHiso <- collapseNames(calcOutput("LUH2v2", landuse_types = "flooded", + cells = cells, aggregate = FALSE, irrigation = TRUE, + cellular = FALSE, selectyears = "past")) + + # FAO rice areas (physical to be comparable with LUH) + riceareaFAOiso <- collapseNames(calcOutput("Croparea", sectoral = "kcr", physical = TRUE, + cellular = FALSE, cells = "magpicell", irrigation = FALSE, + aggregate = FALSE)[, selectyears, "rice_pro"]) + + # Country-level rice area + ricearea <- floodedLUHiso + + # Correction for flooded non-rice areas (floodedLUHiso > riceareaFAOiso) + ricearea[floodedLUHiso > riceareaFAOiso] <- riceareaFAOiso[floodedLUHiso > riceareaFAOiso] + nonriceShr <- ifelse(floodedLUHiso > 0, + ricearea / floodedLUHiso, + 0) + + # Correction for aerobic (non-paddy) rice (floodedLUHiso < riceareaFAOiso) + floodedRicearea <- riceareaFAOiso + floodedRicearea[floodedLUHiso < riceareaFAOiso] <- floodedLUHiso[floodedLUHiso < riceareaFAOiso] + floodedShr <- ifelse(riceareaFAOiso > 0, + floodedRicearea / riceareaFAOiso, + 0) + + # Non-flooded rice area + nonfloodedRicearea <- ricearea * (1 - floodedShr) + + if (!cellular) { + + if (share) { + + out <- 1 - floodedShr + unit <- "Share" + description <- "Share of rice area that is non-flooded" + + } else { + + ricearea <- add_dimension(ricearea, dim = 3.1, + add = "type", nm = "total") + floodedRicearea <- add_dimension(floodedRicearea, dim = 3.1, + add = "type", nm = "flooded") + nonfloodedRicearea <- add_dimension(nonfloodedRicearea, dim = 3.1, + add = "type", nm = "nonflooded") + + out <- collapseNames(mbind(ricearea, floodedRicearea, nonfloodedRicearea)) + unit <- "Mha" + description <- "Physical rice area on country level" + + } + + } else { + ############################################ + ### Ricearea and shares on cellular level + ############################################ + + # Cellular LUH flooded areas + floodedLUH <- collapseNames(calcOutput("LUH2v2", landuse_types = "flooded", + cells = cells, cellular = TRUE, irrigation = TRUE, + selectyears = "past", aggregate = FALSE)) + + # Correction for flooded non-rice areas (floodedLUHiso > riceareaFAOiso) + if (cells == "magpiecell") { + commonCountries <- intersect(getItems(nonriceShr, dim = "country"), getItems(floodedLUH, dim = "country")) + ricearea <- floodedLUH * toolIso2CellCountries(nonriceShr, cells = cells) + } else if (cells == "lpjcell") { + commonCountries <- intersect(getItems(nonriceShr, dim = "country"), getItems(floodedLUH, dim = "iso")) + ricearea <- floodedLUH * nonriceShr[commonCountries, , ] + } else { + stop("When cellular==TRUE in calcRicearea: please select number of cells + (magpiecell or lpjcell) via cells argument") + } + + # Correction for aerobic (non-paddy) rice (floodedLUHiso < riceareaFAOiso) + floodedRicearea <- ricearea * floodedShr[commonCountries, , ] + nonfloodedRicearea <- ricearea * (1 - floodedShr)[commonCountries, , ] + ricearea <- floodedRicearea + nonfloodedRicearea + + ricearea <- add_dimension(ricearea, dim = 3.1, add = "type", nm = "total") + floodedRicearea <- add_dimension(floodedRicearea, dim = 3.1, add = "type", nm = "flooded") + nonfloodedRicearea <- add_dimension(nonfloodedRicearea, dim = 3.1, add = "type", nm = "nonflooded") + + out <- collapseNames(mbind(floodedRicearea, nonfloodedRicearea, ricearea)) + unit <- "Mha" + description <- "Physical rice area on cellular level" + + if (share) { + stop("Argument share = TRUE not supported with cellular = TRUE. + Please select cellular = FALSE to return flooded rice area share") + } + } + + return(list(x = out, + weight = NULL, + unit = unit, + description = description, + isocountries = !cellular)) +} diff --git a/R/convertLPJmL.R b/R/convertLPJmL.R new file mode 100644 index 0000000..ed0e001 --- /dev/null +++ b/R/convertLPJmL.R @@ -0,0 +1,16 @@ +#' @title convertLPJmL +#' @description Convert LPJmL content +#' @param x magpie object provided by the read function +#' @return List of magpie objects with results on cellular level, weight, unit and description. +#' @author Kristine Karstens +#' @seealso +#' [readLPJmL()] +#' @examples +#' \dontrun{ +#' readSource("LPJmL", subtype = "soilc", convert = TRUE) +#' } +#' +convertLPJmL <- function(x) { + + return(x) +} diff --git a/R/convertLUH2v2.R b/R/convertLUH2v2.R new file mode 100644 index 0000000..74ceead --- /dev/null +++ b/R/convertLUH2v2.R @@ -0,0 +1,6 @@ +#' @importFrom magclass ncells setItems +#' @importFrom luscale groupAggregate + +convertLUH2v2 <- function(x, subtype) { + return(toolConv2CountryByCelltype(x, cells = "lpjcell")) +} diff --git a/R/correctGAEZv4.R b/R/correctGAEZv4.R new file mode 100644 index 0000000..8f3be92 --- /dev/null +++ b/R/correctGAEZv4.R @@ -0,0 +1,32 @@ +#' @title correctGAEZv4 +#' @description Correct Global Agro-ecological Zones (GAEZ) data +#' @param x MAgPIE object provided by readGAEZv4 function +#' @return MAgPIE object at 0.5 cellular level +#' @author Felicitas Beier +#' +#' @examples +#' \dontrun{ +#' readSource("GAEZv4", convert = "onlycorrect") +#' } +#' +#' @importFrom madrat toolConditionalReplace +#' @importFrom magclass getYears getNames new.magpie mbind + +correctGAEZv4 <- function(x) { + + mapping <- toolGetMappingCoord2Country(pretty = TRUE) + tmp <- new.magpie(cells_and_regions = setdiff(mapping$coords, getCells(x)), + years = getYears(x), names = getNames(x), fill = NA) + + x <- mbind(x, tmp) + + # NAs are set to 0 + x <- toolConditionalReplace(x, conditions = c("is.na()", "<0"), replaceby = 0) + + # Sort cells correctly and rename + x <- x[mapping$coords, , ] + getCells(x) <- paste(mapping$coords, mapping$iso, sep = ".") + getSets(x) <- c("x", "y", "iso", "year", "MCzones") + + return(x) +} diff --git a/R/correctLPJmL.R b/R/correctLPJmL.R new file mode 100644 index 0000000..4d86923 --- /dev/null +++ b/R/correctLPJmL.R @@ -0,0 +1,25 @@ +#' @title correctLPJmL +#' @description Correct LPJmL content +#' +#' @param x magpie object provided by the read function +#' @return List of magpie objects with results on cellular level, weight, unit and description. +#' @author Kristine Karstens, Felicitas Beier +#' @seealso +#' [correctLPJmL()] +#' +#' @examples +#' \dontrun{ +#' readSource("LPJmL", subtype = "soilc", convert = "onlycorrect") +#' } +#' +#' @importFrom lpjclass readLPJ + +correctLPJmL <- function(x) { + + x <- toolConditionalReplace(x, conditions = c("is.na()", "<0"), replaceby = 0) + if (length(getCells(x)) == 59199) { + x <- toolCell2isoCell(x) + } + + return(x) +} diff --git a/R/correctLPJmLClimateInput.R b/R/correctLPJmLClimateInput.R new file mode 100644 index 0000000..d2946b2 --- /dev/null +++ b/R/correctLPJmLClimateInput.R @@ -0,0 +1,27 @@ +#' @title correctLPJmLClimateInput +#' @description Correct LPJmL climate input variables +#' +#' @param x magpie object provided by the read function +#' +#' @return Magpie objects with results on cellular level, weight, unit and description. +#' @author Marcos Alves, Felicitas Beier +#' +#' @seealso +#' \code{\link{readLPJmLClimateInput}} +#' @examples +#' +#' \dontrun{ +#' readSource("LPJmLClimateInput", subtype, convert="onlycorrect") +#' } +#' +#' @import magclass +#' @importFrom madrat toolConditionalReplace + +correctLPJmLClimateInput <- function(x) { # nolint + + x <- toolConditionalReplace(x, + conditions = c("is.na()"), + replaceby = 0) + + return(x) +} diff --git a/R/correctLPJmLInputs.R b/R/correctLPJmLInputs.R new file mode 100644 index 0000000..c34b2c3 --- /dev/null +++ b/R/correctLPJmLInputs.R @@ -0,0 +1,21 @@ +#' @title correctLPJmLInputs +#' @description correct LPJmLInputs content (dummy function) +#' +#' @param x magpie object provided by the read function +#' +#' @author Felicitas Beier +#' +#' @examples +#' \dontrun{ +#' readSource("LPJmLInputs", convert = "onlycorrect") +#' } +#' +#' @importFrom madrat toolConditionalReplace +#' + +correctLPJmLInputs <- function(x) { + + x <- toolConditionalReplace(x, conditions = c("is.na()", "<0"), replaceby = 0) + + return(x) +} diff --git a/R/correctLPJmL_new.R b/R/correctLPJmL_new.R new file mode 100644 index 0000000..d5417d1 --- /dev/null +++ b/R/correctLPJmL_new.R @@ -0,0 +1,21 @@ +#' @title correctLPJmL_new +#' @description Convert LPJmL content (dummy function) +#' @param x magpie object provided by the read function +#' +#' @author Kristine Karstens +#' @seealso +#' [readLPJmL()] +#' @examples +#' \dontrun{ +#' readSource("LPJmL", convert = "onlycorrect") +#' } +#' +#' @importFrom madrat toolConditionalReplace +#' + +correctLPJmL_new <- function(x) { # nolint: object_name_linter. + + x <- toolConditionalReplace(x, conditions = c("is.na()", "<0"), replaceby = 0) + + return(x) +} diff --git a/R/correctLUH2v2.R b/R/correctLUH2v2.R new file mode 100644 index 0000000..baaa18a --- /dev/null +++ b/R/correctLUH2v2.R @@ -0,0 +1,60 @@ +#' @title correctLUH2v2 +#' @description Correct LUH2v2 content +#' +#' @param x magpie object provided by the read function +#' @param subtype switch between different inputs +#' +#' @return List of magpie object with results on cellular level +#' +#' @author Florian Humpenoeder, Stephen Wirth, Kristine Karstens, Felicitas Beier, Jan Philipp Dietrich, +#' Edna J. Molina Bacca +#' +#' @importFrom magclass getCells +#' +correctLUH2v2 <- function(x, subtype) { + + if (any(is.na(x))) { + vcat(verbosity = 1, paste(sum(is.na(x)) / length(x) * 100, "% of data points with NAs in LUH2. set to 0.")) + x[is.na(x)] <- 0 + } + if (any(x < 0)) { + vcat(verbosity = 1, paste(sum(x < 0) / length(x) * 100, "% of data points with negative values in LUH2. set to 0.")) + x[x < 0] <- 0 + } + + years <- getYears(x, as.integer = TRUE) + + if (grepl("states", subtype) && + length(intersect(2001:2015, years)) > 0 && + 2000 %in% years && + 2005 %in% years) { + # check, if in JPN pasture+rangeland is unnaturally low + if (sum(x["JPN", "y2005", c("pastr", "range")]) < 0.01) { + # if so correct all years since 2001 (first year of buggy data) + # using secondary forest area as buffer + buggedYears <- intersect(2001:2015, years) + pasture <- setYears(x["JPN", "y2000", c("pastr", "range")], NULL) + x["JPN", buggedYears, "secdf"] <- x["JPN", buggedYears, "secdf"] - dimSums(pasture, dim = 3) + x["JPN", buggedYears, c("pastr", "range")] <- x["JPN", buggedYears, c("pastr", "range")] + pasture + + # correct for negative values if secondary forest is exceeded + secdfNegative <- (x["JPN", buggedYears, "secdf"] < 0) + x["JPN", buggedYears, "pastr"][secdfNegative] <- x["JPN", buggedYears, "pastr"][secdfNegative] + + x["JPN", buggedYears, "secdf"][secdfNegative] + x["JPN", buggedYears, "secdf"][secdfNegative] <- 0 + + # correct potentially newly introduced negative values in rangelands + pastrNegative <- (x["JPN", buggedYears, "pastr"] < 0) + x["JPN", buggedYears, "range"][pastrNegative] <- x["JPN", buggedYears, "range"][pastrNegative] + + x["JPN", buggedYears, "pastr"][pastrNegative] + x["JPN", buggedYears, "pastr"][pastrNegative] <- 0 + x["JPN", buggedYears, "range"][x["JPN", buggedYears, "range"] < 0] <- 0 + + } else { + stop("it seems the Japan bug in LUH2v2 has been removed. + Please remove the bugfix in correct LUH2v2 before proceeding!") + } + } + + return(x) +} diff --git a/R/correctLandInG.R b/R/correctLandInG.R new file mode 100644 index 0000000..db6094e --- /dev/null +++ b/R/correctLandInG.R @@ -0,0 +1,24 @@ +#' @title correctLandInG +#' @description correct LandInG data. Convert unit from ha to mio ha +#' @return corrected magpie object +#' @param x magpie object provided by the read function +#' @author David Hoetten, Felicitas Beier +#' @seealso +#' \code{\link{readLandInG}} +#' @examples +#' \dontrun{ +#' a <- readSource("LandInG", convert = "onlycorrect") +#' } +#' +#' @importFrom madrat toolConditionalReplace + +correctLandInG <- function(x) { + + # replace NAs and negatives with 0 + x <- toolConditionalReplace(x, conditions = c("is.na()", "<0"), replaceby = 0) + # convert from ha to Mha + x <- x * 1e-06 + + return(x) + +} diff --git a/R/downloadLPJmLClimateInput.R b/R/downloadLPJmLClimateInput.R new file mode 100644 index 0000000..7d31ebd --- /dev/null +++ b/R/downloadLPJmLClimateInput.R @@ -0,0 +1,68 @@ +#' @title downloadLPJmLClimateInput +#' @description Download GCM climate input used for LPJmL runs +#' +#' @param subtype Switch between different inputs (e.g. "ISIMIP3b:IPSL-CM6A-LR:historical:1850-2014:temperature") +#' Argument consists of GCM version, climate model, scenario and variable, +#' separated by ":" +#' +#' @return metadata entry +#' @author Marcos Alves, Kristine Karstens +#' @examples +#' \dontrun{ +#' readSource("LPJmLClimateInput", convert = "onlycorrect") +#' } +#' +downloadLPJmLClimateInput <- function(subtype = "ISIMIP3bv2:MRI-ESM2-0:ssp370:temperature") { # nolint + + x <- toolSplitSubtype(subtype, list(version = NULL, climatemodel = NULL, + scenario = NULL, variable = NULL)) + + varList <- c(temperature = "tas", + precipitation = "pr", + longWaveNet = "lwnet", + shortWave = "rsds", + temperatureMin = "tasmin", + temperatureMax = "tasmax") + shortVar <- toolSubtypeSelect(x$variable, varList) + + if (x$climatemodel == "GSWP3-W5E5") { + storage <- "/p/projects/lpjml/input/historical/" # nolint: absolute_path_linter. + } else { + storage <- "/p/projects/lpjml/input/scenarios" # nolint: absolute_path_linter. + } + + path <- file.path(storage, # historical or scenarios + x$version, # version: ISIMIP3a or b(v2) + gsub("_", "/", x$scenario), # obsclim e.g. ssp119 + x$climatemodel) # GCMs or GSWP3-W5E5 + + if (!dir.exists(path)) { + path <- file.path(storage, + x$version, + gsub("_", "/", x$scenario), + gsub("_", "-", x$climatemodel)) + } + + fileList <- list.files(path) + file <- grep(paste0(shortVar, "_"), + fileList, value = TRUE) + filePath <- file.path(path, file) + + if (file.exists(filePath)) { + file.copy(filePath, file) + } else { + stop("Data is not available so far!") + } + + # Compose meta data + return(list(url = paste0(storage, filePath), + doi = NULL, + title = x$version, + author = NULL, + version = x$version, + release_date = NULL, + description = NULL, + license = NULL, + reference = NULL) + ) +} diff --git a/R/downloadLPJmL_new.R b/R/downloadLPJmL_new.R new file mode 100644 index 0000000..da31ce9 --- /dev/null +++ b/R/downloadLPJmL_new.R @@ -0,0 +1,117 @@ +#' @title downloadLPJmL_new +#' @description Download LPJmL content by version, climate model and scenario +#' +#' @param subtype Switch between different input +#' It consists of LPJmL version, climate model, scenario and variable. +#' For pasture lpjml runs, the scenario variable is used to navigate the output folder structure +#' (e.g. 'LPJmL4_for_MAgPIE_3dda0615:GSWP3-W5E5:historical:soilc' or +#' "LPJmL5.2_Pasture:IPSL_CM6A_LR:ssp126_co2_limN_00:soilc_past_hist") +#' @return metadata entry +#' @author Kristine Karstens, Marcos Alves, Felicitas Beier +#' @examples +#' \dontrun{ +#' readSource("LPJmL_new", convert = FALSE) +#' } +#' @importFrom utils head +#' @importFrom stringr str_detect +#' @importFrom madrat toolSplitSubtype + +downloadLPJmL_new <- function(subtype = "LPJmL4_for_MAgPIE_44ac93de:GSWP3-W5E5:historical:soilc") { # nolint + + x <- toolSplitSubtype(subtype, + list(version = NULL, + climatemodel = NULL, + scenario = NULL, + variable = NULL)) + + files <- c(soilc = "soilc_natveg", + soilc_layer = "soilc_layer_natveg", + litc = "litc_natveg", + vegc = "vegc_natveg", + alitfallc = "alitfallc_natveg", + alitterfallc = "alitterfallc_natveg", + alitterfallc_wood = "alitterfallc_wood_natveg", + alitterburnc = "alitterburnc_natveg", + alitterburnc_wood = "alitterburnc_wood_natveg", + harvest = "pft_harvest.pft", + irrig = "cft_airrig.pft", + cwater_b = "cft_consump_water_b.pft", + sdate = "sdate", + hdate = "hdate", + mpet = "mpet_natveg", + met_grass_ir = "met_grass_ir", + met_grass_rf = "met_grass_rf", + cft_et_grass_ir = "cft_et_grass_ir", + cft_et_grass_rf = "cft_et_grass_rf", + aprec = "aprec_natveg", + aet = "aet_natveg", + mdischarge = "mdischarge_natveg", + mrunoff = "mrunoff_natveg", + mgpp_grass_ir = "mgpp_grass_ir", + mgpp_grass_rf = "mgpp_grass_rf", + cft_gpp_grass_ir = "cft_gpp_grass_ir", + cft_gpp_grass_rf = "cft_gpp_grass_rf", + vegc_grass = "mean_vegc_mangrass", + litc_grass = "litc_mangrass", + soilc_grass = "soilc_mangrass", + soilc_past_hist = "soilc_hist", + soilc_past_scen = "soilc_scen", + grass_pft_hist = "pft_harvest_hist.pft", + grass_pft_scen = "pft_harvest_scen.pft", + cshift_fast = "cshift_fast_natveg", + cshift_slow = "cshift_slow_natveg", + fpc = "fpc.clm") + + # handling the separate sources of grass runs + if (!grepl("Pasture", x$version, ignore.case = TRUE)) { + storage <- "/p/projects/landuse/users/cmueller/" # nolint: absolute_path_linter. + } else { + storage <- "/p/projects/rd3mod/inputdata/sources/LPJmL/" # nolint: absolute_path_linter. + } + + path <- paste(x$version, x$climatemodel, x$scenario, sep = "/") + if (!dir.exists(file.path(storage, path))) { + path <- paste(x$version, gsub("-", "_", x$climatemodel), x$scenario, sep = "/") + } + + listFiles <- list.files(paste0(storage, path)) + file <- grep(toolSubtypeSelect(x$variable, files), listFiles, value = TRUE) + filePath <- paste0(storage, path, "/", file) + + .findFile <- function(storage, path, listFiles, file) { + outputFiles <- grep(".out", listFiles, value = TRUE) + filesOut <- file.path(storage, path, outputFiles) + order <- order(file.info(filesOut)$ctime, decreasing = TRUE) + filesOut <- filesOut[order] + outputFiles <- outputFiles[order] + x <- sapply(filesOut, function(x) list(readLines(x))) # nolint + out <- sapply(x, function(x) any(stringr::str_detect(x, file))) # nolint + return(outputFiles[out][1]) + } + + if (file.exists(filePath)) { + file.copy(filePath, file) + if (grepl("Pasture", x$version, ignore.case = TRUE)) { + files2copy <- .findFile(storage, path, listFiles, file) + file.copy(file.path(storage, path, files2copy), files2copy, overwrite = TRUE) + } else { + file.copy(paste0(storage, path, "/lpjml_log.out"), "lpjml_log.out") + } + } else { + stop("Data is not available so far!") + } + + # Compose meta data + return(list(url = paste0(storage, filePath), + doi = NULL, + title = x$version, + author = list(person("Christoph", "Mueller", email = "cmueller@pik-potsdam.de"), + person("Jens", "Heinke", email = "heinke@pik-potsdam.de"), + person("Stephen", "Writh", email = "wirth@pik-potsdam.de")), + version = x$version, + release_date = NULL, + description = NULL, + license = "Creative Commons Attribution-ShareAlike 4.0 International License (CC BY-SA 4.0)", + reference = NULL) + ) +} diff --git a/R/downloadLUH2v2.R b/R/downloadLUH2v2.R new file mode 100644 index 0000000..80ad0db --- /dev/null +++ b/R/downloadLUH2v2.R @@ -0,0 +1,12 @@ +#' @importFrom utils download.file tail + +downloadLUH2v2 <- function(subtype = NULL) { + links <- c("https://luh.umd.edu/LUH2/LUH2_v2h/states.nc", + "https://luh.umd.edu/LUH2/LUH2_v2h/transitions.nc", + "https://luh.umd.edu/LUH2/LUH2_v2h/management.nc", + "https://luh.umd.edu/LUH2/LUH2_v2h/staticData_quarterdeg.nc") + for (link in links) { + fname <- tail(strsplit(link, split = "/")[[1]], 1) + download.file(link, destfile = fname, mode = "wb") + } +} diff --git a/R/imports.R b/R/imports.R new file mode 100644 index 0000000..e2ab6b8 --- /dev/null +++ b/R/imports.R @@ -0,0 +1,4 @@ +# Generated by lucode2: do not edit by hand + +#' @import magclass madrat mrdrivers mstools +NULL diff --git a/R/readGAEZv4.R b/R/readGAEZv4.R new file mode 100644 index 0000000..8958466 --- /dev/null +++ b/R/readGAEZv4.R @@ -0,0 +1,59 @@ +#' @title readGAEZv4 +#' @description Read in data from the Global Agro-ecological Zones (GAEZ) data set version 4 +#' @param subtype Subtype to be read +#' @return MAgPIE object at 0.5 cellular level +#' @author Felicitas Beier +#' +#' @examples +#' \dontrun{ +#' readSource("GAEZv4", convert = "onlycorrect") +#' } +#' +#' @importFrom magclass as.magpie mbind getNames +#' @importFrom raster brick raster projectRaster + +readGAEZv4 <- function(subtype = "MCzones") { + + # Transform from 0.08 to 0.5 spatial resolution and convert to magpie object + .transformObject <- function(x) { + x <- brick(projectRaster(from = x, to = raster(res = 0.5), method = "ngb", over = TRUE)) + x <- as.magpie(x) + return(x) + } + + if (subtype == "MCzones") { + ### Multiple cropping zones data + ## Legend + # 0: 0 + # 1: no cropping + # 2: single cropping + # 3: limited double cropping + # 4: double cropping + # 5: double cropping with rice + # 6: double rice cropping + # 7: triple cropping + # 8: triple rice cropping + + ### Rainfed + mcr <- brick(paste(subtype, "mcr_CRUTS32_Hist_0010.tif", sep = "/")) + mcr <- .transformObject(x = mcr) + getNames(mcr) <- "rainfed" + + ### Irrigated + mci <- brick(paste(subtype, "mci_CRUTS32_Hist_0010.tif", sep = "/")) + mci <- .transformObject(x = mci) + getNames(mci) <- "irrigated" + + x <- mbind(mci, mcr) + + } else { + stop("This GAEZ subtype is not available yet. + Please select available subtype, e.g. MCzones for multiple cropping zones") + } + + if (any(is.na(x))) { + stop("produced NA multiple cropping zones") + } + + return(x) +} diff --git a/R/readLPJmL.R b/R/readLPJmL.R new file mode 100644 index 0000000..dd5cc88 --- /dev/null +++ b/R/readLPJmL.R @@ -0,0 +1,376 @@ +#' @title readLPJmL +#' @description Read LPJmL content +#' @param subtype Switch between different input +#' @return List of magpie objects with results on cellular level, weight, unit and description. +#' @author Kristine Karstens, Abhijeet Mishra, Felicitas Beier +#' @seealso +#' [readLPJ()] +#' @examples +#' \dontrun{ +#' readSource("LPJmL", subtype = "LPJmL5:CRU4p02.soilc", convert = "onlycorrect") +#' } +#' +#' @importFrom lpjclass readLPJ + +readLPJmL <- function(subtype = "LPJmL5:CRU4p02.soilc") { # nolint: cyclocomp_linter. + + if (grepl("\\.", subtype)) { + + subtype <- strsplit(gsub(":", "/", subtype), split = "\\.") + folder <- unlist(subtype)[1] + subtype <- unlist(subtype)[2] + + } else { + stop("readLPJmL needs version and climatetype information") + } + + files <- c(soilc = "soilc_natveg.bin", + soilc_layer = "soilc_layer_natveg.bin", + litc = "litc_natveg.bin", + vegc = "vegc_natveg.bin", + vegc_lpjcell = "vegc_natveg.bin", + alitfallc = "alitfallc_natveg.bin", + alitterfallc = "alitterfallc_natveg.bin", + alitfalln = "alitfalln_natveg.bin", + harvest = "pft_harvest.pft.bin", + irrig = "cft_airrig.pft.bin", + irrig_lpjcell = "cft_airrig.pft.bin", + cwater_b = "cft_consump_water_b.pft.bin", + cwater_b_lpjcell = "cft_consump_water_b.pft.bin", + sdate = "sdate.bin", + hdate = "hdate.bin", + transpiration = "mtransp_natveg.bin", + discharge = "mdischarge_natveg.bin", + discharge_lpjcell = "mdischarge_natveg.bin", + runoff = "mrunoff_natveg.bin", + runoff_lpjcell = "mrunoff_natveg.bin", + evaporation = "mevap_natveg.bin", + evap_lake = "mevap_lake.bin", + evap_lake_lpjcell = "mevap_lake.bin", + mevap_lake = "mevap_lake.bin", + mevap_lake_lpjcell = "mevap_lake.bin", + input_lake = "input_lake.bin", + input_lake_lpjcell = "input_lake.bin", + mtranspiration = "mtransp_natveg.bin", + mdischarge = "mdischarge_natveg.bin", + mdischarge_lpjcell = "mdischarge_natveg.bin", + mrunoff = "mrunoff_natveg.bin", + mrunoff_lpjcell = "mrunoff_natveg.bin", + mevaporation = "mevap_natveg.bin", + vegc_grass = "mean_vegc_mangrass.bin", + litc_grass = "litc_mangrass.bin", + soilc_grass = "soilc_mangrass.bin" + ) + + filename <- toolSubtypeSelect(subtype, files) + + if (tmp <- file.exists(file.path(folder, "tmp.out"))) { + + tmp <- readLines(file.path(folder, "tmp.out")) + years <- as.numeric(unlist(regmatches(tmp, gregexpr("\\d{4}", tmp)))) + startYear <- years[1] + years <- seq(years[1], years[2], 1) + + } else { + # default + startYear <- 1901 + years <- seq(startYear, 2017, 1) + } + + unitTrans <- 0.01 # Transformation factor gC/m^2 --> t/ha + + if (grepl("soilc|litc|vegc|alitfallc|alitterfallc|alitfalln|vegc_grass|litc_grass|soilc_grass", + subtype) && subtype != "soilc_layer") { + startYear <- startYear # Start year of data set + years <- years # Vector of years that should be exported + nbands <- 1 # Number of bands in the .bin file + avgRange <- 1 # Number of years used for averaging + + if (grepl("_lpjcell", subtype)) { + x <- readLPJ( + file_name = file.path(folder, filename), + wyears = years, + syear = startYear, + averaging_range = avgRange, + ncells = 67420, + bands = nbands, + soilcells = FALSE) + } else { + x <- readLPJ( + file_name = file.path(folder, filename), + wyears = years, + syear = startYear, + averaging_range = avgRange, + bands = nbands, + soilcells = TRUE) + } + + # Transform to MAgPIE object + if (grepl("_lpjcell", subtype)) { + + class(x) <- "array" + x <- collapseNames(as.magpie(x, spatial = 1)) + mapLPJcell <- toolGetMapping("LPJ_CellBelongingsToCountries.csv", + type = "cell", where = "mrcommons") + getCells(x) <- paste(mapLPJcell$ISO, 1:67420, sep = ".") + names(dimnames(x))[1] <- paste0(names(dimnames(x))[1], ".region") + + } else { + x <- collapseNames(as.magpie(x)) + } + + x <- x * unitTrans + getNames(x) <- subtype + + } else if (grepl("*date*", subtype)) { + + startYear <- startYear # Start year of data set + years <- years # Vector of years that should be exported + nbands <- 24 # Number of bands in the .bin file + avgRange <- 1 # Number of years used for averaging + + x <- readLPJ(file_name = file.path(folder, filename), + wyears = years, + syear = startYear, + averaging_range = avgRange, + bands = nbands, + datatype = integer(), + bytes = 2, + soilcells = TRUE, + ncells = 67420) + + x <- collapseNames(as.magpie(x)) + + } else if (subtype %in% c("soilc_layer")) { + + startYear <- startYear # Start year of data set + years <- years # Vector of years that should be exported + nbands <- 5 # Number of bands in the .bin file + avgRange <- 1 # Number of years used for averaging + + x <- readLPJ( + file_name = file.path(folder, filename), + wyears = years, + syear = startYear, + averaging_range = avgRange, + bands = nbands, + soilcells = TRUE) + + x <- collapseNames(as.magpie(x)) + x <- x * unitTrans + + getNames(x) <- paste0("soilc.", getNames(x)) + getSets(x)[4:5] <- c("data", "layer") + + } else if (grepl("transpiration|discharge|runoff|evaporation|evap_lake", subtype)) { + + startYear <- startYear # Start year of data set + years <- years # Vector of years that should be exported + nbands <- 1 # Number of bands in the .bin file + avgRange <- 1 # Number of years used for averaging + + # monthly values + if (grepl("_lpjcell", subtype)) { + x <- readLPJ( + file_name = file.path(folder, filename), + wyears = years, + syear = startYear, + averaging_range = avgRange, + monthly = TRUE, + ncells = 67420, + soilcells = FALSE) + } else { + x <- readLPJ( + file_name = file.path(folder, filename), + wyears = years, + syear = startYear, + averaging_range = avgRange, + monthly = TRUE, + soilcells = TRUE) + } + + # unit transformation + if (grepl("transpiration", subtype)) { + # Transform units: liter/m^2 -> m^3/ha + unitTransTRANSP <- 10 + x <- x * unitTransTRANSP + + } else if (grepl("discharge", subtype)) { + # In LPJmL: (monthly) discharge given in hm3/d (= mio. m3/day) + # Transform units of discharge: mio. m^3/day -> mio. m^3/month + monthDays <- c(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31) + names(monthDays) <- dimnames(x)[[3]] + for (month in names(monthDays)) { + x[, , month, ] <- x[, , month, ] * monthDays[month] + } + + } else if (grepl("runoff|evap_lake", subtype)) { + # In LPJmL: (monthly) runoff given in LPJmL: mm/month + if (grepl("_lpjcell", subtype)) { + cb <- toolGetMapping("LPJ_CellBelongingsToCountries.csv", + type = "cell", where = "mrcommons") + cellArea <- (111e3 * 0.5) * (111e3 * 0.5) * cos(cb$lat / 180 * pi) + class(x) <- "array" + x <- as.magpie(x, spatial = 1) + # Transform units: liter/m^2 -> liter + x <- x * cellArea + } else { + # Get cellular coordinate information and calculate cell area + cb <- as.data.frame(magpie_coord) + cellArea <- (111e3 * 0.5) * (111e3 * 0.5) * cos(cb$lat / 180 * pi) + # Transform units: liter/m^2 -> liter + x <- as.magpie(x) * cellArea + } + # Transform units: liter -> mio. m^3 + x <- x / (1000 * 1000000) + + } else if (grepl("evaporation", subtype)) { + # Transform units: liter/m^2 -> m^3/ha + unitTransEVAP <- 10 + x <- x * unitTransEVAP + + } + + # Transform to MAgPIE object + if (grepl("_lpjcell", subtype)) { + + class(x) <- "array" + x <- collapseNames(as.magpie(x, spatial = 1)) + mapLPJcell <- toolGetMapping("LPJ_CellBelongingsToCountries.csv", + type = "cell", where = "mrcommons") + getCells(x) <- paste(mapLPJcell$ISO, 1:67420, sep = ".") + names(dimnames(x))[1] <- paste0(names(dimnames(x))[1], ".region") + + } else { + x <- collapseNames(as.magpie(x)) + } + + if (grepl("layer", subtype)) { + + subtype <- gsub("_", "\\.", subtype) # Expand dimension to layers + getNames(x) <- paste0(subtype, ".", getNames(x)) + getSets(x)[4:6] <- c("data", "layer", "month") + + } else { + getNames(x) <- paste0(subtype, ".", getNames(x)) + getSets(x)[4:5] <- c("data", "month") + } + + # Annual value (total over all month) + if (!grepl("^m", subtype)) { + x <- dimSums(x, dim = "month") + } + + } else if (grepl("*harvest*", subtype)) { + + startYear <- startYear # Start year of data set + years <- years # Vector of years that should be exported + nbands <- 32 # Number of bands in the .bin file + avgRange <- 1 # Number of years used for averaging + + x <- readLPJ( + file_name = file.path(folder, filename), + wyears = years, + syear = startYear, + averaging_range = avgRange, + bands = nbands, + soilcells = TRUE) + + # Transformation factor gC/m^2 --> t/ha + yieldTrans <- 0.01 / 0.45 + x <- collapseNames(as.magpie(x)) + x <- x * yieldTrans + + } else if (grepl("irrig|cwater_b", subtype)) { + + startYear <- startYear # Start year of data set + years <- years # Vector of years that should be exported + nbands <- 32 # Number of bands in the .bin file + avgRange <- 1 # Number of years used for averaging + + if (grepl("_lpjcell", subtype)) { + x <- readLPJ( + file_name = file.path(folder, filename), + wyears = years, + syear = startYear, + averaging_range = avgRange, + bands = nbands, + ncells = 67420, + soilcells = FALSE) + } else { + x <- readLPJ( + file_name = file.path(folder, filename), + wyears = years, + syear = startYear, + averaging_range = avgRange, + bands = nbands, + soilcells = TRUE) + } + + if (grepl("_lpjcell", subtype)) { + + class(x) <- "array" + x <- collapseNames(as.magpie(x, spatial = 1)) + mapLPJcell <- toolGetMapping("LPJ_CellBelongingsToCountries.csv", + type = "cell", where = "mrcommons") + getCells(x) <- paste(mapLPJcell$ISO, 1:67420, sep = ".") + names(dimnames(x))[1] <- paste0(names(dimnames(x))[1], ".region") + + } else { + x <- collapseNames(as.magpie(x)) + } + # Transform units (transform from: mm per year = liter per m^2 transform to: m^3 per ha) + # 1 000 liter = 1 m^3 + # 10 000 m^2 = 1 ha + # 1 liter/m^2 = 10 m^3/ha + # -> mm/yr * 10 = m^3/ha + irrigTransform <- 10 + x[, , "irrigated"] <- x[, , "irrigated"] * irrigTransform # units are now: m^3 per ha per year + + } else if (grepl("input_lake", subtype)) { + + startYear <- startYear # Start year of data set + years <- years # Vector of years that should be exported + nbands <- 1 # Number of bands in the .bin file + avgRange <- 1 # Number of years used for averaging + + if (grepl("_lpjcell", subtype)) { + x <- readLPJ( + file_name = file.path(folder, filename), + wyears = years, + syear = startYear, + averaging_range = avgRange, + bands = nbands, + ncells = 67420, + soilcells = FALSE) + } else { + x <- readLPJ( + file_name = file.path(folder, filename), + wyears = years, + syear = startYear, + averaging_range = avgRange, + bands = nbands, + soilcells = TRUE) + } + + if (grepl("_lpjcell", subtype)) { + + class(x) <- "array" + x <- collapseNames(as.magpie(x, spatial = 1)) + mapLPJcell <- toolGetMapping("LPJ_CellBelongingsToCountries.csv", + type = "cell", where = "mrcommons") + getCells(x) <- paste(mapLPJcell$ISO, 1:67420, sep = ".") + names(dimnames(x))[1] <- paste0(names(dimnames(x))[1], ".region") + + } else { + x <- collapseNames(as.magpie(x)) + } + getNames(x) <- subtype + + } else { + stop(paste0("subtype ", subtype, " is not existing")) + } + + return(x) + +} diff --git a/R/readLPJmLClimateInput.R b/R/readLPJmLClimateInput.R new file mode 100644 index 0000000..74e3dc7 --- /dev/null +++ b/R/readLPJmLClimateInput.R @@ -0,0 +1,195 @@ +#' @title readLPJmLClimateInput +#' @description Read Climate data used as LPJmL inputs into MAgPIE objects +#' @param subtype Switch between different inputs, +#' e.g. "ISIMIP3bv2:MRI-ESM2-0:ssp370:1850-2014:tas" +#' Available variables are: * tas - +#' * wet - +#' * per - +#' @param subset Switch between different subsets of the same subtype +#' Available options are: "annualMean", "annualSum", +#' "monthlyMean", "monthlySum", +#' "wetDaysMonth" +#' Note that not all subtype-subset combinations make sense +#' @return MAgPIE objects with results on cellular level. +#' @author Marcos Alves, Kristine Karstens, Felicitas Beier +#' @seealso +#' \code{\link{readLPJmLClimateInput}} +#' @examples +#' \dontrun{ +#' readSource("LPJmLClimateInput", subtype, convert = "onlycorrect") +#' } +#' +#' @importFrom lpjclass read.LPJ_input +#' @importFrom madrat toolSplitSubtype +#' @importFrom magpiesets findset addLocation +#' @importFrom magclass collapseNames collapseDim as.magpie clean_magpie +#' @export + +readLPJmLClimateInput <- function(subtype = "ISIMIP3bv2:MRI-ESM2-0:ssp370:temperature", # nolint + subset = "annualMean") { + + nCells <- 67420 # number of cells in lpjml + subtype <- toolSplitSubtype(subtype, + list(version = NULL, + climatemodel = NULL, + scenario = NULL, + variable = NULL)) + + subsetTypes <- c("annualMean", "annualSum", "monthlyMean", + "monthlySum", "wetDaysMonth", "\\d{4}:\\d{4}") + subsetTypesMean <- c(grep("Mean", subsetTypes, value = TRUE), "\\d{4}:\\d{4}") + + allowedCombos <- list(temperature = subsetTypesMean, + precipitation = subsetTypes, + longWaveNet = subsetTypesMean, + shortWave = subsetTypesMean, + temperatureMin = subsetTypesMean, + temperatureMax = subsetTypesMean) + isAllowed <- any(vapply(allowedCombos[[subtype$variable]], + grepl, x = subset, + FUN.VALUE = logical(1))) + if (!isAllowed) stop("Subtype-subset combination not allowed") + + .prepareLPJinput <- function(subset = NULL) { + + filename <- Sys.glob(c("*.bin", "*.clm")) + filetype <- tail(unlist(strsplit(filename, "\\.")), 1) + + if (filetype == "clm") { + + filedata <- file(description = filename, open = "rb", + blocking = TRUE, encoding = getOption("encoding")) + seek(filedata, where = 15, origin = "start") + inHeader <- as.numeric(readBin(filedata, what = integer(), size = 4, + n = 5, endian = .Platform$endian)) + startyear <- inHeader[1] + nyear <- inHeader[2] + noAnnualPredictions <- inHeader[5] + years <- seq(startyear, startyear + nyear - 1, 1) + close(filedata) + + } else { + stop("File format of LPJmLClimateInput data unknown. Please provide .clm file format.") + } + + if (subset == "wetDaysMonth") { + + if (subtype$variable != "precipitation") stop("Subset 'wetDaysMonth' is only + available for 'precipitation'") + x <- lpjclass::read.LPJ_input(file_name = filename, + out_years = paste0("y", years), + namesum = TRUE, + ncells = nCells, + rule4binary = ">0") / noAnnualPredictions + + class(x) <- "array" + x <- collapseNames(as.magpie(x, spatial = 1)) + + + } else if (subset == "annualMean") { + + x <- lpjclass::read.LPJ_input(file_name = filename, + out_years = paste0("y", years), + namesum = TRUE, + ncells = nCells) / noAnnualPredictions + + class(x) <- "array" + x <- collapseNames(as.magpie(x, spatial = 1)) + + + } else if (subset == "annualSum") { + + x <- lpjclass::read.LPJ_input(file_name = filename, + out_years = paste0("y", years), + namesum = TRUE, + ncells = nCells) + + class(x) <- "array" + x <- collapseNames(as.magpie(x, spatial = 1)) + + + } else if (subset %in% c("monthlyMean", "monthlySum")) { + # define year sets (cut it in bunches) + bunchLength <- 1 + yearsets <- split(years, ceiling(seq_along(years) / bunchLength)) + + # define month mapping + monthLength <- c(jan = 31, feb = 28, mar = 31, apr = 30, + may = 31, jun = 30, jul = 31, aug = 31, + sep = 30, oct = 31, nov = 30, dec = 31) + daysMonth <- NULL + for (m in 1:12) { + daysMonth <- c(daysMonth, rep(names(monthLength[m]), + monthLength[m])) + } + month2day <- cbind(day = 1:sum(monthLength), + month = daysMonth) + monthLength <- as.magpie(monthLength) + + # create output object + x <- NULL + + # loop over bunches + for (b in seq_along(yearsets)) { + # read in a bunch of years + tmp <- lpjclass::read.LPJ_input(file_name = filename, + out_years = paste0("y", yearsets[[b]]), + namesum = FALSE, + ncells = nCells) + + tmp <- array(tmp, dim = dim(tmp)[1:3], dimnames = dimnames(tmp)[1:3]) + tmp <- as.magpie(tmp, spatial = 1) + getSets(tmp) <- c("fake", "year", "day") + # KRISTINE: Please double-check whether following line makes sense + # (introduced because toolAggregate doesn't work without dimension names) + getNames(tmp) <- as.character(seq(1, 365, 1)) + + # aggregate days to month + tmp <- toolAggregate(tmp, + rel = month2day, + from = "day", + to = "month", + dim = 3) + + if (subset == "monthlyMean") { + tmp <- tmp / monthLength + } + + x <- mbind(x, tmp) + getSets(x) <- c("fake", "year", "month") + } + + } else if (grepl("\\d{4}:\\d{4}", subset)) { + + subYears <- eval(parse(text = subset)) + years <- intersect(years, subYears) + if (any(!(subYears %in% years))) { + warning(paste0("Some subsetted years (subset = ", subset, + ") are not availabl\n in the original data.\n", + "Years set to:", years)) + } + + x <- lpjclass::read.LPJ_input(file_name = filename, + out_years = paste0("y", years), + namesum = FALSE, + ncells = nCells) + + class(x) <- "array" + x <- collapseNames(as.magpie(x, spatial = 1)) + + + } else { + stop("Subset argument unknown. Please check function help.") + } + + return(x) + } + + x <- .prepareLPJinput(subset) + + # Add location based on LPJmL cell ordering where fist cell is FJI, second RUS, etc + x <- collapseDim(addLocation(x), dim = c("N", "region")) + x <- clean_magpie(x) + + return(x) +} diff --git a/R/readLPJmLInputs.R b/R/readLPJmLInputs.R new file mode 100644 index 0000000..5128a17 --- /dev/null +++ b/R/readLPJmLInputs.R @@ -0,0 +1,62 @@ +#' @title readLPJmLInputs +#' @description This function reads in LPJmL inputs (inputs to LPJmL) +#' +#' @param subtype Switch between different inputs +#' +#' @return List of magpie objects with results on cellular level, weight, unit and description. +#' +#' @author Felicitas Beier +#' +#' @examples +#' \dontrun{ +#' readSource("LPJmLInputs", subtype = "lakeshare", convert = FALSE) +#' } +#' +#' @importFrom magclass as.magpie collapseNames +#' @importFrom lpjclass readLPJ +#' @importFrom magpiesets addLocation + +readLPJmLInputs <- function(subtype = "lakeshare") { + + files <- c(lakeshare = "glwd_lakes_and_rivers.bin") + file <- toolSubtypeSelect(subtype, files) + + # Data settings + if (subtype %in% c("lakeshare")) { + + unitTrans <- 0.01 + ncells <- 67420 + wyears <- 1 + syear <- 1 + avgRange <- NULL + filetype <- "bin" + bands <- 1 + datatype <- integer() + bytes <- 1 + monthly <- FALSE + } + + # Read in the data + x <- readLPJ(file_name = file, + wyears = wyears, + syear = syear, + averaging_range = avgRange, + ncells = ncells, + file_type = filetype, + bands = bands, + datatype = datatype, + bytes = bytes, + monthly = monthly) + + # Unit transformation + x <- x * unitTrans + + # Transform to magpie object and add dimension details + class(x) <- "array" + x <- collapseNames(as.magpie(x, spatial = 1)) + x <- addLocation(x) + x <- collapseDim(x, dim = "N") + x <- clean_magpie(x) + + return(x) +} diff --git a/R/readLPJmL_new.R b/R/readLPJmL_new.R new file mode 100644 index 0000000..530bcfc --- /dev/null +++ b/R/readLPJmL_new.R @@ -0,0 +1,123 @@ +#' @title readLPJmL_new +#' +#' @description Read in LPJmL outputs +#' +#' @param subtype Switch between different inputs +#' (eg. "LPJmL5.2_Pasture:IPSL_CM6A_LR:ssp126_co2_limN_00:soilc_past_hist") +#' +#' @return List of magpie objects with results on cellular level, weight, unit and description. +#' +#' @author Kristine Karstens, Abhijeet Mishra, Felicitas Beier, Marcos Alves +#' +#' @seealso +#' [readLPJ()] +#' @examples +#' \dontrun{ +#' readSource("LPJmL_new", convert = FALSE) +#' } +#' +#' @importFrom madrat toolSplitSubtype +#' @importFrom magpiesets addLocation +#' @importFrom lpjclass readLPJ +#' @importFrom stringr str_subset str_trim str_split + +readLPJmL_new <- function(subtype = "LPJmL4_for_MAgPIE_44ac93de:GSWP3-W5E5:historical:soilc") { # nolint + + subtype <- toolSplitSubtype(subtype, + list(version = NULL, + climatemodel = NULL, + scenario = NULL, + variable = NULL))$variable + + .prepareLPJ <- function(datatype = numeric(), + bytes = 4, + monthly = FALSE, + nbands = NULL) { # nbands will be overwritten for clm data + + filename <- Sys.glob(c("*.bin", "*.clm")) + filetype <- tail(unlist(strsplit(filename, "\\.")), 1) + + if (filetype == "clm") { + filedata <- file(description = filename, + open = "rb", + blocking = TRUE, + encoding = getOption("encoding")) + seek(filedata, where = 15, origin = "start") + inHeader <- as.numeric(readBin(filedata, + what = integer(), + size = 4, + n = 5, + endian = .Platform$endian)) + startYear <- inHeader[1] + nyear <- inHeader[2] + nbands <- inHeader[5] # nbands will be overwritten for clm data + years <- seq(startYear, startYear + nyear - 1, 1) + headlines <- 51 # generation clm 3 + close(filedata) + + } else if (filetype == "bin") { + + outfile <- grep(".out", list.files(), value = TRUE) %>% head(1) + out <- readLines(outfile) + startYear <- out %>% + str_subset("Output written in year:") %>% + str_split(":") %>% + unlist() %>% + str_trim() %>% + subset(c(FALSE, TRUE)) %>% + as.numeric() + endYear <- out %>% + str_subset("Last year:") %>% + str_split(":") %>% + unlist() %>% + str_trim() %>% + subset(c(FALSE, TRUE)) %>% + as.numeric() + years <- seq(startYear, endYear, 1) + headlines <- 0 + + } else { + stop("File format of LPJmL input data unknown. Please provide .clm or .bin file format.") + } + + x <- readLPJ(file_name = filename, + wyears = years, + syear = startYear, + headlines = headlines, + averaging_range = 1, + ncells = 67420, + file_type = "bin", + bands = nbands, + datatype = datatype, + bytes = bytes, + monthly = monthly) + + class(x) <- "array" + x <- collapseNames(as.magpie(x, spatial = 1)) + x <- collapseDim(addLocation(x), dim = "N") + x <- clean_magpie(x) + + return(x) + } + + if (subtype %in% c("soilc", "litc", "vegc", "alitfallc", "aet", + "vegc_grass", "litc_grass", "soilc_grass", + "aprec", "soilc_past_hist", "soilc_past_scen") || grepl("alitter", subtype)) { + x <- .prepareLPJ(nbands = 1) + } else if (grepl("*date*", subtype)) { + x <- .prepareLPJ(nbands = 24, datatype = integer(), bytes = 2) + } else if (subtype %in% c("soilc_layer", "cshift_slow", "cshift_fast")) { + x <- .prepareLPJ(nbands = 5) + } else if (grepl("mdischarge|mrunoff|mpet|mgpp_grass_ir|mgpp_grass_rf|met_grass_ir|met_grass_rf", subtype)) { + x <- .prepareLPJ(monthly = TRUE) + } else if (grepl("harvest|irrig|cwater_b|grass_pft|cft_gpp_grass_rf|cft_gpp_grass_ir|cft_et_grass_rf|cft_et_grass_ir|cft_transp_pft", # nolint + subtype)) { + x <- .prepareLPJ(nbands = 32) + } else if (grepl("fpc", subtype)) { + x <- .prepareLPJ(nbands = 12) + } else { + stop(paste0("subtype ", subtype, " is not existing")) + } + + return(round(x, digits = 10)) +} diff --git a/R/readLUH2v2.R b/R/readLUH2v2.R new file mode 100644 index 0000000..3f2b510 --- /dev/null +++ b/R/readLUH2v2.R @@ -0,0 +1,180 @@ +#' @title readLUH2v2 +#' @description read LUH inputs +#' +#' @param subtype switch between different inputs +#' +#' @return List of magpie objects with results on cellular level, weight, unit and description +#' @author Florian Humpenoeder, Stephen Wirth, Kristine Karstens, Felicitas Beier, +#' Jan Philipp Dietrich, Patrick v. Jeetze +#' +#' @importFrom ncdf4 nc_open +#' @importFrom terra rast ext subset aggregate project ext<- +#' @importFrom magclass as.magpie mbind +#' @importFrom withr local_tempdir defer +#' @importFrom stringr str_match str_count str_subset + +readLUH2v2 <- function(subtype) { + # set terra options and temporary directory + terraOptions(tempdir = local_tempdir(tmpdir = getConfig("tmpfolder")), todisk = TRUE, memfrac = 0.25) + defer(terraOptions(tempdir = tempdir())) + + # basic settings + timeSel <- seq(1901, 2015, by = 1) + offset <- 849 # year 850=1, year 1900=1051, year 2015=1166 + # grep years to set other than default years, if subtypes ends with '_850to1901' like time span expression + timeSpan <- str_match(subtype, "_(\\d+)to(\\d+)")[2:3] + if (all(!is.na(timeSpan))) { + timeSel <- seq(timeSpan[1], timeSpan[2], by = 1) + subtype <- gsub("_(\\d+)to(\\d+)", "", subtype) + } + + # File to process + fStates <- "states.nc" + fMan <- "management.nc" + fTrans <- "transitions.nc" + + ### Define dimensions + map <- toolGetMappingCoord2Country(pretty = TRUE) + + if (grepl("states", subtype)) { + # Open file and process information + ncFile <- nc_open(fStates) + data <- setdiff(names(ncFile$var), c("secma", "secmb", "lat_bounds", "lon_bounds")) + # Land area + carea <- suppressWarnings(rast("staticData_quarterdeg.nc", subds = "carea")) + ext(carea) <- c(-180, 180, -90, 90) + + x <- NULL + for (item in data) { + # read in share of land type + shr <- suppressWarnings(subset(rast(fStates, subds = item), timeSel - offset)) + checkSum <- terra::global(shr * carea, sum, na.rm = TRUE) + # aggregate from 0.25 degree to 0.5 degree + mag <- terra::aggregate(shr * carea, fact = 2, fun = sum, na.rm = TRUE) + # Check whether sum before and after aggregation is the same. + # Note: unit is km^2, so only rounded to first digit + if (any(round(checkSum - terra::global(mag, sum, na.rm = TRUE), digits = 1) != 0)) { + stop("There is an issue with the aggregation. Please check mrcommons::readLUH2v2") + } + # transform to MAgPIE object and clean up + mag <- as.magpie(terra::extract(mag, map[c("lon", "lat")])[, -1], spatial = 1, temporal = 2) + getNames(mag) <- item + getCells(mag) <- paste(map$coords, map$iso, sep = ".") + getYears(mag) <- timeSel + getSets(mag) <- c("x.y.iso", "t", "data") + x <- mbind(x, mag) + } + + # Convert from km^2 to Mha + x <- x / 10000 + + } else if (grepl("transition", subtype)) { + # Open file and process information + ncFile <- nc_open(fTrans) + luTrans <- setdiff(names(ncFile$var), c("secma", "secmb", "lat_bounds", "lon_bounds")) + luTrans <- grep("to", luTrans, value = TRUE) + + lu <- list(crop = c("c3ann", "c3per", "c4ann", "c4per", "c3nfx"), + past = c("pastr", "range"), + nat = c("primf", "primn", "secdf", "secdn"), + urban = c("urban")) + + luTransReduced <- luTrans + for (i in seq_along(lu)) { + luTransReduced <- gsub(paste(lu[[i]], collapse = "|"), names(lu[i]), luTransReduced) + } + + zeroTrans <- grepl(paste(paste(names(lu), names(lu), sep = "_to_"), + collapse = "|"), luTransReduced) + # Land area + carea <- suppressWarnings(rast("staticData_quarterdeg.nc", subds = "carea")) + ext(carea) <- c(-180, 180, -90, 90) + + x <- new.magpie(map$coords, timeSel, unique(luTransReduced[!zeroTrans]), fill = 0) + + for (item in seq_along(luTrans)) { + # This attributes LUC to the year resulting from it + print(luTrans[item]) + if (!zeroTrans[item]) { + shr <- suppressWarnings(subset(rast(fTrans, subds = luTrans[item]), timeSel - offset - 1)) + checkSum <- terra::global(shr * carea, sum, na.rm = TRUE) + # aggregate from 0.25 degree to 0.5 degree + mag <- terra::aggregate(shr * carea, fact = 2, fun = sum, na.rm = TRUE) + # Check whether sum before and after aggregation is the same. + # Note: unit is km^2, so only rounded to first digit + if (any(round(checkSum - terra::global(mag, sum, na.rm = TRUE), digits = 1) != 0)) { + stop("There is an issue with the aggregation. Please check mrcommons::readLUH2v2") + } + # Transform to MAgPIE object + mag <- as.magpie(terra::extract(mag, map[c("lon", "lat")])[, -1], spatial = 1, temporal = 2) + getNames(mag) <- luTransReduced[item] + getCells(mag) <- paste(map$coords, map$iso, sep = ".") + getYears(mag) <- timeSel + getSets(mag) <- c("x.y.iso", "t", "data") + x[, , luTransReduced[item]] <- collapseNames(x[, , luTransReduced[item]] + mag) + } + } + + getCells(x) <- getCells(mag) + getSets(x) <- getSets(mag) + + # Convert from km^2 to Mha + x <- x / 10000 + + } else if (grepl("irrigation", subtype)) { + # Mapping between states and management_irrigation + dataMan <- c("irrig_c3ann", "irrig_c3per", "irrig_c4ann", "irrig_c4per", "irrig_c3nfx", "flood") + dataStates <- c("c3ann", "c3per", "c4ann", "c4per", "c3nfx", "c3ann") + data <- matrix(data = c(dataMan, dataStates), ncol = 2) + + # Land area + carea <- suppressWarnings(rast("staticData_quarterdeg.nc", subds = "carea")) + ext(carea) <- c(-180, 180, -90, 90) + + x <- NULL + for (item in dataMan) { + shr <- suppressWarnings(subset(rast(fStates, subds = data[data[, 1] == item, 2]), timeSel - offset)) + irShr <- suppressWarnings(subset(rast(fMan, subds = item), timeSel - offset)) + # grid cell fraction of crop area x grid cell area x irrigated fraction of crop area + tmp <- shr + for (i in seq_len(dim(tmp)[3])) { + tmp[[i]] <- shr[[i]] * carea * irShr[[i]] + } + checkSum <- terra::global(tmp, sum, na.rm = TRUE) + # aggregate from 0.25 degree to 0.5 degree + mag <- terra::aggregate(tmp, fact = 2, fun = sum, na.rm = TRUE) + # Check whether sum before and after aggregation is the same. + # Note: unit is km^2, so only rounded to first digit + if (any(round(checkSum - terra::global(mag, sum, na.rm = TRUE), digits = 1) != 0)) { + stop("There is an issue with the aggregation. Please check mrcommons::readLUH2v2") + } + # Transform to MAgPIE object + mag <- as.magpie(terra::extract(mag, map[c("lon", "lat")])[, -1], spatial = 1, temporal = 2) + getNames(mag) <- item + getYears(mag) <- timeSel + getCells(mag) <- paste(map$coords, map$iso, sep = ".") + getSets(mag) <- c("x.y.iso", "t", "data") + x <- mbind(x, mag) + } + + # Convert from km^2 to Mha + x <- x / 10000 + + } else if (grepl("ccode", subtype)) { + # Load raster data on 0.25° and extend to full grid + ccode25 <- suppressWarnings(rast("staticData_quarterdeg.nc", subds = "ccode")) + ext(ccode25) <- c(-180, 180, -90, 90) + + # Create new raster object on 0.5° and re-project 0.25°-raster on 0.5°-raster + r50 <- rast(res = 0.5) + ccode50 <- project(ccode25, r50, method = "near") # re-project to regular grid + + x <- as.magpie(terra::extract(ccode50, map[c("lon", "lat")])[, -1], spatial = 1) + getYears(x) <- 2000 + getNames(x) <- "ccode" + getCells(x) <- paste(map$coords, map$iso, sep = ".") + getSets(x) <- c("x.y.iso", "t", "ccode") + } + + return(clean_magpie(x)) +} diff --git a/R/readLandInG.R b/R/readLandInG.R new file mode 100644 index 0000000..d9fa8d0 --- /dev/null +++ b/R/readLandInG.R @@ -0,0 +1,116 @@ +#' @title readLandInG +#' +#' @description Reads in LandInG data +#' +#' @param subtype Type of LandInG data that should be read: +#' \itemize{ +#' \item \code{physicalArea}: Cropland extend/ physical cropping area separated in irrigated and rainfed +#' \item \code{harvestedArea}: Harvested area separated in different crop types +#' } +#' +#' @return magpie object +#' +#' @importFrom magclass as.magpie collapseNames collapseDim getItems getNames getSets +#' @importFrom magpiesets addLocation +#' @importFrom lpjmlkit read_io +#' @importFrom utils read.delim +#' +#' @author Felicitas Beier +#' @seealso \code{\link{readSource}} +#' @examples +#' \dontrun{ +#' A <- readSource("LandInG", subtype = "harvestedArea", aggregate = FALSE) +#' } +#' +readLandInG <- function(subtype = "physicalArea") { + + if (subtype == "physicalArea") { + + bands <- c("rainfed", "irrigated") + + # filename for irrigated and rainfed physical area + physicalAreaName <- paste0("OutputForMAgPIE_2023-10-20/", + "cft_cropland_MAgPIE_cft_aggregation_20200417_20200127_madrat_", + "multicropping_LUH2v2_disaggregated_30min_1960-2015.bin") + # unit: ha + + # read in data and transform to MAgPIE object + x <- as.magpie(read_io(filename = physicalAreaName, + band_names = bands, + nstep = 1, timestep = 1)) + # add coordinates + x <- collapseDim(addLocation(x), dim = "N") + # rename dimensions + years <- paste0("y", gsub("-12-31", "", getItems(x, dim = "time"))) + getItems(x, dim = "time") <- years + x <- clean_magpie(x) + getSets(x) <- c("x", "y", "iso", "year", "irrigation") + + } else if (subtype == "harvestedArea") { + # Ordered list of band names + # Note: This hard-coded list can be removed as soon as output + # is provided as json file. + bands <- c("rainfed tece", + "rainfed maiz", + "rainfed trce", + "rainfed rice_pro", + "rainfed soybean", + "rainfed rapeseed", + "rainfed groundnut", + "rainfed sunflower", + "rainfed oilpalm", + "rainfed puls_pro", + "rainfed potato", + "rainfed cassav_sp", + "rainfed sugr_cane", + "rainfed sugr_beet", + "rainfed others", + "rainfed cottn_pro", + "rainfed foddr", + "rainfed pasture", + "rainfed begr", + "rainfed betr", + "irrigated tece", + "irrigated maiz", + "irrigated trce", + "irrigated rice_pro", + "irrigated soybean", + "irrigated rapeseed", + "irrigated groundnut", + "irrigated sunflower", + "irrigated oilpalm", + "irrigated puls_pro", + "irrigated potato", + "irrigated cassav_sp", + "irrigated sugr_cane", + "irrigated sugr_beet", + "irrigated others", + "irrigated cottn_pro", + "irrigated foddr", + "irrigated pasture", + "irrigated begr", + "irrigated betr") + + # filename + harvestedAreaName <- paste0("OutputForMAgPIE_2023-10-20/", + "cft_MAgPIE_cft_aggregation_20200417_20200127_madrat_", + "multicropping_LUH2v2_disaggregated_30min_1960-2015.bin") + # unit: ha + + # read in data and transform to MAgPIE object + x <- as.magpie(read_io(filename = harvestedAreaName, + band_names = bands, + nstep = 1, timestep = 1)) + # add coordinates + x <- collapseDim(addLocation(x), dim = "N") + # rename dimensions + years <- paste0("y", gsub("-12-31", "", getItems(x, dim = "time"))) + getItems(x, dim = "time") <- years + getItems(x, dim = 3, raw = TRUE) <- gsub(" ", ".", getItems(x, dim = 3)) + x <- clean_magpie(x) + getSets(x) <- c("x", "y", "iso", "year", "irrigation", "crop") + + } + + return(x) +} diff --git a/R/toolClimateInputVersion.R b/R/toolClimateInputVersion.R new file mode 100644 index 0000000..74ad463 --- /dev/null +++ b/R/toolClimateInputVersion.R @@ -0,0 +1,34 @@ +#' @title toolClimateInputVersion +#' +#' @description Specify default settings for LPJmL climate input version and baseline settings +#' @param lpjmlVersion Add-ons (+*) for further version specification for LPJmL version +#' @param climatetype Switch between different climate scenarios +#' +#' @return configuration as list +#' @author Kristine Karstens +#' +#' @importFrom stringr str_split +#' +#' @export + +toolClimateInputVersion <- function(lpjmlVersion, climatetype) { + + cfgLPJmL <- toolLPJmLVersion(lpjmlVersion, climatetype) + cfg <- NULL + + ##### DEFAULT CLIMATE CONFIG ##### + cfg$versionScen <- "ISIMIP3bv2" + cfg$versionHist <- "ISIMIP3av2" + cfg$baselineHist <- cfgLPJmL$baseline_hist + cfg$refYearHist <- cfgLPJmL$ref_year_hist + cfg$baselineGcm <- cfgLPJmL$baseline_gcm + cfg$refYearGcm <- cfgLPJmL$ref_year_gcm + cfg$climatetype <- climatetype + ##### DEFAULT CLIMATE CONFIG ##### + + if (cfg$climatetype == "GSWP3-W5E5:historical") { + cfg$climatetype <- "GSWP3-W5E5:obsclim" + } + + return(cfg) +} diff --git a/R/toolForestRelocate.R b/R/toolForestRelocate.R new file mode 100644 index 0000000..f9e1aa8 --- /dev/null +++ b/R/toolForestRelocate.R @@ -0,0 +1,235 @@ +#' @title toolForestRelocate +#' @description Reallocates cellular forest information from LUH2 +#' to better match FAO forest information +#' +#' @param lu uncorrected landuse initialisation data set (cell level) +#' @param luCountry uncorrected landuse initialisation on country level +#' @param natTarget target natural land allocation on country level +#' @param vegC vegetation carbon data used as reallocation weight +#' @return List of magpie object with results on cellular level +#' @author Kristine Karstens, Jan Philipp Dietrich, Felicitas Beier, Patrick v. Jeetze +#' @importFrom magclass setNames setItems new.magpie nyears +#' @importFrom nleqslv nleqslv +#' +#' @export + +toolForestRelocate <- function(lu, luCountry, natTarget, vegC) { # nolint + + .arrayReduce <- function(x) { + # drop dimensions but keep time dimension + if (dim(x)[3] != 1) stop("array2D only works with a single data dimension!") + if (dim(x)[1] == 1) return(array(x, dim = dim(x)[2], dimnames = dimnames(x)[2])) + return(array(x, dim = dim(x)[1:2], dimnames = dimnames(x)[1:2])) + } + + forests <- c("primforest", "secdforest", "forestry") + nature <- c(forests, "other") + + if (round(sum(lu) - sum(luCountry), 4) != 0) warning("lu and luCountry differ in total land area") + if (round(sum(lu[, , nature]) - sum(natTarget), 4) != 0) warning("lu and natTarget differ in total land area") + + # store cell area to check later that it remains constant + luCellArea <- setItems(dimSums(lu[, 1, ], dim = 3), dim = 2, NULL) + + # reduce, if necessary to FAO + reduce <- increase <- round(natTarget - luCountry[, , nature], 8) + reduce[reduce > 0] <- 0 + increase[increase < 0] <- 0 + + # grep land areas dependent on vegetation carbon density + if (is.null(getYears(vegC))) getYears(vegC) <- getYears(natTarget) + + # weight function to determine correct cellweights for area removal + findweight <- function(p, cellarea, isoreduction, cellweight) { + rowSums(cellarea * (1 - (1 - cellweight)^p)) + isoreduction + 10^-10 + } + + # loop over countries + countries <- getItems(lu, dim = "iso") + l <- list() + for (iso in countries) { + + l[[iso]] <- lu[iso, , ] + allocate <- setNames(l[[iso]][, , 1] * 0, NULL) + + vegCIso <- vegC[iso, , ] + + # normalized vegetation carbon (with small correction to ensure values between [0,1)) + vegCN <- t(.arrayReduce(vegCIso / (as.magpie(apply(vegCIso, 2, max)) + 10^-10))) + + ########################### + ### Reduction procedure ### + ########################### + + # loop over all land use categories, that have to be reallocated + for (cat in nature) { + + catreduce <- .arrayReduce(reduce[iso, , cat]) + + # check if area has to be cleared + if (any(catreduce != 0)) { + # check for one cell countries + if (dim(l[[iso]])[1] == 1) { + # trivial case of one cell countries + remove <- -as.magpie(catreduce) + } else if (all(dimSums(l[[iso]][, , cat] != 0, dim = 1) == 1)) { + # trivial case in which in each year exactly one cell contains land in the category to be reduced + remove <- setNames(-1 * (l[[iso]][, , cat] != 0) * as.magpie(catreduce), NULL) + } else { + # for other land cell with highest vegc and for all forest categories lowest vegc should be cleared first + if (cat == "other") { + cellweight <- vegCN + } else { + cellweight <- (1 - 10^-16 - vegCN) + } + + # check for edge case in which all land of that category must be removed and treat it separately + fullremoval <- (round(dimSums(l[[iso]], dim = 1)[, , cat] + as.magpie(catreduce), 3) == 0) + if (any(fullremoval)) { + allocate[, fullremoval, ] <- (allocate[, fullremoval, ] + + setNames(l[[iso]][, fullremoval, cat], NULL)) + l[[iso]][, fullremoval, cat] <- 0 + catreduce[fullremoval] <- 0 + } + + t <- (catreduce != 0) + if (any(t)) { + # determine correct parameter for weights for multiple cell countries + # (weights below zero indicate an error) + # only determine them for cases where something has to be removed + p <- rep(1, nyears(l[[iso]])) + names(p) <- rownames(cellweight) + + for (ti in getYears(l[[iso]][, t, ])) { + + sol <- nleqslv(rep(1, nyears(l[[iso]][, ti, ])), findweight, + cellarea = t(.arrayReduce(l[[iso]][, ti, cat])), + isoreduction = catreduce[ti], cellweight = cellweight[ti, ], + control = list(allowSingular = TRUE)) + p[ti] <- sol$x + msg <- sol$message + criticalWarnings <- c("Jacobian is singular (1/condition=0.0e+00) (see allowSingular option)", + "Jacobian is completely unusable (all zero entries?)", + "Iteration limit exceeded") + + if (msg %in% criticalWarnings) { + + vcat(2, paste0("No solution for ", iso, ", ", cat, ", ", msg, ".", + "Restart from higher intial guess.")) + + sol <- nleqslv(rep(10^10, nyears(l[[iso]][, ti, ])), findweight, + cellarea = t(.arrayReduce(l[[iso]][, ti, cat])), + isoreduction = catreduce[ti], cellweight = cellweight[ti, ], + control = list(allowSingular = TRUE)) + p[ti] <- sol$x + msg <- sol$message + if (msg %in% criticalWarnings) warning("No solution for ", iso, ", ", cat, ", ", msg, ".") + + } + } + + if (any(p[t] < 0)) vcat(1, "Negative weight of p=", p, " for: ", cat, " ", iso, " ", t) + remove <- l[[iso]][, , cat] * (1 - (1 - as.magpie(cellweight, spatial = 2))^as.magpie(p)) + remove[, !t, ] <- 0 + } else { + remove <- 0 + } + } + + # remove area from cells and put to "allocate" area + l[[iso]][, , cat] <- l[[iso]][, , cat] - remove + allocate <- allocate + remove + } + } + + ############################ + ### Allocation procedure ### + ############################ + + catincrease <- .arrayReduce(increase[iso, , "other"]) + + # relocate other land to areas with low vegetation carbon density + # check if other land has to be filled + if (any(catincrease != 0)) { + + t <- (catincrease != 0) + + cellweight <- (1 - 10^-16 - vegCN) + + # check for one cell countries + if (dim(l[[iso]])[1] == 1) { + # trivial case of one cell countries + add <- as.magpie(catincrease) + } else if (all(dimSums(allocate != 0, dim = 1) == 1)) { + # trivial case in which in each year exactly one cell contains land in the category to be reduced + add <- setNames((allocate != 0) * as.magpie(catincrease), NULL) + } else { + # determine correct parameter for weights for multiple cell countries (weights below zero indicate an error) + + p <- rep(1, nyears(l[[iso]])) + names(p) <- rownames(cellweight) + + for (ti in getYears(l[[iso]][, t, ])) { + + sol <- nleqslv(rep(1, nyears(l[[iso]][, ti, ])), findweight, + cellarea = t(.arrayReduce(allocate[, ti, ])), + isoreduction = -catincrease[ti], cellweight = cellweight[ti, ]) + p[ti] <- sol$x + } + + if (any(p[t] < 0)) vcat(1, "Negative weight of p=", p, " for: ", cat, " ", iso, " ", t) + add <- allocate * (1 - (1 - as.magpie(cellweight, spatial = 2))^as.magpie(p)) + } + add[, !t, ] <- 0 + + # move area from "allocate" area to other land + l[[iso]][, , "other"] <- l[[iso]][, , "other"] + add + allocate <- allocate - add + } + + # relocate forest land to remaining "allocate" area + # check if forests has to be filled + + catincrease <- increase[iso, , forests] + + if (any(catincrease != 0)) { + # move area from "allocate" area to forests + forestsShare <- catincrease / (setNames(dimSums(catincrease, dim = 3), NULL) + 10^-10) + l[[iso]][, , forests] <- (l[[iso]][, , forests] + setCells(forestsShare, "GLO") * allocate) + allocate[, , ] <- 0 + } + + ############################ + ### Check reallocation ### + ############################ + + error <- abs(dimSums(l[[iso]][, , nature], dim = 1) - natTarget[iso, , ]) + if (max(error) >= 0.001) { + landuse <- getItems(error, dim = 3) + luMissmatches <- paste(landuse[unique(which(error >= 0.001, arr.ind = TRUE)[, 3])], collapse = ", ") + warning("Missmatch (", round(max(error), 3), " Mha) in ", iso, " for ", luMissmatches) + } + + } + + lu[names(l), , ] <- mbind(l) + + .checkCellArea <- function(lu, luCellArea) { + map <- data.frame(from = getItems(lu, dim = 3), to = "sum") + error <- abs(toolAggregate(lu, map, dim = 3) - luCellArea) + cell <- rownames(which(error == max(error), arr.ind = TRUE)) + if (max(error) > 10e-4) { + warning("Total cell areas differ (max diff = ", max(error), " in ", cell, ")!") + } + } + .checkCellArea(lu, luCellArea) + + error <- abs(toolCountryFill(dimSums(lu[, , nature], dim = c("x", "y")), + fill = 0, verbosity = 2) - natTarget) + if (max(error) > 10e-4) { + country <- rownames(which(error == max(error), arr.ind = TRUE)) + warning("Missmatch between computed and target land use (max error = ", max(error), " in ", country, ")") + } + getComment(lu) <- NULL + return(lu) +} diff --git a/R/toolLPJmLVersion.R b/R/toolLPJmLVersion.R new file mode 100644 index 0000000..d1d8149 --- /dev/null +++ b/R/toolLPJmLVersion.R @@ -0,0 +1,63 @@ +#' @title toolLPJmLVersion +#' +#' @description Specify default settings for LPJmL version and baseline settings +#' +#' @param version Switch between LPJmL versions (including add-ons (+*) for further version specification) +#' @param climatetype Switch between different climate scenarios +#' +#' @return configuration as list +#' @author Kristine Karstens +#' +#' @importFrom stringr str_split +#' +#' @export + +toolLPJmLVersion <- function(version, climatetype) { + cfg <- NULL + + ##### DEFAULT CONFIG ##### + cfg$baseline_hist <- "GSWP3-W5E5:historical" + cfg$ref_year_hist <- "y2010" + cfg$baseline_gcm <- "MRI-ESM2-0:ssp370" + cfg$ref_year_gcm <- "y2020" + cfg$readin_version <- version + cfg$baseline_version <- version + cfg$climatetype <- climatetype + ##### DEFAULT CONFIG ##### + + + ##### ADDON CONFIG ##### + # overwrite default settings and LPJmL version for + # (1) add-on tag in version argument - implemented add-ons: + # * `+baseline_gcm` - use another baseline for 2010--2020 + # * `+scen:` - implemented scenario will be handled automatically for + # the readLPJmL call, no additional changes needed here + # * `gsadapt2020` - Specific if in case the gsadapt scenario want to be + # harmonized to "standard" 2020 historical values and + # not with its own historical patterns + + ### version addon + if (grepl("\\+", version)) { + tmp <- unlist(str_split(version, "\\+")) + + if (any(grepl("baseline_gcm", tmp))) { + i <- grep("baseline_gcm", tmp) + cfg$baseline_gcm <- gsub("baseline_gcm", "", tmp[i]) + cfg$readin_version <- tmp[1] + } + + if (any(grepl("gsadapt2020", tmp))) { + + if (cfg$climatetype != cfg$baseline_hist) { + cfg$readin_version <- paste0(tmp[1], "+scen:gsadapt") + } else { + cfg$readin_version <- tmp[1] + } + + cfg$baseline_version <- tmp[1] + } + } + ##### ADDON CONFIG ##### + + return(cfg) +} diff --git a/man/calcCroparea.Rd b/man/calcCroparea.Rd new file mode 100644 index 0000000..3587698 --- /dev/null +++ b/man/calcCroparea.Rd @@ -0,0 +1,46 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/calcCroparea.R +\name{calcCroparea} +\alias{calcCroparea} +\title{calcCroparea} +\usage{ +calcCroparea( + sectoral = "kcr", + physical = TRUE, + cellular = FALSE, + cells = "lpjcell", + irrigation = FALSE +) +} +\arguments{ +\item{sectoral}{"area_harvested" returns croparea aggregated to FAO products, +"ProductionItem" unaggregated ProdSTAT items, +"FoodBalanceItem" Food Balance Sheet categories, +"kcr" MAgPIE items, and "lpj" LPJmL items} + +\item{physical}{if TRUE the sum over all crops agrees with the cropland area per country} + +\item{cellular}{if TRUE: calculates cellular MAgPIE crop area for all magpie croptypes. +Crop area from LUH2 crop types (c3ann, c4ann, c3per, c4per, cnfx) +are mapped to MAgpIE crop types using mappingLUH2cropsToMAgPIEcrops.csv. +Harvested areas of FAO weight area within a specific LUH crop type +to divide into MAgPIE crop types.} + +\item{cells}{Switch between "magpiecell" (59199) and "lpjcell" (67420)} + +\item{irrigation}{If true: cellular areas are returned separated +into irrigated and rainfed (see setup in calcLUH2v2)} +} +\value{ +areas of individual crops from FAOSTAT and weight +} +\description{ +Returns harvested areas of individual crops from FAOSTAT. + Total harvested areas can be lower or higher than arable + land because of multicropping or fallow land. + Rice areas are distributed to flooded LUH areas. Additional FAOSTAT + rice areas are distributed based on country shares. +} +\author{ +Ulrich Kreidenweis, Kristine Karstens, Felicitas Beier +} diff --git a/man/calcCropareaLandInG.Rd b/man/calcCropareaLandInG.Rd new file mode 100644 index 0000000..a4da1e5 --- /dev/null +++ b/man/calcCropareaLandInG.Rd @@ -0,0 +1,52 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/calcCropareaLandInG.R +\name{calcCropareaLandInG} +\alias{calcCropareaLandInG} +\title{calcCropareaLandInG} +\usage{ +calcCropareaLandInG( + sectoral = "kcr", + physical = TRUE, + cellular = FALSE, + cells = "magpiecell", + irrigation = FALSE, + selectyears = "all", + lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", crop = + "ggcmi_phase3_nchecks_bft_e511ac58"), + climatetype = "GSWP3-W5E5:historical" +) +} +\arguments{ +\item{sectoral}{"kcr" MAgPIE items, and "lpj" LPJmL items} + +\item{physical}{if TRUE the sum over all crops plus fallow land (of calcFallowLand) +agrees with the physical cropland of readLandInG(subtype = physical)} + +\item{cellular}{if TRUE: calculates cellular crop area for all magpie croptypes. +Option FALSE is not (yet) available.} + +\item{cells}{Switch between "magpiecell" (59199) and "lpjcell" (67420)} + +\item{irrigation}{If true: cellular areas are returned separated +into irrigated and rainfed} + +\item{selectyears}{extract certain years from the data} + +\item{lpjml}{LPJmL version used to determine multiple cropping suitability} + +\item{climatetype}{Climate scenario or historical baseline "GSWP3-W5E5:historical" +used to determine multiple cropping suitability} +} +\value{ +MAgPIE object with cropareas +} +\description{ +This function uses total physical area and + crop-specific harvested area data from LandInG + to calculate crop-specific physical and harvested + areas considering special rules + for the allocation of perennial and annual crops. +} +\author{ +David Hoetten, Felicitas Beier +} diff --git a/man/calcFallowLand.Rd b/man/calcFallowLand.Rd new file mode 100644 index 0000000..55d73de --- /dev/null +++ b/man/calcFallowLand.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/calcFallowLand.R +\name{calcFallowLand} +\alias{calcFallowLand} +\title{calcFallowLand} +\usage{ +calcFallowLand(cellular = TRUE) +} +\arguments{ +\item{cellular}{TRUE for cellular outputs.} +} +\value{ +MAgPIE object containing fallow land in Mha +} +\description{ +Calculates fallow land on grid cell level, +based on physical cropland extend and harvested area output +of LandInG data. +The formula +"fallow land are = max( physical cropland area - harvested cropland area, 0)" +is used. +Due to multiple cropping, harvested cropland area can be greater than non-fallow land area +and even greater than physical cropland area. +Thus, the results can only be considered a rough estimate of fallow land area. +} +\examples{ +\dontrun{ +calcOutput("FallowLand") +} +} +\seealso{ +\code{\link{readLandInG}} +} +\author{ +David Hoetten, Felicitas Beier +} diff --git a/man/calcForestArea.Rd b/man/calcForestArea.Rd new file mode 100644 index 0000000..3c27592 --- /dev/null +++ b/man/calcForestArea.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/calcForestArea.R +\name{calcForestArea} +\alias{calcForestArea} +\title{calcForestArea} +\usage{ +calcForestArea(selectyears = "past") +} +\arguments{ +\item{selectyears}{defaults to past} +} +\value{ +List of magpie object with results on country level, weight, unit and description. +} +\description{ +Calculates consistent forest area and its subcategories based on FAO_FRA2015 +and LanduseInitialisation data. +} +\examples{ +\dontrun{ +calcOutput("ForestArea") +} +} +\author{ +Kristine Karstens, Jan Philipp Dietrich +} diff --git a/man/calcGrassGPP.Rd b/man/calcGrassGPP.Rd new file mode 100644 index 0000000..e6d856c --- /dev/null +++ b/man/calcGrassGPP.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/calcGrassGPP.R +\name{calcGrassGPP} +\alias{calcGrassGPP} +\title{calcGrassGPP} +\usage{ +calcGrassGPP(selectyears, lpjml, climatetype, season) +} +\arguments{ +\item{selectyears}{Years to be returned} + +\item{lpjml}{LPJmL version required for respective inputs: natveg or crop} + +\item{climatetype}{Switch between different climate scenarios or historical baseline "GSWP3-W5E5:historical"} + +\item{season}{"wholeYear": grass GPP in the entire year (main + off season) +"mainSeason": grass GPPP in the crop-specific growing + period of LPJmL (main season)} +} +\value{ +magpie object in cellular resolution +} +\description{ +Calculates gross primary production (GPP) of grassland + under irrigated and rainfed conditions based on LPJmL inputs. +} +\examples{ +\dontrun{ +calcOutput("GrassGPP", aggregate = FALSE) +} + +} +\author{ +Felicitas Beier +} diff --git a/man/calcGrowingPeriodMonths.Rd b/man/calcGrowingPeriodMonths.Rd new file mode 100644 index 0000000..4f8b954 --- /dev/null +++ b/man/calcGrowingPeriodMonths.Rd @@ -0,0 +1,42 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/calcGrowingPeriodMonths.R +\name{calcGrowingPeriodMonths} +\alias{calcGrowingPeriodMonths} +\title{calcGrowingPeriodMonths} +\usage{ +calcGrowingPeriodMonths(selectyears, lpjml, climatetype, minThreshold = 100) +} +\arguments{ +\item{selectyears}{Years to be returned} + +\item{lpjml}{LPJmL version required for respective inputs: natveg or crop} + +\item{climatetype}{Switch between different climate scenarios or +historical baseline "GSWP3-W5E5:historical"} + +\item{minThreshold}{Threshold of monthly grass GPP to be classified as +growing period month +Unit of the threshold is gC/m^2. +Default: 100gC/m^2 +Note: the default value is chosen based on LPJmL version 5 + to reflect multiple cropping suitability as shown in GAEZ-4. + An update of LPJmL5 with regards to grass management may + require an adjustment of the threshold.} +} +\value{ +magpie object in cellular resolution +} +\description{ +Calculates which gridcell-specific months in which + growing conditions are favorable for crop growth + based on monthly grass GPP +} +\examples{ +\dontrun{ +calcOutput("GrowingPeriodMonths", aggregate = FALSE) +} + +} +\author{ +Felicitas Beier, Jens Heinke +} diff --git a/man/calcLPJmLClimateInput.Rd b/man/calcLPJmLClimateInput.Rd new file mode 100644 index 0000000..03dd763 --- /dev/null +++ b/man/calcLPJmLClimateInput.Rd @@ -0,0 +1,42 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/calcLPJmLClimateInput.R +\name{calcLPJmLClimateInput} +\alias{calcLPJmLClimateInput} +\title{calcLPJmLClimateInput} +\usage{ +calcLPJmLClimateInput( + climatetype = "MRI-ESM2-0:ssp370", + variable = "temperature:annualMean", + stage = "harmonized2020", + lpjmlVersion = "LPJmL4_for_MAgPIE_44ac93de" +) +} +\arguments{ +\item{climatetype}{Switch between different climate scenario} + +\item{variable}{Switch between different climate inputs and temporal resolution} + +\item{stage}{Degree of processing: raw, smoothed - raw or smoothed data from 1930|1951 +raw1901, smoothed1901 - raw or smoothed data from 1901 +harmonized, harmonized2020 - based on toolLPJmLVersion} + +\item{lpjmlVersion}{LPJmL Version hand over} +} +\value{ +magpie object in cellular resolution +} +\description{ +Handle LPJmL climate input data and its time behaviour + (smoothing and harmonizing to baseline) +} +\examples{ +\dontrun{ +calcOutput("LPJmLClimateInput", + climatetype = "MRI-ESM2-0:ssp370", + variable = "temperature:annualMean") +} + +} +\author{ +Marcos Alves, Kristine Karstens, Felicitas Beier +} diff --git a/man/calcLPJmL_new.Rd b/man/calcLPJmL_new.Rd new file mode 100644 index 0000000..2318b12 --- /dev/null +++ b/man/calcLPJmL_new.Rd @@ -0,0 +1,45 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/calcLPJmL_new.R +\name{calcLPJmL_new} +\alias{calcLPJmL_new} +\title{calcLPJmL_new} +\usage{ +calcLPJmL_new( + version = "LPJmL4_for_MAgPIE_44ac93de", + climatetype = "MRI-ESM2-0:ssp370", + subtype = "soilc", + subdata = NULL, + stage = "harmonized2020" +) +} +\arguments{ +\item{version}{Switch between LPJmL versions (including addons for further version specification)} + +\item{climatetype}{Switch between different climate scenarios} + +\item{subtype}{Switch between different lpjml input as specified in readLPJmL} + +\item{subdata}{Switch between data dimension subitems} + +\item{stage}{Degree of processing: raw, smoothed - raw or smoothed data from 1930|1951 +raw1901, smoothed1901 - raw or smoothed data from 1901 +harmonized, harmonized2020 - based on toolLPJmLVersion} +} +\value{ +List of magpie objects with results on cellular level, weight, unit and description. +} +\description{ +Handle LPJmL data and its time behaviour (smoothing and harmonizing to baseline) +} +\examples{ +\dontrun{ +calcOutput("LPJmL_new", subtype = "soilc", aggregate = FALSE) +} + +} +\seealso{ +[readLPJmL()] +} +\author{ +Kristine Karstens, Felicitas Beier +} diff --git a/man/calcLUH2MAgPIE.Rd b/man/calcLUH2MAgPIE.Rd new file mode 100644 index 0000000..6dba8e1 --- /dev/null +++ b/man/calcLUH2MAgPIE.Rd @@ -0,0 +1,44 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/calcLUH2MAgPIE.R +\name{calcLUH2MAgPIE} +\alias{calcLUH2MAgPIE} +\title{calcLUH2MAgPIE} +\usage{ +calcLUH2MAgPIE( + share = "total", + bioenergy = "ignore", + rice = "non_flooded", + selectyears = "past", + missing = "ignore" +) +} +\arguments{ +\item{share}{total (for total numbers), LUHofMAG (for share of LUH within kcr types), +MAGofLUH (for share of kcr within LUH types)} + +\item{bioenergy}{"ignore": 0 for share and totals, +"fix": fixes betr and begr shares in LUHofMAG to 1 for c3per and c4per} + +\item{rice}{rice category: "non_flooded" or "total"} + +\item{selectyears}{years to be returned (default: "past")} + +\item{missing}{"ignore" will leave data as is, +"fill" will add proxy values for data gaps of FAO} +} +\value{ +List of magpie objects with results on country level, weight on country level, unit and description +} +\description{ +Calculates the real aggregation of LUH croptypes to MAgPIE croptypes + out of LUH2FAO and FAO2MAgPIE mappings +} +\examples{ +\dontrun{ +calcOutput("LUH2MAgPIE") +} + +} +\author{ +Kristine Karstens, Felicitas Beier +} diff --git a/man/calcLUH2v2.Rd b/man/calcLUH2v2.Rd new file mode 100644 index 0000000..b028747 --- /dev/null +++ b/man/calcLUH2v2.Rd @@ -0,0 +1,47 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/calcLUH2v2.R +\name{calcLUH2v2} +\alias{calcLUH2v2} +\title{calcLUH2v2} +\usage{ +calcLUH2v2( + landuse_types = "magpie", + irrigation = FALSE, + cellular = FALSE, + cells = "lpjcell", + selectyears = "past" +) +} +\arguments{ +\item{landuse_types}{magpie: magpie landuse classes, +LUH2v2: original landuse classes +flooded: flooded areas as reported by LUH} + +\item{irrigation}{if true: areas are returned separated by irrigated and rainfed, +if false: total areas} + +\item{cellular}{if true: dataset is returned on 0.5 degree resolution} + +\item{cells}{Switch between "magpiecell" (59199) and "lpjcell" (67420) +NOTE: This setting also affects the sums on country level!} + +\item{selectyears}{years to be returned (default: "past")} +} +\value{ +List of magpie objects with results on country level, + weight on country level, unit and description +} +\description{ +Integrates the LUH2v2 landuse-dataset +} +\examples{ +\dontrun{ +calcOutput("LUH2v2") +} +} +\seealso{ +[calcLanduseInitialisation()] +} +\author{ +Benjamin Leon Bodirsky, Florian Humpenoeder, Jens Heinke, Felicitas Beier +} diff --git a/man/calcLanduseInitialisation.Rd b/man/calcLanduseInitialisation.Rd new file mode 100644 index 0000000..fb884c3 --- /dev/null +++ b/man/calcLanduseInitialisation.Rd @@ -0,0 +1,52 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/calcLanduseInitialisation.R +\name{calcLanduseInitialisation} +\alias{calcLanduseInitialisation} +\title{calcLanduseInitialisation} +\usage{ +calcLanduseInitialisation( + cellular = FALSE, + nclasses = "seven", + cells = "lpjcell", + selectyears = "past", + input_magpie = FALSE +) +} +\arguments{ +\item{cellular}{cellular (TRUE) or country-level/regional (FALSE) data? +For country-level vs regional data: remember to set "aggregate" to FALSE.} + +\item{nclasses}{options are either "six", "seven" or "nine". +\itemize{ +\item "six" includes the original land use classes "crop", "past", "forestry", "forest", "urban" and "other" +\item "seven" separates primary and secondary forest and includes "crop", "past", "forestry", "primforest", +"secdforest", "urban" and "other" +\item "nine" adds the separation of pasture and rangelands, as well as a differentiation of primary +and secondary non-forest vegetation and therefore returns "crop", "past", "range", "forestry", "primforest", +"secdforest", "urban", "primother" and "secdother" +}} + +\item{cells}{if cellular is TRUE: "magpiecell" for 59199 cells or "lpjcell" for 67420 cells} + +\item{selectyears}{default on "past"} + +\item{input_magpie}{applies area fix (set cells with zero area to minimal value to +not disturb aggregating to clusters)} +} +\value{ +List of magpie object with results on country or cellular level, weight on cellular level, +unit and description. +} +\description{ +Calculates the cellular MAgPIE landuse initialisation area. + Data from FAO on forestry is used to split the secondary forest pool + of the LU2v2 dataset into forestry and secd_forest. +} +\examples{ +\dontrun{ +calcOutput("LanduseInitialisation") +} +} +\author{ +Jan Philipp Dietrich, Benjamin Leon Bodirsky, Kristine Karstens, Felcitas Beier, Patrick v. Jeetze +} diff --git a/man/calcLanduseInitialisationBase.Rd b/man/calcLanduseInitialisationBase.Rd new file mode 100644 index 0000000..40e4f61 --- /dev/null +++ b/man/calcLanduseInitialisationBase.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/calcLanduseInitialisationBase.R +\name{calcLanduseInitialisationBase} +\alias{calcLanduseInitialisationBase} +\title{calcLanduseInitialisationBase} +\usage{ +calcLanduseInitialisationBase(cells = "lpjcell", selectyears = "past") +} +\arguments{ +\item{cells}{"magpiecell" for 59199 cells or "lpjcell" for 67420 cells} + +\item{selectyears}{Years to be computed (default on "past")} +} +\value{ +Cellular landuse initialisation in its base configuration +} +\description{ +Calculates the cellular MAgPIE landuse initialisation area. Data from FAO on forestry is used +to split the secondary forest pool of the LU2v2 dataset into forestry and secd_forest. This function +returns the data set in a basic configuration. Use \code{\link{calcLanduseInitialisation}} for +more settings. +} +\examples{ +\dontrun{ +calcOutput("LanduseInitialisationBase") +} +} +\author{ +Jan Philipp Dietrich, Benjamin Leon Bodirsky, Kristine Karstens, Felcitas Beier, Patrick v. Jeetze +} diff --git a/man/calcMulticropping.Rd b/man/calcMulticropping.Rd new file mode 100644 index 0000000..6d33ccb --- /dev/null +++ b/man/calcMulticropping.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/calcMulticropping.R +\name{calcMulticropping} +\alias{calcMulticropping} +\title{calcMulticropping} +\usage{ +calcMulticropping(extend_future = FALSE, factortype = "CI") +} +\arguments{ +\item{extend_future}{if TRUE} + +\item{factortype}{CI: cropping intensity factor calculated as ratio of + harvested to physical area where values above one + indicate multicropping, below one fallow land (default) +MC: multiple cropping factor indicating areas that are + harvested more than once in one year calculated taking + fallow land into account explicitly: + harvestedArea / (physicalArea - fallowLand)} +} +\value{ +List of magpie objects with results on country level, weight on country level, unit and description. +} +\description{ +calculates a multiple cropping factor based on area harvested, + physical cropland area (and optionally fallow land). +} +\examples{ +\dontrun{ +calcOutput("Multicropping") +} + +} +\seealso{ +[calcFAOLand()], +[calcCroparea()] +} +\author{ +Benjamin Leon Bodirsky, David Chen, Felicitas Beier +} diff --git a/man/calcMulticroppingSuitability.Rd b/man/calcMulticroppingSuitability.Rd new file mode 100644 index 0000000..7fff44e --- /dev/null +++ b/man/calcMulticroppingSuitability.Rd @@ -0,0 +1,47 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/calcMulticroppingSuitability.R +\name{calcMulticroppingSuitability} +\alias{calcMulticroppingSuitability} +\title{calcMulticroppingSuitability} +\usage{ +calcMulticroppingSuitability( + selectyears, + lpjml, + climatetype, + suitability = "endogenous", + sectoral = "kcr" +) +} +\arguments{ +\item{selectyears}{Years to be returned} + +\item{lpjml}{LPJmL version required for respective inputs: natveg or crop} + +\item{climatetype}{Switch between different climate scenarios or +historical baseline "GSWP3-W5E5:historical"} + +\item{suitability}{"endogenous": suitability for multiple cropping determined + by rules based on grass and crop productivity +"exogenous": suitability for multiple cropping given by + GAEZ data set} + +\item{sectoral}{"kcr" MAgPIE crops, and "lpj" LPJmL crops} +} +\value{ +magpie object in cellular resolution +} +\description{ +Calculates which grid cells are potentially suitable for + multiple cropping activities under rainfed and irrigated conditions. + Calculation is based on the length of the growing period determined by + monthly grassland gross primary production (GPP). +} +\examples{ +\dontrun{ +calcOutput("MulticroppingSuitability", aggregate = FALSE) +} + +} +\author{ +Felicitas Beier, Jens Heinke +} diff --git a/man/calcMultipleCroppingZones.Rd b/man/calcMultipleCroppingZones.Rd new file mode 100644 index 0000000..ffd3694 --- /dev/null +++ b/man/calcMultipleCroppingZones.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/calcMultipleCroppingZones.R +\name{calcMultipleCroppingZones} +\alias{calcMultipleCroppingZones} +\title{calcMultipleCroppingZones} +\usage{ +calcMultipleCroppingZones(layers = 2) +} +\arguments{ +\item{layers}{8 for original GAEZ layers, +3 for aggregated multiple cropping zones with +1 = single cropping, 2 = double cropping, 3 = triple cropping +2 for aggregated boolean multicropping potential with +0 = no multicropping (single cropping), 1 = multiple cropping} +} +\value{ +magpie object in cellular resolution +} +\description{ +This function returns multiple cropping zones at 0.5 degree resolution +} +\examples{ +\dontrun{ +calcOutput("MultipleCroppingZones", layers = 3, aggregate = FALSE) +} + +} +\author{ +Felicitas Beier +} diff --git a/man/calcRicearea.Rd b/man/calcRicearea.Rd new file mode 100644 index 0000000..aaa3781 --- /dev/null +++ b/man/calcRicearea.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/calcRicearea.R +\name{calcRicearea} +\alias{calcRicearea} +\title{calcRicearea} +\usage{ +calcRicearea(cellular = FALSE, cells = "lpjcell", share = TRUE) +} +\arguments{ +\item{cellular}{If TRUE: calculates cellular rice area} + +\item{cells}{Switch between "magpiecell" (59199) and "lpjcell" (67420)} + +\item{share}{If TRUE: non-flooded share is returned. +If FALSE: rice area (flooded, non-flooded, total) in Mha is returned} +} +\value{ +rice areas or rice area shares of flooded and non-flooded category +} +\description{ +calculates rice area based on LUH flooded areas and + physical rice areas reported by FAOSTAT. +} +\author{ +Felicitas Beier, Kristine Karstens +} diff --git a/man/convertLPJmL.Rd b/man/convertLPJmL.Rd new file mode 100644 index 0000000..7ddddae --- /dev/null +++ b/man/convertLPJmL.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/convertLPJmL.R +\name{convertLPJmL} +\alias{convertLPJmL} +\title{convertLPJmL} +\usage{ +convertLPJmL(x) +} +\arguments{ +\item{x}{magpie object provided by the read function} +} +\value{ +List of magpie objects with results on cellular level, weight, unit and description. +} +\description{ +Convert LPJmL content +} +\examples{ +\dontrun{ +readSource("LPJmL", subtype = "soilc", convert = TRUE) +} + +} +\seealso{ +[readLPJmL()] +} +\author{ +Kristine Karstens +} diff --git a/man/correctGAEZv4.Rd b/man/correctGAEZv4.Rd new file mode 100644 index 0000000..31440cf --- /dev/null +++ b/man/correctGAEZv4.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/correctGAEZv4.R +\name{correctGAEZv4} +\alias{correctGAEZv4} +\title{correctGAEZv4} +\usage{ +correctGAEZv4(x) +} +\arguments{ +\item{x}{MAgPIE object provided by readGAEZv4 function} +} +\value{ +MAgPIE object at 0.5 cellular level +} +\description{ +Correct Global Agro-ecological Zones (GAEZ) data +} +\examples{ +\dontrun{ +readSource("GAEZv4", convert = "onlycorrect") +} + +} +\author{ +Felicitas Beier +} diff --git a/man/correctLPJmL.Rd b/man/correctLPJmL.Rd new file mode 100644 index 0000000..d221e8f --- /dev/null +++ b/man/correctLPJmL.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/correctLPJmL.R +\name{correctLPJmL} +\alias{correctLPJmL} +\title{correctLPJmL} +\usage{ +correctLPJmL(x) +} +\arguments{ +\item{x}{magpie object provided by the read function} +} +\value{ +List of magpie objects with results on cellular level, weight, unit and description. +} +\description{ +Correct LPJmL content +} +\examples{ +\dontrun{ +readSource("LPJmL", subtype = "soilc", convert = "onlycorrect") +} + +} +\seealso{ +[correctLPJmL()] +} +\author{ +Kristine Karstens, Felicitas Beier +} diff --git a/man/correctLPJmLClimateInput.Rd b/man/correctLPJmLClimateInput.Rd new file mode 100644 index 0000000..2dada20 --- /dev/null +++ b/man/correctLPJmLClimateInput.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/correctLPJmLClimateInput.R +\name{correctLPJmLClimateInput} +\alias{correctLPJmLClimateInput} +\title{correctLPJmLClimateInput} +\usage{ +correctLPJmLClimateInput(x) +} +\arguments{ +\item{x}{magpie object provided by the read function} +} +\value{ +Magpie objects with results on cellular level, weight, unit and description. +} +\description{ +Correct LPJmL climate input variables +} +\examples{ + +\dontrun{ +readSource("LPJmLClimateInput", subtype, convert="onlycorrect") +} + +} +\seealso{ +\code{\link{readLPJmLClimateInput}} +} +\author{ +Marcos Alves, Felicitas Beier +} diff --git a/man/correctLPJmLInputs.Rd b/man/correctLPJmLInputs.Rd new file mode 100644 index 0000000..1ad9e86 --- /dev/null +++ b/man/correctLPJmLInputs.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/correctLPJmLInputs.R +\name{correctLPJmLInputs} +\alias{correctLPJmLInputs} +\title{correctLPJmLInputs} +\usage{ +correctLPJmLInputs(x) +} +\arguments{ +\item{x}{magpie object provided by the read function} +} +\description{ +correct LPJmLInputs content (dummy function) +} +\examples{ +\dontrun{ +readSource("LPJmLInputs", convert = "onlycorrect") +} + +} +\author{ +Felicitas Beier +} diff --git a/man/correctLPJmL_new.Rd b/man/correctLPJmL_new.Rd new file mode 100644 index 0000000..f6915ea --- /dev/null +++ b/man/correctLPJmL_new.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/correctLPJmL_new.R +\name{correctLPJmL_new} +\alias{correctLPJmL_new} +\title{correctLPJmL_new} +\usage{ +correctLPJmL_new(x) +} +\arguments{ +\item{x}{magpie object provided by the read function} +} +\description{ +Convert LPJmL content (dummy function) +} +\examples{ +\dontrun{ +readSource("LPJmL", convert = "onlycorrect") +} + +} +\seealso{ +[readLPJmL()] +} +\author{ +Kristine Karstens +} diff --git a/man/correctLUH2v2.Rd b/man/correctLUH2v2.Rd new file mode 100644 index 0000000..fd91772 --- /dev/null +++ b/man/correctLUH2v2.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/correctLUH2v2.R +\name{correctLUH2v2} +\alias{correctLUH2v2} +\title{correctLUH2v2} +\usage{ +correctLUH2v2(x, subtype) +} +\arguments{ +\item{x}{magpie object provided by the read function} + +\item{subtype}{switch between different inputs} +} +\value{ +List of magpie object with results on cellular level +} +\description{ +Correct LUH2v2 content +} +\author{ +Florian Humpenoeder, Stephen Wirth, Kristine Karstens, Felicitas Beier, Jan Philipp Dietrich, + Edna J. Molina Bacca +} diff --git a/man/correctLandInG.Rd b/man/correctLandInG.Rd new file mode 100644 index 0000000..88e6289 --- /dev/null +++ b/man/correctLandInG.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/correctLandInG.R +\name{correctLandInG} +\alias{correctLandInG} +\title{correctLandInG} +\usage{ +correctLandInG(x) +} +\arguments{ +\item{x}{magpie object provided by the read function} +} +\value{ +corrected magpie object +} +\description{ +correct LandInG data. Convert unit from ha to mio ha +} +\examples{ +\dontrun{ +a <- readSource("LandInG", convert = "onlycorrect") +} + +} +\seealso{ +\code{\link{readLandInG}} +} +\author{ +David Hoetten, Felicitas Beier +} diff --git a/man/downloadLPJmLClimateInput.Rd b/man/downloadLPJmLClimateInput.Rd new file mode 100644 index 0000000..3039bd1 --- /dev/null +++ b/man/downloadLPJmLClimateInput.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/downloadLPJmLClimateInput.R +\name{downloadLPJmLClimateInput} +\alias{downloadLPJmLClimateInput} +\title{downloadLPJmLClimateInput} +\usage{ +downloadLPJmLClimateInput(subtype = "ISIMIP3bv2:MRI-ESM2-0:ssp370:temperature") +} +\arguments{ +\item{subtype}{Switch between different inputs (e.g. "ISIMIP3b:IPSL-CM6A-LR:historical:1850-2014:temperature") +Argument consists of GCM version, climate model, scenario and variable, +separated by ":"} +} +\value{ +metadata entry +} +\description{ +Download GCM climate input used for LPJmL runs +} +\examples{ +\dontrun{ +readSource("LPJmLClimateInput", convert = "onlycorrect") +} + +} +\author{ +Marcos Alves, Kristine Karstens +} diff --git a/man/downloadLPJmL_new.Rd b/man/downloadLPJmL_new.Rd new file mode 100644 index 0000000..09f0dda --- /dev/null +++ b/man/downloadLPJmL_new.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/downloadLPJmL_new.R +\name{downloadLPJmL_new} +\alias{downloadLPJmL_new} +\title{downloadLPJmL_new} +\usage{ +downloadLPJmL_new( + subtype = "LPJmL4_for_MAgPIE_44ac93de:GSWP3-W5E5:historical:soilc" +) +} +\arguments{ +\item{subtype}{Switch between different input +It consists of LPJmL version, climate model, scenario and variable. +For pasture lpjml runs, the scenario variable is used to navigate the output folder structure +(e.g. 'LPJmL4_for_MAgPIE_3dda0615:GSWP3-W5E5:historical:soilc' or +"LPJmL5.2_Pasture:IPSL_CM6A_LR:ssp126_co2_limN_00:soilc_past_hist")} +} +\value{ +metadata entry +} +\description{ +Download LPJmL content by version, climate model and scenario +} +\examples{ +\dontrun{ +readSource("LPJmL_new", convert = FALSE) +} +} +\author{ +Kristine Karstens, Marcos Alves, Felicitas Beier +} diff --git a/man/readGAEZv4.Rd b/man/readGAEZv4.Rd new file mode 100644 index 0000000..30c5eb0 --- /dev/null +++ b/man/readGAEZv4.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/readGAEZv4.R +\name{readGAEZv4} +\alias{readGAEZv4} +\title{readGAEZv4} +\usage{ +readGAEZv4(subtype = "MCzones") +} +\arguments{ +\item{subtype}{Subtype to be read} +} +\value{ +MAgPIE object at 0.5 cellular level +} +\description{ +Read in data from the Global Agro-ecological Zones (GAEZ) data set version 4 +} +\examples{ +\dontrun{ +readSource("GAEZv4", convert = "onlycorrect") +} + +} +\author{ +Felicitas Beier +} diff --git a/man/readLPJmL.Rd b/man/readLPJmL.Rd new file mode 100644 index 0000000..83d3f9f --- /dev/null +++ b/man/readLPJmL.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/readLPJmL.R +\name{readLPJmL} +\alias{readLPJmL} +\title{readLPJmL} +\usage{ +readLPJmL(subtype = "LPJmL5:CRU4p02.soilc") +} +\arguments{ +\item{subtype}{Switch between different input} +} +\value{ +List of magpie objects with results on cellular level, weight, unit and description. +} +\description{ +Read LPJmL content +} +\examples{ +\dontrun{ +readSource("LPJmL", subtype = "LPJmL5:CRU4p02.soilc", convert = "onlycorrect") +} + +} +\seealso{ +[readLPJ()] +} +\author{ +Kristine Karstens, Abhijeet Mishra, Felicitas Beier +} diff --git a/man/readLPJmLClimateInput.Rd b/man/readLPJmLClimateInput.Rd new file mode 100644 index 0000000..0e0cbd8 --- /dev/null +++ b/man/readLPJmLClimateInput.Rd @@ -0,0 +1,42 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/readLPJmLClimateInput.R +\name{readLPJmLClimateInput} +\alias{readLPJmLClimateInput} +\title{readLPJmLClimateInput} +\usage{ +readLPJmLClimateInput( + subtype = "ISIMIP3bv2:MRI-ESM2-0:ssp370:temperature", + subset = "annualMean" +) +} +\arguments{ +\item{subtype}{Switch between different inputs, +e.g. "ISIMIP3bv2:MRI-ESM2-0:ssp370:1850-2014:tas" +Available variables are: * tas - + * wet - + * per -} + +\item{subset}{Switch between different subsets of the same subtype +Available options are: "annualMean", "annualSum", + "monthlyMean", "monthlySum", + "wetDaysMonth" +Note that not all subtype-subset combinations make sense} +} +\value{ +MAgPIE objects with results on cellular level. +} +\description{ +Read Climate data used as LPJmL inputs into MAgPIE objects +} +\examples{ +\dontrun{ +readSource("LPJmLClimateInput", subtype, convert = "onlycorrect") +} + +} +\seealso{ +\code{\link{readLPJmLClimateInput}} +} +\author{ +Marcos Alves, Kristine Karstens, Felicitas Beier +} diff --git a/man/readLPJmLInputs.Rd b/man/readLPJmLInputs.Rd new file mode 100644 index 0000000..5281d3a --- /dev/null +++ b/man/readLPJmLInputs.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/readLPJmLInputs.R +\name{readLPJmLInputs} +\alias{readLPJmLInputs} +\title{readLPJmLInputs} +\usage{ +readLPJmLInputs(subtype = "lakeshare") +} +\arguments{ +\item{subtype}{Switch between different inputs} +} +\value{ +List of magpie objects with results on cellular level, weight, unit and description. +} +\description{ +This function reads in LPJmL inputs (inputs to LPJmL) +} +\examples{ +\dontrun{ +readSource("LPJmLInputs", subtype = "lakeshare", convert = FALSE) +} + +} +\author{ +Felicitas Beier +} diff --git a/man/readLPJmL_new.Rd b/man/readLPJmL_new.Rd new file mode 100644 index 0000000..54b37cc --- /dev/null +++ b/man/readLPJmL_new.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/readLPJmL_new.R +\name{readLPJmL_new} +\alias{readLPJmL_new} +\title{readLPJmL_new} +\usage{ +readLPJmL_new( + subtype = "LPJmL4_for_MAgPIE_44ac93de:GSWP3-W5E5:historical:soilc" +) +} +\arguments{ +\item{subtype}{Switch between different inputs +(eg. "LPJmL5.2_Pasture:IPSL_CM6A_LR:ssp126_co2_limN_00:soilc_past_hist")} +} +\value{ +List of magpie objects with results on cellular level, weight, unit and description. +} +\description{ +Read in LPJmL outputs +} +\examples{ +\dontrun{ +readSource("LPJmL_new", convert = FALSE) +} + +} +\seealso{ +[readLPJ()] +} +\author{ +Kristine Karstens, Abhijeet Mishra, Felicitas Beier, Marcos Alves +} diff --git a/man/readLUH2v2.Rd b/man/readLUH2v2.Rd new file mode 100644 index 0000000..da599c5 --- /dev/null +++ b/man/readLUH2v2.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/readLUH2v2.R +\name{readLUH2v2} +\alias{readLUH2v2} +\title{readLUH2v2} +\usage{ +readLUH2v2(subtype) +} +\arguments{ +\item{subtype}{switch between different inputs} +} +\value{ +List of magpie objects with results on cellular level, weight, unit and description +} +\description{ +read LUH inputs +} +\author{ +Florian Humpenoeder, Stephen Wirth, Kristine Karstens, Felicitas Beier, +Jan Philipp Dietrich, Patrick v. Jeetze +} diff --git a/man/readLandInG.Rd b/man/readLandInG.Rd new file mode 100644 index 0000000..7253bdb --- /dev/null +++ b/man/readLandInG.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/readLandInG.R +\name{readLandInG} +\alias{readLandInG} +\title{readLandInG} +\usage{ +readLandInG(subtype = "physicalArea") +} +\arguments{ +\item{subtype}{Type of LandInG data that should be read: +\itemize{ +\item \code{physicalArea}: Cropland extend/ physical cropping area separated in irrigated and rainfed +\item \code{harvestedArea}: Harvested area separated in different crop types +}} +} +\value{ +magpie object +} +\description{ +Reads in LandInG data +} +\examples{ +\dontrun{ +A <- readSource("LandInG", subtype = "harvestedArea", aggregate = FALSE) +} + +} +\seealso{ +\code{\link{readSource}} +} +\author{ +Felicitas Beier +} diff --git a/man/toolClimateInputVersion.Rd b/man/toolClimateInputVersion.Rd new file mode 100644 index 0000000..7e17664 --- /dev/null +++ b/man/toolClimateInputVersion.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/toolClimateInputVersion.R +\name{toolClimateInputVersion} +\alias{toolClimateInputVersion} +\title{toolClimateInputVersion} +\usage{ +toolClimateInputVersion(lpjmlVersion, climatetype) +} +\arguments{ +\item{lpjmlVersion}{Add-ons (+*) for further version specification for LPJmL version} + +\item{climatetype}{Switch between different climate scenarios} +} +\value{ +configuration as list +} +\description{ +Specify default settings for LPJmL climate input version and baseline settings +} +\author{ +Kristine Karstens +} diff --git a/man/toolForestRelocate.Rd b/man/toolForestRelocate.Rd new file mode 100644 index 0000000..70b4ce7 --- /dev/null +++ b/man/toolForestRelocate.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/toolForestRelocate.R +\name{toolForestRelocate} +\alias{toolForestRelocate} +\title{toolForestRelocate} +\usage{ +toolForestRelocate(lu, luCountry, natTarget, vegC) +} +\arguments{ +\item{lu}{uncorrected landuse initialisation data set (cell level)} + +\item{luCountry}{uncorrected landuse initialisation on country level} + +\item{natTarget}{target natural land allocation on country level} + +\item{vegC}{vegetation carbon data used as reallocation weight} +} +\value{ +List of magpie object with results on cellular level +} +\description{ +Reallocates cellular forest information from LUH2 + to better match FAO forest information +} +\author{ +Kristine Karstens, Jan Philipp Dietrich, Felicitas Beier, Patrick v. Jeetze +} diff --git a/man/toolLPJmLVersion.Rd b/man/toolLPJmLVersion.Rd new file mode 100644 index 0000000..a88cd48 --- /dev/null +++ b/man/toolLPJmLVersion.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/toolLPJmLVersion.R +\name{toolLPJmLVersion} +\alias{toolLPJmLVersion} +\title{toolLPJmLVersion} +\usage{ +toolLPJmLVersion(version, climatetype) +} +\arguments{ +\item{version}{Switch between LPJmL versions (including add-ons (+*) for further version specification)} + +\item{climatetype}{Switch between different climate scenarios} +} +\value{ +configuration as list +} +\description{ +Specify default settings for LPJmL version and baseline settings +} +\author{ +Kristine Karstens +} diff --git a/mrlandcore.Rproj b/mrlandcore.Rproj new file mode 100644 index 0000000..497f8bf --- /dev/null +++ b/mrlandcore.Rproj @@ -0,0 +1,20 @@ +Version: 1.0 + +RestoreWorkspace: Default +SaveWorkspace: Default +AlwaysSaveHistory: Default + +EnableCodeIndexing: Yes +UseSpacesForTab: Yes +NumSpacesForTab: 2 +Encoding: UTF-8 + +RnwWeave: Sweave +LaTeX: pdfLaTeX + +AutoAppendNewline: Yes +StripTrailingWhitespace: Yes + +BuildType: Package +PackageUseDevtools: Yes +PackageInstallArgs: --no-multiarch --with-keep.source diff --git a/tests/.lintr b/tests/.lintr new file mode 100644 index 0000000..165993b --- /dev/null +++ b/tests/.lintr @@ -0,0 +1,2 @@ +linters: lucode2::lintrRules(allowUndesirable = TRUE) +encoding: "UTF-8"