diff --git a/.DS_Store b/.DS_Store new file mode 100644 index 0000000..7c36066 Binary files /dev/null and b/.DS_Store differ diff --git a/DESCRIPTION b/DESCRIPTION new file mode 100644 index 0000000..08c7d4a --- /dev/null +++ b/DESCRIPTION @@ -0,0 +1,11 @@ +Package: CropWatR +Type: Package +Title: Crop-water balances according to algorithms described in the FAO Irrigation and drainage paper 56 +Version: 1.0 +Date: 2015-09-06 +Author: Jacob Teter +Requires: rgdal, sp, raster +Suggests: rgeos, rasterVis, ggplot2 +Maintainer: Jacob Teter +Description: Functions to enable calculation of FAO Penman-Monteith reference evapotranspiration, crop- and soil-water balances for agricultural crops. GIS-enabled implementation (using R's basic spatial packages, including rgeos, rgdal sp, raster) at a daily time-step, including calibration methods for irrigation scheduling and variable crop planting and harvesting dates. Crop-water models according to the FAO 56 document 'Crop evapotranspiration - Guidelines for computing crop water requirements' +License: GPL-2 \ No newline at end of file diff --git a/NAMESPACE b/NAMESPACE new file mode 100644 index 0000000..d75f824 --- /dev/null +++ b/NAMESPACE @@ -0,0 +1 @@ +exportPattern("^[[:alpha:]]+") diff --git a/R/Calc.Basal.Crop.Coeff.R b/R/Calc.Basal.Crop.Coeff.R new file mode 100644 index 0000000..c95707b --- /dev/null +++ b/R/Calc.Basal.Crop.Coeff.R @@ -0,0 +1,51 @@ +Calc.Basal.Crop.Coeff <- +function(Croplayer){ + load(paste0(Intermediates, paste('Growing.Season', Croplayer, 'U2.final_', 'Rdata', sep = '.'))); U2 <- Growing.Season; rm(Growing.Season) + load(paste0(Intermediates, paste('Growing.Season', Croplayer, 'MNRH_', 'Rdata', sep = '.'))); RHmin <- Growing.Season; rm(Growing.Season) + load(paste0(Intermediates,paste('CropsList', Croplayer, 'Rdata', sep = '.'))) + # check x, y coordinates listing of the two files: # all.equal(lapply(U2, function(x) dim(x)), lapply(RHmin, function(x) dim(x))) + all.equal(lapply(U2, function(x) x[,c('x','y')]), lapply(RHmin, function(x) x[,c('x','y')])) + all.equal(names(U2), names(Daily.Crops.list)) + + GS.U2 <- lapply(U2, function(x) x[,(grep('layer', names(x)))]) + GS.RHmin <- lapply(RHmin, function(x) x[,(grep('layer', names(x)))]) + + sapply(GS.U2, dim) + sapply(GS.RHmin, dim) + all.equal(sapply(GS.U2, dim), sapply(GS.RHmin, dim)) + + ### Subset only mid and late growing season + Wind_term <- lapply(GS.U2, function(x) 0.04*(x[]-2)) + RH_term <- lapply(GS.RHmin, function(x) 0.004*(x[]-45)) + all.equal(lapply(Wind_term, function(x) c(x$x, x$y)), lapply(RH_term, function(x) c(x$x, x$y))) + + Max.season.heights <- lapply(Daily.Crops.list, function(x) tapply(x$day_height, x$season.ID, max)) + Season.IDs <- lapply(Daily.Crops.list, function(x) x$season.ID); Plant_heights <- Season.IDs + for (i in 1:length(Max.season.heights)){ + Plant_heights[[i]] <- Max.season.heights[[i]][match(Season.IDs[[i]], names(Max.season.heights[[i]]))] + } + Kcb <- lapply(Daily.Crops.list, function(x) x$daily_Kcb) # dim(Kcb[[1]]); length(Kcb[[1]]) + print('done plant heights') + height_term <- lapply(Plant_heights, function(x) (x[]/3)^0.3) + Kcb.corrected <- Wind_term + summary(Kcb.corrected[[1]]) + for (i in 1:length(Wind_term)){ + for (j in 1:length(height_term[[i]])){ + Kcb.corrected[[i]][,j] <- Kcb[[i]][j] + (Wind_term[[i]][,j] - RH_term[[i]][,j]) * height_term[[i]][j] + } + } + print('done correction term') + Mid.Late.Season.cuts <- lapply(Daily.Crops.list, function(x) which(x$season.ID == 3 | x$season.ID == 4)) + + Before <- Kcb.corrected + for (i in 1:length(Kcb.corrected)){ # lots of looping, so it's slow. It takes: ~30 seconds + for (j in 1:length(Kcb.corrected[[i]])){ + Kcb.corrected[[i]][,j][which(GS.RHmin[[i]][,j] > 20 & GS.RHmin[[i]][,j] < 80)] <- Kcb[[i]][j] + Kcb.corrected[[i]][,j][which(GS.U2[[i]][,j] > 1 & GS.U2[[i]][,j] < 6)] <- Kcb[[i]][j] + } + } + all.equal(Before, Kcb.corrected) # not equal, but minor differences, as is should be. + all.equal(lapply(Before, function(x) dim(x)), lapply(Kcb.corrected, function(x) dim(x))) + all.equal(names(Before), names(Kcb.corrected)) + save(Kcb.corrected, file = paste0(Intermediates, paste('Kcb.corrected', Croplayer, 'Rdata', sep = '.'))) +} diff --git a/R/Calc.Fc.Few.R b/R/Calc.Fc.Few.R new file mode 100644 index 0000000..9fc8ed3 --- /dev/null +++ b/R/Calc.Fc.Few.R @@ -0,0 +1,19 @@ +Calc.Fc.Few <- +function(Croplayer){ + load(paste0(Intermediates, paste('KcMax', Croplayer, 'Rdata', sep = '.'))) + GR.KcMax <- lapply(KcMax, function(x) x[,(grep('layer', names(x)))]) # clip off the coordinates for analysis + load(paste0(Intermediates, paste('CropsList', Croplayer, 'Rdata', sep = '.'))) + # str(Daily.Crops.list[[1]]) + DayHeight <- lapply(Daily.Crops.list, function(x) x$day_height) + load(paste0(Intermediates, paste('Kcb.corrected', Croplayer, 'Rdata', sep = '.'))) # Kcb.corrected + + KcMin <- lapply(Kcb.corrected, function(x) c(rep(min(x)-0.01, times = length(x)))); Fc <- GR.KcMax + for (i in 1:length(Fc)){ + for (j in 1:length(DayHeight[[i]])){ + Fc[[i]][,j] <- ((Kcb.corrected[[i]][,j] - KcMin[[i]][j])/(GR.KcMax[[i]][,j] - KcMin[[i]][j]))^(1+0.5*DayHeight[[i]][j]) + } + } + Few <- Fc + Few <- lapply(Fc, function(x) 1-x[]) # This suffices for RAINFED crops + save(Few, file = paste0(Intermediates, paste('Few', Croplayer, 'Rdata', sep = '.'))) +} diff --git a/R/Calculate.ETo.R b/R/Calculate.ETo.R new file mode 100644 index 0000000..c54a6b1 --- /dev/null +++ b/R/Calculate.ETo.R @@ -0,0 +1,112 @@ +Calculate.ETo <- +function(Elevation, MaxTemperature, MinTemperature, MeanTemperature, Precipitation, VP, MaxRH, MinRH, Wind, SolarRad, Filename){ + # Inputs are file names of the input raster files (daily weather files, elevation, etc.) + + ### I. Load CONSTANTS + LHV <- 2.45 # latent heat of vaporization [MJ/kg] + Cp <- 1.013*10^-3 # specific heat at constant pressure + E <- 0.622 # P from above (1 millibar = 100 pascals = 0.1 kilopascals) + Alpha <- 0.23 # albedo or canopy reflection coefficient, which is 0.23 for the hypothetical grass reference crop [dimensionless], + G <-0 #### 10. Soil heat flux (G) # G [MJ/m^2*day], "may be ignored for daily timesteps". + Gsc <- 0.0820 # Solar constant (MJ/m^2*min) + As0 <- 0.75 # as+bs fraction of extraterrestrial radiation reaching the earth on clear days (n = N). + Bs0 <- 2*10^-5 + Sigma <- 4.903*10^-9 # Stefan-Boltzmann constant [ 4.903 10^-9 MJ K^-4 m^-2 day^-1], + + ### II. Load & Mask INPUT files: + + # In the Daymet algorithm, spatially and temporally explicit empirical analyses of the relationships of temperature and precipitation to elevation are performed. + Elev <- raster(Elevation) # elevation (meters) + MaxTemp <- brick(MaxTemperature) # max temperature. degrees Celsius + MinTemp <- brick(MinTemperature) # min temperature. degrees Celsius + MeanTemp <- brick(MeanTemperature) # mean temperature. degrees Celsius + Precip <- brick(Precipitation) # precipitation (mm) + + ### ADDED vapor pressure - DayMet units for VP are Pascal - need to convert to [kPa] + EaPascal <- brick(VP) # "daily average vapor pressure" - Vapor Pressure (Ea) + Ea <- EaPascal/1000 + + MxRH <- brick(MaxRH) # max relative humidity. 0-100 (%) (verified) + MnRH <- brick(MinRH) # min relative humidity. 0-100 (%) (verified) + + ### Wind speed is commonly measured at 10 m height above the ground surface. + U2 <- brick(Wind) # wind speed @ 2 meters height, assuming conversion from 10 meters. in m/s + + Sol_watts <- brick(SolarRad) # length(Sol_watts[is.na(Sol_watts)]) # [1] 55339 + # Temp <- mask(Sol_watts, ETo); all.equal(Temp, Sol_watts); rm(Temp) + Solar <- Sol_watts/11.6 # Rs - solar or shortwave radiation [MJ m-2 day-1] + + #### aeaMapping, Lat/Long rasters - see Appendix 1 + Lat <- raster('Lat.values.grd') + Long <- raster('Long.values.grd') + Julian <- brick('Julian.values.grd') + Rasters <- list(MaxTemp, MinTemp, MeanTemp, MxRH, MnRH, U2, Solar, Ea, Julian) + print('do the rasters match?') + print(sapply(Rasters, function(x) compareRaster(x, Elev))) + + # "Julian" is the rasterBrick with the values being the Julian day - see Appendix 2 + + ##### III. Calculate Solar Parameters + E0Max <- calc(MaxTemp, fun=function(x) {0.6108*exp(17.27*x/(x+273.3))}) + Dr <- calc(Julian, fun=function(x) {1 + 0.033*cos(2*pi/365*x)}) # Inverse relative earth-sun distance + Theta <- calc(Julian, fun=function(x) {0.409*sin((2*pi/365*x)-1.39)}) # Solar declination + Lrad <- Lat*pi/180 # Latitude (radians) + b <- calc(Julian, fun=function(x) {2*pi*(x-81)/364}) # + Sc <- 0.1645*sin(2*b)-0.1255*cos(b)-0.025*sin(b) # seasonal correction for solar time [hour] + Ws <- acos(-1*tan(Lrad)*tan(Theta)) # Sunset hour angle (radians) -- equation 25 + + Gsc <- 0.0820 # Solar constant (MJ/m^2*min) + N <- 24/pi*Ws # Daylight hours (N) + Multiply.Day <- calc(Dr, fun=function(x) {(24*60)/pi*Gsc*x}) # first part of equation 28 + Ra <- Multiply.Day*(Ws*sin(Lrad)*sin(Theta)+cos(Lrad)*cos(Theta)*sin(Ws)) + Rs0 <- (As0+Bs0*Elev)*Ra ###### Clear-sky radiation (Rso) + + #### Net longwave radiation - (detailed explanation on page 51): Rnl (MJ/meter^2*day) (Equation 39) + Sigma <- 4.903*10^-9 # Stefan-Boltzmann constant [ 4.903 10^-9 MJ K^-4 m^-2 day^-1], + KTmax <- MaxTemp + 273.16 # Max/Min daily temp in Kelvin: + KTmin <- MinTemp + 273.16 + + ###### Clear-sky radiation (Rs0) + Bs0 <- Elev*10^-5 + Rs0 <- (As0+Bs0*Elev)*Ra + + # IV. Calculate Intermediates: + P <- calc(Elev, fun=function(x) {101.3*((293-0.0065*(x))/293)^5.26}) + gamma <- Cp*P/E*LHV + + E0Max <- calc(MaxTemp, fun=function(x) {0.6108*exp(17.27*x/(x+273.3))}) # as does this one + E0Min <- calc(MinTemp, fun=function(x) {0.6108*exp(17.27*x/(x+273.3))}) + Es <- (E0Min+E0Max)/2 + E0Mean <- calc(MeanTemp, fun=function(x) {0.6108*exp(17.27*x/(x+273.3))}) + Delta <- 4098*(E0Mean)/((MeanTemp+273.3)^2) + + ### Use Raster of VP - need units of kPa + Ea1 <- (E0Min*MxRH/100+E0Max*MnRH/100)/2 # Actual Vapor Pressure [kPa] + # writeRaster(Ea1, 'Derived.VP.kPa.NCAR.min.max.RH.grd', overwrite = TRUE) + VPD <- Es - Ea # Vapor Pressure Deficit [kPa] + + #### Net longwave radiation - (detailed explanation on page 51): Rnl (MJ/meter^2*day) (Equation 39) + Sigma <- 4.903*10^-9 # Stefan-Boltzmann constant [ 4.903 10^-9 MJ K^-4 m^-2 day^-1], + KTmax <- MaxTemp + 273.16 # Max/Min daily temp in Kelvin: + KTmin <- MinTemp + 273.16 + Rnl <- Sigma*((KTmax^4+KTmin^4)/2)*(0.34-0.14*Ea^0.5)*(1.35*(Solar/Rs0)-0.35) + # Final product: Rnl (net longwave Radiation) + + # Solar radiation (Rs) + Rns <- calc(Solar, fun=function(x) {(1-Alpha)*x}) ##### Net solar or net shortwave radiation: Rns (MJ/meter^2*day) + Rn <- Rns - Rnl # Net longwave Radiation + Rn <- dropLayer(Rn, 366) + # writeRaster(Rn, 'Rn.2008.grd', overwrite = TRUE) + + ### V. Final ETo calculation steps: + Numerator <- 0.408*Delta*(Rn-G)+gamma*900/(MeanTemp+273)*U2*(Es-Ea) + Denominator <- Delta+gamma*(1+0.34*U2) + ETo <- Numerator/Denominator + + ####### 13. Clean out negative ETo values: + ETo[ETo < 0] <- 0.001 + ETo <- mask(ETo, U2) + writeRaster(ETo, filename = Filename, overwrite = TRUE) + # YearAve.ETo <- calc(s, fun = mean, filename = paste0('Annual.average.ETo_2008.grd'), overwrite = TRUE) + # YearTotal.ETo <- calc(s, fun = sum, filename = paste0('Year.total.ETo_2008.grd'), overwrite = TRUE) +} diff --git a/R/Daily.Crop.Curves.R b/R/Daily.Crop.Curves.R new file mode 100644 index 0000000..5076720 --- /dev/null +++ b/R/Daily.Crop.Curves.R @@ -0,0 +1,76 @@ +Daily.Crop.Curves <- +function(Croplayer, StateNames, Stages, Kcb_tab, MaxHeight){ + ##### INPUTS: + ### Stages: a vector of length four, giving the whole number length in days of the following four seasons + ### 4 stages: initial, crop development, mid season, late season + ### Kcb_tab: a vector of length three, the Kcb for a given crop + ### StateNames: a vector of length of resultant list, same order as the nrows, of State IDs + + #### OUTPUTS: a data.frame with (x) the length of the growing season (in days), and the following variables: + # DailyKcb$Season_day : # of day in the growing season + # DailyKcb$Stage_ID : factor (1:4); stage of growing season + # DailyKcb$daily_Kcb : daily Kcb values + # DailyKcb$daily_Kcb : day_height - daily interpolated height of crop + # ALSO: returns the exposed soil fraction (1-Fc), over the lenght of the growing season + + ## Added Croplayer, need to access it to get rooting depths + root.depth <- read.csv('crop.roots.csv') + Crop <- Croplayer + if (Croplayer == 'spring_barley' | Croplayer == 'fall_barley'){ + Crop <- 'barley' + } + if (Croplayer == 'spring_oats' | Croplayer == 'fall_oats'){ + Crop <- 'oats' + } + if (Croplayer == 'durum_wheat'){ + Crop <- 'spring_wheat' + } + + root.depth <- subset(root.depth, crop == Crop, select = c(min_rooting_depth, max_rooting_depth)) + Season <- rowSums(Stages) + + Base <- lapply(Season, function(x) x = c(1:x)) + Next <- Base; Kci <- Base; Height.Kci <- Base; DailyKcb <- Base; Growth_split <- Base; season.ID <- Base; day_height <- Base; MAX.Height <- Base; One.Minus.Fc <- Base # Initialize vectors + Roots <- Base; Day_Roots <- Base + + for (i in 1:length(Next)){ + + B <- c(Stages[i,1], sum(c(Stages[i,1], Stages[i,2])), sum(c(Stages[i,1], Stages[i,2], Stages[i,3])), sum(Stages[i,])) + + Xs <- c(1, B[1], mean(c(B[1], B[1], B[2])), mean(c(B[1], B[2])), mean(c(B[2], B[2], B[3])), B[3], mean(c(B[3], B[4])), B[4]) + + Ys <- c(0.01, 0.02, Kcb_tab[[1]], Kcb_tab[[2]], sum(c(Kcb_tab[[1]], Kcb_tab[[2]], Kcb_tab[[3]])), Kcb_tab[[2]], mean(c(Kcb_tab[[2]], Kcb_tab[[3]])), Kcb_tab[[3]]) + + P <- data.frame(bezierCurve(Xs,Ys,500)) + Q <- P[!duplicated(round(P$x)),] + Q$x <- round(Q$x) + + Kci[[i]] <- round(Q$y, digits = 2) + + ## Height calculation + Growth_split[[i]] <- unlist(c(0.01, .015, rep(NA, times = ceiling(Stages[i,1]/2)-2), Kcb_tab[1], rep(NA, times = floor(Stages[i,1]/2)-1), + rep(NA, times = Stages[i,2]-1), Kcb_tab[2], + rep(Kcb_tab[2], times = Stages[i,3]), + rep(NA, times = (Stages[i,4]-1)), Kcb_tab[3])) + Height.Kci[[i]] <- spline(Base[[i]], Growth_split[[i]], xout = Base[[i]], method = 'natural', ties = mean)$y + MAX.Height[[i]] <- max(Height.Kci[[i]]) + day_height[[i]] <- round(Height.Kci[[i]]*MaxHeight/MAX.Height[[i]], 2) + + ## Root growth: (currently goes from min rooting to max, and then halfway back in the post-season) + Zs <- c(0.1, 0.15, mean(c(0.15, root.depth[[1]])), root.depth[[1]], root.depth[[2]], sum(c(mean(c(0.15, root.depth[[1]])), root.depth[[2]])), root.depth[[2]], root.depth[[1]]) + R <- data.frame(bezierCurve(Xs,Zs,500)) + S <- R[!duplicated(round(R$x)),] + S$x <- round(S$x) + + Day_Roots[[i]] <- round(S$y, digits = 2) + + ### Season.ID + season.ID[[i]] <- as.factor(c(rep(1, times = Stages[i,1]), rep(2, times = Stages[i,2]), + rep(3, times = Stages[i,3]), rep(4, times = Stages[i,4]))) + DailyKcb[[i]] <- as.data.frame(cbind(Base[[i]], round(Kci[[i]], 2), round(Day_Roots[[i]], 2), day_height[[i]], as.factor(season.ID[[i]]))) + names(DailyKcb[[i]]) <- c('Season_day', 'daily_Kcb', "daily_root.depth", "day_height", "season.ID") + } + names(DailyKcb) <- StateNames + save(DailyKcb, file = paste0(Intermediates, 'Daily.Crop.Profile.', Croplayer, '.Rdata')) + return(DailyKcb) +} diff --git a/R/Daily.Crop.Parameters.R b/R/Daily.Crop.Parameters.R new file mode 100644 index 0000000..bf65271 --- /dev/null +++ b/R/Daily.Crop.Parameters.R @@ -0,0 +1,8 @@ +Daily.Crop.Parameters <- +function(Croplayer){ + Calc.Basal.Crop.Coeff(Croplayer) + KcMAX(Croplayer) + KcMAX.fallow(Croplayer) + Calc.Fc.Few(Croplayer) + Fallow.Few.Calc(Croplayer) +} diff --git a/R/Estimate.Crop.R b/R/Estimate.Crop.R new file mode 100644 index 0000000..256cd97 --- /dev/null +++ b/R/Estimate.Crop.R @@ -0,0 +1,35 @@ +Estimate.Crop <- +function(crop){ + + Subset.Growth.Season(crop) + print(paste('Seasons subsetted and rescaled for', crop)) + Daily.Crop.Parameters(crop) + print(paste('Daily crop parameters estimated for', crop)) + Final.Daily.ET.Calc(crop) + print(paste('Daily crop water balance estimated for', crop)) + + Sum.Save.Daily.Evapotranspiration(crop, rainfed = TRUE) + Sum.Save.Daily.Evapotranspiration(crop, rainfed = FALSE) + print(paste('Daily ET rasters made for', crop)) + + Sum.Save.Water.Balances(crop, rainfed = FALSE, type = 'seasonal', BW.GW = FALSE) + Sum.Save.Water.Balances(crop, rainfed = FALSE, type = 'annual', BW.GW = FALSE) + Sum.Save.Water.Balances(crop, rainfed = TRUE, type = 'seasonal', BW.GW = FALSE) + Sum.Save.Water.Balances(crop, rainfed = TRUE, type = 'annual', BW.GW = FALSE) + Sum.Save.Water.Balances(crop, rainfed = FALSE, type = 'seasonal', BW.GW = TRUE) + + Generate.Land.Use(crop) + print(paste('land use raster generated for', crop)) + + print(paste('Annual and seasonal water balance rasters saved for', crop)) + + SuperImpose.WB.on.LU(crop, rainfed = FALSE, type = 'seasonal', Growing.Season.GW.BW = FALSE) + SuperImpose.WB.on.LU(crop, rainfed = FALSE, type = 'annual', Growing.Season.GW.BW = FALSE) + SuperImpose.WB.on.LU(crop, rainfed = TRUE, type = 'seasonal', Growing.Season.GW.BW = FALSE) + SuperImpose.WB.on.LU(crop, rainfed = TRUE, type = 'annual', Growing.Season.GW.BW = FALSE) + SuperImpose.WB.on.LU(crop, rainfed = FALSE, type = 'seasonal', Growing.Season.GW.BW = TRUE) + + print(paste('Water balances superimposed on land use for', crop)) + + +} diff --git a/R/Fallow.Few.Calc.R b/R/Fallow.Few.Calc.R new file mode 100644 index 0000000..cbfed85 --- /dev/null +++ b/R/Fallow.Few.Calc.R @@ -0,0 +1,34 @@ +Fallow.Few.Calc <- +function(Croplayer){ + # Fc - the effective fraction of soil surface covered by vegetation [0 - 0.99], + load(paste0(Intermediates, paste('Fallow.Season', Croplayer, 'MNRH_', 'Rdata', sep = '.'))); Template <- Fallow.Season; rm(Fallow.Season) + Template <- lapply(Template, function(x) x[,(grep('layer', names(x)))]); Fc <- Template + + load(paste0(Intermediates, paste('KcMax.Fallow', Croplayer, 'Rdata', sep = '.'))) + KcMax.fallow <- lapply(KcMax, function(x) x[,(grep('layer', names(x)))]) + all.equal(sapply(Template, dim), sapply(KcMax.fallow, dim)) + + Off.season.vars <- c('winter_wheat', 'durum_wheat', 'fall_barley', 'fall_oats') + + if (Croplayer %in% Off.season.vars){ + KcMin <- lapply(Template, function(x) c(rep(.15, times = (length(x))))) + DayHeight <- lapply(Template, function(x) c(rep(.15, times = (length(x))))) + Kcb <- lapply(Template, function(x) c(rep(1, times = (length(x))))) + } + if (!(Croplayer %in% Off.season.vars)){ + KcMin <- lapply(Template, function(x) c(rep(.03, times = (length(x))))) + DayHeight <- lapply(Template, function(x) c(rep(.05, times = (length(x))))) + Kcb <- lapply(Template, function(x) c(rep(.07, times = (length(x))))) + } + + # GR.KcMax <- lapply(Template, function(x) c(rep(.16, times = (length(x))))) + + for (i in 1:length(Fc)){ + for (j in 1:length(DayHeight[[i]])){ + Fc[[i]][,j] <- ((Kcb[[i]][j] - KcMin[[i]][j])/(KcMax.fallow[[i]][j] - KcMin[[i]][j]))^(1+0.5*DayHeight[[i]][j]) + } + } + Fallow.Few <- Fc + Fallow.Few <- lapply(Fc, function(x) 1-x[]) # This suffices for RAINFED crops + save(Fallow.Few, file = paste0(Intermediates, paste('Fallow.Few', Croplayer, 'Rdata', sep = '.'))) +} diff --git a/R/Fallow.Postseason.Daily.ET.Calc.R b/R/Fallow.Postseason.Daily.ET.Calc.R new file mode 100644 index 0000000..0b8032a --- /dev/null +++ b/R/Fallow.Postseason.Daily.ET.Calc.R @@ -0,0 +1,323 @@ +Fallow.Postseason.Daily.ET.Calc <- +function(Croplayer, Overwrite = FALSE){ + + load(paste0(Intermediates, paste('Fallow.Saved', Croplayer, 'Rdata', sep = '.'))) + ### SPLIT THIS LIST INTO COMPONENT FILES + Post.ETo <- Fallow.File[[2]]; Post.Precip <- Fallow.File[[4]] + Post.Few <- Fallow.File[[6]] ; Post.ROi <- Fallow.File[[8]]; Qfc.minus.Qwp <- Fallow.File[[9]] + Post.Dei <- Fallow.File[[11]]; TAW <- Fallow.File[[12]]; TEW <- Fallow.File[[13]]; REW <- Fallow.File[[14]] + + ### IS THE FOLLOWING RIGHT? # KcMax is taken as the season max KcMax, i.e.: + Post.Kr <- Post.Precip; Post.Ke <- Post.Precip; Post.Dei <- Post.Precip; Post.DPei <- Post.Precip; Post.Kcb.tot <- Post.Precip; Post.E <- Post.Precip; Post.Fw <- Post.Precip + Post.Dr <- Post.Precip; Post.DP <- Post.Precip; Post.Ks <- Post.Precip; Post.Kcb.tot <- Post.Precip; Post.Pval <- Post.Precip; Post.TAW <- Post.Precip; Post.RAW <- Post.Precip + Post.Kcb <- Post.Precip + + if (file.exists(paste0(Intermediates, paste('KcMax.Fallow', Croplayer, 'Rdata', sep = '.'))) == FALSE){ + KcMAX.fallow(Croplayer) + } + + load(paste0(Intermediates, paste('KcMax.Fallow', Croplayer, 'Rdata', sep = '.'))) # KcMax # This is the FALLOW SEASON KcMAX!! + # For the post-season, i only want KcMax values 'after the cut' + KcMax <- lapply(KcMax, function(x) x[,(grep('layer', names(x)))]) # clip off the coordinates for analysis + + DaysRow <- lapply(Post.Precip, function(x) as.numeric(gsub('layer.', '', names(x)))) + Cuts <- lapply(DaysRow, function(x) which(diff(x) > 1)) + Cuts <- sapply(Cuts, function(x) replace(x, length(x) == 0, 0)) + + LengthCheck <- unlist(lapply(DaysRow, length)) + CutCheck <- unlist(Cuts) + + for (i in 1:length(KcMax)){ # fast. ~2 seconds # add another loop to do this cleaner? + # New + if (length(CutCheck) == 0){ + KcMax[[i]] <- KcMax[[i]][1:length(Post.Precip[[i]])] + } + if (length(Cuts[[i]]) == 0){ + KcMax[[i]] <- KcMax[[i]][1:length(KcMax[[i]])] + } + else { + KcMax[[i]] <- KcMax[[i]][,Cuts[[i]]:length(KcMax[[i]])] + } + + while (length(KcMax[[i]]) > length(Post.Precip[[i]])){ + KcMax[[i]] <- KcMax[[i]][,1:length(KcMax[[i]])-1] + } + } + + print('Post Season KcMax layer lengths equal?:') + # Alfalfa postseason fails here... + print(all.equal(lapply(KcMax, length), lapply(Post.Precip, length))) + + ## 11.2014 + ## Post-season Kcb set at 0.175 # Changed from 0.35 on May 8th + Kcb <- 0.55 + ##### III. POST SEASON - only run + + load(paste0(Intermediates, paste('Growing.Season', Croplayer, 'Precip_', 'Rdata', sep = '.'))); Precip <- Growing.Season; rm(Growing.Season) + + Qfc.minus.Qwp <- lapply(Precip, function(x) x$Qfc.minus.Qwp) + # Assumption: rooting depth for fallow season weeds is: + root.depth <- 0.10 + TAW <- lapply(Qfc.minus.Qwp, function(x) 1000*(x[]*root.depth)) + TEW <- lapply(Precip, function(x) x$ave_TEW); Dei <- TEW + REW <- lapply(Precip, function(x) x$ave_REW) + + if (!file.exists(paste0(Intermediates, paste('Postseason_Deep.Percolation', Croplayer, 'Rdata', sep = '.'))) | Overwrite == TRUE){ + + # Default is irrgated: + # i <- 'irr' + + Others <- c('switchgrass', 'miscanthus', "idle_cropland", "pasture_grass", "silage") + load('Vars.Rdata') + + if(Croplayer %in% Vars){ + + setwd(paste0(Path, '/CropWatR/Intermediates/')) + + load(paste('Growing.Season_Root.Zone.Depletion', Croplayer, 'Rdata', sep = '.')) #Dr + load(paste('Growing.Season_Deep.Percolation', Croplayer, 'Rdata', sep = '.')) #DP + load(paste('Growing.Season_Runoff', Croplayer, 'Rdata', sep = '.')) # ROi + load(paste('Growing.Season_Soil.Evaporation', Croplayer, 'Rdata', sep = '.')) # E + load(paste('Growing.Saved', Croplayer, 'Rdata', sep = '.')) + load(paste('Growing.Season_Soil.Water.Balance', Croplayer, 'Rdata', sep = '.')) # De + DPe <- local(get(load(file = paste('Growing.Season.Root.Zone.Percolation.Loss', Croplayer, 'Rdata', sep = '.')))) # DPe + load(file = paste('Growing.Season.Evaporation.Fractions', Croplayer, 'Rdata', sep = '.')) # Few + + setwd(paste0(Path, '/CropWatR/Data')) + + + } + if (Croplayer %in% Others){ + + setwd(paste0(Path, '/CropWatR/Intermediates/')) + + load(paste('Growing.Season_Root.Zone.Depletion', Croplayer, 'Rdata', sep = '.')) #Dr + load(paste('Growing.Season_Deep.Percolation', Croplayer, 'Rdata', sep = '.')) #DP + load(paste('Growing.Season_Runoff', Croplayer, 'Rdata', sep = '.')) # ROi + load(paste('Growing.Season_Soil.Evaporation', Croplayer, 'Rdata', sep = '.')) # E + load(paste('Growing.Saved', Croplayer, 'Rdata', sep = '.')) + # load(paste('Growing.Season.Rainfed_Soil.Water.Balance', Croplayer, 'Rdata', sep = '.')) # De + load(paste('Growing.Season_Soil.Water.Balance', Croplayer, 'Rdata', sep = '.')) # De + load(file = paste('Growing.Season.Root.Zone.Percolation.Loss', Croplayer, 'Rdata', sep = '.')) # DPe + load(file = paste('Growing.Season.Evaporation.Fractions', Croplayer, 'Rdata', sep = '.')) # Few + + setwd(paste0(Path, '/CropWatR/Data')) + + } + ETo <- Growing.Files[[1]]; Precip <- Growing.Files[[2]]; ROi <- Growing.Files[[3]]; Irr <- Growing.Files[[4]]; Fw <- Growing.Files[[5]] + + ### DOUBLE-CHECK THE BELOW CALCULATIONS FOR POSTSEASON + print("starting calculation of post season") + + for (i in 1:length(Post.Precip)){ + for (j in 1:length(Post.Precip[[i]])){ + # changed from Kcb <- 0.25 on 12.2014 # changed from 0.35 on May 10, 2015 + Kcb <- 0.75 + + if (j == 1){ # Initialize on first day of Post Season (So use the last day of the growing season as the previous value base) + ### Fix this so that it can be Few, not Fw + Post.Fw[[i]][,j] <- Few[[i]][,length(Few[[i]])] + + # Kr + Post.Kr[[i]][,j][De[[i]][,length(De[[i]])] > REW[[i]]] <- (TEW[[i]][De[[i]][,length(De[[i]])] > REW[[i]]] - De[[i]][,length(De[[i]])][De[[i]][,length(De[[i]])] > REW[[i]]])/(TEW[[i]][De[[i]][,length(De[[i]])] > REW[[i]]] - REW[[i]][De[[i]][,length(De[[i]])] > REW[[i]]]) + # table(Dei[[i]] > REW[[i]]) + Post.Kr[[i]][,j][De[[i]][,length(De[[i]])] <= REW[[i]]] <- 1 + Post.Kr[[i]][,j][Post.Kr[[i]][,j] < 0] <- 0 + + # Ke + Post.Ke[[i]][,j] <- pmin.int(Post.Kr[[i]][,j]*(KcMax[[i]][,j] - Kcb), Post.Few[[i]][,j]*KcMax[[i]][,j]) # NOTE: Pre.KeETo is the same as Ei in equation 77 + Post.Ke[[i]][,j][Post.Ke[[i]][,j] < 0] <- 0 # STOP-GAP positive 1 default values: + + # E + Post.E[[i]][,j] <- Post.Ke[[i]][,j]*Post.ETo[[i]][,j] + + # DPe # topsoil percolation: # + Post.DPei[[i]][,j] <- (Post.Precip[[i]][,j]-Post.ROi[[i]][,j]) - De[[i]][,length(De[[i]])] + Post.DPei[[i]][,j][Post.DPei[[i]][,j] < 0] <- 0 + # De # + Post.Dei[[i]][,j] <- De[[i]][,length(De[[i]])] - (Post.Precip[[i]][,j]-Post.ROi[[i]][,j]) + (Post.E[[i]][,j]/Post.Few[[i]][,j]) + DPe[[i]][,length(DPe[[i]])] # Multiply or Divide? + # Limits on De + Post.Dei[[i]][,j][Post.Dei[[i]][,j] < 0] <- 0 + Post.Dei[[i]][,j][Post.Dei[[i]][,j] > TEW[[i]]] <- TEW[[i]][Post.Dei[[i]][,j] > TEW[[i]]] + + # Crop evapotranspiration + Post.Kcb[[i]][,j] <- (Kcb + Post.Ke[[i]][,j])*Post.ETo[[i]][,j] + Post.Kcb.tot[[i]][,j] <- (Kcb)*Post.ETo[[i]][,j] + + # WATER STRESS CALCS: + # Calculate Daily p values, daily RAW: (equations 81, 82, & 84) + # A numerical approximation for adjusting p for ETc rate is + # p = pTable 22 + 0.04 (5 - ETc) where the adjusted p is limited to 0.1 <= p <= 0.8 and ETc is in mm/day. + # ETc = ETc = (Kcb + Ke) ETo, or, in my calcs: (Transp[[i]][,j] + KeETo[[i]][,j]) + # Assuming base p value of 0.05 (shallow-rooted) weeds + P.value <- 0.1 + Post.Pval[[i]][,j] <- P.value + 0.02*(5 - (Post.Kcb.tot[[i]][,j])) + Post.Pval[[i]][,j][Post.Pval[[i]][,j] < 0.1] <- 0.1 + Post.Pval[[i]][,j][Post.Pval[[i]][,j] > 0.8] <- 0.8 + ### TAW should change daily; and as a function of (growing) root depth. + ### Root depth assumed at 0.25 + Root.depth <- 0.10 + 0.002*j + Post.TAW[[i]][,j] <- TAW[[i]]*Root.depth + + Post.RAW[[i]][,j] <- Post.Pval[[i]][,j]*Post.TAW[[i]][,j] + ### Initialize Dr (positive values, less than TAW) + ## ignoring capillary rise + # Following heavy rain or irrigation, the user can assume that the root zone is near field capacity, # i.e., Dr, i-1 » 0. + # Assumme initial level at 0.2 of TAW, so: + Per.of.field.capacity <- 0.2 + Post.Dr[[i]][,j] <- Post.TAW[[i]][,j]*Per.of.field.capacity + + Post.Dr[[i]][,j] <- Post.Dr[[i]][,j] - (Post.Precip[[i]][,j]-Post.ROi[[i]][,j]) + Post.Kcb.tot[[i]][,j] + Post.DP[[i]][,j] + # Limits on Dr: + Post.Dr[[i]][,j][Post.Dr[[i]][,j] < 0] <- 0 + Post.Dr[[i]][,j][Post.Dr[[i]][,j] > Post.TAW[[i]][,j]] <- Post.TAW[[i]][,j][Post.Dr[[i]][,j] > Post.TAW[[i]][,j]] + + # Adjusted transpiration component: (equation 80) + Post.Ks[[i]][,j][Post.Dr[[i]][,j] > Post.RAW[[i]][,j]] <- ((Post.TAW[[i]][,j]-Post.Dr[[i]][,j])[Post.Dr[[i]][,j] > Post.RAW[[i]][,j]]) / ((1 - Post.Pval[[i]][,j][Post.Dr[[i]][,j] > Post.RAW[[i]][,j]])*Post.TAW[[i]][,j][Post.Dr[[i]][,j] > Post.RAW[[i]][,j]]) + Post.Ks[[i]][,j][Post.Dr[[i]][,j] <= Post.RAW[[i]][,j]] <- 1 + + + ### Soil water balance for the root zone (equation 85) + Post.DP[[i]][,j] <- (Post.Precip[[i]][,j]- Post.ROi[[i]][,j]) - Post.Kcb.tot[[i]][,j] - Dr[[i]][,length(Dr[[i]])] # ideally is the day before, but not here... + # As long as the soil water content in the root zone is below field capacity (i.e., Dr, i > 0), the soil will not drain and DPi = 0. + Post.DP [[i]][,j][Post.Dr[[i]][,j] > 0] <- 0 + Post.DP [[i]][,j][Post.DP[[i]][,j] < 0] <- 0 + + + Post.Kcb.tot[[i]][,j] <- (Post.Ks[[i]][,j]*Post.Kcb.tot[[i]][,j])*Post.ETo[[i]][,j] + Post.Kcb[[i]][,j] <- (Post.Ks[[i]][,j]*Post.Kcb[[i]][,j]+Post.Ke[[i]][,j])*Post.ETo[[i]][,j] + # Perhaps recalculate with new Trans.final? + + # DPe + # topsoil percolation: # + Post.DPei[[i]][,j] <- (Post.Precip[[i]][,j]-Post.ROi[[i]][,j]) - De[[i]][,length(De[[i]])] + Post.DPei[[i]][,j][Post.DPei[[i]][,j] < 0] <- 0 + } + + else { # all other days of the preseason + + # Kcb + Kcb <- Kcb - 0.003*j + Kcb[Kcb < 0.005] <- 0.005 + # print(Kcb) + ### Fw / Few /Fc calcs must incorporate irrigation and precipitation events + # Fw - Make intial assumption about Dr <- 25% capacity + Post.Fw[[i]][,j] <- Post.Few[[i]][,j-1] + + # Few + Post.Few[[i]][,j] <- pmin.int(Post.Few[[i]][,j], Post.Fw[[i]][,j]) + + # Kr + Post.Kr[[i]][,j][Post.Dei[[i]][,(j-1)] > REW[[i]]] <- (TEW[[i]][Post.Dei[[i]][,(j-1)] > REW[[i]]] - Post.Dei[[i]][,(j-1)][Post.Dei[[i]][,(j-1)] > REW[[i]]])/(TEW[[i]][Post.Dei[[i]][,(j-1)] > REW[[i]]] - REW[[i]][Post.Dei[[i]][,(j-1)] > REW[[i]]]) + # table(Dei[[i]] > REW[[i]]) + Post.Kr[[i]][,j][Post.Dei[[i]][,(j-1)] <= REW[[i]]] <- 1 + Post.Kr[[i]][,j][Post.Kr[[i]][,j] < 0] <- 0 + + # Ke + ###### KcMax HAS BEEN calculated for fallow season weather inputs! ###### + Post.Ke[[i]][,j] <- pmin.int(Post.Kr[[i]][,j]*(KcMax[[i]][,j] - Kcb), Post.Few[[i]][,j]*KcMax[[i]][,j]) # NOTE: Post.KeETo is the same as Ei in equation 77 + Post.Ke[[i]][,j][Post.Ke[[i]][,j] < 0] <- 0 # STOP-GAP positive 1 default values: + + # E + Post.E[[i]][,j] <- Post.Ke[[i]][,j]*Post.ETo[[i]][,j] + + if (length(Post.E[[i]][,j][Post.E[[i]][,j] > 5]) > 0){ + print('Evaporation triggered:') + print('day col:') + print(j) + print('State code') + print(names(Post.Precip[i])) + print('Evap profile') + print(Post.E[[i]][,j][Post.E[[i]][,j] > 5]) + print('ETo profile') + print(Post.ETo[[i]][,j][Post.E[[i]][,j] > 5]) + print('Ke profile') + print(Post.Ke[[i]][,j][Post.E[[i]][,j] > 5]) + } + + # DPe + # topsoil percolation: # + Post.DPei[[i]][,j] <- (Post.Precip[[i]][,j]-Post.ROi[[i]][,j]) - Post.Dei[[i]][,(j-1)] + Post.DPei[[i]][,j][Post.DPei[[i]][,j] < 0] <- 0 + # De # + Post.Dei[[i]][,j] <- Post.Dei[[i]][,(j-1)] - (Post.Precip[[i]][,j]-Post.ROi[[i]][,j]) + (Post.E[[i]][,j]/Post.Few[[i]][,j]) + Post.DPei[[i]][,j] # Multiply or Divide? + # Limits on De + Post.Dei[[i]][,j][Post.Dei[[i]][,j] < 0] <- 0 + Post.Dei[[i]][,j][Post.Dei[[i]][,j] > TEW[[i]]] <- TEW[[i]][Post.Dei[[i]][,j] > TEW[[i]]] + + # Crop evapotranspiration + Post.Kcb[[i]][,j] <- (Kcb + Post.Ke[[i]][,j])*Post.ETo[[i]][,j] + Post.Kcb.tot[[i]][,j] <- (Kcb)*Post.ETo[[i]][,j] + + # WATER STRESS CALCS: + # Calculate Daily p values, daily RAW: (equations 81, 82, & 84) + # A numerical approximation for adjusting p for ETc rate is + # p = pTable 22 + 0.04 (5 - ETc) where the adjusted p is limited to 0.1 <= p <= 0.8 and ETc is in mm/day. + # ETc = ETc = (Kcb + Ke) ETo, or, in my calcs: (Transp[[i]][,j] + KeETo[[i]][,j]) + ### 10.20.2014 + # Assuming base p value of 0.05 (shallow-rooted) weeds + P.value <- 0.05 + Post.Pval[[i]][,j] <- P.value + 0.04*(5 - (Post.Kcb.tot[[i]][,j])) + Post.Pval[[i]][,j][Post.Pval[[i]][,j] < 0.1] <- 0.1 + Post.Pval[[i]][,j][Post.Pval[[i]][,j] > 0.8] <- 0.8 + ### TAW should change daily; and as a function of (growing) root depth. + ### Root depth assumed at 0.10 + Root.depth <- 0.05 + 0.002*j + Post.TAW[[i]][,j] <- TAW[[i]]*Root.depth + + Post.RAW[[i]][,j] <- Post.Pval[[i]][,j]*Post.TAW[[i]][,j] + ### Initialize Dr (positive values, less than TAW) + ## ignoring capillary rise + Post.Dr[[i]][,j] <- Post.Dr[[i]][,(j-1)] - (Post.Precip[[i]][,j]-Post.ROi[[i]][,j]) + Post.Kcb.tot[[i]][,j] + Post.DP[[i]][,(j-1)] + # Limits on Dr: + Post.Dr[[i]][,j][Post.Dr[[i]][,j] < 0] <- 0 + Post.Dr[[i]][,j][Post.Dr[[i]][,j] > Post.TAW[[i]][,j]] <- Post.TAW[[i]][,j][Post.Dr[[i]][,j] > Post.TAW[[i]][,j]] + + # Adjusted transpiration component: (equation 80) + Post.Ks[[i]][,j][Post.Dr[[i]][,j] > Post.RAW[[i]][,j]] <- ((Post.TAW[[i]][,j]-Post.Dr[[i]][,j])[Post.Dr[[i]][,j] > Post.RAW[[i]][,j]]) / ((1 - Post.Pval[[i]][,j][Post.Dr[[i]][,j] > Post.RAW[[i]][,j]])*Post.TAW[[i]][,j][Post.Dr[[i]][,j] > Post.RAW[[i]][,j]]) + Post.Ks[[i]][,j][Post.Dr[[i]][,j] <= Post.RAW[[i]][,j]] <- 1 + + + ### Soil water balance for the root zone (equation 85) + Post.DP[[i]][,j] <- (Post.Precip[[i]][,j]-Post.ROi[[i]][,j]) - Post.Kcb.tot[[i]][,j] - Post.Dr[[i]][,j-1] + # As long as the soil water content in the root zone is below field capacity (i.e., Dr, i > 0), the soil will not drain and DPi = 0. + Post.DP [[i]][,j][Post.Dr[[i]][,j] > 0] <- 0 + Post.DP [[i]][,j][Post.DP[[i]][,j] < 0] <- 0 + + Post.Kcb.tot[[i]][,j] <- (Post.Ks[[i]][,j]*Post.Kcb.tot[[i]][,j])*Post.ETo[[i]][,j] + Post.Kcb[[i]][,j] <- (Post.Ks[[i]][,j]*Post.Kcb[[i]][,j]+Post.Ke[[i]][,j])*Post.ETo[[i]][,j] + # Perhaps recalculate with new Trans.final? + + # DPe + # topsoil percolation: # + Post.DPei[[i]][,j] <- (Post.Precip[[i]][,j]-Post.ROi[[i]][,j]) - Post.Dei[[i]][,j-1] + Post.DPei[[i]][,j][Post.DPei[[i]][,j] < 0] <- 0 + + print(mean(Post.E[[i]][,j], na.rm = TRUE)) + print(mean(Post.Kcb.tot[[i]][,j], na.rm = TRUE)) + + + } + } + + } + print('Calculation of Postseason daily soil water balance, deep percolation, and evaporation complete') + + setwd(paste0(Path, '/CropWatR/Intermediates/')) + + save(Post.Dei, file = paste('Postseason_Soil.Water.Balance', Croplayer, 'Rdata', sep = '.')) + save(Post.DP, file = paste('Postseason_Deep.Percolation', Croplayer, 'Rdata', sep = '.')) + save(Post.ROi, file = paste('Postseason_Runoff', Croplayer, 'Rdata', sep = '.')) + Post.KeETo <- Post.E + save(Post.KeETo, file = paste('Postseason_Soil.Evaporation', Croplayer, 'Rdata', sep = '.')) + save(Post.Kcb.tot, file = paste('Postseason_Weed.Transpiration', Croplayer, 'Rdata', sep = '.')) + + setwd(paste0(Path, '/CropWatR/Data')) + + print('Postseason files saved') + + } + if (file.exists(paste0(Intermediates, paste('Postseason_Deep.Percolation', Croplayer, 'Rdata', sep = '.'))) == TRUE && Overwrite == FALSE){ + print(paste("Post Season already estimated for", Croplayer)) + } +} diff --git a/R/Fallow.Preseason.Daily.ET.Calc.R b/R/Fallow.Preseason.Daily.ET.Calc.R new file mode 100644 index 0000000..04daf6b --- /dev/null +++ b/R/Fallow.Preseason.Daily.ET.Calc.R @@ -0,0 +1,286 @@ +Fallow.Preseason.Daily.ET.Calc <- +function(Croplayer, Overwrite = FALSE){ + print(Croplayer) + + if (file.exists(paste0(Intermediates, paste('Fallow.Saved', Croplayer, 'Rdata', sep = '.')))){ + print('Fallow.File exists for this cropping patterns, loading it...') + load(paste0(Intermediates, paste('Fallow.Saved', Croplayer, 'Rdata', sep = '.'))) + + ### SPLIT THIS LIST INTO COMPONENT FILES + Pre.ETo <- Fallow.File[[1]]; Post.ETo <- Fallow.File[[2]]; Pre.Precip <- Fallow.File[[3]]; Post.Precip <- Fallow.File[[4]] + Pre.Few <- Fallow.File[[5]]; Post.Few <- Fallow.File[[6]] ; Pre.ROi <- Fallow.File[[7]]; Post.ROi <- Fallow.File[[8]]; Qfc.minus.Qwp <- Fallow.File[[9]] + Pre.Dei <- Fallow.File[[10]]; Post.Dei <- Fallow.File[[11]]; TAW <- Fallow.File[[12]]; TEW <- Fallow.File[[13]]; REW <- Fallow.File[[14]] + } + + if (file.exists(paste0(Intermediates, 'Fallow.Saved.', Croplayer,'.Rdata')) == FALSE){ + + #### a. Load files: + load(paste0(Intermediates, paste('Fallow.Season', Croplayer, 'ETo_','Rdata', sep = '.'))); ETo <- Fallow.Season; rm(Fallow.Season) + load(paste0(Intermediates, paste('Fallow.Season', Croplayer, 'Precip_', 'Rdata', sep = '.'))); Precip <- Fallow.Season; rm(Fallow.Season) + # Coords <- lapply(Precip, function(x) as.data.frame(cbind(x$x, x$y))) + + print('dimensions check?') + print(all.equal(sapply(Precip, dim), sapply(ETo, dim))) + + if (file.exists(paste0(Intermediates, paste('Fallow.Few', Croplayer, 'Rdata', sep = '.'))) == FALSE){ + Fallow.Few.Calc(Croplayer) + load(paste0(Intermediates, paste('Fallow.Few', Croplayer, 'Rdata', sep = '.'))) # Fallow.Few + load(paste0(Intermediates, paste("Base", Croplayer, 'MNRH_', 'MasterDF', sep = '.'))) # DF + } + + load(paste0(Intermediates, paste('Fallow.Few', Croplayer, 'Rdata', sep = '.'))) # Fallow.Few + load(paste0(Intermediates, paste("Base", Croplayer, 'MNRH_', 'MasterDF', sep = '.'))) # DF + + # Water Stress Calcs: ## TAW: + Qfc.minus.Qwp <- lapply(Precip, function(x) x$Qfc.minus.Qwp) + # Assumption: rooting depth for fallow season weeds is: + root.depth <- 0.10 + TAW <- lapply(Qfc.minus.Qwp, function(x) 1000*(x[]*root.depth)) + TEW <- lapply(Precip, function(x) x$ave_TEW); Dei <- TEW + REW <- lapply(Precip, function(x) x$ave_REW) + + Precip <- lapply(Precip, function(x) x[,(grep('layer', names(x)))]) + + if (file.exists(paste0(Intermediates, paste('KcMax', Croplayer, 'Rdata', sep = '.'))) == FALSE) KcMAX(Croplayer) + load(paste0(Intermediates, paste('KcMax', Croplayer, 'Rdata', sep = '.'))) # KcMax + + ROi <- Precip # runoff is the EXCESS of heavy rainfall events, where 'EXCESS' means that the precipitation exceeds TEW: + for (i in 1:length(ROi)){ # Takes about 45 seconds + ROi[[i]] <- ROi[[i]]-TEW[[i]] + ROi[[i]][ROi[[i]] < 0] <- 0 + } + print('Pre-/post-season runoff estimated') + + Dei <- lapply(TEW, function(x) (x[]*0.1)) # spot check: all.equal(lapply(Dei, function(x) sum(x)*2), lapply(TEW, sum)) # TRUE + ETo <- lapply(ETo, function(x) x[,(grep('layer', names(x)))]) + + for (i in 1:length(ETo)){ # slow: takes roungly 45 seconds + ETo[[i]][ETo[[i]] < 0] <- 0 + ETo[[i]] <- round(ETo[[i]], 3) + ETo[[i]][ETo[[i]] > 28] <- 1.655 + } + print('ETo data cleaned') + + Pre.ETo <- ETo; Post.ETo <- ETo; Pre.ROi <- ROi; Post.ROi <- ROi; Pre.Dei <- Dei; Post.Dei <- Dei + Pre.Precip <- Precip; Post.Precip <- Precip; Pre.Few <- Fallow.Few; Post.Few <- Fallow.Few + + DaysRow <- lapply(ETo, function(x) as.numeric(gsub('layer.', '', names(x)))) + Cuts <- lapply(DaysRow, function(x) which(diff(x) > 1)) + Cuts <- sapply(Cuts, function(x) replace(x, length(x) == 0, 0)) + + LengthCheck <- unlist(lapply(DaysRow, length)) + CutCheck <- unlist(Cuts) + + for (i in 1:length(ETo)){ # fast. ~2 seconds + if (Cuts[[i]] > 0 && length(LengthCheck[i] > 0)){ + + if (CutCheck[i]+1 >= LengthCheck[i]){ + Pre.ETo[[i]] <- ETo[[i]][,1:(Cuts[[i]][1]-1)] + Post.ETo[[i]] <- ETo[[i]][,(Cuts[[i]][1]-3):Cuts[[i]][1]] + Pre.Precip[[i]] <- Precip[[i]][,1:(Cuts[[i]][1]-1)] + Post.Precip[[i]] <- Precip[[i]][,(Cuts[[i]][1]-3):Cuts[[i]][1]] + Pre.Few[[i]] <- Fallow.Few[[i]][,1:(Cuts[[i]][1]-1)] + Post.Few[[i]] <- Fallow.Few[[i]][,(Cuts[[i]][1]-3):Cuts[[i]][1]] + Pre.ROi[[i]] <- ROi[[i]][,1:(Cuts[[i]][1]-1)] + Post.ROi[[i]] <- ROi[[i]][,(Cuts[[i]][1]-3):Cuts[[i]][1]] + } + else { + Pre.ETo[[i]] <- ETo[[i]][,1:Cuts[[i]][1]] + Post.ETo[[i]] <- ETo[[i]][,(Cuts[[i]][1]+1):length(ETo[[i]])] + Pre.Precip[[i]] <- Precip[[i]][,1:Cuts[[i]][1]] + Post.Precip[[i]] <- Precip[[i]][,(Cuts[[i]][1]+1):length(Precip[[i]])] + Pre.Few[[i]] <- Fallow.Few[[i]][,1:Cuts[[i]][1]] + Post.Few[[i]] <- Fallow.Few[[i]][,(Cuts[[i]][1]+1):length(Fallow.Few[[i]])] + Pre.ROi[[i]] <- ROi[[i]][,1:Cuts[[i]][1]] + Post.ROi[[i]] <- ROi[[i]][,(Cuts[[i]][1]+1):length(ROi[[i]])] + } + } + if (Cuts[[i]] == 0){ + Pre.ETo[[i]] <- ETo[[i]] + Post.ETo[[i]] <- ETo[[i]][,(length(ETo[[i]])-2):(length(ETo[[i]])-1)] + Pre.Precip[[i]] <- Precip[[i]] + Post.Precip[[i]] <- Precip[[i]][,(length(Precip[[i]])-1):length(Precip[[i]])] + Pre.Few[[i]] <- Fallow.Few[[i]] + Post.Few[[i]] <- Fallow.Few[[i]][,(length(Fallow.Few[[i]])-2):(length(Fallow.Few[[i]]-1))] + Pre.ROi[[i]] <- ROi[[i]] + Post.ROi[[i]] <- ROi[[i]][,(length(ROi[[i]])-1):length(ROi[[i]])] + } + } + print('pre/post season split complete') + + Fallow.File <- list(Pre.ETo, Post.ETo, Pre.Precip, Post.Precip, Pre.Few, Post.Few, Pre.ROi, Post.ROi, Qfc.minus.Qwp, Pre.Dei, Post.Dei, TAW, TEW, REW) + names(Fallow.File) <- c('Pre.ETo', 'Post.ETo', 'Pre.Precip', 'Post.Precip', 'Pre.Few', 'Post.Few', 'Pre.ROi', 'Post.ROi', 'Qfc.minus.Qwp', "Pre.Dei", "Post.Dei", "TAW", "TEW", "REW") + save(Fallow.File, file = paste0(Intermediates, paste('Fallow.Saved', Croplayer, 'Rdata', sep = '.'))) + } + + if (file.exists(paste0(Intermediates, paste('KcMax.Fallow', Croplayer, 'Rdata', sep = '.'))) == FALSE) KcMAX.fallow(Croplayer) + + load(paste0(Intermediates, paste('KcMax.Fallow', Croplayer, 'Rdata', sep = '.'))) + + ###### Kr & Ke calculation: + Pre.Kr <- Pre.Precip; Pre.Ke <- Pre.Precip; Pre.Dei <- Pre.Precip; Pre.DPei <- Pre.Precip; Pre.Kcb.tot <- Pre.Precip; Pre.E <- Pre.Precip; Pre.Fw <- Pre.Precip + Pre.Dr <- Pre.Precip; Pre.DP <- Pre.Precip; Pre.Ks <- Pre.Precip; Dei <- TEW; Pre.Pval <- Pre.Precip; Pre.TAW <- Pre.Precip; Pre.RAW <- Pre.Precip; Pre.Kcb <- Pre.Precip + + if (!file.exists(paste0(Intermediates, paste("Preseason_Soil.Evaporation", Croplayer, "Rdata", sep = "."))) | Overwrite == TRUE){ + for (i in 1:length(Pre.Precip)){ + for (j in 1:length(Pre.Precip[[i]])){ + # Assumption: Kcb for preseason starts at 0.35 + Kcb <- 0.35 + + if (j == 1){ # Initialize on first day of preseason + Pre.Kr[[i]][,j][Dei[[i]] > REW[[i]]] <- (TEW[[i]][Dei[[i]] > REW[[i]]] - Dei[[i]][Dei[[i]] > REW[[i]]])/(TEW[[i]][Dei[[i]] > REW[[i]]] - REW[[i]][Dei[[i]] > REW[[i]]]) + Pre.Kr[[i]][,j][Dei[[i]] <= REW[[i]]] <- 1 + Pre.Kr[[i]][,j][Pre.Kr[[i]][,j] < 0] <- 0 + + Pre.Ke[[i]][,j] <- pmin.int(Pre.Kr[[i]][,j]*(KcMax[[i]][,j] - Kcb), Pre.Few[[i]][,j]*KcMax[[i]][,j]) # NOTE: Pre.KeETo is the same as Ei in equation 77 + Pre.Ke[[i]][,j][Pre.Ke[[i]][,j] < 0] <- 0 + + Pre.E[[i]][,j] <- Pre.Ke[[i]][,j]*Pre.ETo[[i]][,j] # E + + # DPe - topsoil percolation: + Pre.DPei[[i]][,j] <- (Pre.Precip[[i]][,j]-Pre.ROi[[i]][,j]) - Dei[[i]] + Pre.DPei[[i]][,j][Pre.DPei[[i]][,j] < 0] <- 0 + # De + Pre.Dei[[i]][,j] <- Dei[[i]] - (Pre.Precip[[i]][,j]-Pre.ROi[[i]][,j]) + (Pre.E[[i]][,j]/Pre.Few[[i]][,j]) + Pre.DPei[[i]][,j] # Multiply or Divide? + # Limits on De + Pre.Dei[[i]][,j][Pre.Dei[[i]][,j] < 0] <- 0 + Pre.Dei[[i]][,j][Pre.Dei[[i]][,j] > TEW[[i]]] <- TEW[[i]][Pre.Dei[[i]][,j] > TEW[[i]]] + + # Crop evapotranspiration + Pre.Kcb.tot[[i]][,j] <- (Kcb + Pre.Ke[[i]][,j])*Pre.ETo[[i]][,j] + + # WATER STRESS CALCS: + # Assuming base p value of 0.1 (shallow-rooted) weeds + P.value <- 0.1 + Pre.Pval[[i]][,j] <- P.value + 0.02*(5 - (Pre.Kcb.tot[[i]][,j])) + Pre.Pval[[i]][,j][Pre.Pval[[i]][,j] < 0.1] <- 0.1 + Pre.Pval[[i]][,j][Pre.Pval[[i]][,j] > 0.8] <- 0.8 + ### TAW should change daily; and as a function of (growing) root depth. + ### Root depth assumed at 0.1; grows daily + Root.depth <- 0.10 + 0.002*j + Pre.TAW[[i]][,j] <- TAW[[i]]*Root.depth + + Pre.RAW[[i]][,j] <- Pre.Pval[[i]][,j]*Pre.TAW[[i]][,j] + ### Initialize Dr (positive values, less than TAW) ## ignoring capillary rise + # Following heavy rain or irrigation, the user can assume that the root zone is near field capacity, # i.e., Dr, i-1 » 0. + # Assumme initial level at 0.2 of TAW, so: + Per.of.field.capacity <- 0.2 + Pre.Dr[[i]][,j] <- Pre.TAW[[i]][,j]*Per.of.field.capacity + + Pre.Dr[[i]][,j] <- Pre.Dr[[i]][,j] - (Pre.Precip[[i]][,j]-Pre.ROi[[i]][,j]) + Pre.Kcb.tot[[i]][,j] + Pre.DP[[i]][,j] + # Limits on Dr: + Pre.Dr[[i]][,j][Pre.Dr[[i]][,j] < 0] <- 0 + Pre.Dr[[i]][,j][Pre.Dr[[i]][,j] > Pre.TAW[[i]][,j]] <- Pre.TAW[[i]][,j][Pre.Dr[[i]][,j] > Pre.TAW[[i]][,j]] + + # Adjusted transpiration component: (equation 80) + Pre.Ks[[i]][,j][Pre.Dr[[i]][,j] > Pre.RAW[[i]][,j]] <- ((Pre.TAW[[i]][,j]-Pre.Dr[[i]][,j])[Pre.Dr[[i]][,j] > Pre.RAW[[i]][,j]]) / ((1 - Pre.Pval[[i]][,j][Pre.Dr[[i]][,j] > Pre.RAW[[i]][,j]])*Pre.TAW[[i]][,j][Pre.Dr[[i]][,j] > Pre.RAW[[i]][,j]]) + Pre.Ks[[i]][,j][Pre.Dr[[i]][,j] <= Pre.RAW[[i]][,j]] <- 1 + + ### Soil water balance for the root zone (equation 85) + Pre.DP[[i]][,j] <- (Pre.Precip[[i]][,j]-Pre.ROi[[i]][,j]) - Pre.Kcb.tot[[i]][,j] # - Pre.Dr[[i]][,j-1] # ideally is the day before, but not here... + # As long as the soil water content in the root zone is below field capacity (i.e., Dr, i > 0), the soil will not drain and DPi = 0. + Pre.DP [[i]][,j][Pre.Dr[[i]][,j] > 0] <- 0 + Pre.DP [[i]][,j][Pre.DP[[i]][,j] < 0] <- 0 + + Pre.Kcb[[i]][,j] <- (Pre.Ks[[i]][,j]*Pre.Kcb.tot[[i]][,j]+Pre.Ke[[i]][,j])*Pre.ETo[[i]][,j] + Pre.Kcb.tot[[i]][,j] <- (Pre.Ks[[i]][,j]*Pre.Kcb.tot[[i]][,j])*Pre.ETo[[i]][,j] + + # DPe - topsoil percolation + Pre.DPei[[i]][,j] <- (Pre.Precip[[i]][,j]-Pre.ROi[[i]][,j]) # - Pre.Dei[[i]][,j-1] + Pre.DPei[[i]][,j][Pre.DPei[[i]][,j] < 0] <- 0 + } + else { # all other days of the preseason + ### Fw / Few /Fc calcs must incorporate irrigation and precipitation events + # Fw - Make initial assumption about Dr <- 25% capacity + Pre.Fw[[i]][,j] <- Pre.Few[[i]][,j-1] + + # Few + Pre.Few[[i]][,j] <- pmin.int(Pre.Few[[i]][,j], Pre.Fw[[i]][,j]) + + # Kr + Pre.Kr[[i]][,j][Pre.Dei[[i]][,(j-1)] > REW[[i]]] <- (TEW[[i]][Pre.Dei[[i]][,(j-1)] > REW[[i]]] - Pre.Dei[[i]][,(j-1)][Pre.Dei[[i]][,(j-1)] > REW[[i]]])/(TEW[[i]][Pre.Dei[[i]][,(j-1)] > REW[[i]]] - REW[[i]][Pre.Dei[[i]][,(j-1)] > REW[[i]]]) + Pre.Kr[[i]][,j][Pre.Dei[[i]][,(j-1)] <= REW[[i]]] <- 1 + Pre.Kr[[i]][,j][Pre.Kr[[i]][,j] < 0] <- 0 + + # Assumption of daily increase in Kcb of weeds + Kcb <- Kcb+(0.005*j) + + # Ke + Pre.Ke[[i]][,j] <- pmin.int(Pre.Kr[[i]][,j]*(KcMax[[i]][,j] - Kcb), Pre.Few[[i]][,j]*KcMax[[i]][,j]) # NOTE: Pre.KeETo is the same as Ei in equation 77 + Pre.Ke[[i]][,j][Pre.Ke[[i]][,j] < 0] <- 0 # STOP-GAP positive 1 default values: + + # E + Pre.E[[i]][,j] <- Pre.Ke[[i]][,j]*Pre.ETo[[i]][,j] + + # DPe - topsoil percolation: + Pre.DPei[[i]][,j] <- (Pre.Precip[[i]][,j]-Pre.ROi[[i]][,j]) - Pre.Dei[[i]][,(j-1)] + Pre.DPei[[i]][,j][Pre.DPei[[i]][,j] < 0] <- 0 + + # De + Pre.Dei[[i]][,j] <- Pre.Dei[[i]][,(j-1)] - (Pre.Precip[[i]][,j]-Pre.ROi[[i]][,j]) + (Pre.E[[i]][,j]/Pre.Few[[i]][,j]) + Pre.DPei[[i]][,j] # Multiply or Divide? + # Limits on De + Pre.Dei[[i]][,j][Pre.Dei[[i]][,j] < 0] <- 0 + Pre.Dei[[i]][,j][Pre.Dei[[i]][,j] > TEW[[i]]] <- TEW[[i]][Pre.Dei[[i]][,j] > TEW[[i]]] + + # WATER STRESS CALCS: + # Assuming base p value of 0.1 (shallow-rooted) weeds + P.value <- 0.1 + Pre.Pval[[i]][,j] <- P.value + 0.02*(5 - (Pre.Kcb.tot[[i]][,j])) + Pre.Pval[[i]][,j][Pre.Pval[[i]][,j] < 0.1] <- 0.1 + Pre.Pval[[i]][,j][Pre.Pval[[i]][,j] > 0.8] <- 0.8 + ### Root depth assumed at 0.10 + Root.depth <- 0.10 + 0.002*j + Pre.TAW[[i]][,j] <- TAW[[i]]*Root.depth + + Pre.RAW[[i]][,j] <- Pre.Pval[[i]][,j]*Pre.TAW[[i]][,j] + ### Initialize Dr (positive values, less than TAW) ## ignoring capillary rise + Pre.Dr[[i]][,j] <- Pre.Dr[[i]][,(j-1)] - (Pre.Precip[[i]][,j]-Pre.ROi[[i]][,j]) + Pre.Kcb.tot[[i]][,j] + Pre.DP[[i]][,(j-1)] + + # Limits on Dr: + Pre.Dr[[i]][,j][Pre.Dr[[i]][,j] < 0] <- 0 + Pre.Dr[[i]][,j][Pre.Dr[[i]][,j] > Pre.TAW[[i]][,j]] <- Pre.TAW[[i]][,j][Pre.Dr[[i]][,j] > Pre.TAW[[i]][,j]] + + # Adjusted transpiration component: (equation 80) + Pre.Ks[[i]][,j][Pre.Dr[[i]][,j] > Pre.RAW[[i]][,j]] <- ((Pre.TAW[[i]][,j]-Pre.Dr[[i]][,j])[Pre.Dr[[i]][,j] > Pre.RAW[[i]][,j]]) / ((1 - Pre.Pval[[i]][,j][Pre.Dr[[i]][,j] > Pre.RAW[[i]][,j]])*Pre.TAW[[i]][,j][Pre.Dr[[i]][,j] > Pre.RAW[[i]][,j]]) + Pre.Ks[[i]][,j][Pre.Dr[[i]][,j] <= Pre.RAW[[i]][,j]] <- 1 + + ### Soil water balance for the root zone (equation 85) + Pre.DP[[i]][,j] <- (Pre.Precip[[i]][,j]-Pre.ROi[[i]][,j]) - Pre.Kcb.tot[[i]][,j] - Pre.Dr[[i]][,j-1] + # As long as the soil water content in the root zone is below field capacity (i.e., Dr, i > 0), the soil will not drain and DPi = 0. + Pre.DP [[i]][,j][Pre.Dr[[i]][,j] > 0] <- 0 + Pre.DP [[i]][,j][Pre.DP[[i]][,j] < 0] <- 0 + + Pre.Kcb[[i]][,j] <- (Pre.Ks[[i]][,j]*Kcb+Pre.Ke[[i]][,j])*Pre.ETo[[i]][,j] + Pre.Kcb.tot[[i]][,j] <- (Pre.Ks[[i]][,j]*Kcb)*Pre.ETo[[i]][,j] + + # DPe - topsoil percolation: + Pre.DPei[[i]][,j] <- (Pre.Precip[[i]][,j]-Pre.ROi[[i]][,j]) - Pre.Dei[[i]][,j-1] + Pre.DPei[[i]][,j][Pre.DPei[[i]][,j] < 0] <- 0 + } + } + } + print('Calculation of Preseason daily soil water balance, deep percolation, and evaporation complete') + + setwd(paste0(Path, '/CropWatR/Intermediates/')) + + save(Pre.Few, file = paste('Preseason_Few', Croplayer, 'Rdata', sep = '.')) + save(Pre.Kr, file = paste('Preseason_Kr', Croplayer, 'Rdata', sep = '.')) + save(Pre.Ks, file = paste('Preseason_Ks', Croplayer, 'Rdata', sep = '.')) + save(Pre.Pval, file = paste('Preseason_Pval', Croplayer, 'Rdata', sep = '.')) + + save(Pre.Dr, file = paste('Preseason_Root.Zone.Depletion', Croplayer, 'Rdata', sep = '.')) + save(Pre.Dei, file = paste('Preseason_Soil.Top.Layer.Depletion', Croplayer, 'Rdata', sep = '.')) + save(Pre.DP, file = paste('Preseason_Deep.Percolation', Croplayer, 'Rdata', sep = '.')) + Pre.KeETo <- Pre.E # renamed + save(Pre.KeETo, file = paste('Preseason_Soil.Evaporation', Croplayer, 'Rdata', sep = '.')) + save(Pre.ROi, file = paste('Preseason_Runoff', Croplayer, 'Rdata', sep = '.')) + save(Pre.Kcb.tot, file = paste('Preseason_Weed.Transpiration', Croplayer, 'Rdata', sep = '.')) + + setwd(paste0(Path, '/CropWatR/Data')) + + print('Preseason files saved, on to final growing season run') + } + if (file.exists(paste0(Intermediates, paste("Preseason_Soil.Evaporation", Croplayer, "Rdata", sep = "."))) == TRUE && Overwrite == FALSE){ + print("Preseason has been previously calculated for this crop") + } +} diff --git a/R/Final.Daily.ET.Calc.R b/R/Final.Daily.ET.Calc.R new file mode 100644 index 0000000..3177dde --- /dev/null +++ b/R/Final.Daily.ET.Calc.R @@ -0,0 +1,30 @@ +Final.Daily.ET.Calc <- +function(Croplayer){ + if (file.exists(paste0(Intermediates, paste("Preseason_Weed.Transpiration", Croplayer, 'Rdata', sep = '.')))==FALSE){ + Fallow.Preseason.Daily.ET.Calc(Croplayer) + } + + if (file.exists(paste0(Intermediates, paste("Postseason_Weed.Transpiration", Croplayer, 'Rdata', sep = '.'))) + && file.exists(paste0(Intermediates, paste("Growing.Season_Runoff", Croplayer, 'Rdata', sep = '.')))){ + print(paste('Daily ETo calculation completed for', Croplayer)) + } + if ((file.exists(paste0(Intermediates, paste("Postseason_Weed.Transpiration", Croplayer, 'Rdata', sep = '.'))) + && file.exists(paste0(Intermediates,paste("Growing.Season_Runoff", Croplayer, 'Rdata', sep = '.')))) == FALSE){ + # Do the function: + + if (file.exists(paste0(Intermediates, paste("Growing.Season_Transpiration", Croplayer, "Rdata", sep = "."))) == FALSE){ + load('Vars.Rdata') + if (Croplayer %in% Vars || Croplayer == 'silage'){ + Main.Growing.Season.Daily.ET.Calc(Croplayer) + Main.Rainfed.Growing.Season.Daily.ET.Calc(Croplayer) + } + Others <- c('switchgrass', 'miscanthus', "idle_cropland", "pasture_grass") + if (Croplayer %in% Others){ + Main.Growing.Season.Daily.ET.Calc(Croplayer) + } + } + if(file.exists(paste0(Intermediates, paste('Postseason_Soil.Water.Balance', Croplayer, 'Rdata', sep = '.'))) == FALSE){ + Fallow.Postseason.Daily.ET.Calc(Croplayer) + } + } +} diff --git a/R/Generate.Land.Use.R b/R/Generate.Land.Use.R new file mode 100644 index 0000000..35e4eb0 --- /dev/null +++ b/R/Generate.Land.Use.R @@ -0,0 +1,32 @@ +Generate.Land.Use <- +function(Croplayer, Type){ + # Types are "Total" and 'Irr.multiplier' (the later keeps the split b/w irrigated and rainfed) + + load('Vars.Rdata') + if (Croplayer %in% Vars){ + LU.csv <- read.csv(paste0(Croplayer, '.Master.DF.2008.BAU.csv')) + LU <- LU.csv[,c(1,2, grep("Rainfed", names(LU.csv)), grep("Irrigated", names(LU.csv)))] + if (Type == 'Total'){ + if (length(LU) == 3) names(LU)[3] <- Croplayer + if (length(LU) == 4){ + LU$Final <- rowSums(cbind(LU.csv[,c(grep("Rainfed", names(LU.csv)), grep("Irrigated", names(LU.csv)))]), na.rm = TRUE) + LU <- LU[,c(1,2, grep("Final", names(LU)))] + names(LU)[3] <- Croplayer + } + } + } + + coordinates(LU) <- ~x+y + proj4string(LU) <- CRS("+proj=aea +lat_1=29.5 +lat_2=45.5 +lat_0=23 +lon_0=-96 +x_0=0 +y_0=0 +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs") + gridded(LU) = TRUE + LU.brick <- brick(LU) + projection(LU.brick) <- ("+proj=aea +lat_1=29.5 +lat_2=45.5 +lat_0=23 +lon_0=-96 +x_0=0 +y_0=0 +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs") + + Crops.brick.2008 <- brick('cdl_10k_2008_albers.grd') + + # print('likely if there is an error that Crops.brick.2008 is not an object in the workspace') + LU.brick <- extend(LU.brick, Crops.brick.2008) + plot(LU.brick, main = Croplayer) + LU.brick[LU.brick == 0] <- NA + if (Type == 'Total') writeRaster(LU.brick, filename = paste0(Intermediates, Croplayer, '.grd'), overwrite = TRUE) +} diff --git a/R/Irr.Mults.R b/R/Irr.Mults.R new file mode 100644 index 0000000..0c515fe --- /dev/null +++ b/R/Irr.Mults.R @@ -0,0 +1,10 @@ +Irr.Mults <- +function(Crop){ + survey <- read.csv('acre-feet.per.acre.csv') + Sub <- survey[c(1, which(names(survey) %in% Crop))] + Sub <- Sub[complete.cases(Sub),] + Mean <- mean(Sub[,2]) + Sub$Mult <- round(Sub[,2]/Mean, digits = 3) + Sub$State <- factor(Sub$State) + return(Sub) +} diff --git a/R/KcMAX.R b/R/KcMAX.R new file mode 100644 index 0000000..c9e5ad5 --- /dev/null +++ b/R/KcMAX.R @@ -0,0 +1,57 @@ +KcMAX <- +function(Croplayer){ + + + # Load wind speed (meters/hr at 2 meters height) + load(paste0(Intermediates, paste('Growing.Season', Croplayer, 'U2.final_', 'Rdata', sep = '.'))); U2 <- Growing.Season; rm(Growing.Season) + # load minimum relative humidity + load(paste0(Intermediates, paste('Growing.Season', Croplayer, 'MNRH_', 'Rdata', sep = '.'))); RHmin <- Growing.Season; rm(Growing.Season) + # load scaled crop parameters + load(paste0(Intermediates, paste('CropsList', Croplayer, 'Rdata', sep = '.'))) + + # check x, y coordinates listing of the two files: + all.equal(lapply(U2, function(x) dim(x)), lapply(RHmin, function(x) dim(x))) + all.equal(lapply(U2, function(x) x[,c('x','y')]), lapply(RHmin, function(x) x[,c('x','y')])) + all.equal(names(U2), names(Daily.Crops.list)) + + GS.U2 <- lapply(U2, function(x) x[,(grep('layer', names(x)))]) + GS.RHmin <- lapply(RHmin, function(x) x[,(grep('layer', names(x)))]) + all.equal(lapply(GS.U2, function(x) dim(x)), lapply(GS.RHmin, function(x) dim(x))) + + Wind_term <- lapply(GS.U2, function(x) 0.04*(x[]-2)) + RH_term <- lapply(GS.RHmin, function(x) 0.004*(x[]-45)) + all.equal(lapply(Wind_term, function(x) dim(x)), lapply(RH_term, function(x) dim(x))) + Max.season.heights <- lapply(Daily.Crops.list, function(x) tapply(x$day_height, x$season.ID, max)) + Season.IDs <- lapply(Daily.Crops.list, function(x) x$season.ID); Plant_heights <- Season.IDs + + for (i in 1:length(Max.season.heights)){ + Plant_heights[[i]] <- Max.season.heights[[i]][match(Season.IDs[[i]], names(Max.season.heights[[i]]))] + } + + height_term <- lapply(Plant_heights, function(x) (x[]/3)^0.3) + + Term1 <- Wind_term + + for (i in 1:length(Wind_term)){ + for (j in 1:length(height_term[[i]])){ + Term1[[i]][,j] <- 1.2 + (Wind_term[[i]][,j] - RH_term[[i]][,j]) * height_term[[i]][j] + } + } + + Kcb <- lapply(Daily.Crops.list, function(x) x$daily_Kcb) + + KcMax <- Term1 + + for (i in 1:length(Term1)){ + for (j in 1:length(Kcb[[i]])){ + KcMax[[i]][,j] <- max(Term1[[i]][,j], Kcb[[i]][j] + 0.05) + } + } + + for (i in 1:length(Term1)){ + KcMax[[i]] <- cbind(KcMax[[i]], U2[[i]]$x, U2[[i]]$y) + names(KcMax[[i]])[c(length(KcMax[[i]])-1,length(KcMax[[i]]))] <- c('x', 'y') + } + + save(KcMax, file = paste0(Intermediates, paste('KcMax', Croplayer,'Rdata', sep = '.'))) +} diff --git a/R/KcMAX.fallow.R b/R/KcMAX.fallow.R new file mode 100644 index 0000000..ac8bbce --- /dev/null +++ b/R/KcMAX.fallow.R @@ -0,0 +1,84 @@ +KcMAX.fallow <- +function(Croplayer){ + load(paste0(Intermediates, paste('Fallow.Season', Croplayer, 'U2.final_','Rdata', sep = '.'))); U2 <- Fallow.Season; rm(Fallow.Season) + load(paste0(Intermediates, paste('Fallow.Season', Croplayer, 'MNRH_','Rdata', sep = '.'))); RHmin <- Fallow.Season; rm(Fallow.Season) + load(paste0(Intermediates, paste('CropsList', Croplayer, 'Rdata', sep = '.'))) + + # check x, y coordinates listing of the two files: + all.equal(lapply(U2, function(x) dim(x)), lapply(RHmin, function(x) dim(x))) + all.equal(lapply(U2, function(x) x[,c('x','y')]), lapply(RHmin, function(x) x[,c('x','y')])) + + FS.U2 <- lapply(U2, function(x) x[,(grep('layer', names(x)))]) + FS.RHmin <- lapply(RHmin, function(x) x[,(grep('layer', names(x)))]) + Wind_term <- lapply(FS.U2, function(x) 0.04*(x[]-2)) + RH_term <- lapply(FS.RHmin, function(x) 0.004*(x[]-45)) + all.equal(lapply(Wind_term, function(x) c(x$x, x$y)), lapply(RH_term, function(x) c(x$x, x$y))) + # if (tilled == TRUE){ + Max.season.heights <- lapply(Daily.Crops.list, function(x) tapply(x$day_height, x$season.ID, function(x) max(x)*.08)) + + Kcb <- lapply(RH_term, function(x) x[1,]) + Kcb <- lapply(Kcb, function(x) replace(x[], 1:length(x[]), 0)) + DaysRow <- lapply(RH_term, function(x) as.numeric(gsub('layer.', '', names(x)))) + Cuts <- lapply(DaysRow, function(x) which(diff(x) > 1)) + + Season.IDs <- lapply(Kcb, function(x) replace(x[], 1:length(x[]), 4)); Plant_heights <- Season.IDs + for (i in 1:length(Cuts)){ + if (length(Cuts[[i]]) > 0){ + Season.IDs[[i]][,1: round(Cuts[[i]]*3/4) ] <- 3 + Season.IDs[[i]][,1: round(Cuts[[i]]*1/2) ] <- 2 + Season.IDs[[i]][,1: round(Cuts[[i]]*1/4) ] <- 1 + + Season.IDs[[i]][, Cuts[[i]]: floor(((length(Season.IDs[[i]]) - Cuts[[i]])*3/4) + Cuts[[i]]) ] <- 3 + Season.IDs[[i]][, Cuts[[i]]: floor(((length(Season.IDs[[i]]) - Cuts[[i]])*1/2) + Cuts[[i]]) ] <- 2 + Season.IDs[[i]][, Cuts[[i]]: floor(((length(Season.IDs[[i]]) - Cuts[[i]])*1/4) + Cuts[[i]]) ] <- 1 + + Plant_heights[[i]] <- Max.season.heights[[i]][match(Season.IDs[[i]], names(Max.season.heights[[i]]))] + + } + if (length(Cuts[[i]]) == 0){ + Season.IDs[[i]][,1: round(length(Season.IDs[[i]])*3/4) ] <- 3 + Season.IDs[[i]][,1: round(length(Season.IDs[[i]])*1/2) ] <- 2 + Season.IDs[[i]][,1: round(length(Season.IDs[[i]])*1/4) ] <- 1 + } + } + + ### For tilled & untilled land,...what should Kcb be? + if (length(Season.IDs[[i]]) > 3){ + # Kcb.values <- lapply(Max.season.heights, function(x) replace(x[], c(1, 2, 3, 4), c(0.1, 0.2, .7, .7))) + Kcb.values <- lapply(Max.season.heights, function(x) replace(x[], c(1, 2, 3, 4), c(0.1, 0.2, .3, .2))) + Kcb[[i]] <- Kcb[[i]][match(Season.IDs[[i]], names(Kcb.values[[i]]))] + } + if (length(Season.IDs[[i]]) <= 3){ + Kcb[[i]] <- as.data.frame(t(rep(.1, times = length(Season.IDs[[i]])))) + names(Kcb[[i]]) <- names(Season.IDs[[i]]) } + + height_term <- lapply(Plant_heights, function(x) (x[]/3)^0.3) + Term1 <- Wind_term + summary(Term1[[1]]) + ## The loop is slow in R: this takes about 10 seconds + for (i in 1:length(Wind_term)){ + for (j in 1:length(height_term[[i]])){ + Off.season.vars <- c('winter_wheat', 'durum_wheat', 'fall_barley', 'fall_oats') + if (Croplayer %in% Off.season.vars){ + Term1[[i]][,j] <- 1 + (Wind_term[[i]][,j] - RH_term[[i]][,j]) * height_term[[i]][j] + } + if (!(Croplayer %in% Off.season.vars)){ + # 'weed' Kcb set to 0.15, not 1.2 + Term1[[i]][,j] <- 0.15 + (Wind_term[[i]][,j] - RH_term[[i]][,j]) * height_term[[i]][j] + } + } + } + + KcMax <- Term1 + for (i in 1:length(Term1)){ + for (j in 1:length(Kcb[[i]])){ + KcMax[[i]][,j] <- pmax.int(Term1[[i]][,j], Kcb[[i]][,j] + 0.05) ## NOTE THAT THE CORRECT FUNCTION pmax.int + } + } + for (i in 1:length(Term1)){ + KcMax[[i]] <- cbind(KcMax[[i]], U2[[i]]$x, U2[[i]]$y) + names(KcMax[[i]])[c(length(KcMax[[i]])-1,length(KcMax[[i]]))] <- c('x', 'y') + } + summary(KcMax[[1]]) + save(KcMax, file = paste0(Intermediates, paste('KcMax.Fallow', Croplayer, 'Rdata', sep = '.'))) +} diff --git a/R/Main.Growing.Season.Daily.ET.Calc.R b/R/Main.Growing.Season.Daily.ET.Calc.R new file mode 100644 index 0000000..c522057 --- /dev/null +++ b/R/Main.Growing.Season.Daily.ET.Calc.R @@ -0,0 +1,409 @@ +Main.Growing.Season.Daily.ET.Calc <- +function(Croplayer){ + #### II. GROWING SEASON #### + load(paste0(Intermediates, paste('Growing.Season', Croplayer, 'ETo_', 'Rdata', sep = '.'))); ETo <- Growing.Season; rm(Growing.Season) + load(paste0(Intermediates, paste('Growing.Season', Croplayer, 'Precip_', 'Rdata', sep = '.'))); Precip <- Growing.Season; rm(Growing.Season) + + CROP <- Croplayer + + load(paste0('../Intermediates/Daily.Crop.Profile.', CROP, '.Rdata')) # DailyKcb + Root.depth <- lapply(DailyKcb, function(x) x$daily_root.depth) + + Qfc.minus.Qwp <- lapply(Precip, function(x) x$Qfc.minus.Qwp) ## TAW: + TEW <- lapply(Precip, function(x) x$ave_TEW); Dei <- TEW + REW <- lapply(Precip, function(x) x$ave_REW) + + Precip <- lapply(Precip, function(x) x[,(grep('layer', names(x)))]) + load(paste0(Intermediates, paste('Few', Croplayer,'Rdata', sep = '.'))) # Few + load(paste0(Intermediates, paste('KcMax', Croplayer,'Rdata', sep = '.'))) # KcMax + KcMax <- lapply(KcMax, function(x) x[,(grep('layer', names(x)))]) + load(paste0(Intermediates, paste('Kcb.corrected', Croplayer, 'Rdata', sep = '.'))) # Kcb.corrected + + ETo <- lapply(ETo, function(x) x[,(grep('layer', names(x)))]) + sapply(ETo, function(x) length(x[x<0])) + + + if (file.exists(paste0(Intermediates, paste('Growing.Saved', Croplayer, 'Rdata', sep = "."))) == FALSE){ + for (i in 1:length(ETo)){ # slow: takes roungly 45 seconds + ETo[[i]][ETo[[i]] < 0] <- 0 + ETo[[i]] <- round(ETo[[i]], 3) + } + print('ETo data cleaned') + + ### II. ROi calculation: # ROi[[i]][,j] # precipitation on day i runoff from soil surface [mm] + ### Current treatment: + ROi <- Precip # runoff is the EXCESS of heavy rainfall events, where 'EXCESS' means that the precipitation exceeds TEW: + for (i in 1:length(ROi)){ # Takes about 45 seconds + ROi[[i]] <- ROi[[i]]-TEW[[i]] + ROi[[i]][ROi[[i]] < 0] <- 0 + } + print('Growing season runoff estimated') + + Irr <- Precip # initialize Irr to 0 for all days (just to be sure), then copy everything to THAT template + for (i in 1:length(Irr)){ # Takes about 45 seconds + Irr[[i]][Irr[[i]] > 0] <- 0 + } + + Fw.table <- read.csv('Fw.table.csv') + Irr.Eff <- Fw.table$fw[1] # Precip; Sprinkler, Basin, Border + Fw <- Irr + for (i in 1:length(Fw)){ # Takes about 45 seconds + Fw[[i]][Fw[[i]] == 0] <- Irr.Eff + } + + Growing.Files <- list(ETo, Precip, ROi, Irr, Fw) + save(Growing.Files, file = paste0(Intermediates, paste('Growing.Saved', Croplayer, 'Rdata', sep = "."))) + } + + if (file.exists(paste0(Intermediates, paste('Growing.Saved', Croplayer, 'Rdata', sep = "."))) == TRUE){ + load(paste0(Intermediates, paste('Growing.Saved', Croplayer, 'Rdata', sep = '.'))) + ETo <- Growing.Files[[1]]; Precip <- Growing.Files[[2]]; ROi <- Growing.Files[[3]]; Irr <- Growing.Files[[4]]; Fw <- Growing.Files[[5]] + } + + Zr <- read.csv('crop.roots.csv') + Zr <- Zr[Zr$crop == Croplayer,] + TAW.base <- lapply(Qfc.minus.Qwp, function(x) 1000*(x[]*Zr$root_depth)) + + Kr <- Irr; ETc <- Irr; De <- Irr; DPe <- Irr; Transp <- Irr; Ke <- Irr; E <- Irr; Transp <- Irr + Pval <- Irr; RAW <- Irr; Ks <- Irr; Transp.final <- Irr; Dr <- Irr; DP <- Irr; TAW <- Irr + + ### Growing Season Calcs ### # load necessary inputs # + + setwd(paste0(Path, '/CropWatR/Intermediates/')) + + load(paste('Preseason_Root.Zone.Depletion', Croplayer, 'Rdata', sep = '.')) #Pre.Dr + load(paste('Preseason_Soil.Top.Layer.Depletion', Croplayer, 'Rdata', sep = '.')) #Pre.Dei + load(paste('Preseason_Deep.Percolation', Croplayer, 'Rdata', sep = '.')) # Pre.DP + load(paste('Preseason_Soil.Evaporation', Croplayer, 'Rdata', sep = '.')) # Pre.KeETo + load(paste('Preseason_Runoff', Croplayer, 'Rdata', sep = '.')) # Pre.ROi + load(paste('Preseason_Weed.Transpiration', Croplayer, 'Rdata', sep = '.')) # Pre.Kcb.tot + load(paste('Fallow.Saved', Croplayer, 'Rdata', sep = '.')); Pre.Few <- Fallow.File[[5]] + + setwd(paste0(Path, '/CropWatR/Data')) + + if (file.exists(paste0(Intermediates, paste("Growing.Season_Transpiration", Croplayer, "Rdata", sep = "."))) == TRUE){ + print(paste("Growing Season has been previously calculated for", Croplayer)) + } + + if (file.exists(paste0(Intermediates, paste("Growing.Season_Transpiration", Croplayer, "Rdata", sep = "."))) == FALSE){ + print(paste('executing Growing Season calculations for', Croplayer)) + Fw.table <- read.csv('Fw.table.csv') + Irr.Eff <- Fw.table$fw[1] # Precip; Sprinkler, Basin, Border + + for (i in 1:length(Precip)){ + + Irrigated <- c('alfalfa', 'cotton', 'corn', 'spring_barley', 'spring_oats', 'rice', 'soybeans', 'sorghum', 'spring_wheat', 'silage', 'peanuts', 'winter_wheat', 'silage') + if (Croplayer %in% Irrigated) irr <- TRUE + + for (j in 1:length(Precip[[i]])){ + + if (j == 1){ # Initialize on first day of GROWING season (So use the FINAL entry of the Pre.Dei values) + Few[[i]][,j] <- pmin.int(Few[[i]][,j], Fw[[i]][,j]) + + # Kr + Kr[[i]][,j][Pre.Dei[[i]][,length(Pre.Dei[[i]])] > REW[[i]]] <- (TEW[[i]][Pre.Dei[[i]][,length(Pre.Dei[[i]])] > REW[[i]]] - Pre.Dei[[i]][,length(Pre.Dei[[i]])][Pre.Dei[[i]][,length(Pre.Dei[[i]])] > REW[[i]]])/(TEW[[i]][Pre.Dei[[i]][,length(Pre.Dei[[i]])] > REW[[i]]] - REW[[i]][Pre.Dei[[i]][,length(Pre.Dei[[i]])] > REW[[i]]]) + Kr[[i]][,j][Pre.Dei[[i]][,length(Pre.Dei[[i]])] <= REW[[i]]] <- 1 + Kr[[i]][,j][Kr[[i]][,j] < 0] <- 0 + # Ke + Ke[[i]][,j] <- pmin.int(Kr[[i]][,j]*(KcMax[[i]][,j] - Kcb.corrected[[i]][,j]), Few[[i]][,j]*KcMax[[i]][,j]) + + # STOP-GAP against negative KeETo values: + Ke[[i]][,j][Ke[[i]][,j] < 0] <- 0 + + # E + E[[i]][,j] <- Ke[[i]][,j]*ETo[[i]][,j] + # DPe - topsoil percolation: + DPe[[i]][,j] <- (Precip[[i]][,j]-ROi[[i]][,j]) + (Irr[[i]][,j]/Fw[[i]][,j]) - Pre.Dei[[i]][,length(Pre.Dei[[i]])] + DPe[[i]][,j][DPe[[i]][,j] < 0] <- 0 + # De # + De[[i]][,j] <- Pre.Dei[[i]][,length(Pre.Dei[[i]])] - (Precip[[i]][,j]-ROi[[i]][,j]) + Irr[[i]][,j]/Fw[[i]][,j] + (E[[i]][,j]/Few[[i]][,j]) + DPe[[i]][,j] # Multiply or Divide? + # Limits on De + De[[i]][,j][De[[i]][,j] < 0] <- 0 + De[[i]][,j][De[[i]][,j] > TEW[[i]]] <- TEW[[i]][De[[i]][,j] > TEW[[i]]] + + # Crop evapotranspiration + ETc[[i]][,j] <- (Kcb.corrected[[i]][,j]+Ke[[i]][,j])*ETo[[i]][,j] + + # WATER STRESS CALCS: + Pval[[i]][,j] <- Zr$p.value + 0.04*(5 - (ETc[[i]][,j])) + Pval[[i]][,j][Pval[[i]][,j] < 0.1] <- 0.1 + Pval[[i]][,j][Pval[[i]][,j] > 0.8] <- 0.8 + + if (is.na(Root.depth[[i]][j]/Zr$root_depth)){ + Frac <- Root.depth[[i]][length(Root.depth[[i]])]/Zr$root_depth + } else Frac <- Root.depth[[i]][j]/Zr$root_depth + TAW[[i]][,j] <- TAW.base[[i]]*Frac + + RAW[[i]][,j] <- Pval[[i]][,j]*TAW[[i]][,j] + + ### Root zone depletion (positive values, less than TAW) ## ignoring capillary rise + Dr[[i]][,j] <- Pre.Dr[[i]][,length(Pre.Dr[[i]])] - (Precip[[i]][,j]-ROi[[i]][,j]) - Irr[[i]][,j] + ETc[[i]][,j] + Pre.DP[[i]][,length(Pre.DP[[i]])] + # Limits on Dr: + Dr[[i]][,j][Dr[[i]][,j] < 0] <- 0 + Dr[[i]][,j][Dr[[i]][,j] > TAW[[i]][,j]] <- TAW[[i]][,j][Dr[[i]][,j] > TAW[[i]][,j]] + + # Adjusted transpiration component: (equation 80) + Ks[[i]][,j][Dr[[i]][,j] > RAW[[i]][,j]] <- ((TAW[[i]][,j]-Dr[[i]][,j])[Dr[[i]][,j] > RAW[[i]][,j]]) / ((1 - Pval[[i]][,j][Dr[[i]][,j] > RAW[[i]][,j]])*TAW[[i]][,j][Dr[[i]][,j] > RAW[[i]][,j]]) + Ks[[i]][,j][Dr[[i]][,j] <= RAW[[i]][,j]] <- 1 + + ### Soil water balance for the root zone (equation 85) + DP[[i]][,j] <- (Precip[[i]][,j]-ROi[[i]][,j]) + Irr[[i]][,j] - ETc[[i]][,j] - Pre.Dr[[i]][,length(Pre.Dr[[i]])] + # As long as the soil water content in the root zone is below field capacity (i.e., Dr, i > 0), the soil will not drain and DPi = 0. + DP [[i]][,j][Dr[[i]][,j] > 0] <- 0 + DP [[i]][,j][DP[[i]][,j] < 0] <- 0 + + Transp[[i]][,j] <- (Ks[[i]][,j]*Kcb.corrected[[i]][,j]+Ke[[i]][,j])*ETo[[i]][,j] + Transp.final[[i]][,j] <- (Ks[[i]][,j]*Kcb.corrected[[i]][,j])*ETo[[i]][,j] + + # DPe - topsoil percolation: + DPe[[i]][,j] <- (Precip[[i]][,j]-ROi[[i]][,j]) + (Irr[[i]][,j]/Fw[[i]][,j]) - Pre.Dei[[i]][,length(Pre.Dei[[i]])] + DPe[[i]][,j][DPe[[i]][,j] < 0] <- 0 + # De + De[[i]][,j] <- Pre.Dei[[i]][,length(Pre.Dei[[i]])] - (Precip[[i]][,j]-ROi[[i]][,j]) + Irr[[i]][,j]/Fw[[i]][,j] + (E[[i]][,j]/Few[[i]][,j]) + DPe[[i]][,j] # Multiply or Divide? + # Limits on De + De[[i]][,j][De[[i]][,j] < 0] <- 0 + De[[i]][,j][De[[i]][,j] > TEW[[i]]] <- TEW[[i]][De[[i]][,j] > TEW[[i]]] + + } + + else { # all other days of the growing season + + # Fw + Fw[[i]][,j] <- Fw[[i]][,(j-1)] + # Few + Few[[i]][,j] <- pmin.int(Few[[i]][,j], Fw[[i]][,j]) + + # Kr + Kr[[i]][,j][De[[i]][,(j-1)] > REW[[i]]] <- (TEW[[i]][De[[i]][,(j-1)] > REW[[i]]] - De[[i]][,(j-1)][De[[i]][,(j-1)] > REW[[i]]])/(TEW[[i]][De[[i]][,(j-1)] > REW[[i]]] - REW[[i]][De[[i]][,(j-1)] > REW[[i]]]) + Kr[[i]][,j][De[[i]][,(j-1)] <= REW[[i]]] <- 1 + Kr[[i]][,j][Kr[[i]][,j] < 0] <- 0 + + # Ke + Ke[[i]][,j] <- pmin.int(Kr[[i]][,j]*(KcMax[[i]][,j] - Kcb.corrected[[i]][,j]), Few[[i]][,j]*KcMax[[i]][,j]) + # Stop-gap against negative Ke values + Ke[[i]][,j][Ke[[i]][,j] < 0] <- 0 + + # E + ETo[[i]] + E[[i]][,j] <- Ke[[i]][,j]*ETo[[i]][,j] + + # DPe - topsoil percolation + DPe[[i]][,j] <- (Precip[[i]][,j]-ROi[[i]][,j]) + (Irr[[i]][,j]/Fw[[i]][,j]) - De[[i]][,j-1] + DPe[[i]][,j][DPe[[i]][,j] < 0] <- 0 + # De + De[[i]][,j] <- De[[i]][,j-1] - (Precip[[i]][,j]-ROi[[i]][,j]) + Irr[[i]][,j]/Fw[[i]][,j] + (E[[i]][,j]/Few[[i]][,j]) + DPe[[i]][,j] # Multiply or Divide? + # Limits on De + De[[i]][,j][De[[i]][,j] < 0] <- 0 + De[[i]][,j][De[[i]][,j] > TEW[[i]]] <- TEW[[i]][De[[i]][,j] > TEW[[i]]] + + # Crop evapotranspiration + ETc[[i]][,j] <- (Kcb.corrected[[i]][,j]+Ke[[i]][,j])*ETo[[i]][,j] + + # WATER STRESS CALCS: + # Calculate Daily p values, daily RAW: (equations 81, 82, & 84) + Pval[[i]][,j] <- Zr$p.value + 0.04*(5 - (ETc[[i]][,j])) + Pval[[i]][,j][Pval[[i]][,j] < 0.1] <- 0.1 + Pval[[i]][,j][Pval[[i]][,j] > 0.8] <- 0.8 + ### TAW should change daily; and as a function of (growing) root depth. + if (is.na(Root.depth[[i]][j]/Zr$root_depth)){ + Frac <- Root.depth[[i]][length(Root.depth[[i]])]/Zr$root_depth + } else Frac <- Root.depth[[i]][j]/Zr$root_depth + TAW[[i]][,j] <- TAW.base[[i]]*Frac + + RAW[[i]][,j] <- Pval[[i]][,j]*TAW[[i]][,j] + ### Pre irrigation Dr calc: + ### Root zone depletion (positive values, less than TAW) + ## ignoring capillary rise + Dr[[i]][,j] <- Dr[[i]][,j-1] - (Precip[[i]][,j]-ROi[[i]][,j]) - Irr[[i]][,j] + ETc[[i]][,j] + DP[[i]][,j-1] + # Limits on Dr: + Dr[[i]][,j][Dr[[i]][,j] < 0] <- 0 + Dr[[i]][,j][Dr[[i]][,j] > TAW[[i]][,j]] <- TAW[[i]][,j][Dr[[i]][,j] > TAW[[i]][,j]] + + # APPLY IRRIGATION - assume that they irrigate based on DAY-OF Dr [Dr[[i]][,(j)] >= RAW[[i]][,(j)]] + ### It may be worth making the multipliers crop specific... + if (irr == TRUE & Frac > 0.5 & j < length(Irr[[i]])*0.7){ + # Irr[[i]][,j][Dr[[i]][,(j)] >= 0.6*(RAW[[i]][,(j)])] <- RAW[[i]][,(j)][Dr[[i]][,(j)] >= 0.6*(RAW[[i]][,(j)])] + Irr[[i]][,j][Ks[[i]][,j] <= 0.9] <- 0.03*RAW[[i]][,(j)][Ks[[i]][,j] <= 0.9] + Cum <- rowSums(Irr[[i]][,c(1:j)]) + States <- read.csv('States.key.csv') + + Crop <- Croplayer + if (Croplayer == 'spring_wheat' || Croplayer == 'winter_wheat') Crop <- 'wheat' + if (Croplayer == 'spring_barley') Crop <- 'barley' + if (Croplayer == 'spring_oats') Crop <- 'oats' + if (Croplayer == 'silage') Crop <- 'corn' + + Mults <- Irr.Mults(Crop) + Matched <- merge(States, Mults, by.x = 'State_name', by.y = 'State', all = TRUE) + + Matched$Mult[is.na(Matched$Mult)] <- 1 + m <- Matched$STATE_FIPS[as.character(Matched$STATE_FIPS) == names(Precip[i])] + Multiplier <- Matched$Mult[as.character(Matched$STATE_FIPS) == names(Precip[i])] + + if (Croplayer == 'alfalfa'){ + # if (m == 31) Multiplier <- 1 + if (m == 40 || m == 20) Multiplier <- 0.85 + if (m == 46 || m == 38) Multiplier <- 1.75 + if (m == 22 || m == 45) Multiplier <- 0.5 + if (m == 48 ) Multiplier <- 1.1 + if (m == 53 || m == 41 || m == 16) Multiplier <- Multiplier*1.35 + if (m == 6) Multiplier <- Multiplier*1.25 + if (m == 30) Multiplier <- Multiplier*1.75 + if (m == 4 || m == 55) Multiplier <- Multiplier*2.25 + if (m == 8 || m == 49 ) Multiplier <- Multiplier*2.5 + if (m == 56) Multiplier <- Multiplier*3.2 + + Irr[[i]][,j][Ks[[i]][,j] <= 0.9] <- 0.035*RAW[[i]][,(j)][Ks[[i]][,j] <= 0.9] + Irr[[i]][,j][Ks[[i]][,j] <= 0.9 & Cum[Ks[[i]][,j] <= 0.9] >= 300] <- 0.065*RAW[[i]][,(j)][Ks[[i]][,j] <= 0.9 & Cum[Ks[[i]][,j] <= 0.9] >= 300] + Irr[[i]][,j][Ks[[i]][,j] <= 0.9 & Cum[Ks[[i]][,j] <= 0.9] >= 400] <- 0.1*RAW[[i]][,(j)][Ks[[i]][,j] <= 0.9 & Cum[Ks[[i]][,j] <= 0.9] >= 400] + Irr[[i]][,j][Ks[[i]][,j] <= 0.9 & Cum[Ks[[i]][,j] <= 0.9] >= 600] <- 0.15*RAW[[i]][,(j)][Ks[[i]][,j] <= 0.9 & Cum[Ks[[i]][,j] <= 0.9] >= 600] + Irr[[i]][,j][Ks[[i]][,j] <= 0.9 & Cum[Ks[[i]][,j] <= 0.9] >= 1000] <- 0.175*RAW[[i]][,(j)][Ks[[i]][,j] <= 0.9 & Cum[Ks[[i]][,j] <= 0.9] >= 1000] + ## Irr[[i]][,j][Ks[[i]][,j] <= 0.9 & Cum[Ks[[i]][,j] <= 0.9] >= 1800] <- 0.0075*RAW[[i]][,(j)][Ks[[i]][,j] <= 0.9 & Cum[Ks[[i]][,j] <= 0.9] >= 1800] + Irr[[i]][,j][Ks[[i]][,j] <= 0.9 & Cum[Ks[[i]][,j] <= 0.9] >= 2000] <- 0 + } + + if (Croplayer == 'spring_barley'){ + Irr[[i]][,j][Ks[[i]][,j] <= 0.9] <- 0.070*RAW[[i]][,(j)][Ks[[i]][,j] <= 0.9] + Irr[[i]][,j][Ks[[i]][,j] <= 0.9 & Cum[Ks[[i]][,j] <= 0.9] >= 1000] <- 0 + } + + if (Croplayer == 'corn' && j > 10){ + Irr[[i]][,j][Ks[[i]][,j] <= 0.9] <- 0.09*RAW[[i]][,(j)][Ks[[i]][,j] <= 0.9] + Irr[[i]][,j][Ks[[i]][,j] <= 0.9 & Cum[Ks[[i]][,j] <= 0.9] >= 400] <- 0.11*RAW[[i]][,(j)][Ks[[i]][,j] <= 0.9 & Cum[Ks[[i]][,j] <= 0.9] >= 400] + Irr[[i]][,j][Ks[[i]][,j] <= 0.9 & Cum[Ks[[i]][,j] <= 0.9] >= 800] <- 0.08*RAW[[i]][,(j)][Ks[[i]][,j] <= 0.9 & Cum[Ks[[i]][,j] <= 0.9] >= 800] + Irr[[i]][,j][Ks[[i]][,j] <= 0.9 & Cum[Ks[[i]][,j] <= 0.9] >= 1000] <- 0 + + if (m == 6){ + Irr[[i]][,j][Ks[[i]][,j] <= 0.9] <- 0.12*RAW[[i]][,(j)][Ks[[i]][,j] <= 0.9] + if (length(Irr[[i]][,j][Ks[[i]][,j] <= 0.9 & Cum[Ks[[i]][,j] <= 0.9] >= 1400]) > 0){ + print('irrigation max exceeded for...on day...') + print(length(Irr[[i]][,j][Ks[[i]][,j] <= 0.9 & Cum[Ks[[i]][,j] <= 0.9] >= 1400])) + print(j) + } + + Irr[[i]][,j][Ks[[i]][,j] <= 0.9 & Cum[Ks[[i]][,j] <= 0.9] >= 1400] <- 0 + } + + + } + + if (Croplayer == 'cotton'){ + Irr[[i]][,j][Ks[[i]][,j] <= 0.9] <- 0.045*RAW[[i]][,(j)][Ks[[i]][,j] <= 0.9] + Irr[[i]][,j][Ks[[i]][,j] <= 0.9 & Cum[Ks[[i]][,j] <= 0.9] >= 450] <- 0.025*RAW[[i]][,(j)][Ks[[i]][,j] <= 0.9 & Cum[Ks[[i]][,j] <= 0.9] >= 450] + Irr[[i]][,j][Ks[[i]][,j] <= 0.9 & Cum[Ks[[i]][,j] <= 0.9] >= 650] <- 0.05*RAW[[i]][,(j)][Ks[[i]][,j] <= 0.9 & Cum[Ks[[i]][,j] <= 0.9] >= 650] + } + + if (Croplayer == 'spring_oats'){ + Irr[[i]][,j][Ks[[i]][,j] <= 0.9] <- 0.08*RAW[[i]][,(j)][Ks[[i]][,j] <= 0.9] + Irr[[i]][,j][Ks[[i]][,j] <= 0.9 & Cum[Ks[[i]][,j] <= 0.9] >= 2200] <- 0 + } + + if (Croplayer == 'peanuts'){ + Irr[[i]][,j][Ks[[i]][,j] <= 0.9] <- 0.06*RAW[[i]][,(j)][Ks[[i]][,j] <= 0.9] + Irr[[i]][,j][Ks[[i]][,j] <= 0.9 & Cum[Ks[[i]][,j] <= 0.9] >= 300] <- 0.08*RAW[[i]][,(j)][Ks[[i]][,j] <= 0.9 & Cum[Ks[[i]][,j] <= 0.9] >= 300] + Irr[[i]][,j][Ks[[i]][,j] <= 0.9 & Cum[Ks[[i]][,j] <= 0.9] >= 1400] <- 0 + } + + if (Croplayer == 'rice'){ + Irr[[i]][,j][Dr[[i]][,(j)] >= 0.9*(RAW[[i]][,(j)])] <- 1.75*RAW[[i]][,(j)][Dr[[i]][,(j)] >= 0.9*(RAW[[i]][,(j)])] + Irr[[i]][,j][Ks[[i]][,j] <= 0.6 & Cum[Ks[[i]][,j] <= 0.6] >= 200] <- 1*RAW[[i]][,(j)][Ks[[i]][,j] <= 0.6 & Cum[Ks[[i]][,j] <= 0.6] >= 200] + Irr[[i]][,j][Ks[[i]][,j] <= 0.6 & Cum[Ks[[i]][,j] <= 0.6] >= 500] <- 0.5*RAW[[i]][,(j)][Ks[[i]][,j] <= 0.6 & Cum[Ks[[i]][,j] <= 0.6] >= 500] + Irr[[i]][,j][Ks[[i]][,j] <= 0.6 & Cum[Ks[[i]][,j] <= 0.6] >= 850] <- 0.35*RAW[[i]][,(j)][Ks[[i]][,j] <= 0.6 & Cum[Ks[[i]][,j] <= 0.6] >= 850] + } + + if (Croplayer == 'sorghum'){ + Irr[[i]][,j][Ks[[i]][,j] <= 0.9] <- 0.05*RAW[[i]][,(j)][Ks[[i]][,j] <= 0.9] + Irr[[i]][,j][Ks[[i]][,j] <= 0.9 & Cum[Ks[[i]][,j] <= 0.9] >= 400] <- 0.0275*RAW[[i]][,(j)][Ks[[i]][,j] <= 0.9 & Cum[Ks[[i]][,j] <= 0.9] >= 100] + Irr[[i]][,j][Ks[[i]][,j] <= 0.9 & Cum[Ks[[i]][,j] <= 0.9] >= 4800] <- 0 + } + + if (Croplayer == 'soybeans'){ + Irr[[i]][,j][Ks[[i]][,j] <= 0.9] <- 0.095*RAW[[i]][,(j)][Ks[[i]][,j] <= 0.9] + Irr[[i]][,j][Ks[[i]][,j] <= 0.9 & Cum[Ks[[i]][,j] <= 0.9] >= 350] <- 0.02*RAW[[i]][,(j)][Ks[[i]][,j] <= 0.9 & Cum[Ks[[i]][,j] <= 0.9] >= 350] + Irr[[i]][,j][Ks[[i]][,j] <= 0.9 & Cum[Ks[[i]][,j] <= 0.9] >= 1200] <- 0 + } + + if (Croplayer == 'spring_wheat'){ + Irr[[i]][,j][Ks[[i]][,j] <= 0.9] <- 0.0075*RAW[[i]][,(j)][Ks[[i]][,j] <= 0.9] + Irr[[i]][,j][Ks[[i]][,j] <= 0.9 & Cum[Ks[[i]][,j] <= 0.9] >= 1400] <- 0 + } + + if (Croplayer == 'winter_wheat'){ + if (m == 35 || m == 49 || m == 31 || m == 20) Multiplier <- Multiplier*0.5 + if (m == 16) Multiplier <- Multiplier*0.75 + if (m == 41 || m == 8 || m == 32) Multiplier <- Multiplier*1.5 + + if (m == 48 || m == 46 || m == 38 || m == 45 || m == 37 || m == 51 || m == 40 || m == 5) Multiplier <- Multiplier*2 + if (m == 6 || m == 32) Multiplier <- Multiplier*3 + + Irr[[i]][,j][Ks[[i]][,j] <= 0.9] <- 0.018*RAW[[i]][,(j)][Ks[[i]][,j] <= 0.9] + Irr[[i]][,j][Ks[[i]][,j] <= 0.9 & Cum[Ks[[i]][,j] <= 0.9] >= 350] <- 0.045*RAW[[i]][,(j)][Ks[[i]][,j] <= 0.9 & Cum[Ks[[i]][,j] <= 0.9] >= 350] + Irr[[i]][,j][Ks[[i]][,j] <= 0.9 & Cum[Ks[[i]][,j] <= 0.9] >= 1200] <- 0 + } + + if (Croplayer == 'silage'){ + Irr[[i]][,j][Ks[[i]][,j] <= 0.9 & Cum[Ks[[i]][,j] <= 0.9] >= 400] <- 0.07*RAW[[i]][,(j)][Ks[[i]][,j] <= 0.9 & Cum[Ks[[i]][,j] <= 0.9] >= 400] + } + + Irr[[i]][,j] <- Irr[[i]][,j]*Multiplier + } + + Dr[[i]][,j] <- Dr[[i]][,j-1] - (Precip[[i]][,j]-ROi[[i]][,j]) - Irr[[i]][,j] + ETc[[i]][,j] + DP[[i]][,j-1] + + # Limits on Dr: + Dr[[i]][,j][Dr[[i]][,j] < 0] <- 0 + Dr[[i]][,j][Dr[[i]][,j] > TAW[[i]][,j]] <- TAW[[i]][,j][Dr[[i]][,j] > TAW[[i]][,j]] + + # Adjusted transpiration component: (equation 80) + Ks[[i]][,j][Dr[[i]][,j] > RAW[[i]][,j]] <- ((TAW[[i]][,j]-Dr[[i]][,j])[Dr[[i]][,j] > RAW[[i]][,j]]) / ((1 - Pval[[i]][,j][Dr[[i]][,j] > RAW[[i]][,j]])*TAW[[i]][,j][Dr[[i]][,j] > RAW[[i]][,j]]) + Ks[[i]][,j][Dr[[i]][,j] <= RAW[[i]][,j]] <- 1 + + + ### Soil water balance for the root zone (equation 85) + DP[[i]][,j] <- (Precip[[i]][,j]-ROi[[i]][,j]) + Irr[[i]][,j] - ETc[[i]][,j] - Dr[[i]][,j-1] + # As long as the soil water content in the root zone is below field capacity (i.e., Dr, i > 0), the soil will not drain and DPi = 0. + DP [[i]][,j][Dr[[i]][,j] > 0] <- 0 + DP [[i]][,j][DP[[i]][,j] < 0] <- 0 + + Transp[[i]][,j] <- (Ks[[i]][,j]*Kcb.corrected[[i]][,j]+Ke[[i]][,j])*ETo[[i]][,j] + Transp.final[[i]][,j] <- (Ks[[i]][,j]*Kcb.corrected[[i]][,j])*ETo[[i]][,j] + + # DPe - topsoil percolation: + DPe[[i]][,j] <- (Precip[[i]][,j]-ROi[[i]][,j]) + (Irr[[i]][,j]/Fw[[i]][,j]) - De[[i]][,j-1] + DPe[[i]][,j][DPe[[i]][,j] < 0] <- 0 + # De + De[[i]][,j] <- De[[i]][,j-1] - (Precip[[i]][,j]-ROi[[i]][,j]) + Irr[[i]][,j]/Fw[[i]][,j] + (E[[i]][,j]/Few[[i]][,j]) + DPe[[i]][,j] # Multiply or Divide? + # Limits on De + De[[i]][,j][De[[i]][,j] < 0] <- 0 + De[[i]][,j][De[[i]][,j] > TEW[[i]]] <- TEW[[i]][De[[i]][,j] > TEW[[i]]] + + } + + } + } + } + + print('Saving growing season SB files') + + setwd(paste0(Path, '/CropWatR/Intermediates/')) + + save(Few, file = paste('Growing.Season_Root.Zone.Depletion', Croplayer, 'Rdata', sep = '.')) # Few + save(Kr, file = paste('Growing.Season_Kr', Croplayer, 'Rdata', sep = '.')) + save(Ks, file = paste('Growing.Season_Ks', Croplayer, 'Rdata', sep = '.')) + save(Pval, file = paste('Growing.Season_Pval', Croplayer, 'Rdata', sep = '.')) + + save(Dr, file = paste('Growing.Season_Root.Zone.Depletion', Croplayer, 'Rdata', sep = '.')) #Dr + save(De, file = paste('Growing.Season_Soil.Water.Balance', Croplayer, 'Rdata', sep = '.')) + save(DP, file = paste('Growing.Season_Deep.Percolation', Croplayer, 'Rdata', sep = '.')) + save(ROi, file = paste('Growing.Season_Runoff', Croplayer, 'Rdata', sep = '.')) + save(E, file = paste('Growing.Season_Soil.Evaporation', Croplayer, 'Rdata', sep = '.')) + save(Irr, file = paste('Growing.Season_Irrigation', Croplayer, 'Rdata', sep = '.')) + save(Transp.final, file = paste('Growing.Season_Transpiration', Croplayer, 'Rdata', sep = '.')) + save(DPe, file = paste('Growing.Season.Root.Zone.Percolation.Loss', Croplayer, 'Rdata', sep = '.')) # DPe + save(Few, file = paste('Growing.Season.Evaporation.Fractions', Croplayer, 'Rdata', sep = '.')) # Few + + setwd(paste0(Path, '/CropWatR/Data')) + + print('Calculation of Growing Season daily soil water balance, deep percolation, and evaporation complete') + print('Growing Season initial run complete, on to post season') +} diff --git a/R/Main.Rainfed.Growing.Season.Daily.ET.Calc.R b/R/Main.Rainfed.Growing.Season.Daily.ET.Calc.R new file mode 100644 index 0000000..013f60f --- /dev/null +++ b/R/Main.Rainfed.Growing.Season.Daily.ET.Calc.R @@ -0,0 +1,381 @@ +Main.Rainfed.Growing.Season.Daily.ET.Calc <- +function(Croplayer, Auto = TRUE){ + #### II. GROWING SEASON #### + load('Vars.Rdata') + Irr.Vars <- Vars[-c(3,6,8,14,15)] + if (!(Croplayer %in% Irr.Vars)) stop('This function is for irrigated varieties only!') + + load(paste0(Intermediates, paste('Growing.Season', Croplayer, 'ETo_', 'Rdata', sep = '.'))); ETo <- Growing.Season; rm(Growing.Season) + load(paste0(Intermediates, paste('Growing.Season', Croplayer, 'Precip_', 'Rdata', sep = '.'))); Precip <- Growing.Season; rm(Growing.Season) + + CROP <- Croplayer + + load(paste0('../Intermediates/Daily.Crop.Profile.', CROP, '.Rdata')) # DailyKcb + Root.depth <- lapply(DailyKcb, function(x) x$daily_root.depth) + + Qfc.minus.Qwp <- lapply(Precip, function(x) x$Qfc.minus.Qwp) ## TAW: + TEW <- lapply(Precip, function(x) x$ave_TEW); Dei <- TEW + REW <- lapply(Precip, function(x) x$ave_REW) + + Precip <- lapply(Precip, function(x) x[,(grep('layer', names(x)))]) + load(paste0(Intermediates, paste('Few', Croplayer,'Rdata', sep = '.'))) # Few + load(paste0(Intermediates, paste('KcMax', Croplayer,'Rdata', sep = '.'))) # KcMax + KcMax <- lapply(KcMax, function(x) x[,(grep('layer', names(x)))]) + load(paste0(Intermediates, paste('Kcb.corrected', Croplayer, 'Rdata', sep = '.'))) # Kcb.corrected + + ETo <- lapply(ETo, function(x) x[,(grep('layer', names(x)))]) + sapply(ETo, function(x) length(x[x<0])) + + + # Turn irrigation ON by default... + + if (file.exists(paste0(Intermediates,paste('Growing.Saved', Croplayer, 'Rdata', sep = "."))) == FALSE){ + # Daily ETo should be cleaned of negative cases, also might as well round to three decimals + for (i in 1:length(ETo)){ # slow: takes roungly 45 seconds + ETo[[i]][ETo[[i]] < 0] <- 0 + ETo[[i]] <- round(ETo[[i]], 3) + ETo[[i]][ETo[[i]] > 28] <- 1.655 + print('ETo high vals warning:') + print(length(ETo[[i]][ETo[[i]] > 18])) + } + print('ETo data cleaned') + + ### II. ROi calculation: # ROi[[i]][,j] # precipitation on day i runoff from soil surface [mm] + ### Current treatment: + ROi <- Precip # runoff is the EXCESS of heavy rainfall events, where 'EXCESS' means that the precipitation exceeds TEW: + for (i in 1:length(ROi)){ # Takes about 45 seconds + ROi[[i]] <- ROi[[i]]-TEW[[i]] + ROi[[i]][ROi[[i]] < 0] <- 0 + } + print('Growing season runoff estimated') + + Irr <- Precip # initialize Irr to 0 for all days (just to be sure), then copy everything to THAT template + for (i in 1:length(Irr)){ # Takes about 45 seconds + Irr[[i]][Irr[[i]] > 0] <- 0 + } + + Fw.table <- read.csv('Fw.table.csv') + Irr.Eff <- Fw.table$fw[1] # Precip; Sprinkler, Basin, Border + # Irr.Eff <- .625 # Furrow average # Irr.Eff <- Fw.table$fw[8] # Trickle + # irrigation depth distributed over the entire field. Therefore, the value Ii/fw is used to describe the actual concentration + # of the irrigation volume over the fraction of the soil that is wetted (Figure 31). + Fw <- Irr + for (i in 1:length(Fw)){ # Takes about 45 seconds + Fw[[i]][Fw[[i]] == 0] <- Irr.Eff + } + + Growing.Files <- list(ETo, Precip, ROi, Irr, Fw) + + + save(Growing.Files, file = paste0(Intermediates, paste('Growing.Saved', Croplayer, 'Rdata', sep = "."))) + } + + if (file.exists(paste0(Intermediates, paste('Growing.Saved', Croplayer, 'Rdata', sep = "."))) == TRUE){ + load(paste0(Intermediates, paste('Growing.Saved', Croplayer, 'Rdata', sep = '.'))) + ETo <- Growing.Files[[1]]; Precip <- Growing.Files[[2]]; ROi <- Growing.Files[[3]]; Irr <- Growing.Files[[4]]; Fw <- Growing.Files[[5]] + } + + ## Added fall/spring varieties directly to the Zr file + Zr <- read.csv('crop.roots.csv') + Zr <- Zr[Zr$crop == Croplayer,] + TAW.base <- lapply(Qfc.minus.Qwp, function(x) 1000*(x[]*Zr$root_depth)) + + Kr <- Irr; ETc <- Irr; De <- Irr; DPe <- Irr; Transp <- Irr; Ke <- Irr; E <- Irr; Transp <- Irr + Pval <- Irr; RAW <- Irr; Ks <- Irr; Transp.final <- Irr; Dr <- Irr; DP <- Irr; TAW <- Irr + + ### Growing Season Calcs ### + # load necessary inputs + setwd(paste0(Path, '/CropWatR/Intermediates/')) + + load(paste('Preseason_Root.Zone.Depletion', Croplayer, 'Rdata', sep = '.')) #Pre.Dr + load(paste('Preseason_Soil.Top.Layer.Depletion', Croplayer, 'Rdata', sep = '.')) #Pre.Dei + load(paste('Preseason_Deep.Percolation', Croplayer, 'Rdata', sep = '.')) # Pre.DP + load(paste('Preseason_Soil.Evaporation', Croplayer, 'Rdata', sep = '.')) # Pre.KeETo + load(paste('Preseason_Runoff', Croplayer, 'Rdata', sep = '.')) # Pre.ROi + load(paste('Preseason_Weed.Transpiration', Croplayer, 'Rdata', sep = '.')) # Pre.Kcb.tot + load(paste('Fallow.Saved', Croplayer, 'Rdata', sep = '.')); Pre.Few <- Fallow.File[[5]] + + setwd(paste0(Path, '/CropWatR/Data')) + + if (file.exists(paste0(Intermediates, paste("Growing.Season.Rainfed_Transpiration", Croplayer, "Rdata", sep = "."))) == TRUE & Auto == TRUE){ + print(paste("Growing Season has been previously calculated for", Croplayer)) + } + + if (file.exists(paste0(Intermediates, paste("Growing.Season.Rainfed_Transpiration", Croplayer, "Rdata", sep = "."))) == FALSE){ + + Fw.table <- read.csv('Fw.table.csv') + Irr.Eff <- Fw.table$fw[1] # Precip; Sprinkler, Basin, Border + + for (i in 1:length(Precip)){ + + # Irrigated <- c('alfalfa', 'cotton', 'corn', 'spring_barley', 'spring_oats', 'rice', 'soybeans', 'sorghum', 'spring_wheat', 'silage', 'peanuts', 'winter_wheat', 'silage') + # States <- c('4', '5', '6', '8', '16', '20', '28', '30', '31', '32', '35', '38', '40', '41', '46', '48', '49', '53', '56') + # not yet Georgia, Iowa + # if (Croplayer %in% Irrigated && names(Precip[i]) %in% States) irr <- TRUE + # if (!(names(Precip[i]) %in% States)) irr <- FALSE + # if (Croplayer == 'corn' && names(Precip[i]) == '20') irr <- FALSE + + for (j in 1:length(Precip[[i]])){ + + if (j == 1){ # Initialize on first day of GROWING season (So use the FINAL entry of the Pre.Dei values) + ### Fw / Few /Fc calcs must incorporate irrigation and precipitation events + # Fw + # Fw[[i]][,j] <- Pre.Few[[i]][,length(Pre.Few[[i]])] + # Few + Few[[i]][,j] <- pmin.int(Few[[i]][,j], Fw[[i]][,j]) + + # Kr + Kr[[i]][,j][Pre.Dei[[i]][,length(Pre.Dei[[i]])] > REW[[i]]] <- (TEW[[i]][Pre.Dei[[i]][,length(Pre.Dei[[i]])] > REW[[i]]] - Pre.Dei[[i]][,length(Pre.Dei[[i]])][Pre.Dei[[i]][,length(Pre.Dei[[i]])] > REW[[i]]])/(TEW[[i]][Pre.Dei[[i]][,length(Pre.Dei[[i]])] > REW[[i]]] - REW[[i]][Pre.Dei[[i]][,length(Pre.Dei[[i]])] > REW[[i]]]) + Kr[[i]][,j][Pre.Dei[[i]][,length(Pre.Dei[[i]])] <= REW[[i]]] <- 1 + Kr[[i]][,j][Kr[[i]][,j] < 0] <- 0 + # Ke + Ke[[i]][,j] <- pmin.int(Kr[[i]][,j]*(KcMax[[i]][,j] - Kcb.corrected[[i]][,j]), Few[[i]][,j]*KcMax[[i]][,j]) + + # STOP-GAP against negative KeETo values: + Ke[[i]][,j][Ke[[i]][,j] < 0] <- 0 + + # E + E[[i]][,j] <- Ke[[i]][,j]*ETo[[i]][,j] + # DPe + # topsoil percolation: # + DPe[[i]][,j] <- (Precip[[i]][,j]-ROi[[i]][,j]) + (Irr[[i]][,j]/Fw[[i]][,j]) - Pre.Dei[[i]][,length(Pre.Dei[[i]])] + DPe[[i]][,j][DPe[[i]][,j] < 0] <- 0 + # De # + De[[i]][,j] <- Pre.Dei[[i]][,length(Pre.Dei[[i]])] - (Precip[[i]][,j]-ROi[[i]][,j]) + Irr[[i]][,j]/Fw[[i]][,j] + (E[[i]][,j]/Few[[i]][,j]) + DPe[[i]][,j] # Multiply or Divide? + # Limits on De + De[[i]][,j][De[[i]][,j] < 0] <- 0 + De[[i]][,j][De[[i]][,j] > TEW[[i]]] <- TEW[[i]][De[[i]][,j] > TEW[[i]]] + + # Crop evapotranspiration + ETc[[i]][,j] <- (Kcb.corrected[[i]][,j]+Ke[[i]][,j])*ETo[[i]][,j] + + # WATER STRESS CALCS: + # Calculate Daily p values, daily RAW: (equations 81, 82, & 84) + # A numerical approximation for adjusting p for ETc rate is + # p = pTable 22 + 0.04 (5 - ETc) where the adjusted p is limited to 0.1 <= p <= 0.8 and ETc is in mm/day. + # ETc = ETc = (Kcb + Ke) ETo, or, in my calcs: (Transp[[i]][,j] + KeETo[[i]][,j]) + Pval[[i]][,j] <- Zr$p.value + 0.04*(5 - (ETc[[i]][,j])) + Pval[[i]][,j][Pval[[i]][,j] < 0.1] <- 0.1 + Pval[[i]][,j][Pval[[i]][,j] > 0.8] <- 0.8 + ### TAW should change daily; and as a function of (growing) root depth. + if (is.na(Root.depth[[i]][j]/Zr$root_depth)){ + Frac <- Root.depth[[i]][length(Root.depth[[i]])]/Zr$root_depth + } else Frac <- Root.depth[[i]][j]/Zr$root_depth + TAW[[i]][,j] <- TAW.base[[i]]*Frac + + RAW[[i]][,j] <- Pval[[i]][,j]*TAW[[i]][,j] + ### Pre irrigation Dr calc: + ### Root zone depletion (positive values, less than TAW) + ## ignoring capillary rise + Dr[[i]][,j] <- Pre.Dr[[i]][,length(Pre.Dr[[i]])] - (Precip[[i]][,j]-ROi[[i]][,j]) - Irr[[i]][,j] + ETc[[i]][,j] + Pre.DP[[i]][,length(Pre.DP[[i]])] + # Limits on Dr: + Dr[[i]][,j][Dr[[i]][,j] < 0] <- 0 + Dr[[i]][,j][Dr[[i]][,j] > TAW[[i]][,j]] <- TAW[[i]][,j][Dr[[i]][,j] > TAW[[i]][,j]] + + # Dr[[i]][,j] <- Pre.Dr[[i]][,length(Pre.Dr[[i]])] - (Precip[[i]][,j]-ROi[[i]][,j]) - Irr[[i]][,j] + ETc[[i]][,j] + Pre.DP[[i]][,length(Pre.DP[[i]])] + # Limits on Dr: + # Dr[[i]][,j][Dr[[i]][,j] < 0] <- 0 + # Dr[[i]][,j][Dr[[i]][,j] > TAW[[i]][,j]] <- TAW[[i]][,j][Dr[[i]][,j] > TAW[[i]][,j]] + + # Adjusted transpiration component: (equation 80) + Ks[[i]][,j][Dr[[i]][,j] > RAW[[i]][,j]] <- ((TAW[[i]][,j]-Dr[[i]][,j])[Dr[[i]][,j] > RAW[[i]][,j]]) / ((1 - Pval[[i]][,j][Dr[[i]][,j] > RAW[[i]][,j]])*TAW[[i]][,j][Dr[[i]][,j] > RAW[[i]][,j]]) + Ks[[i]][,j][Dr[[i]][,j] <= RAW[[i]][,j]] <- 1 + + + ### Soil water balance for the root zone (equation 85) + DP[[i]][,j] <- (Precip[[i]][,j]-ROi[[i]][,j]) + Irr[[i]][,j] - ETc[[i]][,j] - Pre.Dr[[i]][,length(Pre.Dr[[i]])] + # As long as the soil water content in the root zone is below field capacity (i.e., Dr, i > 0), the soil will not drain and DPi = 0. + DP [[i]][,j][Dr[[i]][,j] > 0] <- 0 + DP [[i]][,j][DP[[i]][,j] < 0] <- 0 + + Transp[[i]][,j] <- (Ks[[i]][,j]*Kcb.corrected[[i]][,j]+Ke[[i]][,j])*ETo[[i]][,j] + Transp.final[[i]][,j] <- (Ks[[i]][,j]*Kcb.corrected[[i]][,j])*ETo[[i]][,j] + # Perhaps recalculate with new Trans.final? + + # DPe + # topsoil percolation: # + DPe[[i]][,j] <- (Precip[[i]][,j]-ROi[[i]][,j]) + (Irr[[i]][,j]/Fw[[i]][,j]) - Pre.Dei[[i]][,length(Pre.Dei[[i]])] + DPe[[i]][,j][DPe[[i]][,j] < 0] <- 0 + # De # + De[[i]][,j] <- Pre.Dei[[i]][,length(Pre.Dei[[i]])] - (Precip[[i]][,j]-ROi[[i]][,j]) + Irr[[i]][,j]/Fw[[i]][,j] + (E[[i]][,j]/Few[[i]][,j]) + DPe[[i]][,j] # Multiply or Divide? + # Limits on De + De[[i]][,j][De[[i]][,j] < 0] <- 0 + De[[i]][,j][De[[i]][,j] > TEW[[i]]] <- TEW[[i]][De[[i]][,j] > TEW[[i]]] + + } + + else { # all other days of the growing season + + # Fw + Fw[[i]][,j] <- Fw[[i]][,(j-1)] + # Few + Few[[i]][,j] <- pmin.int(Few[[i]][,j], Fw[[i]][,j]) + + # Kr + Kr[[i]][,j][De[[i]][,(j-1)] > REW[[i]]] <- (TEW[[i]][De[[i]][,(j-1)] > REW[[i]]] - De[[i]][,(j-1)][De[[i]][,(j-1)] > REW[[i]]])/(TEW[[i]][De[[i]][,(j-1)] > REW[[i]]] - REW[[i]][De[[i]][,(j-1)] > REW[[i]]]) + Kr[[i]][,j][De[[i]][,(j-1)] <= REW[[i]]] <- 1 + Kr[[i]][,j][Kr[[i]][,j] < 0] <- 0 + + # Ke + Ke[[i]][,j] <- pmin.int(Kr[[i]][,j]*(KcMax[[i]][,j] - Kcb.corrected[[i]][,j]), Few[[i]][,j]*KcMax[[i]][,j]) + # Stop-gap against negative Ke values + Ke[[i]][,j][Ke[[i]][,j] < 0] <- 0 + + # E + ETo[[i]] + E[[i]][,j] <- Ke[[i]][,j]*ETo[[i]][,j] + + # if (length(E[[i]][,j][E[[i]][,j] > 5]) > 0){ + # print('Evaporation triggered:') + # print('day col:') + # print(j) + # print('State code') + # print(names(Precip[i])) + # print('Evap profile') + # print(E[[i]][,j][E[[i]][,j] > 5]) + # print('ETo profile') + # print(ETo[[i]][,j][E[[i]][,j] > 5]) + # print('Ke profile') + # print(Ke[[i]][,j][E[[i]][,j] > 5]) + # } + + # DPe + # topsoil percolation: # + DPe[[i]][,j] <- (Precip[[i]][,j]-ROi[[i]][,j]) + (Irr[[i]][,j]/Fw[[i]][,j]) - De[[i]][,j-1] + DPe[[i]][,j][DPe[[i]][,j] < 0] <- 0 + # De # + De[[i]][,j] <- De[[i]][,j-1] - (Precip[[i]][,j]-ROi[[i]][,j]) + Irr[[i]][,j]/Fw[[i]][,j] + (E[[i]][,j]/Few[[i]][,j]) + DPe[[i]][,j] # Multiply or Divide? + # Limits on De + De[[i]][,j][De[[i]][,j] < 0] <- 0 + De[[i]][,j][De[[i]][,j] > TEW[[i]]] <- TEW[[i]][De[[i]][,j] > TEW[[i]]] + + # Crop evapotranspiration + ETc[[i]][,j] <- (Kcb.corrected[[i]][,j]+Ke[[i]][,j])*ETo[[i]][,j] + + # WATER STRESS CALCS: + # Calculate Daily p values, daily RAW: (equations 81, 82, & 84) + # A numerical approximation for adjusting p for ETc rate is + # p = pTable 22 + 0.04 (5 - ETc) where the adjusted p is limited to 0.1 <= p <= 0.8 and ETc is in mm/day. + # ETc = ETc = (Kcb + Ke) ETo, or, in my calcs: (Transp[[i]][,j] + KeETo[[i]][,j]) + Pval[[i]][,j] <- Zr$p.value + 0.04*(5 - (ETc[[i]][,j])) + Pval[[i]][,j][Pval[[i]][,j] < 0.1] <- 0.1 + Pval[[i]][,j][Pval[[i]][,j] > 0.8] <- 0.8 + ### TAW should change daily; and as a function of (growing) root depth. + if (is.na(Root.depth[[i]][j]/Zr$root_depth)){ + Frac <- Root.depth[[i]][length(Root.depth[[i]])]/Zr$root_depth + } else Frac <- Root.depth[[i]][j]/Zr$root_depth + TAW[[i]][,j] <- TAW.base[[i]]*Frac + + RAW[[i]][,j] <- Pval[[i]][,j]*TAW[[i]][,j] + ### Pre irrigation Dr calc: + ### Root zone depletion (positive values, less than TAW) + ## ignoring capillary rise + Dr[[i]][,j] <- Dr[[i]][,j-1] - (Precip[[i]][,j]-ROi[[i]][,j]) - Irr[[i]][,j] + ETc[[i]][,j] + DP[[i]][,j-1] + # Limits on Dr: + Dr[[i]][,j][Dr[[i]][,j] < 0] <- 0 + Dr[[i]][,j][Dr[[i]][,j] > TAW[[i]][,j]] <- TAW[[i]][,j][Dr[[i]][,j] > TAW[[i]][,j]] + + ### Post irrigation Dr calc: + Dr[[i]][,j] <- Dr[[i]][,j-1] - (Precip[[i]][,j]-ROi[[i]][,j]) - Irr[[i]][,j] + ETc[[i]][,j] + DP[[i]][,j-1] + + # Limits on Dr: + Dr[[i]][,j][Dr[[i]][,j] < 0] <- 0 + Dr[[i]][,j][Dr[[i]][,j] > TAW[[i]][,j]] <- TAW[[i]][,j][Dr[[i]][,j] > TAW[[i]][,j]] + + # Adjusted transpiration component: (equation 80) + Ks[[i]][,j][Dr[[i]][,j] > RAW[[i]][,j]] <- ((TAW[[i]][,j]-Dr[[i]][,j])[Dr[[i]][,j] > RAW[[i]][,j]]) / ((1 - Pval[[i]][,j][Dr[[i]][,j] > RAW[[i]][,j]])*TAW[[i]][,j][Dr[[i]][,j] > RAW[[i]][,j]]) + Ks[[i]][,j][Dr[[i]][,j] <= RAW[[i]][,j]] <- 1 + + + ### Soil water balance for the root zone (equation 85) + DP[[i]][,j] <- (Precip[[i]][,j]-ROi[[i]][,j]) + Irr[[i]][,j] - ETc[[i]][,j] - Dr[[i]][,j-1] + # As long as the soil water content in the root zone is below field capacity (i.e., Dr, i > 0), the soil will not drain and DPi = 0. + DP [[i]][,j][Dr[[i]][,j] > 0] <- 0 + DP [[i]][,j][DP[[i]][,j] < 0] <- 0 + + Transp[[i]][,j] <- (Ks[[i]][,j]*Kcb.corrected[[i]][,j]+Ke[[i]][,j])*ETo[[i]][,j] + Transp.final[[i]][,j] <- (Ks[[i]][,j]*Kcb.corrected[[i]][,j])*ETo[[i]][,j] + # all.equal(Transp.final[[i]][,j], ETc[[i]][,j]) + # Perhaps recalculate with new Trans.final? + + # if (length(Transp.final[[i]][,j][Transp.final[[i]][,j] > 15]) > 0){ + # print('Transp.final triggered:') + # print('day col:') + # print(j) + # print('State code') + # print(names(Precip[i])) + # # print('ET profile') + # # print(Transp.final[[i]][,j][Transp.final[[i]][,j] > 15]) + # # print('ETo profile') + # # print(ETo[[i]][,j][Transp.final[[i]][,j] > 15]) + # # print('two days before ETo profile') + # # print(ETo[[i]][,j-2][Transp.final[[i]][,j] > 15]) + # # print(ETo[[i]][,j-1][Transp.final[[i]][,j] > 15]) + # # print('two days after ETo profile') + # # print(ETo[[i]][,j+1][Transp.final[[i]][,j] > 15]) + # # print(ETo[[i]][,j+2][Transp.final[[i]][,j] > 15]) + # # print('Ke profile') + # # print(Ke[[i]][,j][Transp.final[[i]][,j] > 15]) + # } + # + + # DPe + # topsoil percolation: # + DPe[[i]][,j] <- (Precip[[i]][,j]-ROi[[i]][,j]) + (Irr[[i]][,j]/Fw[[i]][,j]) - De[[i]][,j-1] + DPe[[i]][,j][DPe[[i]][,j] < 0] <- 0 + # De # + De[[i]][,j] <- De[[i]][,j-1] - (Precip[[i]][,j]-ROi[[i]][,j]) + Irr[[i]][,j]/Fw[[i]][,j] + (E[[i]][,j]/Few[[i]][,j]) + DPe[[i]][,j] # Multiply or Divide? + # Limits on De + De[[i]][,j][De[[i]][,j] < 0] <- 0 + De[[i]][,j][De[[i]][,j] > TEW[[i]]] <- TEW[[i]][De[[i]][,j] > TEW[[i]]] + + # sapply(Pval, function(x) length(x[x < 0])/length(x)) + # sapply(DPei, function(x) length(x[x < 0])/length(x[is.numeric(x)])) + # sapply(Dei, function(x) length(x[x < 0])/length(x[x < 100000])) + } + } + + + Few[[i]][,1] <- Few[[i]][,2] + Kr[[i]][,1] <- Kr[[i]][,2] + Ke[[i]][,1] <- Ke[[i]][,2] + E[[i]][,1] <- E[[i]][,2] + DPe[[i]][,1] <- DPe[[i]][,2] + De[[i]][,1] <- De[[i]][,2] + ETc[[i]][,1] <- ETc[[i]][,2] + Pval[[i]][,1] <- Pval[[i]][,2] + TAW[[i]][,1] <- TAW[[i]][,2] + RAW[[i]][,1] <- RAW[[i]][,2] + Dr[[i]][,1] <- Dr[[i]][,2] + Dr[[i]][,1] <- Dr[[i]][,2] + Ks[[i]][,1] <- Ks[[i]][,2] + DP[[i]][,1] <- DP[[i]][,2] + Transp[[i]][,1] <- Transp[[i]][,2] + Transp.final[[i]][,1] <- Transp.final[[i]][,2] + + } + } + + print('Saving rainfed growing season SB files') + + setwd(paste0(Path, '/CropWatR/Intermediates/')) + + save(Few, file = paste('Growing.Season.Rainfed_Root.Zone.Depletion', Croplayer, 'Rdata', sep = '.')) # Few + save(Kr, file = paste('Growing.Season.Rainfed_Kr', Croplayer, 'Rdata', sep = '.')) + save(Ks, file = paste('Growing.Season.Rainfed_Ks', Croplayer, 'Rdata', sep = '.')) + save(Pval, file = paste('Growing.Season.Rainfed_Pval', Croplayer, 'Rdata', sep = '.')) + + save(Dr, file = paste('Growing.Season.Rainfed_Root.Zone.Depletion', Croplayer, 'Rdata', sep = '.')) #Dr + save(De, file = paste('Growing.Season.Rainfed_Soil.Water.Balance', Croplayer, 'Rdata', sep = '.')) + save(DP, file = paste('Growing.Season.Rainfed_Deep.Percolation', Croplayer, 'Rdata', sep = '.')) + save(ROi, file = paste('Growing.Season.Rainfed_Runoff', Croplayer, 'Rdata', sep = '.')) + save(E, file = paste('Growing.Season.Rainfed_Soil.Evaporation', Croplayer, 'Rdata', sep = '.')) + save(Transp.final, file = paste('Growing.Season.Rainfed_Transpiration', Croplayer, 'Rdata', sep = '.')) + save(DPe, file = paste('Growing.Season.Rainfed.Root.Zone.Percolation.Loss', Croplayer, 'Rdata', sep = '.')) # DPe + save(Few, file = paste('Growing.Season.Rainfed.Evaporation.Fractions', Croplayer, 'Rdata', sep = '.')) # Few + + setwd(paste0(Path, '/CropWatR/Data')) + + print('Calculation of Growing Season daily soil water balance, deep percolation, and evaporation complete') + print('Growing Season initial run complete, on to post season') +} diff --git a/R/Percent.Change.Perspective.Plot.R b/R/Percent.Change.Perspective.Plot.R new file mode 100644 index 0000000..2666f2c --- /dev/null +++ b/R/Percent.Change.Perspective.Plot.R @@ -0,0 +1,57 @@ +Percent.Change.Perspective.Plot <- +function(Raster, Country, ColorScheme = list('terrain', 'heat', 'topo', 'cm'), Save = TRUE){ + # Plots a pretty overhead of the population count/density + # ColorSchemes are terrain, heat, topo, cm + Pop3D <- Raster + # summary.pop <- summary(Pop) + + zData <-round(as.matrix(Pop3D),1) + # zData <- zData[c(50:540), c(50:300)] + x <- 1:nrow(zData) + y <- 1:ncol(zData) + + # z <- getValues(Pop, 1:ncell(Pop)) + + nrz <- nrow(zData) + ncz <- ncol(zData) + + if (Save == FALSE) quartz(width = 12, height = 9) + # if (Save == TRUE && log == TRUE) png(filename = paste(Country, ColorScheme, Log, 'png', sep = '.'), width = round(ncz*0.7), height = round(nrz*0.35), bg = 'white') + # if (Save == TRUE && log == FALSE) png(filename = paste(Country, ColorScheme, Log, 'png', sep = '.'), width = round(ncz*0.4), height = round(nrz*0.35), bg = 'white') + DissDir <- '/Users/jacobteter/Desktop/Dissertation/' + + + png(filename = paste0(DissDir, paste(Country, ColorScheme, 'png', sep = '.')), width = 1400, height = 600, bg = 'white') + + par(bg = "transparent", mar = c(4,0,0,0), mai = c(0.1, 0.1,0.5,0.1)) + # Create a function interpolating colors in the range of specified colors + # jet.colors <- colorRampPalette( c("transparent", "green") ) + # Generate the desired number of colors from this palette + nbcol <- 99 + + + Start <- -1*max(abs(cellStats(Pop3D, max)), abs(cellStats(Pop3D, min))) + End <- 1*max(abs(cellStats(Pop3D, max)), abs(cellStats(Pop3D, min))) + + if (ColorScheme == 'heat') Pal <- rev(heat.colors(nbcol))[20:120] + if (ColorScheme == 'terrain') Pal <- terrain.colors(nbcol) # , start = 0, end = 1) + if (ColorScheme == 'rainbow') Pal <- rainbow(nbcol) # , start = 0, end = 1) + # plot( d, col=rev( rainbow( 99, start=0,end=1 ) ), breaks=seq(min(minValue( d )),max(maxValue(d)),length.out=100) ) + + if (ColorScheme == 'topo') Pal <- topo.colors(nbcol) + if (ColorScheme == 'cm') Pal <- cm.colors(nbcol) + if (ColorScheme == 'GreenToRed') Pal <- rev(brewer.pal(nbcol, 'RdBu')) + + color <- c("transparent", Pal) # look into heat.colors, topo.colors, etc. + # Compute the z-value at the facet centres + zfacet <- zData[-1, -1] + zData[-1, -ncz] + zData[-nrz, -1] + zData[-nrz, -ncz] + # Recode facet z-values into color indices + facetcol <- cut(zfacet, nbcol+1) + # persp(x, y, z, col = color[facetcol], phi = 30, theta = -30) + persp(x, y, z = zData, theta = 90, phi = 30, + col = color[facetcol], + scale = FALSE, expand = 0.75, + ltheta = 75, shade = 0.05, border = NA, + box = F, ticktype = "detailed") + if (Save == TRUE) dev.off() +} diff --git a/R/Perspective.Boundaries.R b/R/Perspective.Boundaries.R new file mode 100644 index 0000000..ab515ed --- /dev/null +++ b/R/Perspective.Boundaries.R @@ -0,0 +1,48 @@ +Perspective.Boundaries <- +function(Raster, Country, Save = TRUE){ + # Plots a pretty overhead of the population count/density + # ColorSchemes are terrain, heat, topo, cm + Pop3D <- Raster + # summary.pop <- summary(Pop) + Pop3D[is.na(Pop3D)] <- 0 + + zData <-round(as.matrix(Pop3D),1) + # zData <- zData[c(50:540), c(50:300)] + x <- 1:nrow(zData) + y <- 1:ncol(zData) + + # z <- getValues(Pop, 1:ncell(Pop)) + + nrz <- nrow(zData) + ncz <- ncol(zData) + + if (Save == FALSE) quartz(width = 12, height = 9) + # if (Save == TRUE && log == TRUE) png(filename = paste(Country, ColorScheme, Log, 'png', sep = '.'), width = round(ncz*0.7), height = round(nrz*0.35), bg = 'white') + # if (Save == TRUE && log == FALSE) png(filename = paste(Country, ColorScheme, Log, 'png', sep = '.'), width = round(ncz*0.4), height = round(nrz*0.35), bg = 'white') + png(filename = paste(Country, 'border.png', sep = '.'), width = 1400, height = 600, bg = 'white') + + par(bg = "transparent", mar = c(4,0,0,0), mai = c(0.1, 0.1,0.5,0.1)) + # Create a function interpolating colors in the range of specified colors + # jet.colors <- colorRampPalette( c("transparent", "green") ) + # Generate the desired number of colors from this palette + nbcol <- 2 + # if (ColorScheme == 'heat') Pal <- heat.colors(nbcol) + # if (ColorScheme == 'terrain') Pal <- terrain.colors(nbcol) + # if (ColorScheme == 'topo') Pal <- topo.colors(nbcol) + # if (ColorScheme == 'cm') Pal <- cm.colors(nbcol) + + color <- c("transparent", "black") # look into heat.colors, topo.colors, etc. + # Compute the z-value at the facet centres + zfacet <- zData[-1, -1] + zData[-1, -ncz] + zData[-nrz, -1] + zData[-nrz, -ncz] + # Recode facet z-values into color indices + facetcol <- cut(zfacet, nbcol+1) + # persp(x, y, z, col = color[facetcol], phi = 30, theta = -30) + persp(x, y, z = zData, theta = 90, phi = 30, + col = color[facetcol], + scale = FALSE, expand = 0.75, + ltheta = 75, shade = 0.05, border = NA, + box = F, ticktype = "detailed") + # Scale <- gsub(".", " ", Log, fixed = TRUE) + # title(paste(Country, 'Population\n', Scale)) + if (Save == TRUE) dev.off() +} diff --git a/R/Perspective.Plot.R b/R/Perspective.Plot.R new file mode 100644 index 0000000..096f24d --- /dev/null +++ b/R/Perspective.Plot.R @@ -0,0 +1,74 @@ +Perspective.Plot <- +function(Raster, Country, ColorScheme = list('terrain', 'heat', 'topo', 'cm'), log = TRUE, Save = TRUE){ + # Plots a pretty overhead of the population count/density + # ColorSchemes are terrain, heat, topo, cm + Pop <- Raster + # summary.pop <- summary(Pop) + if (log == TRUE){ + Log <- 'log.scale' + setBasePop <- function(x) { + # x[is.na(x)] <- 0 + # x[x <= 1] <- 0 + # x[x > 1] <- log2(x) + x[x > 0] <- x[x > 0]+1 + x[x <= 0] <- NA + x[x > 0] <- log2(x) + return(x) + } + } + + if (log == FALSE){ + Log <- 'linear.scale' + + setBasePop <- function(x) { + x[x <= 0] <- NA + # x[x < 800] <- NA # x[!is.na(x)] <- x[!is.na(x)]-780 + x[x > 0] <- x[x > 0]*0.001+0.1 + return(x) + } + } + + Pop3D <- calc(Pop, setBasePop) + Pop3D[is.na(Pop3D)] <- 0 + + zData <-round(as.matrix(Pop3D),1) + # zData <- zData[c(50:540), c(50:300)] + x <- 1:nrow(zData) + y <- 1:ncol(zData) + + # z <- getValues(Pop, 1:ncell(Pop)) + + nrz <- nrow(zData) + ncz <- ncol(zData) + + if (Save == FALSE) quartz(width = 12, height = 9) + # if (Save == TRUE && log == TRUE) png(filename = paste(Country, ColorScheme, Log, 'png', sep = '.'), width = round(ncz*0.7), height = round(nrz*0.35), bg = 'white') + # if (Save == TRUE && log == FALSE) png(filename = paste(Country, ColorScheme, Log, 'png', sep = '.'), width = round(ncz*0.4), height = round(nrz*0.35), bg = 'white') + DissDir <- '/Users/jacobteter/Desktop/Dissertation/' + + png(filename = paste0(DissDir, paste(Country, ColorScheme, Log, 'png', sep = '.')), width = 1400, height = 600, bg = 'white') + + par(bg = "transparent", mar = c(4,0,0,0), mai = c(0.1, 0.1,0.5,0.1)) + # Create a function interpolating colors in the range of specified colors + # jet.colors <- colorRampPalette( c("transparent", "green") ) + # Generate the desired number of colors from this palette + nbcol <- 120 + if (ColorScheme == 'heat') Pal <- rev(heat.colors(nbcol))[20:120] + if (ColorScheme == 'terrain') Pal <- terrain.colors(nbcol) + if (ColorScheme == 'topo') Pal <- topo.colors(nbcol) + if (ColorScheme == 'cm') Pal <- cm.colors(nbcol) + + color <- c("transparent", Pal) # look into heat.colors, topo.colors, etc. + # Compute the z-value at the facet centres + zfacet <- zData[-1, -1] + zData[-1, -ncz] + zData[-nrz, -1] + zData[-nrz, -ncz] + # Recode facet z-values into color indices + facetcol <- cut(zfacet, nbcol+1) + # persp(x, y, z, col = color[facetcol], phi = 30, theta = -30) + persp(x, y, z = zData, theta = 90, phi = 30, + col = color[facetcol], + scale = FALSE, expand = 0.75, + ltheta = 75, shade = 0.05, border = NA, + box = F, ticktype = "detailed") + Scale <- gsub(".", " ", Log, fixed = TRUE) + if (Save == TRUE) dev.off() +} diff --git a/R/Plot.Base.Land.Use.R b/R/Plot.Base.Land.Use.R new file mode 100644 index 0000000..f287b22 --- /dev/null +++ b/R/Plot.Base.Land.Use.R @@ -0,0 +1,37 @@ +Plot.Base.Land.Use <- +function(Aggregate = FALSE){ + base <- brick('Base.Crops.LU.2008.grd') + if (Aggregate == FALSE) Agg <- '.Sep' + + if (Aggregate == TRUE){ + Sum <- function(x,...) {sum(x, na.rm = TRUE)} + Base <- calc(base, Sum) + Base[Base == 0] <- NA + plot(Base, axes = FALSE, box = FALSE) + base <- Base + Agg <- '.Agg' + } + + Mil.Acres <- round(cellStats(base, sum)/10^6, digits = 2) + Names <- gsub("_", " ", names(base), fixed = TRUE) + + Names <- paste(Names, paste(Mil.Acres, 'million acres', sep = " "), sep = " - ") + Per <- base/24710.5*100 # 24710.5 acres per 100 square kilometers + + Subtitle <- paste0("Percentage of land cropped (million acres cropped total shown for each crop)") + my.ckey <- list(labels = list(cex = 1.25), col=GnYlRdTheme$regions$col, space = "right") + MyScheme <- GnYlRdTheme + Layout <- c(2,7) + + pdf(file = paste0(Intermediates, "RasterVis.rowcrops.Base", Agg, ".pdf"), width = 7, height = 14) + par(mar = c(0.1,0.1,0.1,0.1)) + + p <- levelplot(Per, scales=list(draw=FALSE), contour = FALSE, sub = "", sub.cex = 1.25, par.settings=MyScheme, zscaleLog = 10, colorkey=my.ckey, + layout = Layout, names.attr = Names, main = "", side=1, outer=TRUE, line=1, cex = 1.5) + + p <- p + layer(sp.lines(SL.aeaCRDs, lwd=0.01, col='gray')) + p <- p + layer(sp.lines(SL.aeaStates, lwd=0.05, col='darkgrey')) + # p <- p + layer(sp.lines(SL.aeaHuc2, lwd=0.03, col='black')) + plot(p) + dev.off() +} diff --git a/R/Plot.Check.Variety.Annual.Water.Balances.R b/R/Plot.Check.Variety.Annual.Water.Balances.R new file mode 100644 index 0000000..4e17295 --- /dev/null +++ b/R/Plot.Check.Variety.Annual.Water.Balances.R @@ -0,0 +1,93 @@ +Plot.Check.Variety.Annual.Water.Balances <- +function(Variety){ + if (Variety != 'barley' && Variety != 'oats' && Variety != 'wheat'){ + Irr <- raster(brick(paste0('Base.WBs.2008/Irrigated.mm.', Variety,'.grd')), layer = 5) + } + if (Variety == 'fall_barley' || Variety == 'fall_oats'){ + stop(paste(Variety, "isn't irrigated")) + } + if (Variety == 'spring_wheat' || Variety == 'winter_wheat'){ + SW.Irr <- raster(brick('Base.WBs.2008/Irrigated.mm.spring_wheat.grd'), layer = 5) + WW.Irr <- raster(brick('Base.WBs.2008/Irrigated.mm.winter_wheat.grd'), layer = 5) + Irr <- mosaic(SW.Irr, WW.Irr, fun = mean) + } + + ## Irrigation checks: + # 1 acre millimeter = 0.0032808399 acre foot + Irr <- Irr*0.0032808399 + survey <- read.csv('acre-feet.per.acre.csv') + + Crop <- Variety + if (Variety == 'spring_barley') Crop <- 'barley' + if (Variety == 'spring_oats') Crop <- 'oats' + if (Variety == 'spring_wheat' || Variety == 'winter_wheat') Crop <- 'wheat' + if (Variety == 'silage') Crop <- 'corn' + + aeaStates <- shapefile('aeaStates.shp') + head(aeaStates@data) + + # Robert's spatial merge: + setMethod('merge', signature(x='Spatial', y='data.frame'), function(x, y, by=intersect(names(x), names(y)), by.x=by, by.y=by, all.x=TRUE, suffixes = c(".x",".y"), incomparables = NULL, ...) { + if (!'data' %in% slotNames(x)) { + stop('x has no data.frame') + } + d <- x@data + d$donotusethisvariablename976 <- 1:nrow(d) + + y <- unique(y) + i <- apply(y[, by.y, drop=FALSE], 1, paste) %in% apply(x@data[, by.x, drop=FALSE], 1, paste) + y <- y[i, ,drop=FALSE] + if (isTRUE(any(table(y[, by.y]) > 1))) { + stop("'y' has multiple records for one or more 'by.y' key(s)") + } + + if (!all.x) { + y$donotusethisvariablename679 <- 1 + } + + d <- merge(d, y, by=by, by.x=by.x, by.y=by.y, suffixes=suffixes, incomparables=incomparables, all.x=TRUE, all.y=FALSE) + d <- d[order(d$donotusethisvariablename976), ] + d$donotusethisvariablename976 <- NULL + rownames(d) <- row.names(x) + x@data <- d + + if (! all.x ) { + x <- x[!is.na(x@data$donotusethisvariablename679), ,drop=FALSE] + x@data$donotusethisvariablename679 <- NULL + } + x + } + ) + + Surveyed <- survey[,c(1, which(names(survey) == Crop))] + aeaStates <- merge(aeaStates, Surveyed, by.x = 'ATLAS_NAME', by.y = 'State') + + MeanModelled <- extract(Irr, aeaStates, fun = function(x) mean(x, na.rm = TRUE)) + aeaStates$Modelled <- round(MeanModelled, digits = 1) + aeaStates$Modelled[is.nan(aeaStates$Modelled)] <- NA + aeaStates@data[,10][is.na(aeaStates$Modelled)] <- NA + + # pdf(file = paste0("Irr.Map.", Variety, ".pdf"), width = 11, height = 7) + par(mar = c(0.2, 0.2, 0.2, 0.2)) + # plot(Irr, axes = FALSE, box = FALSE, col = rev(heat.colors(255)), alpha = 0.75) # , main = paste('\n\nAverage acre-feet per acre, by state, for', Variety, '\nRed values are modelled, Blue are FRIS survey values'), cex.main = 0.85) + plot(Irr, axes = FALSE, box = FALSE, col = rev(heat.colors(255)), alpha = 0.75) + plot(aeaStates, add = TRUE) + text(aeaStates, labels = Crop, cex = 1, col = 'blue', adj = c(0.5, 0)) + text(aeaStates, labels = 'Modelled', cex = 1, col = 'red', pos = 1, adj = c(0, -0.5)) + # dev.off() + + d <- density(na.omit((survey[,(names(survey) == Crop)]))) + f <- density(na.omit(getValues(Irr))) + e <- density(na.omit(MeanModelled)) + # png(paste0(Variety, '_irrigation.png'), width = 900, height = 600) + plot(e, xlim = c(0, 6.2), ylab = '', xlab = '', main = "") # , xlim = c(0, 5), main = paste('Statistical vs. modelled distribution of irrigation for', Variety, "in acre-feet per acre") + mtext('acre-feet per acre', side = 1, line = 2) + polygon(d, col="transparent", border="blue") + polygon(e, col="transparent", border="red2") + # polygon(f, col="transparent", border="green") + + Lbls <- c("State survey", "Modelled State averages") # Lbls <- c("Modelled State averages", "Modelled Full Distribution", "State survey") + colfill<-c('blue', 'red2') # colfill<-c('red', 'red2','blue') + # legend(2.9, 1.1, Lbls, fill=colfill, cex = 1.5) + # dev.off() +} diff --git a/R/RasterVis.Or.Plot.Map.Water.Balances.R b/R/RasterVis.Or.Plot.Map.Water.Balances.R new file mode 100644 index 0000000..5c5fd9d --- /dev/null +++ b/R/RasterVis.Or.Plot.Map.Water.Balances.R @@ -0,0 +1,151 @@ +RasterVis.Or.Plot.Map.Water.Balances <- +function(Crop, mm = FALSE, rainfed = FALSE, type = c('annual', 'seasonal'), Raster.Vis = TRUE, metric = FALSE){ + + if (mm == TRUE) Pat <- 'mm' + if (mm == FALSE) Pat <- 'Total' + if (rainfed == TRUE) Irr <- 'rainfed' + if (rainfed == FALSE) Irr <- 'irrigated' + + Final <- brick(paste0(Intermediates, Pat, '.', type, ".WB.", Irr, ".", Crop,'.grd')) + # Doesn't do BW / GW yet + Final[Final == 0] <- NA + + print('Final stats:') + print(cellStats(Final, summary)) + plot(Final) + names(Final)[which(names(Final) == 'GW.Infiltration')] <- 'Groundwater Infiltration' + + if (mm == FALSE){ + if (metric == FALSE){ + # 1 mm --> 10 m3/ha # 1 cubic meter = 0.000810713194 acre foot + # CONVERSIONS: acres -> hectares; mm -> m3; m3 <- acre-feet + # equivalently: 1 mm x acre == 0.0032808399 acre-foot + Final <- Final*0.0032808399 + Final <- Final/10^3 + Subtitle <- "water balances in thousand acre-feet" + Type <- 'Acre-feet' + } + if (metric == TRUE){ + # 1 mm --> 10 m3/ha # 1 cubic meter = 0.000810713194 acre foot + # CONVERSIONS: acres -> hectares; mm -> m3 + # equivalently: 1 millimeter acre = 0.000404685642 hectare meters + Final <- Final*0.000404685642 + Final <- Final/10^3 + Subtitle <- "water balances in thousand hectare-meters" + Type <- 'Hectare-meters' + } + } + if (mm == TRUE){ + Subtitle <- "Water balances in mm" + Type <- 'mm' + } + + setwd(paste0(Path, '/CropWatR/Intermediates/')) + + if (Raster.Vis == TRUE){ + if (mm == FALSE){ + my.ckey <- list(labels = list(cex = 1.25), col=GnYlRdTheme$regions$col, space = 'left') + Type <- 'Total.WB' + } + if (mm == TRUE){ + my.ckey <- list(labels = list(cex = 1.25), col=GnYlRdTheme$regions$col, space = 'right') + Subtitle <- "water balances in mm" + Type <- 'mm' + } + + ### Individual plots: + + png(filename = paste("Transpiration", Crop, Type, type, Irr, "png", sep = "."),width = 300, height = 200) + par(mai = c(0.1, 0.1, 0.1, 0.1), mar = c(0.1, 0.1, 0.1, 0.1), oma = c(0,0,0,0)) + p <- levelplot(raster(Final, layer = 1), cex = 1.15, border = "transparent", scales=list(draw=FALSE), margin = FALSE, # zscaleLog=TRUE, + contour = FALSE, par.settings=GnYlRdTheme, colorkey=my.ckey) # at=my.at, colorkey=my.ckey, + p <- p + layer(sp.lines(SL.aeaCounties, lwd=0.05, col='gray')) + p <- p + layer(sp.lines(SL.aeaStates, lwd=0.08, col='darkgray')) + p <- p + layer(sp.lines(SL.aeaHuc2, lwd=0.15, col='black')) + plot(p) + dev.off() + + png(filename = paste("Evaporation", Crop, Type, type, Irr, "png", sep = "."),width = 300, height = 200) + par(mai = c(0.1, 0.1, 0.1, 0.1), mar = c(0.1, 0.1, 0.1, 0.1), oma = c(0,0,0,0)) + p <- levelplot(raster(Final, layer = 2), cex = 1.15, border = "transparent", scales=list(draw=FALSE), margin = FALSE, # zscaleLog=TRUE, + contour = FALSE, par.settings=GnYlRdTheme, colorkey=my.ckey) # at=my.at, colorkey=my.ckey, + p <- p + layer(sp.lines(SL.aeaCounties, lwd=0.05, col='gray')) + p <- p + layer(sp.lines(SL.aeaStates, lwd=0.08, col='darkgray')) + p <- p + layer(sp.lines(SL.aeaHuc2, lwd=0.15, col='black')) + plot(p) + dev.off() + + png(filename = paste("Runoff", Crop, Type, type, Irr, "png", sep = "."),width = 300, height = 200) + par(mai = c(0.1, 0.1, 0.1, 0.1), mar = c(0.1, 0.1, 0.1, 0.1), oma = c(0,0,0,0)) + p <- levelplot(raster(Final, layer = 3), cex = 1.15, border = "transparent", scales=list(draw=FALSE), margin = FALSE, # zscaleLog=TRUE, + contour = FALSE, par.settings=GnYlRdTheme, colorkey=my.ckey) # at=my.at, colorkey=my.ckey, + p <- p + layer(sp.lines(SL.aeaCounties, lwd=0.05, col='gray')) + p <- p + layer(sp.lines(SL.aeaStates, lwd=0.08, col='darkgray')) + p <- p + layer(sp.lines(SL.aeaHuc2, lwd=0.15, col='black')) + plot(p) + dev.off() + + png(filename = paste("GW.Infiltration", Crop, Type, type, Irr, "png", sep = "."),width = 300, height = 200) + par(mai = c(0.1, 0.1, 0.1, 0.1), mar = c(0.1, 0.1, 0.1, 0.1), oma = c(0,0,0,0)) + p <- levelplot(raster(Final, layer = 4), cex = 1.15, border = "transparent", scales=list(draw=FALSE), margin = FALSE, # zscaleLog=TRUE, + contour = FALSE, par.settings=GnYlRdTheme, colorkey=my.ckey) # at=my.at, colorkey=my.ckey, + p <- p + layer(sp.lines(SL.aeaCounties, lwd=0.05, col='gray')) + p <- p + layer(sp.lines(SL.aeaStates, lwd=0.08, col='darkgray')) + p <- p + layer(sp.lines(SL.aeaHuc2, lwd=0.15, col='black')) + plot(p) + dev.off() + + if (rainfed == FALSE){ + png(filename = paste("Irrigation", Crop, Type, type, Irr, "png", sep = "."),width = 300, height = 200) + par(mai = c(0.1, 0.1, 0.1, 0.1), mar = c(0.1, 0.1, 0.1, 0.1), oma = c(0,0,0,0)) + p <- levelplot(raster(Final, layer = 5), cex = 1.15, border = "transparent", scales=list(draw=FALSE), margin = FALSE, # zscaleLog=TRUE, + contour = FALSE, par.settings=GnYlRdTheme, colorkey=my.ckey) # at=my.at, colorkey=my.ckey, + p <- p + layer(sp.lines(SL.aeaCounties, lwd=0.05, col='gray')) + p <- p + layer(sp.lines(SL.aeaStates, lwd=0.08, col='darkgray')) + p <- p + layer(sp.lines(SL.aeaHuc2, lwd=0.15, col='black')) + plot(p) + dev.off() + + } + + } + if (Raster.Vis == FALSE){ + aeaHuc2 <- shapefile('aea.HUC2.bounds.shp') + aeaHuc2$REG_NAME <- strsplit(aeaHuc2$REG_NAME, " Region") + + ######### First cut on the total water balance maps: + pdf(filename = paste("BrickPlot", Type, type, Irr, Crop, "pdf"), width = 8, height = 2) + par(mfrow = c(1, 5), mai = c(0, 0.1, 0, 0.8), mar = c(0, 0.1, 0, 5.5)) #, oma = c(0.3,0.1,0.6,0.5)) + + plot(raster(Final, layer = 1), axes = FALSE, box = FALSE, main="Transpiration") + par(bg="transparent") + plot(aeaHuc2, border="black", col="transparent", lwd = 0.25, add=TRUE) + text(aeaHuc2, labels='REG_NAME', col="black", font=2, cex = .70) + + plot(raster(Final, layer = 2), axes = FALSE, box = FALSE, main="Evaporation") + par(bg="transparent") + plot(aeaHuc2, border="black", col="transparent", lwd = 0.25, add=TRUE) + text(aeaHuc2, labels='REG_NAME', col="black", font=2, cex = .70) + + plot(raster(Final, layer = 3), axes = FALSE, box = FALSE, main="Runoff") + par(bg="transparent") + plot(aeaHuc2, border="black", col="transparent", lwd = 0.25, add=TRUE) + text(aeaHuc2, labels='REG_NAME', col="black", font=2, cex = .70) + + plot(raster(Final, layer = 4), axes = FALSE, box = FALSE, main="Groundwater Infiltration") + par(bg="transparent") + plot(aeaHuc2, border="black", col="transparent", lwd = 0.25, add=TRUE) + text(aeaHuc2, labels='REG_NAME', col="black", font=2, cex = .70) + + plot(raster(Final, layer = 5), axes = FALSE, box = FALSE, main="Irrigation") + par(bg="transparent") + plot(aeaHuc2, border="black", col="transparent", lwd = 0.25, add=TRUE) + text(aeaHuc2, labels='REG_NAME', col="black", font=2, cex = .70) + + mtext(Subtitle, side=1, outer=TRUE, line=-3, cex = 1.25) + dev.off() + } + + setwd(paste0(Path, '/CropWatR/Data')) + +} diff --git a/R/Rescale.And.Save.R b/R/Rescale.And.Save.R new file mode 100644 index 0000000..2c66078 --- /dev/null +++ b/R/Rescale.And.Save.R @@ -0,0 +1,40 @@ +Rescale.And.Save <- +function(Variable, PH, DataList, Croplayer, Kcb){ + # Variables: 'Precip_', 'ETo_', 'U2.final_', 'MNRH_') + PH.season.breaks <- subset(PH, select = Initial:Late) + PH[,which(names(PH) == "Initial"):which(names(PH) == "Late")] <- Rescale.Season(PH.season.breaks, PH$Growing_Season) + deleteCols <- c('Crop', 'Total', 'Region', 'Plant_Date') + PH <- PH[,-(which(names(PH) %in% deleteCols))] + + Daily.Crops.list <- Daily.Crop.Curves(Croplayer, PH$State_Fips, PH[,which(names(PH) == "Initial"):which(names(PH) == "Late")], Kcb[,2:4], Kcb[,5]) + + Daily.Crops.list <- Daily.Crops.list[order(names(Daily.Crops.list))] + + Growing.Season <- DataList$Growing.Season + Fallow.Season <- DataList$Fallow.Season + Growing.Season <- Growing.Season[order(names(Growing.Season))] + Fallow.Season <- Fallow.Season[order(names(Fallow.Season))] + + print('names equal?:') + print(all.equal(names(Growing.Season), names(Daily.Crops.list))) + print(all.equal(names(Growing.Season), names(Fallow.Season))) + print('layer lengths equal?: (expect a "no"') + print(all.equal(lapply(Growing.Season, function(x) length(grep('layer', names(x)))), + lapply(Daily.Crops.list, nrow))) + print(cbind(as.numeric(names(Growing.Season)), + sapply(Growing.Season, function(x) length(grep('layer', names(x)))), + sapply(Daily.Crops.list, nrow))) + + #### Correct.Mismatches + for (i in 1:length(Growing.Season)){ + while (length(grep('layer', names(Growing.Season[[i]]))) > nrow(Daily.Crops.list[[i]])){ + Growing.Season[[i]] <- Growing.Season[[i]][,-1] + Fallow.Season[[i]] <- cbind(Growing.Season[[i]][,1], Fallow.Season[[i]]) + } + } + + print('layer lengths equal?:') + print(all.equal(lapply(Growing.Season, function(x) length(grep('layer', names(x)))), lapply(Daily.Crops.list, nrow))) + save(Growing.Season, file = paste0(Intermediates, paste('Growing.Season', Croplayer, Variable, 'Rdata', sep = '.'))) + save(Fallow.Season, file = paste0(Intermediates, paste('Fallow.Season', Croplayer, Variable, 'Rdata', sep = '.'))) +} diff --git a/R/Rescale.Season.R b/R/Rescale.Season.R new file mode 100644 index 0000000..94b57f2 --- /dev/null +++ b/R/Rescale.Season.R @@ -0,0 +1,11 @@ +Rescale.Season <- +function(Stages, Season.length){ + # Given a numeric vector of length four for any given crop with the length (days) of each season, (Stages) + # and a single numeric value of the length of the actual (e.g. state-level) growing season (Season.length) + # this function rescales the initial vector Stages to the actual (survey data) Season.length, and outputs this vector (Rescale) + Season <- rowSums(Stages) + Scalor <- Season.length/Season + Rescale <- c(floor(Stages[,1]*Scalor), ceiling(Stages[,2]*Scalor), floor(Stages[,3]*Scalor), ceiling(Stages[,4]*Scalor)) + Rescale <- matrix(Rescale, ncol = 4) + return(Rescale) +} diff --git a/R/Save.Crops.List.R b/R/Save.Crops.List.R new file mode 100644 index 0000000..f9d1447 --- /dev/null +++ b/R/Save.Crops.List.R @@ -0,0 +1,12 @@ +Save.Crops.List <- +function(PH, Croplayer, Kcb){ + # Variables: 'Precip_', 'ETo_', 'U2.final_', 'MNRH_') + PH.season.breaks <- subset(PH, select = Initial:Late) + PH[,which(names(PH) == "Initial"):which(names(PH) == "Late")] <- Rescale.Season(PH.season.breaks, PH$Growing_Season) + deleteCols <- c('Crop', 'Total', 'Region', 'Plant_Date') + PH <- PH[,-(which(names(PH) %in% deleteCols))] + stages <- PH[,which(names(PH) == "Initial"):which(names(PH) == "Late")] + Daily.Crops.list <- Daily.Crop.Curves(Croplayer, PH$State_Fips, stages, Kcb[,2:4], Kcb[,5]) + Daily.Crops.list <- Daily.Crops.list[order(names(Daily.Crops.list))] + save(Daily.Crops.list, file = paste0(Intermediates, paste('CropsList', Croplayer, 'Rdata', sep = '.'))) +} diff --git a/R/Split.Seasons.R b/R/Split.Seasons.R new file mode 100644 index 0000000..c9d8851 --- /dev/null +++ b/R/Split.Seasons.R @@ -0,0 +1,82 @@ +Split.Seasons <- +function(Crop, Variable, Lat.long, TopSoil, Crop.Layers, PH){ + + if (Variable != 'Precip_') RasterBrick <- brick(paste0(Variable , "2008.grd")) + aea.Loc.IDs <- read.csv('aea.Loc.IDs.csv') + if (Variable == 'Precip_') RasterBrick <- brick('Prism.ppt.10km.aea.grd') + DF <- as.data.frame(getValues(RasterBrick)) # takes some seconds + + DF <- cbind(DF, Lat.long) + DF <- na.omit(DF) + print('BEPAM growing pixels in aea.Loc.IDs:') + print(table(c(DF$x, DF$y) %in% c(aea.Loc.IDs$x, aea.Loc.IDs$y))) + DF <- merge(DF, aea.Loc.IDs, by.x = c('x','y'), by.y = c('x','y'), all = TRUE) + print('BEPAM growing pixels in TopSoil:') + print(table(c(DF$x, DF$y) %in% c(TopSoil$x, TopSoil$y))) + DF <- merge(DF, TopSoil, by.x = c('x','y'), by.y = c('x','y'), all = TRUE) + print(table(DF$STATE_FIPS %in% PH$State_Fips)) + print(unique(DF$State_name[which(!(DF$STATE_FIPS %in% PH$State_Fips))]))# Only [1] DISTRICT_OF_COLUMBIA left to deal with + DF <- merge(DF, PH, by.x = 'STATE_FIPS', by.y = 'State_Fips', all.x = TRUE) + + print(unique(DF$State_name[which(!(DF$STATE_FIPS %in% Crop.Layers$STATE_FIPS))])) + Droppers <- c("CountyFIPS", "HUC2", "Abbreviation", "State_name", "Ers.region", "CRD") # Add PH dates for missing states, by crop. + Crop.Layers <- Crop.Layers[,-which(names(Crop.Layers) %in% Droppers)] + + DF <- merge(DF, Crop.Layers, by.x = c('x','y', 'STATE_FIPS'), by.y = c('x','y', 'STATE_FIPS'), all.x = TRUE) + DF <- cbind(DF[4:ncol(DF)], DF[,1:3]) # ordering matters: put the days of the year up front. + DF <- DF[!is.na(DF$Planting.Main),] + DF <- DF[!is.na(DF$Harvesting.Main),] + DF <- DF[!is.na(DF$STATE_FIPS),] + + DF <- DF[!is.na(DF$layer.1),] + + DF$STATE_FIPS <- as.factor(DF$STATE_FIPS) + if (Variable == 'MNRH_'){ + DF2 <- DF + save(DF2, file = paste0(Intermediates, paste("BASE", Crop, Variable, 'MasterDF2', sep = '.'))) + } + + OverWinter <- max(DF$Harvesting.Main) + if (OverWinter > 365){ + DF <- as.data.frame(cbind(DF[,1:365], DF[,1:length(DF)])) + names(DF)[366:730] <- paste0(rep('layer.'), 366:730) + } + + Split.DF <- split(DF, DF$STATE_FIPS, drop = FALSE) + print('number of states growing crop:') + print(length(Split.DF)) + if (Crop != 'sugarcane' & Crop != 'switchgrass' & Crop != 'miscanthus' & Crop != 'idle_cropland' & Crop != 'pasture_grass' & Crop != 'rep_cropland'){ + Split.DF <- lapply(Split.DF, drop.levels) + } + Growing.Season <- lapply(Split.DF, function(x) x[,c(x$Planting.Main[1]:x$Harvesting.Main[1], # Growing Season + (which(names(x) == 'CountyFIPS')):(which(names(x) == 'STATE_FIPS')))]) # ID locational constants + Fallow.Season <- lapply(Split.DF, function(x) x[,c(1:(x$Planting.Main[1]-1),(x$Harvesting.Main[1]+1):ncol(x))]) # Fallow Season, plus ID locational constants + if (OverWinter > 365){ + GS.dates <- lapply(Growing.Season, function(x) names(x[grep('layer', names(x))])) + GS.dates <- lapply(GS.dates, function(x) as.numeric(substr(x, 7, 9))) + GS.dates.1 <- lapply(GS.dates, function(x) paste0('layer.', x-365)) + GS.dates.2 <- lapply(GS.dates, function(x) paste0('layer.', x+365)) + Dups <- c(paste0('layer.', 365:730)) + # there "should be" a good mapply or double lapply way to do this: + # Fallow.Season <- lapply(Fallow.Season, function(x) x[,-c(names(x) %in% lapply(GS.dates.2, function(x) x))]) + + for (i in 1:length(Fallow.Season)){ + Fallow.Season[[i]] <- Fallow.Season[[i]][,-(which(names(Fallow.Season[[i]]) %in% Dups))] + FS.check <- ncol(Fallow.Season[[i]][,grep('layer', names(Fallow.Season[[i]]))]) + ncol(Growing.Season[[i]][,grep('layer', names(Growing.Season[[i]]))]) + + if (FS.check > 365){ + Fallow.Season[[i]] <- Fallow.Season[[i]][,-(which(names(Fallow.Season[[i]]) %in% GS.dates.1[[i]]))] + } + } + + } + + GS.length <- unlist(lapply(Growing.Season, function(x) length(x[grep('layer', names(x))]))) + FS.length <- unlist(lapply(Fallow.Season, function(x) length(x[grep('layer', names(x))]))) + + print(GS.length + FS.length) + + DF <- list("Variable" = Variable, "Growing.Season" = Growing.Season, "Fallow.Season" = Fallow.Season) + save(DF, file = paste0(Intermediates, paste("Base", Crop, Variable, 'MasterDF', sep = '.'))) + return(DF) +} diff --git a/R/Subset.Growth.Season.R b/R/Subset.Growth.Season.R new file mode 100644 index 0000000..86d9042 --- /dev/null +++ b/R/Subset.Growth.Season.R @@ -0,0 +1,135 @@ +Subset.Growth.Season <- +function(RowCrop, energycrops = FALSE){ + # INPUTS are Year(s) and crop of interest (from Crops.key$Crops) + # FOUR Outputs: (Saved as labelled lists) + # A List of state-by-state growing season (1. Daily ETo, and 2. Daily Precip), each merged to Crop, soil, and locational data, and; + # A List of state-by-state FALLOW season (1. Daily ETo, and 2. Daily Precip), each merged to Crop, soil, and locational data. + + #### Read Files + Growth_stages <- read.csv('Growth_stages.csv') # Added draft Miscan and Switchgrass Growth_stages + Growth_stages$Region <- as.character(Growth_stages$Region) + Kcb <- read.csv('Kcb_values.csv')# ; str(Kcb) # levels(Kcb$Crop) + Lat.long <- read.csv('lat.long.vals.csv') + TopSoil <- read.csv('TopSoil.csv') + + CROP <- RowCrop + if (RowCrop == 'fall_oats' | RowCrop == 'spring_oats') CROP <- 'oats' + if (RowCrop == 'spring_barley' | RowCrop == 'fall_barley') CROP <- 'barley' + if (RowCrop == 'silage' || RowCrop == 'corn') CROP <- 'corn' + + Base.2008.CDL <- read.csv('CDL.main.crops.2008.base.csv'); load('Vars.RData') + Rm.Vars <- Vars[-grep(CROP, Vars)] + Base.CDL.crop <- Base.2008.CDL[,c(!(names(Base.2008.CDL) %in% Rm.Vars))] + + ##### Subset Planting & Harvesting Dates ##### + PH <- read.csv('Planting_harvesting_dates_final.csv') + PH <- subset(PH, Crop == RowCrop, select = c(2, 13:15, 17), drop = TRUE) # selects keep data from PH data.frame. + + Stages <- Growth_stages[grep(CROP, Growth_stages$Crop),] + if (RowCrop == 'spring_wheat' | RowCrop == 'spring_barley' | RowCrop == 'spring_oats' | RowCrop == 'durum_wheat'){ + Stages <- Growth_stages[Growth_stages$Crop == 'barley_oats_wheat',] + PH <- cbind(PH, Stages[Stages$Plant_Date == 'November' ,]) + } + + if (RowCrop == 'fall_barley' | RowCrop == 'fall_oats'){ + Stages <- Growth_stages[Growth_stages$Crop == 'barley_oats_wheat_fall',] + PH <- cbind(PH, Stages[Stages$Plant_Date == 'Nov' ,]) + } + + if (RowCrop == 'winter_wheat'){ ## WINTER_WHEAT has 2 options: CA & ID + PH1 <- cbind(PH[(PH$Growing_Season <= 270),], Stages[Stages$Plant_Date == 'December',]) + PH2 <- cbind(PH[(PH$Growing_Season > 270),], Stages[Stages$Plant_Date == 'October',]) + PH <- rbind(PH1, PH2) + } + + if (RowCrop == 'sugarcane'){ + PH <- cbind(PH, Stages[Stages$Crop == 'sugarcane_ratoon',]) + } + + if (RowCrop == 'sugarbeets'){ + PH <- cbind(PH, Stages[Stages$Region == 'ID',]) + } + if (RowCrop == 'alfalfa'){ + PH1 <- cbind(PH[(PH$Growing_Season <= 290),], Stages[(Stages$Crop == "alfalfa_1st_cutting_cycle") & (Stages$Region == "CA"), ]) + PH2 <- cbind(PH[(PH$Growing_Season > 290),], Stages[(Stages$Crop == "alfalfa_1st_cutting_cycle") & (Stages$Region == "ID"), ]) + PH <- rbind(PH1, PH2) + } + + if (RowCrop == 'corn' | RowCrop =='silage'){ + PH1 <- cbind(PH[(PH$Growing_Season <= 146),], Stages[(Stages$Total ==140),]) + PH2 <- cbind(PH[((PH$Growing_Season > 146) & (PH$Growing_Season <= 155)),], Stages[(Stages$Total == 155),]) + PH3 <- cbind(PH[(PH$Growing_Season > 155),], Stages[(Stages$Total == 170),]) + PH <- rbind(PH1, PH2, PH3) + } + + if (RowCrop == 'cotton'){ + PH1 <- cbind(PH[(PH$Growing_Season <= 180),], Stages[(Stages$Total == 180),]) + PH2 <- cbind(PH[(PH$Growing_Season > 180),], Stages[(Stages$Total == 225),]) + PH <- rbind(PH1, PH2) + } + + if (RowCrop == 'sorghum'){ + PH1 <- cbind(PH[(PH$State_Fips == 4 | PH$State_Fips == 35| PH$State_Fips == 48),], Stages[(Stages$Total == 130),]) + PH2 <- cbind(PH[(PH$State_Fips != 4 & PH$State_Fips != 35 & PH$State_Fips != 48),], Stages[(Stages$Total == 125),]) + PH <- rbind(PH1, PH2) + } + + if (RowCrop == 'idle_cropland' | RowCrop == 'pasture_grass' | RowCrop == 'rep_cropland'){ + PH <- cbind(PH, Stages) + } + + if (RowCrop == 'rice' | RowCrop == 'soybeans' | RowCrop == 'peanuts' | RowCrop == 'miscanthus' | RowCrop == 'switchgrass'){ + PH <- cbind(PH, Stages) + } + + print('on to split seasons functions') + + #### Generate Climate Files -- Variables: 'Precip_', 'ETo_', 'U2.final_', 'MNRH_') + + if (file.exists(paste0(Intermediates, paste("Base", RowCrop, 'MNRH_', 'MasterDF', sep = '.'))) == FALSE){ + E.Precip_Seasons <- Split.Seasons(RowCrop, 'Precip_', Lat.long, TopSoil, Base.CDL.crop, PH) + ETo.Seasons <- Split.Seasons(RowCrop, 'ETo_', Lat.long, TopSoil, Base.CDL.crop, PH) + U2.Seasons <- Split.Seasons(RowCrop, 'U2.final_', Lat.long, TopSoil, Base.CDL.crop, PH) + MNRH.Seasons <- Split.Seasons(RowCrop, 'MNRH_', Lat.long, TopSoil, Base.CDL.crop, PH) + } + + if (file.exists(paste0(Intermediates, paste("Base", RowCrop, 'MNRH_', 'MasterDF', sep = '.')))){ + load(paste0(Intermediates, paste("Base", RowCrop, 'Precip_', 'MasterDF', sep = '.'))); E.Precip_Seasons <- DF + load(paste0(Intermediates, paste("Base", RowCrop, 'ETo_', 'MasterDF', sep = '.'))); ETo.Seasons <- DF + load(paste0(Intermediates, paste("Base", RowCrop, 'U2.final_', 'MasterDF', sep = '.'))); U2.Seasons <- DF + load(paste0(Intermediates, paste("Base", RowCrop, 'MNRH_', 'MasterDF', sep = '.'))); MNRH.Seasons <- DF; rm(DF) + } + + ##### CROP-SPECIFIC TREATMENTS + if (RowCrop == 'cotton' | RowCrop == 'rice' | RowCrop == 'soybeans' | RowCrop == 'peanuts' | RowCrop == 'alfalfa' | + RowCrop == 'sugarcane' | RowCrop == 'spring_wheat' | RowCrop == 'miscanthus' | RowCrop == 'switchgrass' | + RowCrop == 'idle_cropland' | RowCrop == 'pasture_grass' | RowCrop == 'rep_cropland'){ + Kcb <- Kcb[grep(RowCrop, Kcb$Crop),] # subset for the crop of interest + } + + if (RowCrop == 'durum_wheat') Kcb <- Kcb[Kcb$Crop == 'spring_wheat',] + if (RowCrop == 'fall_oats') Kcb <- Kcb[Kcb$Crop == 'oats',] + if (RowCrop == 'spring_oats') Kcb <- Kcb[Kcb$Crop == 'spring_oats',] + if (RowCrop == 'fall_barley') Kcb <- Kcb[Kcb$Crop == 'barley',] + if (RowCrop == 'spring_barley') Kcb <- Kcb[Kcb$Crop == 'spring_barley',] + if (RowCrop == 'corn' | RowCrop == 'silage') Kcb <- Kcb[Kcb$Crop == 'corn_field_harvest_high_grain_moisture',] + if (RowCrop == 'winter_wheat') Kcb <- Kcb[Kcb$Crop == 'winter_wheat_unfrozen',] + if (RowCrop == 'sorghum') Kcb <- Kcb[Kcb$Crop == 'sorghum_grain',] + if (RowCrop == 'sugarbeets') Kcb <- Kcb[Kcb$Crop == 'sugarbeets_rainfed_or_dry_end',] + + print('on to Rescale.And.Save') + + #### Rescale and Save Seasons + # Variables: 'Precip_', 'ETo_', 'U2.final_', 'MNRH_') + Rescale.And.Save('Precip_', PH, E.Precip_Seasons, RowCrop, Kcb) + Rescale.And.Save('ETo_', PH, ETo.Seasons, RowCrop, Kcb) + Rescale.And.Save('U2.final_', PH, U2.Seasons, RowCrop, Kcb) + Rescale.And.Save('MNRH_', PH, MNRH.Seasons, RowCrop, Kcb) + + ##### Save Crops List + Save.Crops.List(PH, RowCrop, Kcb) + + if(file.exists(paste0(Intermediates, paste("Base", RowCrop, 'MNRH_', 'MasterDF', sep = '.'))) == FALSE){ + print(paste('Crops List file already saved for', RowCrop)) + } +} diff --git a/R/Sum.Save.Daily.Evapotranspiration.R b/R/Sum.Save.Daily.Evapotranspiration.R new file mode 100644 index 0000000..1d70a39 --- /dev/null +++ b/R/Sum.Save.Daily.Evapotranspiration.R @@ -0,0 +1,118 @@ +Sum.Save.Daily.Evapotranspiration <- +function(Croplayer, rainfed = FALSE){ + + Crop <- Croplayer + if (Croplayer == 'spring_barley' || Croplayer == 'fall_barley') Crop <- 'barley' + if (Croplayer == 'spring_oats' || Croplayer == 'fall_oats') Crop <- 'oats' + print(Croplayer) + + setwd(paste0(Path, '/CropWatR/Intermediates/')) + + if (rainfed == FALSE){ + + + load(paste('Preseason_Soil.Evaporation', Croplayer, 'Rdata', sep = '.')) # Pre.KeETo + load(paste('Preseason_Weed.Transpiration', Croplayer, 'Rdata', sep = '.')) # Pre.Kcb.tot + Pre.Evap <- lapply(Pre.KeETo, function(x) x[,(grep('layer', names(x)))]) + Pre.weed.Kcb <- lapply(Pre.Kcb.tot, function(x) x[,(grep('layer', names(x)))]) + + load(paste('Growing.Season_Soil.Evaporation', Croplayer, 'Rdata', sep = '.')) # E + load(file = paste('Growing.Season_Transpiration', Croplayer, 'Rdata', sep = '.')) # Transp.final + + Transpiration <- lapply(Transp.final, function(x) x[,(grep('layer', names(x)))]) + Evap <- lapply(E, function(x) x[,(grep('layer', names(x)))]) + Post.KeETo <- local(get(load(paste('Postseason_Soil.Evaporation', Croplayer, 'Rdata', sep = '.')))) # Post.KeETo + Post.Kcb.tot <- local(get(load(paste('Postseason_Weed.Transpiration', Croplayer, 'Rdata', sep = '.')))) # Post.Kcb.tot + Post.Evap <- lapply(Post.KeETo, function(x) x[,(grep('layer', names(x)))]) + Post.weed.Kcb <- lapply(Post.Kcb.tot, function(x) x[,(grep('layer', names(x)))]) + } + + if (rainfed == TRUE){ + load(paste('Preseason_Soil.Evaporation', Croplayer, 'Rdata', sep = '.')) # Pre.KeETo + load(paste('Preseason_Weed.Transpiration', Croplayer, 'Rdata', sep = '.')) # Pre.Kcb.tot + Pre.Evap <- lapply(Pre.KeETo, function(x) x[,(grep('layer', names(x)))]) + Pre.weed.Kcb <- lapply(Pre.Kcb.tot, function(x) x[,(grep('layer', names(x)))]) + + load(paste('Growing.Season.Rainfed_Soil.Evaporation', Croplayer, 'Rdata', sep = '.')) # E + load(file = paste('Growing.Season.Rainfed_Transpiration', Croplayer, 'Rdata', sep = '.')) # Transp.final + + Transpiration <- lapply(Transp.final, function(x) x[,(grep('layer', names(x)))]) + Evap <- lapply(E, function(x) x[,(grep('layer', names(x)))]) + Post.KeETo <- local(get(load(paste('Postseason_Soil.Evaporation', Croplayer, 'Rdata', sep = '.')))) # Post.KeETo + Post.Kcb.tot <- local(get(load(paste('Postseason_Weed.Transpiration', Croplayer, 'Rdata', sep = '.')))) # Post.Kcb.tot + Post.Evap <- lapply(Post.KeETo, function(x) x[,(grep('layer', names(x)))]) + Post.weed.Kcb <- lapply(Post.Kcb.tot, function(x) x[,(grep('layer', names(x)))]) + } + + load(paste("BASE", Croplayer, 'MNRH_', 'MasterDF2', sep = '.')) # DF2 + IDs.1 <- as.numeric(rownames(DF2)) # as.numeric is crucial + Coords <- cbind(DF2$x, DF2$y) + Coords <- as.data.frame(cbind(IDs.1, Coords)) + IDs.2 <- as.numeric(unlist(lapply(E, function(x) rownames(x)))) # as.numeric is crucial + table(IDs.2 %in% IDs.1) + + Rows <- as.data.frame(cbind(IDs.2)) + print(table(Coords$IDs.1 %in% Rows$IDs.2)) + Rows.Fin <- merge(Coords, Rows, by.x = 'IDs.1', by.y = 'IDs.2') + names(Rows.Fin)[1:3] <- c('IDs', 'x', 'y') + + PreP <- Pre.Evap; PostP <- Post.Evap; GR.P <- Evap; Final <- Pre.Evap + + for (i in 1:length(Pre.Evap)){ + PreP[[i]] <- Pre.Evap[[i]] + Pre.weed.Kcb[[i]] + GR.P[[i]] <- Evap[[i]] + Transpiration[[i]] + PostP[[i]] <- Post.Evap[[i]] + Post.weed.Kcb[[i]] + Final[[i]] <- as.data.frame(cbind(PreP[[i]], GR.P[[i]], PostP[[i]])) + } + + if (Croplayer == 'durum_wheat' || Croplayer == 'fall_barley'){ + Cut <- names(unlist(lapply(Final, function(x) which(nrow(x) == 0)))) + Fini <- Final[-(which(names(Final) %in% Cut))] + Fini <- lapply(Final, function(x) x[,1:362]) + } + if (Croplayer == 'sugarbeets'){ + Cut <- names(unlist(lapply(Final, function(x) which(ncol(x) < 362)))) + Fini <- Final[-(which(names(Final) %in% Cut))] + lapply(Fini, dim) + } + + if (Croplayer == 'alfalfa'){ + Fini <- lapply(Final, function(x) x[,1:358]) + } + + if (Croplayer != 'durum_wheat' && Croplayer != 'alfalfa' && Croplayer != 'fall_barley'){ + Fini <- lapply(Final, function(x) x[,1:362]) + } + + Base <- Fini[[1]] + for (i in 2:length(Fini)){ + names(Fini[[i]]) <- names(Base) + Base <- rbind(Base, Fini[[i]]) + } + Base$IDs <- as.numeric(rownames(Base)) + print(table(as.numeric(rownames(Base)) %in% Rows.Fin$IDs)) + + Water.Balance <- merge(Rows.Fin, Base, by = 'IDs', all.y = TRUE) + WB <- Water.Balance[,-c(1:3)]; Identifiers <- Water.Balance[,c(1:3)] + Water.Balance <- Water.Balance[,-1] + coordinates(Water.Balance) <- ~x+y + proj4string(Water.Balance) <- CRS("+proj=aea +lat_1=29.5 +lat_2=45.5 +lat_0=23 +lon_0=-96 +x_0=0 +y_0=0 +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs") + gridded(Water.Balance) = TRUE + WB.brick <- brick(Water.Balance) + projection(WB.brick) <- ("+proj=aea +lat_1=29.5 +lat_2=45.5 +lat_0=23 +lon_0=-96 +x_0=0 +y_0=0 +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs") + Crops.brick.2008 <- brick('cdl_10k_2008_albers.grd') + WB.brick <- extend(WB.brick, Crops.brick.2008) + print(cellStats(WB.brick, summary)) + names(WB.brick) <- gsub('layer', 'day', names(WB.brick)) + + if (Croplayer != 'pasture_grass'){ + if (file.exists(paste0(Croplayer,'.grd'))){ + LU.brick <- brick(paste0(Croplayer,'.grd')) + } + WB.brick[is.na(LU.brick)] <- NA + } + setwd(paste0(Path, '/CropWatR/Data')) + + if (rainfed == FALSE) writeRaster(WB.brick, filename = paste(Croplayer, 'Daily.ET.grd', sep = '.'), overwrite = TRUE) + if (rainfed == TRUE) writeRaster(WB.brick, filename = paste(Croplayer, 'Rainfed.Daily.ET.grd', sep = '.'), overwrite = TRUE) +} diff --git a/R/Sum.Save.Water.Balances.R b/R/Sum.Save.Water.Balances.R new file mode 100644 index 0000000..8d02454 --- /dev/null +++ b/R/Sum.Save.Water.Balances.R @@ -0,0 +1,282 @@ +Sum.Save.Water.Balances <- +function(Croplayer, rainfed = FALSE, type = c('seasonal', 'annual'), BW.GW = FALSE){ + + setwd(paste0(Path, '/CropWatR/Intermediates/')) + + if (rainfed == FALSE && type == 'annual'){ + ####### I. GW.infiltration: + load(paste('Preseason_Deep.Percolation', Croplayer, 'Rdata', sep = '.')) # Pre.DP + load(paste('Growing.Season_Deep.Percolation', Croplayer, 'Rdata', sep = '.')) # DP + Post.DP <- local(get(load(paste('Postseason_Deep.Percolation', Croplayer,'Rdata', sep = '.')))) # Post.DP + Pre.GW.Infiltration <- unlist(lapply(Pre.DP, function(x) rowSums(x[,(grep('layer', names(x)))]))) + GS.GW.Infiltration <- unlist(lapply(DP, function(x) rowSums(x[,(grep('layer', names(x)))]))) + Post.GW.Infiltration <- unlist(lapply(Post.DP, function(x) rowSums(x[,(grep('layer', names(x)))]))) + GW.Infiltration <- rowSums(as.data.frame(cbind(Pre.GW.Infiltration, GS.GW.Infiltration, Post.GW.Infiltration))) + print(paste("Infiltration Summary for", Croplayer)) + print(c(summary(Pre.GW.Infiltration), summary(GS.GW.Infiltration), summary(Post.GW.Infiltration), summary(GW.Infiltration))) + + ####### II. Evaporation: + load(paste('Preseason_Soil.Evaporation', Croplayer, 'Rdata', sep = '.')) # Pre.KeETo + load(paste('Growing.Season_Soil.Evaporation', Croplayer, 'Rdata', sep = '.')) # E + Post.KeETo <- local(get(load(paste('Postseason_Soil.Evaporation', Croplayer, 'Rdata', sep = '.')))) # Post.KeETo + Pre.Evap <- unlist(lapply(Pre.KeETo, function(x) rowSums(x[,(grep('layer', names(x)))]))) + Evap <- unlist(lapply(E, function(x) rowSums(x[,(grep('layer', names(x)))]))) + Post.Evap <- unlist(lapply(Post.KeETo, function(x) rowSums(x[,(grep('layer', names(x)))]))) + Evaporation <- rowSums(as.data.frame(cbind(Pre.Evap, Evap, Post.Evap))) + print(paste("Evaporation Summary for", Croplayer)) + + load(paste('Preseason_Weed.Transpiration', Croplayer, 'Rdata', sep = '.')) # Pre.Kcb.tot + Pre.weed.Kcb <- unlist(lapply(Pre.Kcb.tot, function(x) rowSums(x[,(grep('layer', names(x)))]))) + Post.Kcb.tot <- local(get(load(paste('Postseason_Weed.Transpiration', Croplayer, 'Rdata', sep = '.')))) # Post.Kcb.tot + Post.weed.Kcb <- unlist(lapply(Post.Kcb.tot, function(x) rowSums(x[,(grep('layer', names(x)))]))) + + Evapor.Fallow.Transpir <- rowSums(as.data.frame(cbind(Pre.Evap, Pre.weed.Kcb, Evap, Post.Evap, Post.weed.Kcb))) + print(c(summary(Pre.Evap), summary(Evap), summary(Post.Evap), summary(Evaporation))) + + ####### III. Runoff: + load(paste('Preseason_Runoff', Croplayer, 'Rdata', sep = '.')) # Pre.ROi + load(paste('Growing.Season_Runoff', Croplayer, 'Rdata', sep = '.')) # ROi + Post.ROi <- local(get(load(paste('Postseason_Runoff', Croplayer, 'Rdata', sep = '.')))) # Post.ROi + Pre.runoff <- unlist(lapply(Pre.ROi, function(x) rowSums(x[,(grep('layer', names(x)))]))) + runoff <- unlist(lapply(ROi, function(x) rowSums(x[,(grep('layer', names(x)))]))) + Post.runoff <- unlist(lapply(Post.ROi, function(x) rowSums(x[,(grep('layer', names(x)))]))) + Runoff <- rowSums(as.data.frame(cbind(Pre.runoff, runoff, Post.runoff))) + print(paste("Runoff Summary for", Croplayer)) + print(c(summary(Pre.runoff), summary(runoff), summary(Post.runoff), summary(Runoff))) + + ####### IV. Crop Transpiration: + load(file = paste('Growing.Season_Transpiration', Croplayer, 'Rdata', sep = '.')) # Transp.final + Transpiration <- unlist(lapply(Transp.final, function(x) rowSums(x[,(grep('layer', names(x)))]))) + print(paste("Transpiration Summary for", Croplayer)) + print(summary(Transpiration)) + + ## V. Weed Transpiration: + load(paste('Preseason_Weed.Transpiration', Croplayer, 'Rdata', sep = '.')) # Pre.Kcb.tot + Post.Kcb.tot <- local(get(load(paste('Postseason_Weed.Transpiration', Croplayer, 'Rdata', sep = '.')))) # Post.Kcb.tot + Pre.weed.Kcb <- unlist(lapply(Pre.Kcb.tot, function(x) rowSums(x[,(grep('layer', names(x)))]))) + Post.weed.Kcb <- unlist(lapply(Post.Kcb.tot, function(x) rowSums(x[,(grep('layer', names(x)))]))) + Fallow.Transpiration <- rowSums(as.data.frame(cbind(Pre.weed.Kcb, Post.weed.Kcb))) + print(paste("Weed Evaporation Summary for", Croplayer)) + print(c(summary(Pre.weed.Kcb), summary(Post.weed.Kcb), summary(Fallow.Transpiration))) + + ####### V. Irrigation: + load(file = paste('Growing.Season_Irrigation', Croplayer, 'Rdata', sep = '.')) # Irr + print(paste("Irrigation Summary for", Croplayer)) + Irrigation <- unlist(lapply(Irr, function(x) rowSums(x[,(grep('layer', names(x)))])))# + Irrigate <- Irrigation + Irrigate[Irrigate == 0] <- NA + print(summary(Irrigate)) + + ##### VI. Create long dataframe of coordinates: + load(paste("BASE", Croplayer, 'MNRH_', 'MasterDF2', sep = '.')) # DF2 + IDs.1 <- as.numeric(rownames(DF2)) # as.numeric is crucial + Coords <- cbind(DF2$x, DF2$y) + Coords <- as.data.frame(cbind(IDs.1, Coords)) + IDs.2 <- as.numeric(unlist(lapply(Pre.DP, function(x) rownames(x)))) # as.numeric is crucial + table(IDs.2 %in% IDs.1) + + Water.Balance <- as.data.frame(cbind(IDs.2, Transpiration, Evapor.Fallow.Transpir, Runoff, GW.Infiltration, Irrigation)) + } + + if (rainfed == TRUE && type == 'annual'){ + + ####### I. GW.infiltration: + load(paste('Preseason_Deep.Percolation', Croplayer, 'Rdata', sep = '.')) # Pre.DP + load(paste('Growing.Season.Rainfed_Deep.Percolation', Croplayer, 'Rdata', sep = '.')) # DP + Post.DP <- local(get(load(paste('Postseason_Deep.Percolation', Croplayer,'Rdata', sep = '.')))) # Post.DP + Pre.GW.Infiltration <- unlist(lapply(Pre.DP, function(x) rowSums(x[,(grep('layer', names(x)))]))) + GS.GW.Infiltration <- unlist(lapply(DP, function(x) rowSums(x[,(grep('layer', names(x)))]))) + Post.GW.Infiltration <- unlist(lapply(Post.DP, function(x) rowSums(x[,(grep('layer', names(x)))]))) + GW.Infiltration <- rowSums(as.data.frame(cbind(Pre.GW.Infiltration, GS.GW.Infiltration, Post.GW.Infiltration))) + print(paste("Infiltration Summary for", Croplayer)) + print(c(summary(Pre.GW.Infiltration), summary(GS.GW.Infiltration), summary(Post.GW.Infiltration), summary(GW.Infiltration))) + + ####### II. Evaporation: + load(paste('Preseason_Soil.Evaporation', Croplayer, 'Rdata', sep = '.')) # Pre.KeETo + load(paste('Growing.Season.Rainfed_Soil.Evaporation', Croplayer, 'Rdata', sep = '.')) # E + Post.KeETo <- local(get(load(paste('Postseason_Soil.Evaporation', Croplayer, 'Rdata', sep = '.')))) # Post.KeETo + Pre.Evap <- unlist(lapply(Pre.KeETo, function(x) rowSums(x[,(grep('layer', names(x)))]))) + Evap <- unlist(lapply(E, function(x) rowSums(x[,(grep('layer', names(x)))]))) + Post.Evap <- unlist(lapply(Post.KeETo, function(x) rowSums(x[,(grep('layer', names(x)))]))) + + load(paste('Preseason_Weed.Transpiration', Croplayer, 'Rdata', sep = '.')) # Pre.Kcb.tot + Pre.weed.Kcb <- unlist(lapply(Pre.Kcb.tot, function(x) rowSums(x[,(grep('layer', names(x)))]))) + Post.Kcb.tot <- local(get(load(paste('Postseason_Weed.Transpiration', Croplayer, 'Rdata', sep = '.')))) # Post.Kcb.tot + Post.weed.Kcb <- unlist(lapply(Post.Kcb.tot, function(x) rowSums(x[,(grep('layer', names(x)))]))) + + Evapor.Fallow.Transpir <- rowSums(as.data.frame(cbind(Pre.Evap, Pre.weed.Kcb, Evap, Post.Evap, Post.weed.Kcb))) + + Evaporation <- rowSums(as.data.frame(cbind(Pre.Evap, Evap, Post.Evap))) + print(paste("Evaporation Summary for", Croplayer)) + print(c(summary(Pre.Evap), summary(Evap), summary(Post.Evap), summary(Evaporation))) + + ####### III. Runoff: + load(paste('Preseason_Runoff', Croplayer, 'Rdata', sep = '.')) # Pre.ROi + load(paste('Growing.Season.Rainfed_Runoff', Croplayer, 'Rdata', sep = '.')) # ROi + Post.ROi <- local(get(load(paste('Postseason_Runoff', Croplayer, 'Rdata', sep = '.')))) # Post.ROi + Pre.runoff <- unlist(lapply(Pre.ROi, function(x) rowSums(x[,(grep('layer', names(x)))]))) + runoff <- unlist(lapply(ROi, function(x) rowSums(x[,(grep('layer', names(x)))]))) + Post.runoff <- unlist(lapply(Post.ROi, function(x) rowSums(x[,(grep('layer', names(x)))]))) + Runoff <- rowSums(as.data.frame(cbind(Pre.runoff, runoff, Post.runoff))) + print(paste("Runoff Summary for", Croplayer)) + print(c(summary(Pre.runoff), summary(runoff), summary(Post.runoff), summary(Runoff))) + + ####### IV. Transpiration: + load(file = paste('Growing.Season.Rainfed_Transpiration', Croplayer, 'Rdata', sep = '.')) # Transp.final + Transpiration <- unlist(lapply(Transp.final, function(x) rowSums(x[,(grep('layer', names(x)))]))) + print(paste("Transpiration Summary for", Croplayer)) + print(summary(Transpiration)) + + ####### V. Weed Transpiration: + load(paste('Preseason_Weed.Transpiration', Croplayer, 'Rdata', sep = '.')) # Pre.Kcb.tot + Post.Kcb.tot <- local(get(load(paste('Postseason_Weed.Transpiration', Croplayer, 'Rdata', sep = '.')))) # Post.Kcb.tot + Pre.weed.Kcb <- unlist(lapply(Pre.Kcb.tot, function(x) rowSums(x[,(grep('layer', names(x)))]))) + Post.weed.Kcb <- unlist(lapply(Post.Kcb.tot, function(x) rowSums(x[,(grep('layer', names(x)))]))) + Fallow.Transpiration <- rowSums(as.data.frame(cbind(Pre.weed.Kcb, Post.weed.Kcb))) + print(paste("Weed Transpiration Summary for", Croplayer)) + print(c(summary(Pre.weed.Kcb), summary(Post.weed.Kcb), summary(Fallow.Transpiration))) + + ####### V. Irrigation: NA + + # ##### VI. Create long dataframe of coordinates: + load(paste("BASE", Croplayer, 'MNRH_', 'MasterDF2', sep = '.')) # DF2 + IDs.1 <- as.numeric(rownames(DF2)) # as.numeric is crucial + Coords <- cbind(DF2$x, DF2$y) + Coords <- as.data.frame(cbind(IDs.1, Coords)) + IDs.2 <- as.numeric(unlist(lapply(Pre.DP, function(x) rownames(x)))) # as.numeric is crucial + table(IDs.2 %in% IDs.1) + + Water.Balance <- as.data.frame(cbind(IDs.2, Transpiration, Evapor.Fallow.Transpir, Runoff, GW.Infiltration)) + + + } + + if (rainfed == FALSE && type == 'seasonal'){ + + ####### I. GW.infiltration: + load(paste('Growing.Season_Deep.Percolation', Croplayer, 'Rdata', sep = '.')) # DP + GS.GW.Infiltration <- unlist(lapply(DP, function(x) rowSums(x[,(grep('layer', names(x)))]))) + print(paste("Infiltration Summary for", Croplayer)) + print(summary(GS.GW.Infiltration)) + + ####### II. Evaporation: + load(paste('Growing.Season_Soil.Evaporation', Croplayer, 'Rdata', sep = '.')) # KeETo + Evap <- unlist(lapply(E, function(x) rowSums(x[,(grep('layer', names(x)))]))) + print(paste("Evaporation Summary for", Croplayer)) + print(summary(Evap)) + + # all.equal(lapply(Few, function(x) dim(x)), lapply(KeETo, function(x) dim(x))) + + ####### III. Runoff: + load(paste('Growing.Season_Runoff', Croplayer, 'Rdata', sep = '.')) # ROi + runoff <- unlist(lapply(ROi, function(x) rowSums(x[,(grep('layer', names(x)))]))) + print(paste("Runoff Summary for", Croplayer)) + print(summary(runoff)) + + ####### IV. Transpiration: + load(file = paste('Growing.Season_Transpiration', Croplayer, 'Rdata', sep = '.')) # Transp.final + Transpiration <- unlist(lapply(Transp.final, function(x) rowSums(x[,(grep('layer', names(x)))]))) + print(paste("Transpiration Summary for", Croplayer)) + print(summary(Transpiration)) + + ####### V. Irrigation: + load(file = paste('Growing.Season_Irrigation', Croplayer, 'Rdata', sep = '.')) # Irr + print(paste("Irrigation Summary for", Croplayer)) + Irrigation <- unlist(lapply(Irr, function(x) rowSums(x[,(grep('layer', names(x)))])))# + Irrigate <- Irrigation + Irrigate[Irrigate == 0] <- NA + print(summary(Irrigate)) + + # ##### VI. Create long dataframe of coordinates: + load(paste("BASE", Croplayer, 'MNRH_', 'MasterDF2', sep = '.')) # DF2 + IDs.1 <- as.numeric(rownames(DF2)) # as.numeric is crucial + Coords <- cbind(DF2$x, DF2$y) + Coords <- as.data.frame(cbind(IDs.1, Coords)) + IDs.2 <- as.numeric(unlist(lapply(DP, function(x) rownames(x)))) # as.numeric is crucial + table(IDs.2 %in% IDs.1) + + if (BW.GW == FALSE) Water.Balance <- as.data.frame(cbind(IDs.2, Transpiration, Evap, runoff, GS.GW.Infiltration, Irrigation)) + + + if (BW.GW == TRUE){ + GreenWater <- Transpiration + Evap + BlueWater <- Irrigation + Water.Balance <- as.data.frame(cbind(IDs.2, GreenWater, BlueWater)) + } + } + + if (rainfed == TRUE && type == 'seasonal'){ + + ####### I. GW.infiltration: + load(paste('Growing.Season.Rainfed_Deep.Percolation', Croplayer, 'Rdata', sep = '.')) # DP + GS.GW.Infiltration <- unlist(lapply(DP, function(x) rowSums(x[,(grep('layer', names(x)))]))) + print(paste("Infiltration Summary for", Croplayer)) + print(summary(GS.GW.Infiltration)) + + ####### II. Evaporation: + load(paste('Growing.Season.Rainfed_Soil.Evaporation', Croplayer, 'Rdata', sep = '.')) # E + Evap <- unlist(lapply(E, function(x) rowSums(x[,(grep('layer', names(x)))]))) + print(paste("Evaporation Summary for", Croplayer)) + print(summary(Evap)) + + # all.equal(lapply(Few, function(x) dim(x)), lapply(KeETo, function(x) dim(x))) + + ####### III. Runoff: + load(paste('Growing.Season.Rainfed_Runoff', Croplayer, 'Rdata', sep = '.')) # ROi + runoff <- unlist(lapply(ROi, function(x) rowSums(x[,(grep('layer', names(x)))]))) + print(paste("Runoff Summary for", Croplayer)) + print(summary(runoff)) + + ####### IV. Transpiration: + load(file = paste('Growing.Season.Rainfed_Transpiration', Croplayer, 'Rdata', sep = '.')) # Transp.final + Transpiration <- unlist(lapply(Transp.final, function(x) rowSums(x[,(grep('layer', names(x)))]))) + print(paste("Transpiration Summary for", Croplayer)) + print(summary(Transpiration)) + + # ##### VI. Create long dataframe of coordinates: + load(paste("BASE", Croplayer, 'MNRH_', 'MasterDF2', sep = '.')) # DF2 + IDs.1 <- as.numeric(rownames(DF2)) # as.numeric is crucial + Coords <- cbind(DF2$x, DF2$y) + Coords <- as.data.frame(cbind(IDs.1, Coords)) + IDs.2 <- as.numeric(unlist(lapply(DP, function(x) rownames(x)))) # as.numeric is crucial + table(IDs.2 %in% IDs.1) + + if (BW.GW == FALSE) Water.Balance <- as.data.frame(cbind(IDs.2, Transpiration, Evap, runoff, GS.GW.Infiltration)) + + + if (BW.GW == TRUE){ + GreenWater <- Transpiration + Evap + BlueWater <- Irrigation + Water.Balance <- as.data.frame(cbind(IDs.2, GreenWater, BlueWater)) + } + } + + print(table(Coords$IDs.1 %in% Water.Balance$IDs.2)) + Water.Balance <- merge(Coords, Water.Balance, by.x = 'IDs.1', by.y = 'IDs.2') + names(Water.Balance)[1:3] <- c('IDs', 'x', 'y') + Water.Balance[Water.Balance == 0] <- NA + Water.Balance <- Water.Balance[,-1] + coordinates(Water.Balance) <- ~x+y + proj4string(Water.Balance) <- CRS("+proj=aea +lat_1=29.5 +lat_2=45.5 +lat_0=23 +lon_0=-96 +x_0=0 +y_0=0 +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs") + gridded(Water.Balance) = TRUE + WB.brick <- brick(Water.Balance) + projection(WB.brick) <- ("+proj=aea +lat_1=29.5 +lat_2=45.5 +lat_0=23 +lon_0=-96 +x_0=0 +y_0=0 +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs") + Crops.brick.2008 <- brick('../Data/cdl_10k_2008_albers.grd') + + WB.brick <- extend(WB.brick, Crops.brick.2008) + plot(WB.brick) + print(cellStats(WB.brick, summary)) + + if (rainfed == FALSE && type == 'annual') writeRaster(WB.brick, filename = paste(Croplayer, 'Basic.WB.grd', sep = '.'), overwrite = TRUE) + if (rainfed == FALSE && type == 'seasonal') writeRaster(WB.brick, filename = paste(Croplayer, 'Growing.Season.WB.grd', sep = '.'), overwrite = TRUE) + + if (rainfed == TRUE && type == 'annual') writeRaster(WB.brick, filename = paste(Croplayer, 'Basic.Rainfed.WB.grd', sep = '.'), overwrite = TRUE) + if (rainfed == TRUE && type == 'seasonal') writeRaster(WB.brick, filename = paste(Croplayer, 'Growing.Season.Rainfed.WB.grd', sep = '.'), overwrite = TRUE) + + if (BW.GW == FALSE && type == 'annual') writeRaster(WB.brick, filename = paste(Croplayer, 'Growing.Season.WB.grd', sep = '.'), overwrite = TRUE) + if (BW.GW == TRUE && type == 'seasonal') writeRaster(WB.brick, filename = paste(Croplayer, 'Growing.Season.GW.BW.WB.grd', sep = '.'), overwrite = TRUE) + if (BW.GW == TRUE && type != 'seasonal') print('Blue / Green water volumes only relevant for the growing season') + + setwd(paste0(Path, '/CropWatR/Data')) + +} diff --git a/R/SuperImpose.WB.on.LU.R b/R/SuperImpose.WB.on.LU.R new file mode 100644 index 0000000..6cd657c --- /dev/null +++ b/R/SuperImpose.WB.on.LU.R @@ -0,0 +1,88 @@ +SuperImpose.WB.on.LU <- +function(Croplayer, rainfed = FALSE, type = c('seasonal', 'annual'), Growing.Season.GW.BW = FALSE){ + load('Vars.Rdata') + Irr.Vars <- Vars[-c(3,6,8,14,15)] + if (Growing.Season.GW.BW == TRUE) class <- 'BW.GW' + if (Growing.Season.GW.BW == FALSE) class <- 'WB' + if (rainfed == FALSE) Irr <- 'irrigated' + if (rainfed == TRUE) Irr <- 'rainfed' + + if (Croplayer %in% Irr.Vars){ + + LU.brick <- raster(paste0(Intermediates, Croplayer, '.grd')) + LU.brick[LU.brick == 0] <- NA + + if (rainfed == FALSE && type == 'annual') WB.brick <- brick(paste0(Intermediates, Croplayer, '.Basic.WB.grd')) + if (rainfed == FALSE && type == 'seasonal') WB.brick <- brick(paste0(Intermediates, Croplayer, '.Growing.Season.WB.grd')) + if (rainfed == TRUE && type == 'annual') WB.brick <- brick(paste0(Intermediates, Croplayer, '.Basic.Rainfed.WB.grd')) + if (rainfed == TRUE && type == 'seasonal') WB.brick <- brick(paste0(Intermediates, Croplayer, '.Growing.Season.Rainfed.WB.grd')) + if (Growing.Season.GW.BW == FALSE && type == 'annual') WB.brick <- brick(paste0(Intermediates, Croplayer, '.Basic.WB.grd')) + if (Growing.Season.GW.BW == TRUE && type == 'seasonal') WB.brick <- brick(paste0(Intermediates, Croplayer, '.Growing.Season.GW.BW.WB.grd')) + if (Growing.Season.GW.BW == TRUE && type == 'seasonal' && rainfed == FALSE) WB.brick <- brick(paste0(Intermediates, Croplayer, '.Growing.Season.BW.GW.WB.grd')) + + Names <- names(WB.brick) + + WB.brick <- extend(WB.brick, LU.brick) + LU.brick <- extend(LU.brick, WB.brick) + LU.brick <- extend(LU.brick, WB.brick) + + WB.brick <- calc(WB.brick, fun = function(x) replace(x, x < 0, 0.001)) + + WB.total <- overlay(WB.brick, LU.brick, fun=prod) + names(WB.total) <- names(WB.brick) + WB.total[WB.total == 0] <- NA + + # mm treatment: + LU.mm <- LU.brick + LU.mm[LU.mm > 0] <- 1 + # mask by land use + WB.mm <- overlay(WB.brick, LU.mm, fun=prod) + names(WB.mm) <- names(WB.brick) + + print(paste('saving', Croplayer)) + print(cellStats(WB.total, summary)) + print(cellStats(WB.mm, summary)) + + writeRaster(WB.total, filename = paste0(Intermediates, 'Total.', type, ".", class, ".", Irr, ".", Croplayer,'.grd'), overwrite = TRUE) + writeRaster(WB.mm, filename = paste0(Intermediates, 'mm.', type, ".", class, ".", Irr, ".", Croplayer, '.grd'), overwrite = TRUE) + + } + + if(!(Croplayer %in% Irr.Vars)){ + LU.brick <- raster(paste0(Intermediates, Croplayer, '.grd')) + LU.brick[LU.brick == 0] <- NA + + if (rainfed == FALSE && type == 'annual') WB.brick <- brick(paste0(Intermediates, Croplayer, '.Basic.WB.grd')) + if (rainfed == FALSE && type == 'seasonal') WB.brick <- brick(paste0(Intermediates, Croplayer, '.Growing.Season.WB.grd')) + if (rainfed == TRUE && type == 'annual') WB.brick <- brick(paste0(Intermediates, Croplayer, '.Basic.Rainfed.WB.grd')) + if (rainfed == TRUE && type == 'seasonal') WB.brick <- brick(paste0(Intermediates, Croplayer, '.Growing.Season.Rainfed.WB.grd')) + if (Growing.Season.GW.BW == FALSE && type == 'annual') WB.brick <- brick(paste0(Intermediates, Croplayer, '.Basic.WB.grd')) + if (Growing.Season.GW.BW == TRUE && type == 'seasonal') WB.brick <- brick(paste0(Intermediates, Croplayer, '.Growing.Season.GW.BW.WB.grd')) + if (Growing.Season.GW.BW == TRUE && type == 'seasonal' && rainfed == FALSE) WB.brick <- brick(paste0(Intermediates, Croplayer, '.Growing.Season.BW.GW.WB.grd')) + + Names <- names(WB.brick) + + WB.brick <- extend(WB.brick, LU.brick) + LU.brick <- extend(LU.brick, WB.brick) + + WB.brick <- calc(WB.brick, fun = function(x) replace(x, x < 0, 0.001)) + + WB.total <- overlay(WB.brick, LU.brick, fun=prod) + names(WB.total) <- names(WB.brick) + WB.total[WB.total == 0] <- NA + + # mm treatment: + LU.mm <- LU.brick + LU.mm[LU.mm > 0] <- 1 + # mask by land use + WB.mm <- overlay(WB.brick, LU.mm, fun=prod) + names(WB.mm) <- names(WB.brick) + + print(paste('saving', Croplayer)) + print(cellStats(WB.total, summary)) + print(cellStats(WB.mm, summary)) + + writeRaster(WB.total, filename = paste0(Intermediates, 'Total.', type, ".", class, ".", Irr, ".", Croplayer,'.grd'), overwrite = TRUE) + writeRaster(WB.mm, filename = paste0(Intermediates, 'mm.', type, ".", class, ".", Irr, ".", Croplayer, '.grd'), overwrite = TRUE) + } +} diff --git a/R/Vioplot.Water.Balances.R b/R/Vioplot.Water.Balances.R new file mode 100644 index 0000000..0c1836e --- /dev/null +++ b/R/Vioplot.Water.Balances.R @@ -0,0 +1,177 @@ +Vioplot.Water.Balances <- +function(Crop, mm = TRUE, rainfed = FALSE, type = c('annual', 'seasonal'), Agg.Level = 'HUC2', metric = FALSE){ + if (mm == TRUE) Pat <- 'mm' + if (mm == FALSE) Pat <- 'Total' + if (rainfed == TRUE) Irr <- 'rainfed' + if (rainfed == FALSE) Irr <- 'irrigated' + + Final <- brick(paste0(Intermediates, Pat, '.', type, ".WB.", Irr, ".", Crop,'.grd')) + # Doesn't do BW / GW yet + Final[Final == 0] <- NA + + print('Final stats:') + print(cellStats(Final, summary)) + plot(Final) + + Final[Final == 0] <- NA + names(Final)[2] <- 'Evaporation' + print('Final stats:') + print(cellStats(Final, summary)) + plot(Final) + names(Final)[which(names(Final) == 'GW.Infiltration')] <- 'Groundwater Infiltration' + + if (mm == FALSE){ + if (metric == FALSE){ + # 1 mm --> 10 m3/ha # 1 cubic meter = 0.000810713194 acre foot + # CONVERSIONS: acres -> hectares; mm -> m3; m3 <- acre-feet + # equivalently: 1 mm x acre == 0.0032808399 acre foot + Final <- Final*0.0032808399 + Final <- Final/10^3 + Subtitle <- "water balances in thousand acre-feet" + Type <- 'Acre-feet' + } + if (metric == TRUE){ + # 1 mm --> 10 m3/ha # 1 cubic meter = 0.000810713194 acre foot + # CONVERSIONS: acres -> hectares; mm -> m3 + # equivalently: 1 millimeter acre = 0.000404685642 hectare meters + Final <- Final*0.000404685642 + Final <- Final/10^3 + Subtitle <- "water balances in thousand hectare-meters" + Type <- 'Hectare-meters' + } + } + if (mm == TRUE){ + Subtitle <- "Water balances in mm" + Type <- 'mm' + } + + AggShp <- shapefile(paste0('aea', Agg.Level, '.shp')) + if (Agg.Level == 'HUC2') Labels <- as.character(gsub(' Region', '', AggShp$REG_NAME, fixed = TRUE)) + if (Agg.Level == 'States') Labels <- as.character(AggShp$ATLAS_NAME) + + aea.Loc.IDs <- read.csv('aea.Loc.IDs.csv') + d <- as.data.frame(Final) + xy <- as.data.frame(xyFromCell(Final, 1:ncell(Final))) + DF <- cbind(xy, d) + DF[DF == 0.00] <- NA + summary(na.omit(DF)) + print(table(cbind(DF$x, DF$y) %in% cbind(aea.Loc.IDs$x, aea.Loc.IDs$y))) + print(table(cbind(aea.Loc.IDs$x, aea.Loc.IDs$y) %in% cbind(DF$x,DF$y))) + + DF <- merge(DF, aea.Loc.IDs, by.x = c('x','y'), by.y = c('x','y'), all.x = TRUE) + + ############################################# + ############### Distributions ############### + ############################################# + require(vioplot) + library(plotrix) + + Identifiers <- c("x", "y", "CountyFIPS", "STATE_FIPS", "HUC2", "Abbreviation", "State_name", "Ers.region", "CRD") + Identifiers <- Identifiers[-(which(Identifiers == Agg.Level))] + + Average <- DF[,-(which(names(DF) %in% Identifiers))] + str(Average) + Average <- Average[!is.na(Average$HUC2),] + summary(Average) + + Average[Average$HUC2 == '16',c(1,3,4)] <- Average[Average$HUC2 == '16',c(1,3,4)]*0.55 + Average[Average$HUC2 == '17',c(1,3,4)] <- Average[Average$HUC2 == '17',c(1,3,4)]*0.7 + Average[Average$HUC2 == '18',c(1,3,4)] <- Average[Average$HUC2 == '18',c(1,3,4)]*1.3 + + Average[Average$HUC2 == '16',5] <- Average[Average$HUC2 == '16',5]*0.5 + Average[Average$HUC2 == '17',5] <- Average[Average$HUC2 == '17',5]*0.35 + Average[Average$HUC2 == '18',c(4,5)] <- Average[Average$HUC2 == '18',c(4,5)]*1.15 + + Transp.by.HUC <- split(Average$Transpiration, as.factor(Average$HUC2)) + Tr.by.HUC <- lapply(Transp.by.HUC, function(x) na.omit(x)) + Tr.Means <- unlist(lapply(Transp.by.HUC, function(x) mean(x, na.rm = TRUE)+3*sd(x, na.rm = TRUE))) + Tr.Labs <- unlist(lapply(Transp.by.HUC, function(x) mean(x, na.rm = TRUE)+2*sd(x, na.rm = TRUE))) + + Evap.by.HUC <- split(Average$Evaporation, as.factor(Average$HUC2)) + Ev.by.HUC <- lapply(Evap.by.HUC, function(x) na.omit(x)) + + Runoff.by.HUC <- split(Average$Runoff, as.factor(Average$HUC2)) + Ro.by.HUC <- lapply(Runoff.by.HUC, function(x) na.omit(x)) + + GW.Inf.by.HUC <- split(Average$Groundwater.Infiltration, as.factor(Average$HUC2)) + GW.by.HUC <- lapply(GW.Inf.by.HUC, function(x) na.omit(x)) + + Irr.Inf.by.HUC <- split(Average$Irrigation, as.factor(Average$HUC2)) + Irr.by.HUC <- lapply(Irr.Inf.by.HUC, function(x) na.omit(x)) + Irr.Means <- unlist(lapply(Irr.by.HUC, function(x) mean(x, na.rm = TRUE)+3*sd(x, na.rm = TRUE))) + + addAlpha <- function(colors, alpha=1.0) { + r <- col2rgb(colors, alpha=T) + r[4,] <- alpha*255 + r <- r/255.0 + return(rgb(r[1,], r[2,], r[3,], r[4,])) + } + + BlueT <- addAlpha('blue', alpha = .5) + GreenT <- addAlpha('green', alpha = .5) + RedT <- addAlpha('red', alpha = .75) + + # Initialize an empty background plot + x <- c(0:18) + y <- c(0:18) + # rescale y: (ggplot) + Max <- max(Tr.Means) + 150 + # Max <- max(Irr.Means) + target.scale <- c(0, Max, na.rm = TRUE) + y <- rescale(y, target.scale) + + setwd(paste0(Path, '/CropWatR/Intermediates/')) + + bmp(filename = paste("ViolinPlot.Water.Regions", Crop, type, Irr, Type, "WB.bmp", sep = "."), width = 1300, height = 700) + par(mai = c(3, 0.5, 0.2, 0.2), mar = c(3, 3, 2, 2), oma = c(1,1,1,1)) + + plot(x, y, col = 'transparent', frame.plot = FALSE , xlab = "", xaxt = 'n') + + vioplot(GW.by.HUC[[1]], GW.by.HUC[[2]], GW.by.HUC[[3]], GW.by.HUC[[4]], GW.by.HUC[[5]], + GW.by.HUC[[6]], GW.by.HUC[[7]], GW.by.HUC[[8]], GW.by.HUC[[9]], GW.by.HUC[[10]], + GW.by.HUC[[11]], GW.by.HUC[[12]], GW.by.HUC[[13]], GW.by.HUC[[14]], GW.by.HUC[[15]], + GW.by.HUC[[16]], GW.by.HUC[[17]], GW.by.HUC[[18]], col = 'transparent', border = rgb(8, 160, 255, max = 255), + rectCol = 'black', ylim = c(0,6), add = TRUE)# names = c(HUC.names)) + + + vioplot(Ev.by.HUC[[1]], Ev.by.HUC[[2]], Ev.by.HUC[[3]], Ev.by.HUC[[4]], Ev.by.HUC[[5]], + Ev.by.HUC[[6]], Ev.by.HUC[[7]], Ev.by.HUC[[8]], Ev.by.HUC[[9]], Ev.by.HUC[[10]], + Ev.by.HUC[[11]], Ev.by.HUC[[12]], Ev.by.HUC[[13]], Ev.by.HUC[[14]], Ev.by.HUC[[15]], + Ev.by.HUC[[16]], Ev.by.HUC[[17]], Ev.by.HUC[[18]], col = RedT, + rectCol = 'black', ylim = c(0,6), add = TRUE)# names = c(HUC.names)) + + vioplot(Irr.by.HUC[[1]], Irr.by.HUC[[2]], Irr.by.HUC[[3]], Irr.by.HUC[[4]], Irr.by.HUC[[5]], + Irr.by.HUC[[6]], Irr.by.HUC[[7]], Irr.by.HUC[[8]], Irr.by.HUC[[9]], Irr.by.HUC[[10]], + Irr.by.HUC[[11]], Irr.by.HUC[[12]], Irr.by.HUC[[13]], Irr.by.HUC[[14]], Irr.by.HUC[[15]], + Irr.by.HUC[[16]], Irr.by.HUC[[17]], Irr.by.HUC[[18]], col = BlueT, border = rgb(180, 16, 25, max = 255), + rectCol = 'black', ylim = c(0,6), add = TRUE)# names = c(HUC.names)) + + vioplot(Ro.by.HUC[[1]], Ro.by.HUC[[2]], Ro.by.HUC[[3]], Ro.by.HUC[[4]], Ro.by.HUC[[5]], + Ro.by.HUC[[6]], Ro.by.HUC[[7]], Ro.by.HUC[[8]], Ro.by.HUC[[9]], Ro.by.HUC[[10]], + Ro.by.HUC[[11]], Ro.by.HUC[[12]], Ro.by.HUC[[13]], Ro.by.HUC[[14]], Ro.by.HUC[[15]], + Ro.by.HUC[[16]], Ro.by.HUC[[17]], Ro.by.HUC[[18]], col = 'transparent', border = 'brown', + rectCol = 'black', ylim = c(0,6), add = TRUE)# names = c(HUC.names)) + + vioplot(Tr.by.HUC[[1]], Tr.by.HUC[[2]], Tr.by.HUC[[3]], Tr.by.HUC[[4]], Tr.by.HUC[[5]], + Tr.by.HUC[[6]], Tr.by.HUC[[7]], Tr.by.HUC[[8]], Tr.by.HUC[[9]], Tr.by.HUC[[10]], + Tr.by.HUC[[11]], Tr.by.HUC[[12]], Tr.by.HUC[[13]], Tr.by.HUC[[14]], Tr.by.HUC[[15]], + Tr.by.HUC[[16]], Tr.by.HUC[[17]], Tr.by.HUC[[18]], col = GreenT, + rectCol = 'red', ylim = c(0,6), add = TRUE)# names = c(HUC.names)) + + + # add a legend: + colfill <- c(GreenT, RedT, 'transparent', 'transparent', BlueT) + colbord <- c('black', 'black', 'brown', rgb(8, 160, 255, max = 255), rgb(180, 16, 25, max = 255)) # , 'yellow') + Labs <- c('transpiration', 'evaporation', 'runoff', 'groundwater infiltration', 'irrigation') + par(srt = 0) + # legend(3.5, 900, Labs, fill=colfill, border = colbord, cex = 1.5) + + title(paste('Annual water balances (mm) for', Crop, sep = " "), cex.main = 1.75) + par(srt = 30) + text( x = c(1:18), y = c(Tr.Labs)+100, labels = c(Labels),cex = 1.5) + + dev.off() + + setwd(paste0(Path, '/CropWatR/Data')) + +} diff --git a/R/anRpackage-internal.R b/R/anRpackage-internal.R new file mode 100644 index 0000000..c80d993 --- /dev/null +++ b/R/anRpackage-internal.R @@ -0,0 +1,126 @@ +.Random.seed <- +c(403L, 10L, 327653094L, -1581507216L, -1939233133L, 1681588017L, +1038501344L, -118087042L, 2145456393L, -1763069125L, 810715914L, +-1044659476L, -1158529169L, 1604673701L, 1349536348L, -833197518L, +2088878381L, 1864320999L, -133017842L, 953770216L, -206433557L, +2038774665L, 251979544L, -256447930L, -1581774175L, -975737549L, +1667052706L, 1913273236L, -1023344105L, -569080307L, -903732444L, +1543970570L, -1702186379L, -2106510897L, -787416362L, -2055856512L, +2056126659L, 1844764257L, -1770285360L, -1683804114L, -727697959L, +741984747L, -1732920230L, 1530799644L, 529712927L, 1441749877L, +-1193688564L, -706210846L, -219692867L, -2056163529L, -1883744290L, +-161176296L, 806946939L, -228643303L, -2141829464L, -465484714L, +556925137L, -519889789L, 313802514L, 1258621604L, -1242212761L, +247678909L, 505485620L, 717953690L, -1089218331L, 182192767L, +-1784376314L, -462960752L, -1620080077L, -680697391L, -1993833600L, +346938974L, -755440215L, -589208485L, 1515109482L, -1508170484L, +569567055L, -1644948475L, -1833096516L, 1710070674L, 350836877L, +468737735L, 1708275630L, -952819192L, -1532361205L, -388018455L, +128436664L, -708073882L, 499491585L, -423369325L, 1269972546L, +-1331887628L, -1736221705L, 1733418989L, 824273028L, -512389462L, +496935957L, -894552913L, 1641003702L, 298744032L, -915078109L, +1421851457L, 2091886128L, -406686642L, 399121593L, -1248536373L, +1967465850L, -778332036L, 550005951L, -1237735019L, 958931372L, +1770771330L, -2052843171L, 1958352983L, -714289346L, -1229981832L, +1792089179L, -26883143L, 381368840L, -1273356106L, -1654171663L, +1743454755L, -1257493902L, 1275343044L, 1184749191L, 1364643421L, +439464020L, -1845013894L, -142644795L, 600349471L, -1226565978L, +1036814384L, 490101459L, -534433551L, -1899611104L, -861033794L, +710647497L, -1135707013L, -1389047222L, -1689196884L, 1776738735L, +919439717L, 893032220L, 1745623922L, -1019987987L, -1377159129L, +-1581465522L, 2093622440L, 1070221995L, 1302331337L, 491181016L, +1717629574L, -99638431L, 1282352883L, -2135729822L, 1568532436L, +-1303784745L, 1574992077L, 443093092L, -1729692086L, 73132981L, +-366864625L, -923376618L, -355365184L, 1691916419L, 1651766433L, +854940304L, -440546962L, -1479366887L, 1299602347L, -514201190L, +453143900L, -137444257L, 702938165L, 1029072844L, -1455475934L, +-112431747L, 1803320951L, 2012030878L, 1664927320L, 901181371L, +-1313423015L, -797902104L, -810253546L, 789447825L, 1041029443L, +1082258514L, -940521756L, -900300505L, 1485959549L, 1017641076L, +-675792294L, 1473631909L, -1191050049L, -1041377466L, 592909776L, +1820706803L, 1912766225L, -666403008L, -1232845026L, -2119600151L, +2018139419L, -1788283094L, 627574860L, -1412300785L, 624151365L, +-1190568708L, 1985178450L, -732877619L, -478933881L, -255109266L, +-654497464L, 1790905675L, 784814249L, 33952248L, -1514217178L, +-1831730623L, 1692249043L, -126133886L, 504720820L, -523060937L, +-1474188243L, 639736132L, 568118890L, -1507972907L, 882755183L, +505680758L, -540851040L, 1998216547L, -1952544832L, -2081555140L, +1361145488L, 43680802L, -348426232L, -1308566388L, -1220030436L, +-1599384430L, -396743552L, -466861036L, 1892885288L, 2099123258L, +-1059091248L, -1137109908L, -1365670220L, 527716370L, 754212832L, +515058636L, 514350560L, 1401691170L, -1643174616L, -1170319092L, +1802300988L, -1372703502L, -1012324112L, 1118627652L, 296538200L, +-1038794182L, 1539143920L, 530928316L, 1998748180L, -2129531710L, +886040160L, -1649805956L, -1782483760L, 213361698L, 99772584L, +-1835872884L, 690213308L, 128129074L, 415630144L, 1814040244L, +-1790615224L, 29172410L, 299597584L, -1653907220L, 449292372L, +-1919482094L, 1832952224L, -1882921012L, -1566572704L, -267920190L, +1093955112L, -348579412L, -1508359364L, -1165241486L, -2068689104L, +77586468L, 1804316216L, 220484314L, -157223024L, 696481020L, +454753684L, 240202562L, 110610944L, -811661252L, 772878928L, +-86085470L, 1369105224L, 1005357580L, 1998256860L, -1100631982L, +-194163584L, -2046720172L, -1995427864L, -2069036294L, 1647626064L, +1315644460L, -1081878156L, 1572245138L, -1824218528L, -912117620L, +1355559264L, -289138462L, -2082337624L, -837171508L, -741926404L, +-646726734L, -2120317968L, -2056793660L, 118541656L, 921706874L, +-1089187408L, -1488557636L, -2047590828L, -926246462L, -1944231136L, +1111946172L, 1320874064L, 1543830498L, -445046936L, -1508673716L, +-632672516L, -686278926L, -312394496L, -1939641228L, -1593373176L, +-1507662406L, -188090928L, 338606060L, 995470228L, 1562527954L, +1475363936L, -292205236L, -277474528L, -612787582L, -1229225496L, +-346514452L, 1663204924L, 622265970L, 1482427248L, 808893732L, +-870671816L, 656978330L, -1935053360L, -1416108612L, 1200221844L, +591110786L, 2040774080L, 12031804L, -553020784L, -1257425118L, +1451783688L, -1759468788L, -260840548L, -2056168430L, 1487350656L, +-9045228L, -1055034072L, 1244172346L, -1825831984L, 520583788L, +320195636L, -737357678L, 2027616608L, 62725452L, -1131473440L, +2025331618L, -4703320L, 2031459468L, 917418940L, 429450354L, +2004068336L, 1842594884L, 1569826904L, 1411964986L, -583030672L, +-127132100L, -532486380L, -530134334L, 1204343520L, -412285828L, +-535655216L, 2042008482L, -1045672408L, -2003001076L, 1085638588L, +928067890L, 79853760L, 118059572L, 1244535496L, 602374842L, -962245488L, +-858028308L, 1265358420L, 1866655378L, -1037269216L, 1074026444L, +-1980020512L, -2084778302L, 755766312L, -1214055508L, -1327715652L, +287523314L, -721025488L, -1876338780L, 629645752L, 274578266L, +-802351984L, -2081006724L, -804921580L, -1754817214L, 852381440L, +1030740924L, -773210288L, 962404642L, 269863496L, -1950459892L, +1116802140L, 110858706L, 1313895936L, 8319316L, 1710817512L, +579645690L, 157034192L, 403573036L, 203413748L, -119575150L, +352069984L, -2137528308L, -1993962784L, 1397326434L, -2049918296L, +-9487796L, 1984014204L, 1878142258L, 79332976L, 842382148L, 570181592L, +-1091289222L, -1947185616L, 635172796L, 1855567444L, 939305026L, +-1830412128L, -518476100L, -989132336L, -211850589L, 1666798244L, +966935378L, -1817032025L, -1913571599L, 2005276214L, -470582572L, +1434652261L, -1003340689L, 335824552L, 2054308870L, -1195617997L, +-1712927339L, 2036294130L, -2023731648L, -1823297623L, 863400475L, +-2110518292L, 301714426L, -1876154321L, -225662919L, 61094478L, +914561692L, 706052109L, -23503753L, -1315210112L, 625851102L, +1852631467L, 2130256557L, -1407322342L, 1119070168L, 868525121L, +712438515L, 1349694740L, -194387806L, -2109358665L, 309244289L, +861112198L, 527689156L, -1678265099L, 1284390239L, -1844908104L, +-543579498L, -1272148829L, 170870373L, 110240642L, 34996464L, +981985433L, 1760592011L, 908650876L, -1848092758L, 1974536159L, +444843369L, 53926270L, -173364884L, 1710805437L, -1348820345L, +-1944521104L, 1770216718L, -1667866053L, -1061508835L, -117695542L, +1700549864L, -906721327L, 1485248963L, 1466614468L, 1598513522L, +1420659783L, 1833918481L, -216364650L, 1011838196L, 1698449029L, +-1245622321L, 154246856L, -1674881178L, 1676217747L, 1792839413L, +-536424750L, -1537361632L, -1191880439L, -1868558789L, 2006131596L, +714482202L, 1465148047L, -457839143L, 240267886L, -99442180L, +302469997L, -141263593L, 147437792L, 1538858686L, -2006987637L, +-486855923L, 1660107578L, -820874376L, 675356961L, -242726445L, +-1780811532L, 948083074L, -145609705L, -310813983L, 240346150L, +-780476124L, 242016725L, -239182465L, 36594712L, -990999754L, +36408771L, -1539067L, -1019019358L, 1532910480L, -1326866631L, +68914155L, 192396508L, -2126461686L, 1652722687L, -1790202295L, +456293342L, 300295052L, -2119220387L, 25076583L, -1570846576L, +-940927314L, -229395621L, -2040085699L, 293685674L, 81077832L, +-1972431247L, 1404151779L, -330657052L, -1141683694L, 509246951L, +1713465777L, 602660854L, -750910956L, 1193307429L, 747208239L, +1600048104L, -1911579450L, -1563145869L, -2138590763L, -326957646L, +1532205952L, 125321065L, 759919579L, -286835924L, -771300038L, +-1757783057L, -1816875399L, -1617053426L, 4483292L, -1039802547L, +1120423607L, -817750976L, 815150366L, -1032114197L, -302427283L, +72360410L, -1512768616L, 207454721L, 832271283L, 521786068L, +-396684318L, -545118601L, -1242538047L, 2098740550L, 934104196L, +-2109926859L, 1059494431L, 248166727L) diff --git a/R/bez.R b/R/bez.R new file mode 100644 index 0000000..562021f --- /dev/null +++ b/R/bez.R @@ -0,0 +1,13 @@ +bez <- +function(x, y, t){ + outx <- 0 + outy <- 0 + n <- length(x)-1 + for (i in 0:n) + { + outx <- outx + choose(n, i)*((1-t)^(n-i))*t^i*x[i+1] + outy <- outy + choose(n, i)*((1-t)^(n-i))*t^i*y[i+1] + } + + return (list(x=outx, y=outy)) +} diff --git a/R/bezierCurve.R b/R/bezierCurve.R new file mode 100644 index 0000000..4738322 --- /dev/null +++ b/R/bezierCurve.R @@ -0,0 +1,17 @@ +bezierCurve <- +function(x, y, n=10){ + outx <- NULL + outy <- NULL + + i <- 1 + for (t in seq(0, 1, length.out=n)) + { + b <- bez(x, y, t) + outx[i] <- b$x + outy[i] <- b$y + + i <- i+1 + } + + return (list(x=outx, y=outy)) +} diff --git a/data/Path.rda b/data/Path.rda new file mode 100644 index 0000000..788fb7b Binary files /dev/null and b/data/Path.rda differ diff --git a/man/Calc.Basal.Crop.Coeff.Rd b/man/Calc.Basal.Crop.Coeff.Rd new file mode 100644 index 0000000..5a1c2fd --- /dev/null +++ b/man/Calc.Basal.Crop.Coeff.Rd @@ -0,0 +1,117 @@ +\name{Calc.Basal.Crop.Coeff} +\alias{Calc.Basal.Crop.Coeff} +%- Also NEED an '\alias' for EACH other topic documented here. +\title{ +%% ~~function to do ... ~~ +} +\description{ +%% ~~ A concise (1-5 lines) description of what the function does. ~~ +} +\usage{ +Calc.Basal.Crop.Coeff(Croplayer) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{Croplayer}{ +%% ~~Describe \code{Croplayer} here~~ +} +} +\details{ +%% ~~ If necessary, more details than the description above ~~ +} +\value{ +%% ~Describe the value returned +%% If it is a LIST, use +%% \item{comp1 }{Description of 'comp1'} +%% \item{comp2 }{Description of 'comp2'} +%% ... +} +\references{ +%% ~put references to the literature/web site here ~ +} +\author{ +%% ~~who you are~~ +} +\note{ +%% ~~further notes~~ +} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +\seealso{ +%% ~~objects to See Also as \code{\link{help}}, ~~~ +} +\examples{ +##---- Should be DIRECTLY executable !! ---- +##-- ==> Define data, use random, +##-- or do help(data=index) for the standard data sets. + +## The function is currently defined as +function (Croplayer) +{ + load(paste0(Intermediates, paste("Growing.Season", Croplayer, + "U2.final_", "Rdata", sep = "."))) + U2 <- Growing.Season + rm(Growing.Season) + load(paste0(Intermediates, paste("Growing.Season", Croplayer, + "MNRH_", "Rdata", sep = "."))) + RHmin <- Growing.Season + rm(Growing.Season) + load(paste0(Intermediates, paste("CropsList", Croplayer, + "Rdata", sep = "."))) + all.equal(lapply(U2, function(x) x[, c("x", "y")]), lapply(RHmin, + function(x) x[, c("x", "y")])) + all.equal(names(U2), names(Daily.Crops.list)) + GS.U2 <- lapply(U2, function(x) x[, (grep("layer", names(x)))]) + GS.RHmin <- lapply(RHmin, function(x) x[, (grep("layer", + names(x)))]) + sapply(GS.U2, dim) + sapply(GS.RHmin, dim) + all.equal(sapply(GS.U2, dim), sapply(GS.RHmin, dim)) + Wind_term <- lapply(GS.U2, function(x) 0.04 * (x[] - 2)) + RH_term <- lapply(GS.RHmin, function(x) 0.004 * (x[] - 45)) + all.equal(lapply(Wind_term, function(x) c(x$x, x$y)), lapply(RH_term, + function(x) c(x$x, x$y))) + Max.season.heights <- lapply(Daily.Crops.list, function(x) tapply(x$day_height, + x$season.ID, max)) + Season.IDs <- lapply(Daily.Crops.list, function(x) x$season.ID) + Plant_heights <- Season.IDs + for (i in 1:length(Max.season.heights)) { + Plant_heights[[i]] <- Max.season.heights[[i]][match(Season.IDs[[i]], + names(Max.season.heights[[i]]))] + } + Kcb <- lapply(Daily.Crops.list, function(x) x$daily_Kcb) + print("done plant heights") + height_term <- lapply(Plant_heights, function(x) (x[]/3)^0.3) + Kcb.corrected <- Wind_term + summary(Kcb.corrected[[1]]) + for (i in 1:length(Wind_term)) { + for (j in 1:length(height_term[[i]])) { + Kcb.corrected[[i]][, j] <- Kcb[[i]][j] + (Wind_term[[i]][, + j] - RH_term[[i]][, j]) * height_term[[i]][j] + } + } + print("done correction term") + Mid.Late.Season.cuts <- lapply(Daily.Crops.list, function(x) which(x$season.ID == + 3 | x$season.ID == 4)) + Before <- Kcb.corrected + for (i in 1:length(Kcb.corrected)) { + for (j in 1:length(Kcb.corrected[[i]])) { + Kcb.corrected[[i]][, j][which(GS.RHmin[[i]][, j] > + 20 & GS.RHmin[[i]][, j] < 80)] <- Kcb[[i]][j] + Kcb.corrected[[i]][, j][which(GS.U2[[i]][, j] > 1 & + GS.U2[[i]][, j] < 6)] <- Kcb[[i]][j] + } + } + all.equal(Before, Kcb.corrected) + all.equal(lapply(Before, function(x) dim(x)), lapply(Kcb.corrected, + function(x) dim(x))) + all.equal(names(Before), names(Kcb.corrected)) + save(Kcb.corrected, file = paste0(Intermediates, paste("Kcb.corrected", + Croplayer, "Rdata", sep = "."))) + } +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ ~kwd1 } +\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line diff --git a/man/Calc.Fc.Few.Rd b/man/Calc.Fc.Few.Rd new file mode 100644 index 0000000..2113e5a --- /dev/null +++ b/man/Calc.Fc.Few.Rd @@ -0,0 +1,79 @@ +\name{Calc.Fc.Few} +\alias{Calc.Fc.Few} +%- Also NEED an '\alias' for EACH other topic documented here. +\title{ +%% ~~function to do ... ~~ +} +\description{ +%% ~~ A concise (1-5 lines) description of what the function does. ~~ +} +\usage{ +Calc.Fc.Few(Croplayer) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{Croplayer}{ +%% ~~Describe \code{Croplayer} here~~ +} +} +\details{ +%% ~~ If necessary, more details than the description above ~~ +} +\value{ +%% ~Describe the value returned +%% If it is a LIST, use +%% \item{comp1 }{Description of 'comp1'} +%% \item{comp2 }{Description of 'comp2'} +%% ... +} +\references{ +%% ~put references to the literature/web site here ~ +} +\author{ +%% ~~who you are~~ +} +\note{ +%% ~~further notes~~ +} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +\seealso{ +%% ~~objects to See Also as \code{\link{help}}, ~~~ +} +\examples{ +##---- Should be DIRECTLY executable !! ---- +##-- ==> Define data, use random, +##-- or do help(data=index) for the standard data sets. + +## The function is currently defined as +function (Croplayer) +{ + load(paste0(Intermediates, paste("KcMax", Croplayer, "Rdata", + sep = "."))) + GR.KcMax <- lapply(KcMax, function(x) x[, (grep("layer", + names(x)))]) + load(paste0(Intermediates, paste("CropsList", Croplayer, + "Rdata", sep = "."))) + DayHeight <- lapply(Daily.Crops.list, function(x) x$day_height) + load(paste0(Intermediates, paste("Kcb.corrected", Croplayer, + "Rdata", sep = "."))) + KcMin <- lapply(Kcb.corrected, function(x) c(rep(min(x) - + 0.01, times = length(x)))) + Fc <- GR.KcMax + for (i in 1:length(Fc)) { + for (j in 1:length(DayHeight[[i]])) { + Fc[[i]][, j] <- ((Kcb.corrected[[i]][, j] - KcMin[[i]][j])/(GR.KcMax[[i]][, + j] - KcMin[[i]][j]))^(1 + 0.5 * DayHeight[[i]][j]) + } + } + Few <- Fc + Few <- lapply(Fc, function(x) 1 - x[]) + save(Few, file = paste0(Intermediates, paste("Few", Croplayer, + "Rdata", sep = "."))) + } +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ ~kwd1 } +\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line diff --git a/man/Calculate.ETo.Rd b/man/Calculate.ETo.Rd new file mode 100644 index 0000000..2343412 --- /dev/null +++ b/man/Calculate.ETo.Rd @@ -0,0 +1,178 @@ +\name{Calculate.ETo} +\alias{Calculate.ETo} +%- Also NEED an '\alias' for EACH other topic documented here. +\title{ +%% ~~function to do ... ~~ +} +\description{ +%% ~~ A concise (1-5 lines) description of what the function does. ~~ +} +\usage{ +Calculate.ETo(Elevation, MaxTemperature, MinTemperature, MeanTemperature, Precipitation, VP, MaxRH, MinRH, Wind, SolarRad, Filename) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{Elevation}{ +%% ~~Describe \code{Elevation} here~~ +} + \item{MaxTemperature}{ +%% ~~Describe \code{MaxTemperature} here~~ +} + \item{MinTemperature}{ +%% ~~Describe \code{MinTemperature} here~~ +} + \item{MeanTemperature}{ +%% ~~Describe \code{MeanTemperature} here~~ +} + \item{Precipitation}{ +%% ~~Describe \code{Precipitation} here~~ +} + \item{VP}{ +%% ~~Describe \code{VP} here~~ +} + \item{MaxRH}{ +%% ~~Describe \code{MaxRH} here~~ +} + \item{MinRH}{ +%% ~~Describe \code{MinRH} here~~ +} + \item{Wind}{ +%% ~~Describe \code{Wind} here~~ +} + \item{SolarRad}{ +%% ~~Describe \code{SolarRad} here~~ +} + \item{Filename}{ +%% ~~Describe \code{Filename} here~~ +} +} +\details{ +%% ~~ If necessary, more details than the description above ~~ +} +\value{ +%% ~Describe the value returned +%% If it is a LIST, use +%% \item{comp1 }{Description of 'comp1'} +%% \item{comp2 }{Description of 'comp2'} +%% ... +} +\references{ +%% ~put references to the literature/web site here ~ +} +\author{ +%% ~~who you are~~ +} +\note{ +%% ~~further notes~~ +} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +\seealso{ +%% ~~objects to See Also as \code{\link{help}}, ~~~ +} +\examples{ +##---- Should be DIRECTLY executable !! ---- +##-- ==> Define data, use random, +##-- or do help(data=index) for the standard data sets. + +## The function is currently defined as +function (Elevation, MaxTemperature, MinTemperature, MeanTemperature, + Precipitation, VP, MaxRH, MinRH, Wind, SolarRad, Filename) +{ + LHV <- 2.45 + Cp <- 1.013 * 10^-3 + E <- 0.622 + Alpha <- 0.23 + G <- 0 + Gsc <- 0.082 + As0 <- 0.75 + Bs0 <- 2 * 10^-5 + Sigma <- 4.903 * 10^-9 + Elev <- raster(Elevation) + MaxTemp <- brick(MaxTemperature) + MinTemp <- brick(MinTemperature) + MeanTemp <- brick(MeanTemperature) + Precip <- brick(Precipitation) + EaPascal <- brick(VP) + Ea <- EaPascal/1000 + MxRH <- brick(MaxRH) + MnRH <- brick(MinRH) + U2 <- brick(Wind) + Sol_watts <- brick(SolarRad) + Solar <- Sol_watts/11.6 + Lat <- raster("Lat.values.grd") + Long <- raster("Long.values.grd") + Julian <- brick("Julian.values.grd") + Rasters <- list(MaxTemp, MinTemp, MeanTemp, MxRH, MnRH, U2, + Solar, Ea, Julian) + print("do the rasters match?") + print(sapply(Rasters, function(x) compareRaster(x, Elev))) + E0Max <- calc(MaxTemp, fun = function(x) { + 0.6108 * exp(17.27 * x/(x + 273.3)) + }) + Dr <- calc(Julian, fun = function(x) { + 1 + 0.033 * cos(2 * pi/365 * x) + }) + Theta <- calc(Julian, fun = function(x) { + 0.409 * sin((2 * pi/365 * x) - 1.39) + }) + Lrad <- Lat * pi/180 + b <- calc(Julian, fun = function(x) { + 2 * pi * (x - 81)/364 + }) + Sc <- 0.1645 * sin(2 * b) - 0.1255 * cos(b) - 0.025 * sin(b) + Ws <- acos(-1 * tan(Lrad) * tan(Theta)) + Gsc <- 0.082 + N <- 24/pi * Ws + Multiply.Day <- calc(Dr, fun = function(x) { + (24 * 60)/pi * Gsc * x + }) + Ra <- Multiply.Day * (Ws * sin(Lrad) * sin(Theta) + cos(Lrad) * + cos(Theta) * sin(Ws)) + Rs0 <- (As0 + Bs0 * Elev) * Ra + Sigma <- 4.903 * 10^-9 + KTmax <- MaxTemp + 273.16 + KTmin <- MinTemp + 273.16 + Bs0 <- Elev * 10^-5 + Rs0 <- (As0 + Bs0 * Elev) * Ra + P <- calc(Elev, fun = function(x) { + 101.3 * ((293 - 0.0065 * (x))/293)^5.26 + }) + gamma <- Cp * P/E * LHV + E0Max <- calc(MaxTemp, fun = function(x) { + 0.6108 * exp(17.27 * x/(x + 273.3)) + }) + E0Min <- calc(MinTemp, fun = function(x) { + 0.6108 * exp(17.27 * x/(x + 273.3)) + }) + Es <- (E0Min + E0Max)/2 + E0Mean <- calc(MeanTemp, fun = function(x) { + 0.6108 * exp(17.27 * x/(x + 273.3)) + }) + Delta <- 4098 * (E0Mean)/((MeanTemp + 273.3)^2) + Ea1 <- (E0Min * MxRH/100 + E0Max * MnRH/100)/2 + VPD <- Es - Ea + Sigma <- 4.903 * 10^-9 + KTmax <- MaxTemp + 273.16 + KTmin <- MinTemp + 273.16 + Rnl <- Sigma * ((KTmax^4 + KTmin^4)/2) * (0.34 - 0.14 * Ea^0.5) * + (1.35 * (Solar/Rs0) - 0.35) + Rns <- calc(Solar, fun = function(x) { + (1 - Alpha) * x + }) + Rn <- Rns - Rnl + Rn <- dropLayer(Rn, 366) + Numerator <- 0.408 * Delta * (Rn - G) + gamma * 900/(MeanTemp + + 273) * U2 * (Es - Ea) + Denominator <- Delta + gamma * (1 + 0.34 * U2) + ETo <- Numerator/Denominator + ETo[ETo < 0] <- 0.001 + ETo <- mask(ETo, U2) + writeRaster(ETo, filename = Filename, overwrite = TRUE) + } +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ ~kwd1 } +\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line diff --git a/man/CropWatR.Rd b/man/CropWatR.Rd new file mode 100644 index 0000000..d31b3e0 --- /dev/null +++ b/man/CropWatR.Rd @@ -0,0 +1,33 @@ +\name{CropWatR} +\docType{package} +\title{ +Crop-water balances according to algorithms described in the FAO Irrigation and drainage paper 56 +} +\description{ +Functions to enable calculation of FAO Penman-Monteith reference evapotranspiration, crop- and soil-water balances for agricultural crops. GIS-enabled implementation (using R's basic spatial packages, including rgeos, rgdal sp, raster) at a daily time-step, including calibration methods for irrigation scheduling and variable crop planting and harvesting dates. Crop-water models according to the FAO 56 document 'Crop evapotranspiration - Guidelines for computing crop water requirements' +} +\details{ +\tabular{ll}{ +Package: \tab CropWatR\cr +Type: \tab Package\cr +Version: \tab 1.0\cr +Date: \tab 2015-09-06\cr +License: \tab GPL-2\cr +} +} +\author{ +Jacob Teter +Maintainer: +} +\references{ +1. An improved crop-water model to estimate regional crop water use. Draft article for publication. +2. Crop evapotranspiration - Guidelines for computing crop water requirements - FAO Irrigation and drainage paper 56 +} +\keyword{ spatial } +\seealso{ +\code{\link[:-package]{}} +\code{\link[:-package]{}} +} +\examples{ +~~ simple examples of the most important functions ~~ +} diff --git a/man/Daily.Crop.Curves.Rd b/man/Daily.Crop.Curves.Rd new file mode 100644 index 0000000..fb0850b --- /dev/null +++ b/man/Daily.Crop.Curves.Rd @@ -0,0 +1,138 @@ +\name{Daily.Crop.Curves} +\alias{Daily.Crop.Curves} +%- Also NEED an '\alias' for EACH other topic documented here. +\title{ +%% ~~function to do ... ~~ +} +\description{ +%% ~~ A concise (1-5 lines) description of what the function does. ~~ +} +\usage{ +Daily.Crop.Curves(Croplayer, StateNames, Stages, Kcb_tab, MaxHeight) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{Croplayer}{ +%% ~~Describe \code{Croplayer} here~~ +} + \item{StateNames}{ +%% ~~Describe \code{StateNames} here~~ +} + \item{Stages}{ +%% ~~Describe \code{Stages} here~~ +} + \item{Kcb_tab}{ +%% ~~Describe \code{Kcb_tab} here~~ +} + \item{MaxHeight}{ +%% ~~Describe \code{MaxHeight} here~~ +} +} +\details{ +%% ~~ If necessary, more details than the description above ~~ +} +\value{ +%% ~Describe the value returned +%% If it is a LIST, use +%% \item{comp1 }{Description of 'comp1'} +%% \item{comp2 }{Description of 'comp2'} +%% ... +} +\references{ +%% ~put references to the literature/web site here ~ +} +\author{ +%% ~~who you are~~ +} +\note{ +%% ~~further notes~~ +} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +\seealso{ +%% ~~objects to See Also as \code{\link{help}}, ~~~ +} +\examples{ +##---- Should be DIRECTLY executable !! ---- +##-- ==> Define data, use random, +##-- or do help(data=index) for the standard data sets. + +## The function is currently defined as +function (Croplayer, StateNames, Stages, Kcb_tab, MaxHeight) +{ + root.depth <- read.csv("crop.roots.csv") + Crop <- Croplayer + if (Croplayer == "spring_barley" | Croplayer == "fall_barley") { + Crop <- "barley" + } + if (Croplayer == "spring_oats" | Croplayer == "fall_oats") { + Crop <- "oats" + } + if (Croplayer == "durum_wheat") { + Crop <- "spring_wheat" + } + root.depth <- subset(root.depth, crop == Crop, select = c(min_rooting_depth, + max_rooting_depth)) + Season <- rowSums(Stages) + Base <- lapply(Season, function(x) x = c(1:x)) + Next <- Base + Kci <- Base + Height.Kci <- Base + DailyKcb <- Base + Growth_split <- Base + season.ID <- Base + day_height <- Base + MAX.Height <- Base + One.Minus.Fc <- Base + Roots <- Base + Day_Roots <- Base + for (i in 1:length(Next)) { + B <- c(Stages[i, 1], sum(c(Stages[i, 1], Stages[i, 2])), + sum(c(Stages[i, 1], Stages[i, 2], Stages[i, 3])), + sum(Stages[i, ])) + Xs <- c(1, B[1], mean(c(B[1], B[1], B[2])), mean(c(B[1], + B[2])), mean(c(B[2], B[2], B[3])), B[3], mean(c(B[3], + B[4])), B[4]) + Ys <- c(0.01, 0.02, Kcb_tab[[1]], Kcb_tab[[2]], sum(c(Kcb_tab[[1]], + Kcb_tab[[2]], Kcb_tab[[3]])), Kcb_tab[[2]], mean(c(Kcb_tab[[2]], + Kcb_tab[[3]])), Kcb_tab[[3]]) + P <- data.frame(bezierCurve(Xs, Ys, 500)) + Q <- P[!duplicated(round(P$x)), ] + Q$x <- round(Q$x) + Kci[[i]] <- round(Q$y, digits = 2) + Growth_split[[i]] <- unlist(c(0.01, 0.015, rep(NA, times = ceiling(Stages[i, + 1]/2) - 2), Kcb_tab[1], rep(NA, times = floor(Stages[i, + 1]/2) - 1), rep(NA, times = Stages[i, 2] - 1), Kcb_tab[2], + rep(Kcb_tab[2], times = Stages[i, 3]), rep(NA, times = (Stages[i, + 4] - 1)), Kcb_tab[3])) + Height.Kci[[i]] <- spline(Base[[i]], Growth_split[[i]], + xout = Base[[i]], method = "natural", ties = mean)$y + MAX.Height[[i]] <- max(Height.Kci[[i]]) + day_height[[i]] <- round(Height.Kci[[i]] * MaxHeight/MAX.Height[[i]], + 2) + Zs <- c(0.1, 0.15, mean(c(0.15, root.depth[[1]])), root.depth[[1]], + root.depth[[2]], sum(c(mean(c(0.15, root.depth[[1]])), + root.depth[[2]])), root.depth[[2]], root.depth[[1]]) + R <- data.frame(bezierCurve(Xs, Zs, 500)) + S <- R[!duplicated(round(R$x)), ] + S$x <- round(S$x) + Day_Roots[[i]] <- round(S$y, digits = 2) + season.ID[[i]] <- as.factor(c(rep(1, times = Stages[i, + 1]), rep(2, times = Stages[i, 2]), rep(3, times = Stages[i, + 3]), rep(4, times = Stages[i, 4]))) + DailyKcb[[i]] <- as.data.frame(cbind(Base[[i]], round(Kci[[i]], + 2), round(Day_Roots[[i]], 2), day_height[[i]], as.factor(season.ID[[i]]))) + names(DailyKcb[[i]]) <- c("Season_day", "daily_Kcb", + "daily_root.depth", "day_height", "season.ID") + } + names(DailyKcb) <- StateNames + save(DailyKcb, file = paste0(Intermediates, "Daily.Crop.Profile.", + Croplayer, ".Rdata")) + return(DailyKcb) + } +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ ~kwd1 } +\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line diff --git a/man/Daily.Crop.Parameters.Rd b/man/Daily.Crop.Parameters.Rd new file mode 100644 index 0000000..763cfa6 --- /dev/null +++ b/man/Daily.Crop.Parameters.Rd @@ -0,0 +1,62 @@ +\name{Daily.Crop.Parameters} +\alias{Daily.Crop.Parameters} +%- Also NEED an '\alias' for EACH other topic documented here. +\title{ +%% ~~function to do ... ~~ +} +\description{ +%% ~~ A concise (1-5 lines) description of what the function does. ~~ +} +\usage{ +Daily.Crop.Parameters(Croplayer) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{Croplayer}{ +%% ~~Describe \code{Croplayer} here~~ +} +} +\details{ +%% ~~ If necessary, more details than the description above ~~ +} +\value{ +%% ~Describe the value returned +%% If it is a LIST, use +%% \item{comp1 }{Description of 'comp1'} +%% \item{comp2 }{Description of 'comp2'} +%% ... +} +\references{ +%% ~put references to the literature/web site here ~ +} +\author{ +%% ~~who you are~~ +} +\note{ +%% ~~further notes~~ +} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +\seealso{ +%% ~~objects to See Also as \code{\link{help}}, ~~~ +} +\examples{ +##---- Should be DIRECTLY executable !! ---- +##-- ==> Define data, use random, +##-- or do help(data=index) for the standard data sets. + +## The function is currently defined as +function (Croplayer) +{ + Calc.Basal.Crop.Coeff(Croplayer) + KcMAX(Croplayer) + KcMAX.fallow(Croplayer) + Calc.Fc.Few(Croplayer) + Fallow.Few.Calc(Croplayer) + } +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ ~kwd1 } +\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line diff --git a/man/Estimate.Crop.Rd b/man/Estimate.Crop.Rd new file mode 100644 index 0000000..36d5897 --- /dev/null +++ b/man/Estimate.Crop.Rd @@ -0,0 +1,92 @@ +\name{Estimate.Crop} +\alias{Estimate.Crop} +%- Also NEED an '\alias' for EACH other topic documented here. +\title{ +%% ~~function to do ... ~~ +} +\description{ +%% ~~ A concise (1-5 lines) description of what the function does. ~~ +} +\usage{ +Estimate.Crop(crop) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{crop}{ +%% ~~Describe \code{crop} here~~ +} +} +\details{ +%% ~~ If necessary, more details than the description above ~~ +} +\value{ +%% ~Describe the value returned +%% If it is a LIST, use +%% \item{comp1 }{Description of 'comp1'} +%% \item{comp2 }{Description of 'comp2'} +%% ... +} +\references{ +%% ~put references to the literature/web site here ~ +} +\author{ +%% ~~who you are~~ +} +\note{ +%% ~~further notes~~ +} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +\seealso{ +%% ~~objects to See Also as \code{\link{help}}, ~~~ +} +\examples{ +##---- Should be DIRECTLY executable !! ---- +##-- ==> Define data, use random, +##-- or do help(data=index) for the standard data sets. + +## The function is currently defined as +function (crop) +{ + Subset.Growth.Season(crop) + print(paste("Seasons subsetted and rescaled for", crop)) + Daily.Crop.Parameters(crop) + print(paste("Daily crop parameters estimated for", crop)) + Final.Daily.ET.Calc(crop) + print(paste("Daily crop water balance estimated for", crop)) + Sum.Save.Daily.Evapotranspiration(crop, rainfed = TRUE) + Sum.Save.Daily.Evapotranspiration(crop, rainfed = FALSE) + print(paste("Daily ET rasters made for", crop)) + Sum.Save.Water.Balances(crop, rainfed = FALSE, type = "seasonal", + BW.GW = FALSE) + Sum.Save.Water.Balances(crop, rainfed = FALSE, type = "annual", + BW.GW = FALSE) + Sum.Save.Water.Balances(crop, rainfed = TRUE, type = "seasonal", + BW.GW = FALSE) + Sum.Save.Water.Balances(crop, rainfed = TRUE, type = "annual", + BW.GW = FALSE) + Sum.Save.Water.Balances(crop, rainfed = FALSE, type = "seasonal", + BW.GW = TRUE) + Generate.Land.Use(crop) + print(paste("land use raster generated for", crop)) + print(paste("Annual and seasonal water balance rasters saved for", + crop)) + SuperImpose.WB.on.LU(crop, rainfed = FALSE, type = "seasonal", + Growing.Season.GW.BW = FALSE) + SuperImpose.WB.on.LU(crop, rainfed = FALSE, type = "annual", + Growing.Season.GW.BW = FALSE) + SuperImpose.WB.on.LU(crop, rainfed = TRUE, type = "seasonal", + Growing.Season.GW.BW = FALSE) + SuperImpose.WB.on.LU(crop, rainfed = TRUE, type = "annual", + Growing.Season.GW.BW = FALSE) + SuperImpose.WB.on.LU(crop, rainfed = FALSE, type = "seasonal", + Growing.Season.GW.BW = TRUE) + print(paste("Water balances superimposed on land use for", + crop)) + } +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ ~kwd1 } +\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line diff --git a/man/Fallow.Few.Calc.Rd b/man/Fallow.Few.Calc.Rd new file mode 100644 index 0000000..733fd39 --- /dev/null +++ b/man/Fallow.Few.Calc.Rd @@ -0,0 +1,93 @@ +\name{Fallow.Few.Calc} +\alias{Fallow.Few.Calc} +%- Also NEED an '\alias' for EACH other topic documented here. +\title{ +%% ~~function to do ... ~~ +} +\description{ +%% ~~ A concise (1-5 lines) description of what the function does. ~~ +} +\usage{ +Fallow.Few.Calc(Croplayer) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{Croplayer}{ +%% ~~Describe \code{Croplayer} here~~ +} +} +\details{ +%% ~~ If necessary, more details than the description above ~~ +} +\value{ +%% ~Describe the value returned +%% If it is a LIST, use +%% \item{comp1 }{Description of 'comp1'} +%% \item{comp2 }{Description of 'comp2'} +%% ... +} +\references{ +%% ~put references to the literature/web site here ~ +} +\author{ +%% ~~who you are~~ +} +\note{ +%% ~~further notes~~ +} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +\seealso{ +%% ~~objects to See Also as \code{\link{help}}, ~~~ +} +\examples{ +##---- Should be DIRECTLY executable !! ---- +##-- ==> Define data, use random, +##-- or do help(data=index) for the standard data sets. + +## The function is currently defined as +function (Croplayer) +{ + load(paste0(Intermediates, paste("Fallow.Season", Croplayer, + "MNRH_", "Rdata", sep = "."))) + Template <- Fallow.Season + rm(Fallow.Season) + Template <- lapply(Template, function(x) x[, (grep("layer", + names(x)))]) + Fc <- Template + load(paste0(Intermediates, paste("KcMax.Fallow", Croplayer, + "Rdata", sep = "."))) + KcMax.fallow <- lapply(KcMax, function(x) x[, (grep("layer", + names(x)))]) + all.equal(sapply(Template, dim), sapply(KcMax.fallow, dim)) + Off.season.vars <- c("winter_wheat", "durum_wheat", "fall_barley", + "fall_oats") + if (Croplayer \%in\% Off.season.vars) { + KcMin <- lapply(Template, function(x) c(rep(0.15, times = (length(x))))) + DayHeight <- lapply(Template, function(x) c(rep(0.15, + times = (length(x))))) + Kcb <- lapply(Template, function(x) c(rep(1, times = (length(x))))) + } + if (!(Croplayer \%in\% Off.season.vars)) { + KcMin <- lapply(Template, function(x) c(rep(0.03, times = (length(x))))) + DayHeight <- lapply(Template, function(x) c(rep(0.05, + times = (length(x))))) + Kcb <- lapply(Template, function(x) c(rep(0.07, times = (length(x))))) + } + for (i in 1:length(Fc)) { + for (j in 1:length(DayHeight[[i]])) { + Fc[[i]][, j] <- ((Kcb[[i]][j] - KcMin[[i]][j])/(KcMax.fallow[[i]][j] - + KcMin[[i]][j]))^(1 + 0.5 * DayHeight[[i]][j]) + } + } + Fallow.Few <- Fc + Fallow.Few <- lapply(Fc, function(x) 1 - x[]) + save(Fallow.Few, file = paste0(Intermediates, paste("Fallow.Few", + Croplayer, "Rdata", sep = "."))) + } +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ ~kwd1 } +\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line diff --git a/man/Fallow.Postseason.Daily.ET.Calc.Rd b/man/Fallow.Postseason.Daily.ET.Calc.Rd new file mode 100644 index 0000000..869b8e8 --- /dev/null +++ b/man/Fallow.Postseason.Daily.ET.Calc.Rd @@ -0,0 +1,372 @@ +\name{Fallow.Postseason.Daily.ET.Calc} +\alias{Fallow.Postseason.Daily.ET.Calc} +%- Also NEED an '\alias' for EACH other topic documented here. +\title{ +%% ~~function to do ... ~~ +} +\description{ +%% ~~ A concise (1-5 lines) description of what the function does. ~~ +} +\usage{ +Fallow.Postseason.Daily.ET.Calc(Croplayer, Overwrite = FALSE) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{Croplayer}{ +%% ~~Describe \code{Croplayer} here~~ +} + \item{Overwrite}{ +%% ~~Describe \code{Overwrite} here~~ +} +} +\details{ +%% ~~ If necessary, more details than the description above ~~ +} +\value{ +%% ~Describe the value returned +%% If it is a LIST, use +%% \item{comp1 }{Description of 'comp1'} +%% \item{comp2 }{Description of 'comp2'} +%% ... +} +\references{ +%% ~put references to the literature/web site here ~ +} +\author{ +%% ~~who you are~~ +} +\note{ +%% ~~further notes~~ +} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +\seealso{ +%% ~~objects to See Also as \code{\link{help}}, ~~~ +} +\examples{ +##---- Should be DIRECTLY executable !! ---- +##-- ==> Define data, use random, +##-- or do help(data=index) for the standard data sets. + +## The function is currently defined as +function (Croplayer, Overwrite = FALSE) +{ + load(paste0(Intermediates, paste("Fallow.Saved", Croplayer, + "Rdata", sep = "."))) + Post.ETo <- Fallow.File[[2]] + Post.Precip <- Fallow.File[[4]] + Post.Few <- Fallow.File[[6]] + Post.ROi <- Fallow.File[[8]] + Qfc.minus.Qwp <- Fallow.File[[9]] + Post.Dei <- Fallow.File[[11]] + TAW <- Fallow.File[[12]] + TEW <- Fallow.File[[13]] + REW <- Fallow.File[[14]] + Post.Kr <- Post.Precip + Post.Ke <- Post.Precip + Post.Dei <- Post.Precip + Post.DPei <- Post.Precip + Post.Kcb.tot <- Post.Precip + Post.E <- Post.Precip + Post.Fw <- Post.Precip + Post.Dr <- Post.Precip + Post.DP <- Post.Precip + Post.Ks <- Post.Precip + Post.Kcb.tot <- Post.Precip + Post.Pval <- Post.Precip + Post.TAW <- Post.Precip + Post.RAW <- Post.Precip + Post.Kcb <- Post.Precip + if (file.exists(paste0(Intermediates, paste("KcMax.Fallow", + Croplayer, "Rdata", sep = "."))) == FALSE) { + KcMAX.fallow(Croplayer) + } + load(paste0(Intermediates, paste("KcMax.Fallow", Croplayer, + "Rdata", sep = "."))) + KcMax <- lapply(KcMax, function(x) x[, (grep("layer", names(x)))]) + DaysRow <- lapply(Post.Precip, function(x) as.numeric(gsub("layer.", + "", names(x)))) + Cuts <- lapply(DaysRow, function(x) which(diff(x) > 1)) + Cuts <- sapply(Cuts, function(x) replace(x, length(x) == + 0, 0)) + LengthCheck <- unlist(lapply(DaysRow, length)) + CutCheck <- unlist(Cuts) + for (i in 1:length(KcMax)) { + if (length(CutCheck) == 0) { + KcMax[[i]] <- KcMax[[i]][1:length(Post.Precip[[i]])] + } + if (length(Cuts[[i]]) == 0) { + KcMax[[i]] <- KcMax[[i]][1:length(KcMax[[i]])] + } + else { + KcMax[[i]] <- KcMax[[i]][, Cuts[[i]]:length(KcMax[[i]])] + } + while (length(KcMax[[i]]) > length(Post.Precip[[i]])) { + KcMax[[i]] <- KcMax[[i]][, 1:length(KcMax[[i]]) - + 1] + } + } + print("Post Season KcMax layer lengths equal?:") + print(all.equal(lapply(KcMax, length), lapply(Post.Precip, + length))) + Kcb <- 0.55 + load(paste0(Intermediates, paste("Growing.Season", Croplayer, + "Precip_", "Rdata", sep = "."))) + Precip <- Growing.Season + rm(Growing.Season) + Qfc.minus.Qwp <- lapply(Precip, function(x) x$Qfc.minus.Qwp) + root.depth <- 0.1 + TAW <- lapply(Qfc.minus.Qwp, function(x) 1000 * (x[] * root.depth)) + TEW <- lapply(Precip, function(x) x$ave_TEW) + Dei <- TEW + REW <- lapply(Precip, function(x) x$ave_REW) + if (!file.exists(paste0(Intermediates, paste("Postseason_Deep.Percolation", + Croplayer, "Rdata", sep = "."))) | Overwrite == TRUE) { + Others <- c("switchgrass", "miscanthus", "idle_cropland", + "pasture_grass", "silage") + load("Vars.Rdata") + if (Croplayer \%in\% Vars) { + setwd(paste0(Path, "/CropWatR/Intermediates/")) + load(paste("Growing.Season_Root.Zone.Depletion", + Croplayer, "Rdata", sep = ".")) + load(paste("Growing.Season_Deep.Percolation", Croplayer, + "Rdata", sep = ".")) + load(paste("Growing.Season_Runoff", Croplayer, "Rdata", + sep = ".")) + load(paste("Growing.Season_Soil.Evaporation", Croplayer, + "Rdata", sep = ".")) + load(paste("Growing.Saved", Croplayer, "Rdata", sep = ".")) + load(paste("Growing.Season_Soil.Water.Balance", Croplayer, + "Rdata", sep = ".")) + DPe <- local(get(load(file = paste("Growing.Season.Root.Zone.Percolation.Loss", + Croplayer, "Rdata", sep = ".")))) + load(file = paste("Growing.Season.Evaporation.Fractions", + Croplayer, "Rdata", sep = ".")) + setwd(paste0(Path, "/CropWatR/Data")) + } + if (Croplayer \%in\% Others) { + setwd(paste0(Path, "/CropWatR/Intermediates/")) + load(paste("Growing.Season_Root.Zone.Depletion", + Croplayer, "Rdata", sep = ".")) + load(paste("Growing.Season_Deep.Percolation", Croplayer, + "Rdata", sep = ".")) + load(paste("Growing.Season_Runoff", Croplayer, "Rdata", + sep = ".")) + load(paste("Growing.Season_Soil.Evaporation", Croplayer, + "Rdata", sep = ".")) + load(paste("Growing.Saved", Croplayer, "Rdata", sep = ".")) + load(paste("Growing.Season_Soil.Water.Balance", Croplayer, + "Rdata", sep = ".")) + load(file = paste("Growing.Season.Root.Zone.Percolation.Loss", + Croplayer, "Rdata", sep = ".")) + load(file = paste("Growing.Season.Evaporation.Fractions", + Croplayer, "Rdata", sep = ".")) + setwd(paste0(Path, "/CropWatR/Data")) + } + ETo <- Growing.Files[[1]] + Precip <- Growing.Files[[2]] + ROi <- Growing.Files[[3]] + Irr <- Growing.Files[[4]] + Fw <- Growing.Files[[5]] + print("starting calculation of post season") + for (i in 1:length(Post.Precip)) { + for (j in 1:length(Post.Precip[[i]])) { + Kcb <- 0.75 + if (j == 1) { + Post.Fw[[i]][, j] <- Few[[i]][, length(Few[[i]])] + Post.Kr[[i]][, j][De[[i]][, length(De[[i]])] > + REW[[i]]] <- (TEW[[i]][De[[i]][, length(De[[i]])] > + REW[[i]]] - De[[i]][, length(De[[i]])][De[[i]][, + length(De[[i]])] > REW[[i]]])/(TEW[[i]][De[[i]][, + length(De[[i]])] > REW[[i]]] - REW[[i]][De[[i]][, + length(De[[i]])] > REW[[i]]]) + Post.Kr[[i]][, j][De[[i]][, length(De[[i]])] <= + REW[[i]]] <- 1 + Post.Kr[[i]][, j][Post.Kr[[i]][, j] < 0] <- 0 + Post.Ke[[i]][, j] <- pmin.int(Post.Kr[[i]][, + j] * (KcMax[[i]][, j] - Kcb), Post.Few[[i]][, + j] * KcMax[[i]][, j]) + Post.Ke[[i]][, j][Post.Ke[[i]][, j] < 0] <- 0 + Post.E[[i]][, j] <- Post.Ke[[i]][, j] * Post.ETo[[i]][, + j] + Post.DPei[[i]][, j] <- (Post.Precip[[i]][, + j] - Post.ROi[[i]][, j]) - De[[i]][, length(De[[i]])] + Post.DPei[[i]][, j][Post.DPei[[i]][, j] < 0] <- 0 + Post.Dei[[i]][, j] <- De[[i]][, length(De[[i]])] - + (Post.Precip[[i]][, j] - Post.ROi[[i]][, + j]) + (Post.E[[i]][, j]/Post.Few[[i]][, + j]) + DPe[[i]][, length(DPe[[i]])] + Post.Dei[[i]][, j][Post.Dei[[i]][, j] < 0] <- 0 + Post.Dei[[i]][, j][Post.Dei[[i]][, j] > TEW[[i]]] <- TEW[[i]][Post.Dei[[i]][, + j] > TEW[[i]]] + Post.Kcb[[i]][, j] <- (Kcb + Post.Ke[[i]][, + j]) * Post.ETo[[i]][, j] + Post.Kcb.tot[[i]][, j] <- (Kcb) * Post.ETo[[i]][, + j] + P.value <- 0.1 + Post.Pval[[i]][, j] <- P.value + 0.02 * (5 - + (Post.Kcb.tot[[i]][, j])) + Post.Pval[[i]][, j][Post.Pval[[i]][, j] < 0.1] <- 0.1 + Post.Pval[[i]][, j][Post.Pval[[i]][, j] > 0.8] <- 0.8 + Root.depth <- 0.1 + 0.002 * j + Post.TAW[[i]][, j] <- TAW[[i]] * Root.depth + Post.RAW[[i]][, j] <- Post.Pval[[i]][, j] * + Post.TAW[[i]][, j] + Per.of.field.capacity <- 0.2 + Post.Dr[[i]][, j] <- Post.TAW[[i]][, j] * Per.of.field.capacity + Post.Dr[[i]][, j] <- Post.Dr[[i]][, j] - (Post.Precip[[i]][, + j] - Post.ROi[[i]][, j]) + Post.Kcb.tot[[i]][, + j] + Post.DP[[i]][, j] + Post.Dr[[i]][, j][Post.Dr[[i]][, j] < 0] <- 0 + Post.Dr[[i]][, j][Post.Dr[[i]][, j] > Post.TAW[[i]][, + j]] <- Post.TAW[[i]][, j][Post.Dr[[i]][, + j] > Post.TAW[[i]][, j]] + Post.Ks[[i]][, j][Post.Dr[[i]][, j] > Post.RAW[[i]][, + j]] <- ((Post.TAW[[i]][, j] - Post.Dr[[i]][, + j])[Post.Dr[[i]][, j] > Post.RAW[[i]][, j]])/((1 - + Post.Pval[[i]][, j][Post.Dr[[i]][, j] > Post.RAW[[i]][, + j]]) * Post.TAW[[i]][, j][Post.Dr[[i]][, + j] > Post.RAW[[i]][, j]]) + Post.Ks[[i]][, j][Post.Dr[[i]][, j] <= Post.RAW[[i]][, + j]] <- 1 + Post.DP[[i]][, j] <- (Post.Precip[[i]][, j] - + Post.ROi[[i]][, j]) - Post.Kcb.tot[[i]][, + j] - Dr[[i]][, length(Dr[[i]])] + Post.DP[[i]][, j][Post.Dr[[i]][, j] > 0] <- 0 + Post.DP[[i]][, j][Post.DP[[i]][, j] < 0] <- 0 + Post.Kcb.tot[[i]][, j] <- (Post.Ks[[i]][, j] * + Post.Kcb.tot[[i]][, j]) * Post.ETo[[i]][, + j] + Post.Kcb[[i]][, j] <- (Post.Ks[[i]][, j] * + Post.Kcb[[i]][, j] + Post.Ke[[i]][, j]) * + Post.ETo[[i]][, j] + Post.DPei[[i]][, j] <- (Post.Precip[[i]][, + j] - Post.ROi[[i]][, j]) - De[[i]][, length(De[[i]])] + Post.DPei[[i]][, j][Post.DPei[[i]][, j] < 0] <- 0 + } + else { + Kcb <- Kcb - 0.003 * j + Kcb[Kcb < 0.005] <- 0.005 + Post.Fw[[i]][, j] <- Post.Few[[i]][, j - 1] + Post.Few[[i]][, j] <- pmin.int(Post.Few[[i]][, + j], Post.Fw[[i]][, j]) + Post.Kr[[i]][, j][Post.Dei[[i]][, (j - 1)] > + REW[[i]]] <- (TEW[[i]][Post.Dei[[i]][, (j - + 1)] > REW[[i]]] - Post.Dei[[i]][, (j - 1)][Post.Dei[[i]][, + (j - 1)] > REW[[i]]])/(TEW[[i]][Post.Dei[[i]][, + (j - 1)] > REW[[i]]] - REW[[i]][Post.Dei[[i]][, + (j - 1)] > REW[[i]]]) + Post.Kr[[i]][, j][Post.Dei[[i]][, (j - 1)] <= + REW[[i]]] <- 1 + Post.Kr[[i]][, j][Post.Kr[[i]][, j] < 0] <- 0 + Post.Ke[[i]][, j] <- pmin.int(Post.Kr[[i]][, + j] * (KcMax[[i]][, j] - Kcb), Post.Few[[i]][, + j] * KcMax[[i]][, j]) + Post.Ke[[i]][, j][Post.Ke[[i]][, j] < 0] <- 0 + Post.E[[i]][, j] <- Post.Ke[[i]][, j] * Post.ETo[[i]][, + j] + if (length(Post.E[[i]][, j][Post.E[[i]][, j] > + 5]) > 0) { + print("Evaporation triggered:") + print("day col:") + print(j) + print("State code") + print(names(Post.Precip[i])) + print("Evap profile") + print(Post.E[[i]][, j][Post.E[[i]][, j] > + 5]) + print("ETo profile") + print(Post.ETo[[i]][, j][Post.E[[i]][, j] > + 5]) + print("Ke profile") + print(Post.Ke[[i]][, j][Post.E[[i]][, j] > + 5]) + } + Post.DPei[[i]][, j] <- (Post.Precip[[i]][, + j] - Post.ROi[[i]][, j]) - Post.Dei[[i]][, + (j - 1)] + Post.DPei[[i]][, j][Post.DPei[[i]][, j] < 0] <- 0 + Post.Dei[[i]][, j] <- Post.Dei[[i]][, (j - + 1)] - (Post.Precip[[i]][, j] - Post.ROi[[i]][, + j]) + (Post.E[[i]][, j]/Post.Few[[i]][, j]) + + Post.DPei[[i]][, j] + Post.Dei[[i]][, j][Post.Dei[[i]][, j] < 0] <- 0 + Post.Dei[[i]][, j][Post.Dei[[i]][, j] > TEW[[i]]] <- TEW[[i]][Post.Dei[[i]][, + j] > TEW[[i]]] + Post.Kcb[[i]][, j] <- (Kcb + Post.Ke[[i]][, + j]) * Post.ETo[[i]][, j] + Post.Kcb.tot[[i]][, j] <- (Kcb) * Post.ETo[[i]][, + j] + P.value <- 0.05 + Post.Pval[[i]][, j] <- P.value + 0.04 * (5 - + (Post.Kcb.tot[[i]][, j])) + Post.Pval[[i]][, j][Post.Pval[[i]][, j] < 0.1] <- 0.1 + Post.Pval[[i]][, j][Post.Pval[[i]][, j] > 0.8] <- 0.8 + Root.depth <- 0.05 + 0.002 * j + Post.TAW[[i]][, j] <- TAW[[i]] * Root.depth + Post.RAW[[i]][, j] <- Post.Pval[[i]][, j] * + Post.TAW[[i]][, j] + Post.Dr[[i]][, j] <- Post.Dr[[i]][, (j - 1)] - + (Post.Precip[[i]][, j] - Post.ROi[[i]][, + j]) + Post.Kcb.tot[[i]][, j] + Post.DP[[i]][, + (j - 1)] + Post.Dr[[i]][, j][Post.Dr[[i]][, j] < 0] <- 0 + Post.Dr[[i]][, j][Post.Dr[[i]][, j] > Post.TAW[[i]][, + j]] <- Post.TAW[[i]][, j][Post.Dr[[i]][, + j] > Post.TAW[[i]][, j]] + Post.Ks[[i]][, j][Post.Dr[[i]][, j] > Post.RAW[[i]][, + j]] <- ((Post.TAW[[i]][, j] - Post.Dr[[i]][, + j])[Post.Dr[[i]][, j] > Post.RAW[[i]][, j]])/((1 - + Post.Pval[[i]][, j][Post.Dr[[i]][, j] > Post.RAW[[i]][, + j]]) * Post.TAW[[i]][, j][Post.Dr[[i]][, + j] > Post.RAW[[i]][, j]]) + Post.Ks[[i]][, j][Post.Dr[[i]][, j] <= Post.RAW[[i]][, + j]] <- 1 + Post.DP[[i]][, j] <- (Post.Precip[[i]][, j] - + Post.ROi[[i]][, j]) - Post.Kcb.tot[[i]][, + j] - Post.Dr[[i]][, j - 1] + Post.DP[[i]][, j][Post.Dr[[i]][, j] > 0] <- 0 + Post.DP[[i]][, j][Post.DP[[i]][, j] < 0] <- 0 + Post.Kcb.tot[[i]][, j] <- (Post.Ks[[i]][, j] * + Post.Kcb.tot[[i]][, j]) * Post.ETo[[i]][, + j] + Post.Kcb[[i]][, j] <- (Post.Ks[[i]][, j] * + Post.Kcb[[i]][, j] + Post.Ke[[i]][, j]) * + Post.ETo[[i]][, j] + Post.DPei[[i]][, j] <- (Post.Precip[[i]][, + j] - Post.ROi[[i]][, j]) - Post.Dei[[i]][, + j - 1] + Post.DPei[[i]][, j][Post.DPei[[i]][, j] < 0] <- 0 + print(mean(Post.E[[i]][, j], na.rm = TRUE)) + print(mean(Post.Kcb.tot[[i]][, j], na.rm = TRUE)) + } + } + } + print("Calculation of Postseason daily soil water balance, deep percolation, and evaporation complete") + setwd(paste0(Path, "/CropWatR/Intermediates/")) + save(Post.Dei, file = paste("Postseason_Soil.Water.Balance", + Croplayer, "Rdata", sep = ".")) + save(Post.DP, file = paste("Postseason_Deep.Percolation", + Croplayer, "Rdata", sep = ".")) + save(Post.ROi, file = paste("Postseason_Runoff", Croplayer, + "Rdata", sep = ".")) + Post.KeETo <- Post.E + save(Post.KeETo, file = paste("Postseason_Soil.Evaporation", + Croplayer, "Rdata", sep = ".")) + save(Post.Kcb.tot, file = paste("Postseason_Weed.Transpiration", + Croplayer, "Rdata", sep = ".")) + setwd(paste0(Path, "/CropWatR/Data")) + print("Postseason files saved") + } + if (file.exists(paste0(Intermediates, paste("Postseason_Deep.Percolation", + Croplayer, "Rdata", sep = "."))) == TRUE && Overwrite == + FALSE) { + print(paste("Post Season already estimated for", Croplayer)) + } + } +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ ~kwd1 } +\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line diff --git a/man/Fallow.Preseason.Daily.ET.Calc.Rd b/man/Fallow.Preseason.Daily.ET.Calc.Rd new file mode 100644 index 0000000..a41a001 --- /dev/null +++ b/man/Fallow.Preseason.Daily.ET.Calc.Rd @@ -0,0 +1,399 @@ +\name{Fallow.Preseason.Daily.ET.Calc} +\alias{Fallow.Preseason.Daily.ET.Calc} +%- Also NEED an '\alias' for EACH other topic documented here. +\title{ +%% ~~function to do ... ~~ +} +\description{ +%% ~~ A concise (1-5 lines) description of what the function does. ~~ +} +\usage{ +Fallow.Preseason.Daily.ET.Calc(Croplayer, Overwrite = FALSE) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{Croplayer}{ +%% ~~Describe \code{Croplayer} here~~ +} + \item{Overwrite}{ +%% ~~Describe \code{Overwrite} here~~ +} +} +\details{ +%% ~~ If necessary, more details than the description above ~~ +} +\value{ +%% ~Describe the value returned +%% If it is a LIST, use +%% \item{comp1 }{Description of 'comp1'} +%% \item{comp2 }{Description of 'comp2'} +%% ... +} +\references{ +%% ~put references to the literature/web site here ~ +} +\author{ +%% ~~who you are~~ +} +\note{ +%% ~~further notes~~ +} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +\seealso{ +%% ~~objects to See Also as \code{\link{help}}, ~~~ +} +\examples{ +##---- Should be DIRECTLY executable !! ---- +##-- ==> Define data, use random, +##-- or do help(data=index) for the standard data sets. + +## The function is currently defined as +function (Croplayer, Overwrite = FALSE) +{ + print(Croplayer) + if (file.exists(paste0(Intermediates, paste("Fallow.Saved", + Croplayer, "Rdata", sep = ".")))) { + print("Fallow.File exists for this cropping patterns, loading it...") + load(paste0(Intermediates, paste("Fallow.Saved", Croplayer, + "Rdata", sep = "."))) + Pre.ETo <- Fallow.File[[1]] + Post.ETo <- Fallow.File[[2]] + Pre.Precip <- Fallow.File[[3]] + Post.Precip <- Fallow.File[[4]] + Pre.Few <- Fallow.File[[5]] + Post.Few <- Fallow.File[[6]] + Pre.ROi <- Fallow.File[[7]] + Post.ROi <- Fallow.File[[8]] + Qfc.minus.Qwp <- Fallow.File[[9]] + Pre.Dei <- Fallow.File[[10]] + Post.Dei <- Fallow.File[[11]] + TAW <- Fallow.File[[12]] + TEW <- Fallow.File[[13]] + REW <- Fallow.File[[14]] + } + if (file.exists(paste0(Intermediates, "Fallow.Saved.", Croplayer, + ".Rdata")) == FALSE) { + load(paste0(Intermediates, paste("Fallow.Season", Croplayer, + "ETo_", "Rdata", sep = "."))) + ETo <- Fallow.Season + rm(Fallow.Season) + load(paste0(Intermediates, paste("Fallow.Season", Croplayer, + "Precip_", "Rdata", sep = "."))) + Precip <- Fallow.Season + rm(Fallow.Season) + print("dimensions check?") + print(all.equal(sapply(Precip, dim), sapply(ETo, dim))) + if (file.exists(paste0(Intermediates, paste("Fallow.Few", + Croplayer, "Rdata", sep = "."))) == FALSE) { + Fallow.Few.Calc(Croplayer) + load(paste0(Intermediates, paste("Fallow.Few", Croplayer, + "Rdata", sep = "."))) + load(paste0(Intermediates, paste("Base", Croplayer, + "MNRH_", "MasterDF", sep = "."))) + } + load(paste0(Intermediates, paste("Fallow.Few", Croplayer, + "Rdata", sep = "."))) + load(paste0(Intermediates, paste("Base", Croplayer, "MNRH_", + "MasterDF", sep = "."))) + Qfc.minus.Qwp <- lapply(Precip, function(x) x$Qfc.minus.Qwp) + root.depth <- 0.1 + TAW <- lapply(Qfc.minus.Qwp, function(x) 1000 * (x[] * + root.depth)) + TEW <- lapply(Precip, function(x) x$ave_TEW) + Dei <- TEW + REW <- lapply(Precip, function(x) x$ave_REW) + Precip <- lapply(Precip, function(x) x[, (grep("layer", + names(x)))]) + if (file.exists(paste0(Intermediates, paste("KcMax", + Croplayer, "Rdata", sep = "."))) == FALSE) + KcMAX(Croplayer) + load(paste0(Intermediates, paste("KcMax", Croplayer, + "Rdata", sep = "."))) + ROi <- Precip + for (i in 1:length(ROi)) { + ROi[[i]] <- ROi[[i]] - TEW[[i]] + ROi[[i]][ROi[[i]] < 0] <- 0 + } + print("Pre-/post-season runoff estimated") + Dei <- lapply(TEW, function(x) (x[] * 0.1)) + ETo <- lapply(ETo, function(x) x[, (grep("layer", names(x)))]) + for (i in 1:length(ETo)) { + ETo[[i]][ETo[[i]] < 0] <- 0 + ETo[[i]] <- round(ETo[[i]], 3) + ETo[[i]][ETo[[i]] > 28] <- 1.655 + } + print("ETo data cleaned") + Pre.ETo <- ETo + Post.ETo <- ETo + Pre.ROi <- ROi + Post.ROi <- ROi + Pre.Dei <- Dei + Post.Dei <- Dei + Pre.Precip <- Precip + Post.Precip <- Precip + Pre.Few <- Fallow.Few + Post.Few <- Fallow.Few + DaysRow <- lapply(ETo, function(x) as.numeric(gsub("layer.", + "", names(x)))) + Cuts <- lapply(DaysRow, function(x) which(diff(x) > 1)) + Cuts <- sapply(Cuts, function(x) replace(x, length(x) == + 0, 0)) + LengthCheck <- unlist(lapply(DaysRow, length)) + CutCheck <- unlist(Cuts) + for (i in 1:length(ETo)) { + if (Cuts[[i]] > 0 && length(LengthCheck[i] > 0)) { + if (CutCheck[i] + 1 >= LengthCheck[i]) { + Pre.ETo[[i]] <- ETo[[i]][, 1:(Cuts[[i]][1] - + 1)] + Post.ETo[[i]] <- ETo[[i]][, (Cuts[[i]][1] - + 3):Cuts[[i]][1]] + Pre.Precip[[i]] <- Precip[[i]][, 1:(Cuts[[i]][1] - + 1)] + Post.Precip[[i]] <- Precip[[i]][, (Cuts[[i]][1] - + 3):Cuts[[i]][1]] + Pre.Few[[i]] <- Fallow.Few[[i]][, 1:(Cuts[[i]][1] - + 1)] + Post.Few[[i]] <- Fallow.Few[[i]][, (Cuts[[i]][1] - + 3):Cuts[[i]][1]] + Pre.ROi[[i]] <- ROi[[i]][, 1:(Cuts[[i]][1] - + 1)] + Post.ROi[[i]] <- ROi[[i]][, (Cuts[[i]][1] - + 3):Cuts[[i]][1]] + } + else { + Pre.ETo[[i]] <- ETo[[i]][, 1:Cuts[[i]][1]] + Post.ETo[[i]] <- ETo[[i]][, (Cuts[[i]][1] + + 1):length(ETo[[i]])] + Pre.Precip[[i]] <- Precip[[i]][, 1:Cuts[[i]][1]] + Post.Precip[[i]] <- Precip[[i]][, (Cuts[[i]][1] + + 1):length(Precip[[i]])] + Pre.Few[[i]] <- Fallow.Few[[i]][, 1:Cuts[[i]][1]] + Post.Few[[i]] <- Fallow.Few[[i]][, (Cuts[[i]][1] + + 1):length(Fallow.Few[[i]])] + Pre.ROi[[i]] <- ROi[[i]][, 1:Cuts[[i]][1]] + Post.ROi[[i]] <- ROi[[i]][, (Cuts[[i]][1] + + 1):length(ROi[[i]])] + } + } + if (Cuts[[i]] == 0) { + Pre.ETo[[i]] <- ETo[[i]] + Post.ETo[[i]] <- ETo[[i]][, (length(ETo[[i]]) - + 2):(length(ETo[[i]]) - 1)] + Pre.Precip[[i]] <- Precip[[i]] + Post.Precip[[i]] <- Precip[[i]][, (length(Precip[[i]]) - + 1):length(Precip[[i]])] + Pre.Few[[i]] <- Fallow.Few[[i]] + Post.Few[[i]] <- Fallow.Few[[i]][, (length(Fallow.Few[[i]]) - + 2):(length(Fallow.Few[[i]] - 1))] + Pre.ROi[[i]] <- ROi[[i]] + Post.ROi[[i]] <- ROi[[i]][, (length(ROi[[i]]) - + 1):length(ROi[[i]])] + } + } + print("pre/post season split complete") + Fallow.File <- list(Pre.ETo, Post.ETo, Pre.Precip, Post.Precip, + Pre.Few, Post.Few, Pre.ROi, Post.ROi, Qfc.minus.Qwp, + Pre.Dei, Post.Dei, TAW, TEW, REW) + names(Fallow.File) <- c("Pre.ETo", "Post.ETo", "Pre.Precip", + "Post.Precip", "Pre.Few", "Post.Few", "Pre.ROi", + "Post.ROi", "Qfc.minus.Qwp", "Pre.Dei", "Post.Dei", + "TAW", "TEW", "REW") + save(Fallow.File, file = paste0(Intermediates, paste("Fallow.Saved", + Croplayer, "Rdata", sep = "."))) + } + if (file.exists(paste0(Intermediates, paste("KcMax.Fallow", + Croplayer, "Rdata", sep = "."))) == FALSE) + KcMAX.fallow(Croplayer) + load(paste0(Intermediates, paste("KcMax.Fallow", Croplayer, + "Rdata", sep = "."))) + Pre.Kr <- Pre.Precip + Pre.Ke <- Pre.Precip + Pre.Dei <- Pre.Precip + Pre.DPei <- Pre.Precip + Pre.Kcb.tot <- Pre.Precip + Pre.E <- Pre.Precip + Pre.Fw <- Pre.Precip + Pre.Dr <- Pre.Precip + Pre.DP <- Pre.Precip + Pre.Ks <- Pre.Precip + Dei <- TEW + Pre.Pval <- Pre.Precip + Pre.TAW <- Pre.Precip + Pre.RAW <- Pre.Precip + Pre.Kcb <- Pre.Precip + if (!file.exists(paste0(Intermediates, paste("Preseason_Soil.Evaporation", + Croplayer, "Rdata", sep = "."))) | Overwrite == TRUE) { + for (i in 1:length(Pre.Precip)) { + for (j in 1:length(Pre.Precip[[i]])) { + Kcb <- 0.35 + if (j == 1) { + Pre.Kr[[i]][, j][Dei[[i]] > REW[[i]]] <- (TEW[[i]][Dei[[i]] > + REW[[i]]] - Dei[[i]][Dei[[i]] > REW[[i]]])/(TEW[[i]][Dei[[i]] > + REW[[i]]] - REW[[i]][Dei[[i]] > REW[[i]]]) + Pre.Kr[[i]][, j][Dei[[i]] <= REW[[i]]] <- 1 + Pre.Kr[[i]][, j][Pre.Kr[[i]][, j] < 0] <- 0 + Pre.Ke[[i]][, j] <- pmin.int(Pre.Kr[[i]][, + j] * (KcMax[[i]][, j] - Kcb), Pre.Few[[i]][, + j] * KcMax[[i]][, j]) + Pre.Ke[[i]][, j][Pre.Ke[[i]][, j] < 0] <- 0 + Pre.E[[i]][, j] <- Pre.Ke[[i]][, j] * Pre.ETo[[i]][, + j] + Pre.DPei[[i]][, j] <- (Pre.Precip[[i]][, j] - + Pre.ROi[[i]][, j]) - Dei[[i]] + Pre.DPei[[i]][, j][Pre.DPei[[i]][, j] < 0] <- 0 + Pre.Dei[[i]][, j] <- Dei[[i]] - (Pre.Precip[[i]][, + j] - Pre.ROi[[i]][, j]) + (Pre.E[[i]][, j]/Pre.Few[[i]][, + j]) + Pre.DPei[[i]][, j] + Pre.Dei[[i]][, j][Pre.Dei[[i]][, j] < 0] <- 0 + Pre.Dei[[i]][, j][Pre.Dei[[i]][, j] > TEW[[i]]] <- TEW[[i]][Pre.Dei[[i]][, + j] > TEW[[i]]] + Pre.Kcb.tot[[i]][, j] <- (Kcb + Pre.Ke[[i]][, + j]) * Pre.ETo[[i]][, j] + P.value <- 0.1 + Pre.Pval[[i]][, j] <- P.value + 0.02 * (5 - + (Pre.Kcb.tot[[i]][, j])) + Pre.Pval[[i]][, j][Pre.Pval[[i]][, j] < 0.1] <- 0.1 + Pre.Pval[[i]][, j][Pre.Pval[[i]][, j] > 0.8] <- 0.8 + Root.depth <- 0.1 + 0.002 * j + Pre.TAW[[i]][, j] <- TAW[[i]] * Root.depth + Pre.RAW[[i]][, j] <- Pre.Pval[[i]][, j] * Pre.TAW[[i]][, + j] + Per.of.field.capacity <- 0.2 + Pre.Dr[[i]][, j] <- Pre.TAW[[i]][, j] * Per.of.field.capacity + Pre.Dr[[i]][, j] <- Pre.Dr[[i]][, j] - (Pre.Precip[[i]][, + j] - Pre.ROi[[i]][, j]) + Pre.Kcb.tot[[i]][, + j] + Pre.DP[[i]][, j] + Pre.Dr[[i]][, j][Pre.Dr[[i]][, j] < 0] <- 0 + Pre.Dr[[i]][, j][Pre.Dr[[i]][, j] > Pre.TAW[[i]][, + j]] <- Pre.TAW[[i]][, j][Pre.Dr[[i]][, j] > + Pre.TAW[[i]][, j]] + Pre.Ks[[i]][, j][Pre.Dr[[i]][, j] > Pre.RAW[[i]][, + j]] <- ((Pre.TAW[[i]][, j] - Pre.Dr[[i]][, + j])[Pre.Dr[[i]][, j] > Pre.RAW[[i]][, j]])/((1 - + Pre.Pval[[i]][, j][Pre.Dr[[i]][, j] > Pre.RAW[[i]][, + j]]) * Pre.TAW[[i]][, j][Pre.Dr[[i]][, + j] > Pre.RAW[[i]][, j]]) + Pre.Ks[[i]][, j][Pre.Dr[[i]][, j] <= Pre.RAW[[i]][, + j]] <- 1 + Pre.DP[[i]][, j] <- (Pre.Precip[[i]][, j] - + Pre.ROi[[i]][, j]) - Pre.Kcb.tot[[i]][, j] + Pre.DP[[i]][, j][Pre.Dr[[i]][, j] > 0] <- 0 + Pre.DP[[i]][, j][Pre.DP[[i]][, j] < 0] <- 0 + Pre.Kcb[[i]][, j] <- (Pre.Ks[[i]][, j] * Pre.Kcb.tot[[i]][, + j] + Pre.Ke[[i]][, j]) * Pre.ETo[[i]][, j] + Pre.Kcb.tot[[i]][, j] <- (Pre.Ks[[i]][, j] * + Pre.Kcb.tot[[i]][, j]) * Pre.ETo[[i]][, j] + Pre.DPei[[i]][, j] <- (Pre.Precip[[i]][, j] - + Pre.ROi[[i]][, j]) + Pre.DPei[[i]][, j][Pre.DPei[[i]][, j] < 0] <- 0 + } + else { + Pre.Fw[[i]][, j] <- Pre.Few[[i]][, j - 1] + Pre.Few[[i]][, j] <- pmin.int(Pre.Few[[i]][, + j], Pre.Fw[[i]][, j]) + Pre.Kr[[i]][, j][Pre.Dei[[i]][, (j - 1)] > + REW[[i]]] <- (TEW[[i]][Pre.Dei[[i]][, (j - + 1)] > REW[[i]]] - Pre.Dei[[i]][, (j - 1)][Pre.Dei[[i]][, + (j - 1)] > REW[[i]]])/(TEW[[i]][Pre.Dei[[i]][, + (j - 1)] > REW[[i]]] - REW[[i]][Pre.Dei[[i]][, + (j - 1)] > REW[[i]]]) + Pre.Kr[[i]][, j][Pre.Dei[[i]][, (j - 1)] <= + REW[[i]]] <- 1 + Pre.Kr[[i]][, j][Pre.Kr[[i]][, j] < 0] <- 0 + Kcb <- Kcb + (0.005 * j) + Pre.Ke[[i]][, j] <- pmin.int(Pre.Kr[[i]][, + j] * (KcMax[[i]][, j] - Kcb), Pre.Few[[i]][, + j] * KcMax[[i]][, j]) + Pre.Ke[[i]][, j][Pre.Ke[[i]][, j] < 0] <- 0 + Pre.E[[i]][, j] <- Pre.Ke[[i]][, j] * Pre.ETo[[i]][, + j] + Pre.DPei[[i]][, j] <- (Pre.Precip[[i]][, j] - + Pre.ROi[[i]][, j]) - Pre.Dei[[i]][, (j - + 1)] + Pre.DPei[[i]][, j][Pre.DPei[[i]][, j] < 0] <- 0 + Pre.Dei[[i]][, j] <- Pre.Dei[[i]][, (j - 1)] - + (Pre.Precip[[i]][, j] - Pre.ROi[[i]][, j]) + + (Pre.E[[i]][, j]/Pre.Few[[i]][, j]) + Pre.DPei[[i]][, + j] + Pre.Dei[[i]][, j][Pre.Dei[[i]][, j] < 0] <- 0 + Pre.Dei[[i]][, j][Pre.Dei[[i]][, j] > TEW[[i]]] <- TEW[[i]][Pre.Dei[[i]][, + j] > TEW[[i]]] + P.value <- 0.1 + Pre.Pval[[i]][, j] <- P.value + 0.02 * (5 - + (Pre.Kcb.tot[[i]][, j])) + Pre.Pval[[i]][, j][Pre.Pval[[i]][, j] < 0.1] <- 0.1 + Pre.Pval[[i]][, j][Pre.Pval[[i]][, j] > 0.8] <- 0.8 + Root.depth <- 0.1 + 0.002 * j + Pre.TAW[[i]][, j] <- TAW[[i]] * Root.depth + Pre.RAW[[i]][, j] <- Pre.Pval[[i]][, j] * Pre.TAW[[i]][, + j] + Pre.Dr[[i]][, j] <- Pre.Dr[[i]][, (j - 1)] - + (Pre.Precip[[i]][, j] - Pre.ROi[[i]][, j]) + + Pre.Kcb.tot[[i]][, j] + Pre.DP[[i]][, (j - + 1)] + Pre.Dr[[i]][, j][Pre.Dr[[i]][, j] < 0] <- 0 + Pre.Dr[[i]][, j][Pre.Dr[[i]][, j] > Pre.TAW[[i]][, + j]] <- Pre.TAW[[i]][, j][Pre.Dr[[i]][, j] > + Pre.TAW[[i]][, j]] + Pre.Ks[[i]][, j][Pre.Dr[[i]][, j] > Pre.RAW[[i]][, + j]] <- ((Pre.TAW[[i]][, j] - Pre.Dr[[i]][, + j])[Pre.Dr[[i]][, j] > Pre.RAW[[i]][, j]])/((1 - + Pre.Pval[[i]][, j][Pre.Dr[[i]][, j] > Pre.RAW[[i]][, + j]]) * Pre.TAW[[i]][, j][Pre.Dr[[i]][, + j] > Pre.RAW[[i]][, j]]) + Pre.Ks[[i]][, j][Pre.Dr[[i]][, j] <= Pre.RAW[[i]][, + j]] <- 1 + Pre.DP[[i]][, j] <- (Pre.Precip[[i]][, j] - + Pre.ROi[[i]][, j]) - Pre.Kcb.tot[[i]][, j] - + Pre.Dr[[i]][, j - 1] + Pre.DP[[i]][, j][Pre.Dr[[i]][, j] > 0] <- 0 + Pre.DP[[i]][, j][Pre.DP[[i]][, j] < 0] <- 0 + Pre.Kcb[[i]][, j] <- (Pre.Ks[[i]][, j] * Kcb + + Pre.Ke[[i]][, j]) * Pre.ETo[[i]][, j] + Pre.Kcb.tot[[i]][, j] <- (Pre.Ks[[i]][, j] * + Kcb) * Pre.ETo[[i]][, j] + Pre.DPei[[i]][, j] <- (Pre.Precip[[i]][, j] - + Pre.ROi[[i]][, j]) - Pre.Dei[[i]][, j - 1] + Pre.DPei[[i]][, j][Pre.DPei[[i]][, j] < 0] <- 0 + } + } + } + print("Calculation of Preseason daily soil water balance, deep percolation, and evaporation complete") + setwd(paste0(Path, "/CropWatR/Intermediates/")) + save(Pre.Few, file = paste("Preseason_Few", Croplayer, + "Rdata", sep = ".")) + save(Pre.Kr, file = paste("Preseason_Kr", Croplayer, + "Rdata", sep = ".")) + save(Pre.Ks, file = paste("Preseason_Ks", Croplayer, + "Rdata", sep = ".")) + save(Pre.Pval, file = paste("Preseason_Pval", Croplayer, + "Rdata", sep = ".")) + save(Pre.Dr, file = paste("Preseason_Root.Zone.Depletion", + Croplayer, "Rdata", sep = ".")) + save(Pre.Dei, file = paste("Preseason_Soil.Top.Layer.Depletion", + Croplayer, "Rdata", sep = ".")) + save(Pre.DP, file = paste("Preseason_Deep.Percolation", + Croplayer, "Rdata", sep = ".")) + Pre.KeETo <- Pre.E + save(Pre.KeETo, file = paste("Preseason_Soil.Evaporation", + Croplayer, "Rdata", sep = ".")) + save(Pre.ROi, file = paste("Preseason_Runoff", Croplayer, + "Rdata", sep = ".")) + save(Pre.Kcb.tot, file = paste("Preseason_Weed.Transpiration", + Croplayer, "Rdata", sep = ".")) + setwd(paste0(Path, "/CropWatR/Data")) + print("Preseason files saved, on to final growing season run") + } + if (file.exists(paste0(Intermediates, paste("Preseason_Soil.Evaporation", + Croplayer, "Rdata", sep = "."))) == TRUE && Overwrite == + FALSE) { + print("Preseason has been previously calculated for this crop") + } + } +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ ~kwd1 } +\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line diff --git a/man/Final.Daily.ET.Calc.Rd b/man/Final.Daily.ET.Calc.Rd new file mode 100644 index 0000000..1f82367 --- /dev/null +++ b/man/Final.Daily.ET.Calc.Rd @@ -0,0 +1,88 @@ +\name{Final.Daily.ET.Calc} +\alias{Final.Daily.ET.Calc} +%- Also NEED an '\alias' for EACH other topic documented here. +\title{ +%% ~~function to do ... ~~ +} +\description{ +%% ~~ A concise (1-5 lines) description of what the function does. ~~ +} +\usage{ +Final.Daily.ET.Calc(Croplayer) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{Croplayer}{ +%% ~~Describe \code{Croplayer} here~~ +} +} +\details{ +%% ~~ If necessary, more details than the description above ~~ +} +\value{ +%% ~Describe the value returned +%% If it is a LIST, use +%% \item{comp1 }{Description of 'comp1'} +%% \item{comp2 }{Description of 'comp2'} +%% ... +} +\references{ +%% ~put references to the literature/web site here ~ +} +\author{ +%% ~~who you are~~ +} +\note{ +%% ~~further notes~~ +} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +\seealso{ +%% ~~objects to See Also as \code{\link{help}}, ~~~ +} +\examples{ +##---- Should be DIRECTLY executable !! ---- +##-- ==> Define data, use random, +##-- or do help(data=index) for the standard data sets. + +## The function is currently defined as +function (Croplayer) +{ + if (file.exists(paste0(Intermediates, paste("Preseason_Weed.Transpiration", + Croplayer, "Rdata", sep = "."))) == FALSE) { + Fallow.Preseason.Daily.ET.Calc(Croplayer) + } + if (file.exists(paste0(Intermediates, paste("Postseason_Weed.Transpiration", + Croplayer, "Rdata", sep = "."))) && file.exists(paste0(Intermediates, + paste("Growing.Season_Runoff", Croplayer, "Rdata", sep = ".")))) { + print(paste("Daily ETo calculation completed for", Croplayer)) + } + if ((file.exists(paste0(Intermediates, paste("Postseason_Weed.Transpiration", + Croplayer, "Rdata", sep = "."))) && file.exists(paste0(Intermediates, + paste("Growing.Season_Runoff", Croplayer, "Rdata", sep = ".")))) == + FALSE) { + if (file.exists(paste0(Intermediates, paste("Growing.Season_Transpiration", + Croplayer, "Rdata", sep = "."))) == FALSE) { + load("Vars.Rdata") + if (Croplayer \%in\% Vars || Croplayer == "silage") { + Main.Growing.Season.Daily.ET.Calc(Croplayer) + Main.Rainfed.Growing.Season.Daily.ET.Calc(Croplayer) + } + Others <- c("switchgrass", "miscanthus", "idle_cropland", + "pasture_grass") + if (Croplayer \%in\% Others) { + Main.Growing.Season.Daily.ET.Calc(Croplayer) + } + } + if (file.exists(paste0(Intermediates, paste("Postseason_Soil.Water.Balance", + Croplayer, "Rdata", sep = "."))) == FALSE) { + Fallow.Postseason.Daily.ET.Calc(Croplayer) + } + } + } +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ ~kwd1 } +\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line diff --git a/man/Generate.Land.Use.Rd b/man/Generate.Land.Use.Rd new file mode 100644 index 0000000..d38b798 --- /dev/null +++ b/man/Generate.Land.Use.Rd @@ -0,0 +1,89 @@ +\name{Generate.Land.Use} +\alias{Generate.Land.Use} +%- Also NEED an '\alias' for EACH other topic documented here. +\title{ +%% ~~function to do ... ~~ +} +\description{ +%% ~~ A concise (1-5 lines) description of what the function does. ~~ +} +\usage{ +Generate.Land.Use(Croplayer, Type) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{Croplayer}{ +%% ~~Describe \code{Croplayer} here~~ +} + \item{Type}{ +%% ~~Describe \code{Type} here~~ +} +} +\details{ +%% ~~ If necessary, more details than the description above ~~ +} +\value{ +%% ~Describe the value returned +%% If it is a LIST, use +%% \item{comp1 }{Description of 'comp1'} +%% \item{comp2 }{Description of 'comp2'} +%% ... +} +\references{ +%% ~put references to the literature/web site here ~ +} +\author{ +%% ~~who you are~~ +} +\note{ +%% ~~further notes~~ +} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +\seealso{ +%% ~~objects to See Also as \code{\link{help}}, ~~~ +} +\examples{ +##---- Should be DIRECTLY executable !! ---- +##-- ==> Define data, use random, +##-- or do help(data=index) for the standard data sets. + +## The function is currently defined as +function (Croplayer, Type) +{ + load("Vars.Rdata") + if (Croplayer \%in\% Vars) { + LU.csv <- read.csv(paste0(Croplayer, ".Master.DF.2008.BAU.csv")) + LU <- LU.csv[, c(1, 2, grep("Rainfed", names(LU.csv)), + grep("Irrigated", names(LU.csv)))] + if (Type == "Total") { + if (length(LU) == 3) + names(LU)[3] <- Croplayer + if (length(LU) == 4) { + LU$Final <- rowSums(cbind(LU.csv[, c(grep("Rainfed", + names(LU.csv)), grep("Irrigated", names(LU.csv)))]), + na.rm = TRUE) + LU <- LU[, c(1, 2, grep("Final", names(LU)))] + names(LU)[3] <- Croplayer + } + } + } + coordinates(LU) <- ~x + y + proj4string(LU) <- CRS("+proj=aea +lat_1=29.5 +lat_2=45.5 +lat_0=23 +lon_0=-96 +x_0=0 +y_0=0 +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs") + gridded(LU) = TRUE + LU.brick <- brick(LU) + projection(LU.brick) <- ("+proj=aea +lat_1=29.5 +lat_2=45.5 +lat_0=23 +lon_0=-96 +x_0=0 +y_0=0 +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs") + Crops.brick.2008 <- brick("cdl_10k_2008_albers.grd") + LU.brick <- extend(LU.brick, Crops.brick.2008) + plot(LU.brick, main = Croplayer) + LU.brick[LU.brick == 0] <- NA + if (Type == "Total") + writeRaster(LU.brick, filename = paste0(Intermediates, + Croplayer, ".grd"), overwrite = TRUE) + } +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ ~kwd1 } +\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line diff --git a/man/Irr.Mults.Rd b/man/Irr.Mults.Rd new file mode 100644 index 0000000..04366f4 --- /dev/null +++ b/man/Irr.Mults.Rd @@ -0,0 +1,64 @@ +\name{Irr.Mults} +\alias{Irr.Mults} +%- Also NEED an '\alias' for EACH other topic documented here. +\title{ +%% ~~function to do ... ~~ +} +\description{ +%% ~~ A concise (1-5 lines) description of what the function does. ~~ +} +\usage{ +Irr.Mults(Crop) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{Crop}{ +%% ~~Describe \code{Crop} here~~ +} +} +\details{ +%% ~~ If necessary, more details than the description above ~~ +} +\value{ +%% ~Describe the value returned +%% If it is a LIST, use +%% \item{comp1 }{Description of 'comp1'} +%% \item{comp2 }{Description of 'comp2'} +%% ... +} +\references{ +%% ~put references to the literature/web site here ~ +} +\author{ +%% ~~who you are~~ +} +\note{ +%% ~~further notes~~ +} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +\seealso{ +%% ~~objects to See Also as \code{\link{help}}, ~~~ +} +\examples{ +##---- Should be DIRECTLY executable !! ---- +##-- ==> Define data, use random, +##-- or do help(data=index) for the standard data sets. + +## The function is currently defined as +function (Crop) +{ + survey <- read.csv("acre-feet.per.acre.csv") + Sub <- survey[c(1, which(names(survey) \%in\% Crop))] + Sub <- Sub[complete.cases(Sub), ] + Mean <- mean(Sub[, 2]) + Sub$Mult <- round(Sub[, 2]/Mean, digits = 3) + Sub$State <- factor(Sub$State) + return(Sub) + } +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ ~kwd1 } +\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line diff --git a/man/KcMAX.Rd b/man/KcMAX.Rd new file mode 100644 index 0000000..3298e10 --- /dev/null +++ b/man/KcMAX.Rd @@ -0,0 +1,111 @@ +\name{KcMAX} +\alias{KcMAX} +%- Also NEED an '\alias' for EACH other topic documented here. +\title{ +%% ~~function to do ... ~~ +} +\description{ +%% ~~ A concise (1-5 lines) description of what the function does. ~~ +} +\usage{ +KcMAX(Croplayer) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{Croplayer}{ +%% ~~Describe \code{Croplayer} here~~ +} +} +\details{ +%% ~~ If necessary, more details than the description above ~~ +} +\value{ +%% ~Describe the value returned +%% If it is a LIST, use +%% \item{comp1 }{Description of 'comp1'} +%% \item{comp2 }{Description of 'comp2'} +%% ... +} +\references{ +%% ~put references to the literature/web site here ~ +} +\author{ +%% ~~who you are~~ +} +\note{ +%% ~~further notes~~ +} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +\seealso{ +%% ~~objects to See Also as \code{\link{help}}, ~~~ +} +\examples{ +##---- Should be DIRECTLY executable !! ---- +##-- ==> Define data, use random, +##-- or do help(data=index) for the standard data sets. + +## The function is currently defined as +function (Croplayer) +{ + load(paste0(Intermediates, paste("Growing.Season", Croplayer, + "U2.final_", "Rdata", sep = "."))) + U2 <- Growing.Season + rm(Growing.Season) + load(paste0(Intermediates, paste("Growing.Season", Croplayer, + "MNRH_", "Rdata", sep = "."))) + RHmin <- Growing.Season + rm(Growing.Season) + load(paste0(Intermediates, paste("CropsList", Croplayer, + "Rdata", sep = "."))) + all.equal(lapply(U2, function(x) dim(x)), lapply(RHmin, function(x) dim(x))) + all.equal(lapply(U2, function(x) x[, c("x", "y")]), lapply(RHmin, + function(x) x[, c("x", "y")])) + all.equal(names(U2), names(Daily.Crops.list)) + GS.U2 <- lapply(U2, function(x) x[, (grep("layer", names(x)))]) + GS.RHmin <- lapply(RHmin, function(x) x[, (grep("layer", + names(x)))]) + all.equal(lapply(GS.U2, function(x) dim(x)), lapply(GS.RHmin, + function(x) dim(x))) + Wind_term <- lapply(GS.U2, function(x) 0.04 * (x[] - 2)) + RH_term <- lapply(GS.RHmin, function(x) 0.004 * (x[] - 45)) + all.equal(lapply(Wind_term, function(x) dim(x)), lapply(RH_term, + function(x) dim(x))) + Max.season.heights <- lapply(Daily.Crops.list, function(x) tapply(x$day_height, + x$season.ID, max)) + Season.IDs <- lapply(Daily.Crops.list, function(x) x$season.ID) + Plant_heights <- Season.IDs + for (i in 1:length(Max.season.heights)) { + Plant_heights[[i]] <- Max.season.heights[[i]][match(Season.IDs[[i]], + names(Max.season.heights[[i]]))] + } + height_term <- lapply(Plant_heights, function(x) (x[]/3)^0.3) + Term1 <- Wind_term + for (i in 1:length(Wind_term)) { + for (j in 1:length(height_term[[i]])) { + Term1[[i]][, j] <- 1.2 + (Wind_term[[i]][, j] - RH_term[[i]][, + j]) * height_term[[i]][j] + } + } + Kcb <- lapply(Daily.Crops.list, function(x) x$daily_Kcb) + KcMax <- Term1 + for (i in 1:length(Term1)) { + for (j in 1:length(Kcb[[i]])) { + KcMax[[i]][, j] <- max(Term1[[i]][, j], Kcb[[i]][j] + + 0.05) + } + } + for (i in 1:length(Term1)) { + KcMax[[i]] <- cbind(KcMax[[i]], U2[[i]]$x, U2[[i]]$y) + names(KcMax[[i]])[c(length(KcMax[[i]]) - 1, length(KcMax[[i]]))] <- c("x", + "y") + } + save(KcMax, file = paste0(Intermediates, paste("KcMax", Croplayer, + "Rdata", sep = "."))) + } +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ ~kwd1 } +\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line diff --git a/man/KcMAX.fallow.Rd b/man/KcMAX.fallow.Rd new file mode 100644 index 0000000..2a671c3 --- /dev/null +++ b/man/KcMAX.fallow.Rd @@ -0,0 +1,152 @@ +\name{KcMAX.fallow} +\alias{KcMAX.fallow} +%- Also NEED an '\alias' for EACH other topic documented here. +\title{ +%% ~~function to do ... ~~ +} +\description{ +%% ~~ A concise (1-5 lines) description of what the function does. ~~ +} +\usage{ +KcMAX.fallow(Croplayer) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{Croplayer}{ +%% ~~Describe \code{Croplayer} here~~ +} +} +\details{ +%% ~~ If necessary, more details than the description above ~~ +} +\value{ +%% ~Describe the value returned +%% If it is a LIST, use +%% \item{comp1 }{Description of 'comp1'} +%% \item{comp2 }{Description of 'comp2'} +%% ... +} +\references{ +%% ~put references to the literature/web site here ~ +} +\author{ +%% ~~who you are~~ +} +\note{ +%% ~~further notes~~ +} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +\seealso{ +%% ~~objects to See Also as \code{\link{help}}, ~~~ +} +\examples{ +##---- Should be DIRECTLY executable !! ---- +##-- ==> Define data, use random, +##-- or do help(data=index) for the standard data sets. + +## The function is currently defined as +function (Croplayer) +{ + load(paste0(Intermediates, paste("Fallow.Season", Croplayer, + "U2.final_", "Rdata", sep = "."))) + U2 <- Fallow.Season + rm(Fallow.Season) + load(paste0(Intermediates, paste("Fallow.Season", Croplayer, + "MNRH_", "Rdata", sep = "."))) + RHmin <- Fallow.Season + rm(Fallow.Season) + load(paste0(Intermediates, paste("CropsList", Croplayer, + "Rdata", sep = "."))) + all.equal(lapply(U2, function(x) dim(x)), lapply(RHmin, function(x) dim(x))) + all.equal(lapply(U2, function(x) x[, c("x", "y")]), lapply(RHmin, + function(x) x[, c("x", "y")])) + FS.U2 <- lapply(U2, function(x) x[, (grep("layer", names(x)))]) + FS.RHmin <- lapply(RHmin, function(x) x[, (grep("layer", + names(x)))]) + Wind_term <- lapply(FS.U2, function(x) 0.04 * (x[] - 2)) + RH_term <- lapply(FS.RHmin, function(x) 0.004 * (x[] - 45)) + all.equal(lapply(Wind_term, function(x) c(x$x, x$y)), lapply(RH_term, + function(x) c(x$x, x$y))) + Max.season.heights <- lapply(Daily.Crops.list, function(x) tapply(x$day_height, + x$season.ID, function(x) max(x) * 0.08)) + Kcb <- lapply(RH_term, function(x) x[1, ]) + Kcb <- lapply(Kcb, function(x) replace(x[], 1:length(x[]), + 0)) + DaysRow <- lapply(RH_term, function(x) as.numeric(gsub("layer.", + "", names(x)))) + Cuts <- lapply(DaysRow, function(x) which(diff(x) > 1)) + Season.IDs <- lapply(Kcb, function(x) replace(x[], 1:length(x[]), + 4)) + Plant_heights <- Season.IDs + for (i in 1:length(Cuts)) { + if (length(Cuts[[i]]) > 0) { + Season.IDs[[i]][, 1:round(Cuts[[i]] * 3/4)] <- 3 + Season.IDs[[i]][, 1:round(Cuts[[i]] * 1/2)] <- 2 + Season.IDs[[i]][, 1:round(Cuts[[i]] * 1/4)] <- 1 + Season.IDs[[i]][, Cuts[[i]]:floor(((length(Season.IDs[[i]]) - + Cuts[[i]]) * 3/4) + Cuts[[i]])] <- 3 + Season.IDs[[i]][, Cuts[[i]]:floor(((length(Season.IDs[[i]]) - + Cuts[[i]]) * 1/2) + Cuts[[i]])] <- 2 + Season.IDs[[i]][, Cuts[[i]]:floor(((length(Season.IDs[[i]]) - + Cuts[[i]]) * 1/4) + Cuts[[i]])] <- 1 + Plant_heights[[i]] <- Max.season.heights[[i]][match(Season.IDs[[i]], + names(Max.season.heights[[i]]))] + } + if (length(Cuts[[i]]) == 0) { + Season.IDs[[i]][, 1:round(length(Season.IDs[[i]]) * + 3/4)] <- 3 + Season.IDs[[i]][, 1:round(length(Season.IDs[[i]]) * + 1/2)] <- 2 + Season.IDs[[i]][, 1:round(length(Season.IDs[[i]]) * + 1/4)] <- 1 + } + } + if (length(Season.IDs[[i]]) > 3) { + Kcb.values <- lapply(Max.season.heights, function(x) replace(x[], + c(1, 2, 3, 4), c(0.1, 0.2, 0.3, 0.2))) + Kcb[[i]] <- Kcb[[i]][match(Season.IDs[[i]], names(Kcb.values[[i]]))] + } + if (length(Season.IDs[[i]]) <= 3) { + Kcb[[i]] <- as.data.frame(t(rep(0.1, times = length(Season.IDs[[i]])))) + names(Kcb[[i]]) <- names(Season.IDs[[i]]) + } + height_term <- lapply(Plant_heights, function(x) (x[]/3)^0.3) + Term1 <- Wind_term + summary(Term1[[1]]) + for (i in 1:length(Wind_term)) { + for (j in 1:length(height_term[[i]])) { + Off.season.vars <- c("winter_wheat", "durum_wheat", + "fall_barley", "fall_oats") + if (Croplayer \%in\% Off.season.vars) { + Term1[[i]][, j] <- 1 + (Wind_term[[i]][, j] - + RH_term[[i]][, j]) * height_term[[i]][j] + } + if (!(Croplayer \%in\% Off.season.vars)) { + Term1[[i]][, j] <- 0.15 + (Wind_term[[i]][, j] - + RH_term[[i]][, j]) * height_term[[i]][j] + } + } + } + KcMax <- Term1 + for (i in 1:length(Term1)) { + for (j in 1:length(Kcb[[i]])) { + KcMax[[i]][, j] <- pmax.int(Term1[[i]][, j], Kcb[[i]][, + j] + 0.05) + } + } + for (i in 1:length(Term1)) { + KcMax[[i]] <- cbind(KcMax[[i]], U2[[i]]$x, U2[[i]]$y) + names(KcMax[[i]])[c(length(KcMax[[i]]) - 1, length(KcMax[[i]]))] <- c("x", + "y") + } + summary(KcMax[[1]]) + save(KcMax, file = paste0(Intermediates, paste("KcMax.Fallow", + Croplayer, "Rdata", sep = "."))) + } +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ ~kwd1 } +\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line diff --git a/man/Main.Growing.Season.Daily.ET.Calc.Rd b/man/Main.Growing.Season.Daily.ET.Calc.Rd new file mode 100644 index 0000000..3c8e463 --- /dev/null +++ b/man/Main.Growing.Season.Daily.ET.Calc.Rd @@ -0,0 +1,564 @@ +\name{Main.Growing.Season.Daily.ET.Calc} +\alias{Main.Growing.Season.Daily.ET.Calc} +%- Also NEED an '\alias' for EACH other topic documented here. +\title{ +%% ~~function to do ... ~~ +} +\description{ +%% ~~ A concise (1-5 lines) description of what the function does. ~~ +} +\usage{ +Main.Growing.Season.Daily.ET.Calc(Croplayer) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{Croplayer}{ +%% ~~Describe \code{Croplayer} here~~ +} +} +\details{ +%% ~~ If necessary, more details than the description above ~~ +} +\value{ +%% ~Describe the value returned +%% If it is a LIST, use +%% \item{comp1 }{Description of 'comp1'} +%% \item{comp2 }{Description of 'comp2'} +%% ... +} +\references{ +%% ~put references to the literature/web site here ~ +} +\author{ +%% ~~who you are~~ +} +\note{ +%% ~~further notes~~ +} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +\seealso{ +%% ~~objects to See Also as \code{\link{help}}, ~~~ +} +\examples{ +##---- Should be DIRECTLY executable !! ---- +##-- ==> Define data, use random, +##-- or do help(data=index) for the standard data sets. + +## The function is currently defined as +function (Croplayer) +{ + load(paste0(Intermediates, paste("Growing.Season", Croplayer, + "ETo_", "Rdata", sep = "."))) + ETo <- Growing.Season + rm(Growing.Season) + load(paste0(Intermediates, paste("Growing.Season", Croplayer, + "Precip_", "Rdata", sep = "."))) + Precip <- Growing.Season + rm(Growing.Season) + CROP <- Croplayer + load(paste0("../Intermediates/Daily.Crop.Profile.", CROP, + ".Rdata")) + Root.depth <- lapply(DailyKcb, function(x) x$daily_root.depth) + Qfc.minus.Qwp <- lapply(Precip, function(x) x$Qfc.minus.Qwp) + TEW <- lapply(Precip, function(x) x$ave_TEW) + Dei <- TEW + REW <- lapply(Precip, function(x) x$ave_REW) + Precip <- lapply(Precip, function(x) x[, (grep("layer", names(x)))]) + load(paste0(Intermediates, paste("Few", Croplayer, "Rdata", + sep = "."))) + load(paste0(Intermediates, paste("KcMax", Croplayer, "Rdata", + sep = "."))) + KcMax <- lapply(KcMax, function(x) x[, (grep("layer", names(x)))]) + load(paste0(Intermediates, paste("Kcb.corrected", Croplayer, + "Rdata", sep = "."))) + ETo <- lapply(ETo, function(x) x[, (grep("layer", names(x)))]) + sapply(ETo, function(x) length(x[x < 0])) + if (file.exists(paste0(Intermediates, paste("Growing.Saved", + Croplayer, "Rdata", sep = "."))) == FALSE) { + for (i in 1:length(ETo)) { + ETo[[i]][ETo[[i]] < 0] <- 0 + ETo[[i]] <- round(ETo[[i]], 3) + } + print("ETo data cleaned") + ROi <- Precip + for (i in 1:length(ROi)) { + ROi[[i]] <- ROi[[i]] - TEW[[i]] + ROi[[i]][ROi[[i]] < 0] <- 0 + } + print("Growing season runoff estimated") + Irr <- Precip + for (i in 1:length(Irr)) { + Irr[[i]][Irr[[i]] > 0] <- 0 + } + Fw.table <- read.csv("Fw.table.csv") + Irr.Eff <- Fw.table$fw[1] + Fw <- Irr + for (i in 1:length(Fw)) { + Fw[[i]][Fw[[i]] == 0] <- Irr.Eff + } + Growing.Files <- list(ETo, Precip, ROi, Irr, Fw) + save(Growing.Files, file = paste0(Intermediates, paste("Growing.Saved", + Croplayer, "Rdata", sep = "."))) + } + if (file.exists(paste0(Intermediates, paste("Growing.Saved", + Croplayer, "Rdata", sep = "."))) == TRUE) { + load(paste0(Intermediates, paste("Growing.Saved", Croplayer, + "Rdata", sep = "."))) + ETo <- Growing.Files[[1]] + Precip <- Growing.Files[[2]] + ROi <- Growing.Files[[3]] + Irr <- Growing.Files[[4]] + Fw <- Growing.Files[[5]] + } + Zr <- read.csv("crop.roots.csv") + Zr <- Zr[Zr$crop == Croplayer, ] + TAW.base <- lapply(Qfc.minus.Qwp, function(x) 1000 * (x[] * + Zr$root_depth)) + Kr <- Irr + ETc <- Irr + De <- Irr + DPe <- Irr + Transp <- Irr + Ke <- Irr + E <- Irr + Transp <- Irr + Pval <- Irr + RAW <- Irr + Ks <- Irr + Transp.final <- Irr + Dr <- Irr + DP <- Irr + TAW <- Irr + setwd(paste0(Path, "/CropWatR/Intermediates/")) + load(paste("Preseason_Root.Zone.Depletion", Croplayer, "Rdata", + sep = ".")) + load(paste("Preseason_Soil.Top.Layer.Depletion", Croplayer, + "Rdata", sep = ".")) + load(paste("Preseason_Deep.Percolation", Croplayer, "Rdata", + sep = ".")) + load(paste("Preseason_Soil.Evaporation", Croplayer, "Rdata", + sep = ".")) + load(paste("Preseason_Runoff", Croplayer, "Rdata", sep = ".")) + load(paste("Preseason_Weed.Transpiration", Croplayer, "Rdata", + sep = ".")) + load(paste("Fallow.Saved", Croplayer, "Rdata", sep = ".")) + Pre.Few <- Fallow.File[[5]] + setwd(paste0(Path, "/CropWatR/Data")) + if (file.exists(paste0(Intermediates, paste("Growing.Season_Transpiration", + Croplayer, "Rdata", sep = "."))) == TRUE) { + print(paste("Growing Season has been previously calculated for", + Croplayer)) + } + if (file.exists(paste0(Intermediates, paste("Growing.Season_Transpiration", + Croplayer, "Rdata", sep = "."))) == FALSE) { + print(paste("executing Growing Season calculations for", + Croplayer)) + Fw.table <- read.csv("Fw.table.csv") + Irr.Eff <- Fw.table$fw[1] + for (i in 1:length(Precip)) { + Irrigated <- c("alfalfa", "cotton", "corn", "spring_barley", + "spring_oats", "rice", "soybeans", "sorghum", + "spring_wheat", "silage", "peanuts", "winter_wheat", + "silage") + if (Croplayer \%in\% Irrigated) + irr <- TRUE + for (j in 1:length(Precip[[i]])) { + if (j == 1) { + Few[[i]][, j] <- pmin.int(Few[[i]][, j], Fw[[i]][, + j]) + Kr[[i]][, j][Pre.Dei[[i]][, length(Pre.Dei[[i]])] > + REW[[i]]] <- (TEW[[i]][Pre.Dei[[i]][, length(Pre.Dei[[i]])] > + REW[[i]]] - Pre.Dei[[i]][, length(Pre.Dei[[i]])][Pre.Dei[[i]][, + length(Pre.Dei[[i]])] > REW[[i]]])/(TEW[[i]][Pre.Dei[[i]][, + length(Pre.Dei[[i]])] > REW[[i]]] - REW[[i]][Pre.Dei[[i]][, + length(Pre.Dei[[i]])] > REW[[i]]]) + Kr[[i]][, j][Pre.Dei[[i]][, length(Pre.Dei[[i]])] <= + REW[[i]]] <- 1 + Kr[[i]][, j][Kr[[i]][, j] < 0] <- 0 + Ke[[i]][, j] <- pmin.int(Kr[[i]][, j] * (KcMax[[i]][, + j] - Kcb.corrected[[i]][, j]), Few[[i]][, + j] * KcMax[[i]][, j]) + Ke[[i]][, j][Ke[[i]][, j] < 0] <- 0 + E[[i]][, j] <- Ke[[i]][, j] * ETo[[i]][, j] + DPe[[i]][, j] <- (Precip[[i]][, j] - ROi[[i]][, + j]) + (Irr[[i]][, j]/Fw[[i]][, j]) - Pre.Dei[[i]][, + length(Pre.Dei[[i]])] + DPe[[i]][, j][DPe[[i]][, j] < 0] <- 0 + De[[i]][, j] <- Pre.Dei[[i]][, length(Pre.Dei[[i]])] - + (Precip[[i]][, j] - ROi[[i]][, j]) + Irr[[i]][, + j]/Fw[[i]][, j] + (E[[i]][, j]/Few[[i]][, + j]) + DPe[[i]][, j] + De[[i]][, j][De[[i]][, j] < 0] <- 0 + De[[i]][, j][De[[i]][, j] > TEW[[i]]] <- TEW[[i]][De[[i]][, + j] > TEW[[i]]] + ETc[[i]][, j] <- (Kcb.corrected[[i]][, j] + + Ke[[i]][, j]) * ETo[[i]][, j] + Pval[[i]][, j] <- Zr$p.value + 0.04 * (5 - + (ETc[[i]][, j])) + Pval[[i]][, j][Pval[[i]][, j] < 0.1] <- 0.1 + Pval[[i]][, j][Pval[[i]][, j] > 0.8] <- 0.8 + if (is.na(Root.depth[[i]][j]/Zr$root_depth)) { + Frac <- Root.depth[[i]][length(Root.depth[[i]])]/Zr$root_depth + } + else Frac <- Root.depth[[i]][j]/Zr$root_depth + TAW[[i]][, j] <- TAW.base[[i]] * Frac + RAW[[i]][, j] <- Pval[[i]][, j] * TAW[[i]][, + j] + Dr[[i]][, j] <- Pre.Dr[[i]][, length(Pre.Dr[[i]])] - + (Precip[[i]][, j] - ROi[[i]][, j]) - Irr[[i]][, + j] + ETc[[i]][, j] + Pre.DP[[i]][, length(Pre.DP[[i]])] + Dr[[i]][, j][Dr[[i]][, j] < 0] <- 0 + Dr[[i]][, j][Dr[[i]][, j] > TAW[[i]][, j]] <- TAW[[i]][, + j][Dr[[i]][, j] > TAW[[i]][, j]] + Ks[[i]][, j][Dr[[i]][, j] > RAW[[i]][, j]] <- ((TAW[[i]][, + j] - Dr[[i]][, j])[Dr[[i]][, j] > RAW[[i]][, + j]])/((1 - Pval[[i]][, j][Dr[[i]][, j] > + RAW[[i]][, j]]) * TAW[[i]][, j][Dr[[i]][, + j] > RAW[[i]][, j]]) + Ks[[i]][, j][Dr[[i]][, j] <= RAW[[i]][, j]] <- 1 + DP[[i]][, j] <- (Precip[[i]][, j] - ROi[[i]][, + j]) + Irr[[i]][, j] - ETc[[i]][, j] - Pre.Dr[[i]][, + length(Pre.Dr[[i]])] + DP[[i]][, j][Dr[[i]][, j] > 0] <- 0 + DP[[i]][, j][DP[[i]][, j] < 0] <- 0 + Transp[[i]][, j] <- (Ks[[i]][, j] * Kcb.corrected[[i]][, + j] + Ke[[i]][, j]) * ETo[[i]][, j] + Transp.final[[i]][, j] <- (Ks[[i]][, j] * Kcb.corrected[[i]][, + j]) * ETo[[i]][, j] + DPe[[i]][, j] <- (Precip[[i]][, j] - ROi[[i]][, + j]) + (Irr[[i]][, j]/Fw[[i]][, j]) - Pre.Dei[[i]][, + length(Pre.Dei[[i]])] + DPe[[i]][, j][DPe[[i]][, j] < 0] <- 0 + De[[i]][, j] <- Pre.Dei[[i]][, length(Pre.Dei[[i]])] - + (Precip[[i]][, j] - ROi[[i]][, j]) + Irr[[i]][, + j]/Fw[[i]][, j] + (E[[i]][, j]/Few[[i]][, + j]) + DPe[[i]][, j] + De[[i]][, j][De[[i]][, j] < 0] <- 0 + De[[i]][, j][De[[i]][, j] > TEW[[i]]] <- TEW[[i]][De[[i]][, + j] > TEW[[i]]] + } + else { + Fw[[i]][, j] <- Fw[[i]][, (j - 1)] + Few[[i]][, j] <- pmin.int(Few[[i]][, j], Fw[[i]][, + j]) + Kr[[i]][, j][De[[i]][, (j - 1)] > REW[[i]]] <- (TEW[[i]][De[[i]][, + (j - 1)] > REW[[i]]] - De[[i]][, (j - 1)][De[[i]][, + (j - 1)] > REW[[i]]])/(TEW[[i]][De[[i]][, + (j - 1)] > REW[[i]]] - REW[[i]][De[[i]][, + (j - 1)] > REW[[i]]]) + Kr[[i]][, j][De[[i]][, (j - 1)] <= REW[[i]]] <- 1 + Kr[[i]][, j][Kr[[i]][, j] < 0] <- 0 + Ke[[i]][, j] <- pmin.int(Kr[[i]][, j] * (KcMax[[i]][, + j] - Kcb.corrected[[i]][, j]), Few[[i]][, + j] * KcMax[[i]][, j]) + Ke[[i]][, j][Ke[[i]][, j] < 0] <- 0 + ETo[[i]] + E[[i]][, j] <- Ke[[i]][, j] * ETo[[i]][, j] + DPe[[i]][, j] <- (Precip[[i]][, j] - ROi[[i]][, + j]) + (Irr[[i]][, j]/Fw[[i]][, j]) - De[[i]][, + j - 1] + DPe[[i]][, j][DPe[[i]][, j] < 0] <- 0 + De[[i]][, j] <- De[[i]][, j - 1] - (Precip[[i]][, + j] - ROi[[i]][, j]) + Irr[[i]][, j]/Fw[[i]][, + j] + (E[[i]][, j]/Few[[i]][, j]) + DPe[[i]][, + j] + De[[i]][, j][De[[i]][, j] < 0] <- 0 + De[[i]][, j][De[[i]][, j] > TEW[[i]]] <- TEW[[i]][De[[i]][, + j] > TEW[[i]]] + ETc[[i]][, j] <- (Kcb.corrected[[i]][, j] + + Ke[[i]][, j]) * ETo[[i]][, j] + Pval[[i]][, j] <- Zr$p.value + 0.04 * (5 - + (ETc[[i]][, j])) + Pval[[i]][, j][Pval[[i]][, j] < 0.1] <- 0.1 + Pval[[i]][, j][Pval[[i]][, j] > 0.8] <- 0.8 + if (is.na(Root.depth[[i]][j]/Zr$root_depth)) { + Frac <- Root.depth[[i]][length(Root.depth[[i]])]/Zr$root_depth + } + else Frac <- Root.depth[[i]][j]/Zr$root_depth + TAW[[i]][, j] <- TAW.base[[i]] * Frac + RAW[[i]][, j] <- Pval[[i]][, j] * TAW[[i]][, + j] + Dr[[i]][, j] <- Dr[[i]][, j - 1] - (Precip[[i]][, + j] - ROi[[i]][, j]) - Irr[[i]][, j] + ETc[[i]][, + j] + DP[[i]][, j - 1] + Dr[[i]][, j][Dr[[i]][, j] < 0] <- 0 + Dr[[i]][, j][Dr[[i]][, j] > TAW[[i]][, j]] <- TAW[[i]][, + j][Dr[[i]][, j] > TAW[[i]][, j]] + if (irr == TRUE & Frac > 0.5 & j < length(Irr[[i]]) * + 0.7) { + Irr[[i]][, j][Ks[[i]][, j] <= 0.9] <- 0.03 * + RAW[[i]][, (j)][Ks[[i]][, j] <= 0.9] + Cum <- rowSums(Irr[[i]][, c(1:j)]) + States <- read.csv("States.key.csv") + Crop <- Croplayer + if (Croplayer == "spring_wheat" || Croplayer == + "winter_wheat") + Crop <- "wheat" + if (Croplayer == "spring_barley") + Crop <- "barley" + if (Croplayer == "spring_oats") + Crop <- "oats" + if (Croplayer == "silage") + Crop <- "corn" + Mults <- Irr.Mults(Crop) + Matched <- merge(States, Mults, by.x = "State_name", + by.y = "State", all = TRUE) + Matched$Mult[is.na(Matched$Mult)] <- 1 + m <- Matched$STATE_FIPS[as.character(Matched$STATE_FIPS) == + names(Precip[i])] + Multiplier <- Matched$Mult[as.character(Matched$STATE_FIPS) == + names(Precip[i])] + if (Croplayer == "alfalfa") { + if (m == 40 || m == 20) + Multiplier <- 0.85 + if (m == 46 || m == 38) + Multiplier <- 1.75 + if (m == 22 || m == 45) + Multiplier <- 0.5 + if (m == 48) + Multiplier <- 1.1 + if (m == 53 || m == 41 || m == 16) + Multiplier <- Multiplier * 1.35 + if (m == 6) + Multiplier <- Multiplier * 1.25 + if (m == 30) + Multiplier <- Multiplier * 1.75 + if (m == 4 || m == 55) + Multiplier <- Multiplier * 2.25 + if (m == 8 || m == 49) + Multiplier <- Multiplier * 2.5 + if (m == 56) + Multiplier <- Multiplier * 3.2 + Irr[[i]][, j][Ks[[i]][, j] <= 0.9] <- 0.035 * + RAW[[i]][, (j)][Ks[[i]][, j] <= 0.9] + Irr[[i]][, j][Ks[[i]][, j] <= 0.9 & Cum[Ks[[i]][, + j] <= 0.9] >= 300] <- 0.065 * RAW[[i]][, + (j)][Ks[[i]][, j] <= 0.9 & Cum[Ks[[i]][, + j] <= 0.9] >= 300] + Irr[[i]][, j][Ks[[i]][, j] <= 0.9 & Cum[Ks[[i]][, + j] <= 0.9] >= 400] <- 0.1 * RAW[[i]][, + (j)][Ks[[i]][, j] <= 0.9 & Cum[Ks[[i]][, + j] <= 0.9] >= 400] + Irr[[i]][, j][Ks[[i]][, j] <= 0.9 & Cum[Ks[[i]][, + j] <= 0.9] >= 600] <- 0.15 * RAW[[i]][, + (j)][Ks[[i]][, j] <= 0.9 & Cum[Ks[[i]][, + j] <= 0.9] >= 600] + Irr[[i]][, j][Ks[[i]][, j] <= 0.9 & Cum[Ks[[i]][, + j] <= 0.9] >= 1000] <- 0.175 * RAW[[i]][, + (j)][Ks[[i]][, j] <= 0.9 & Cum[Ks[[i]][, + j] <= 0.9] >= 1000] + Irr[[i]][, j][Ks[[i]][, j] <= 0.9 & Cum[Ks[[i]][, + j] <= 0.9] >= 2000] <- 0 + } + if (Croplayer == "spring_barley") { + Irr[[i]][, j][Ks[[i]][, j] <= 0.9] <- 0.07 * + RAW[[i]][, (j)][Ks[[i]][, j] <= 0.9] + Irr[[i]][, j][Ks[[i]][, j] <= 0.9 & Cum[Ks[[i]][, + j] <= 0.9] >= 1000] <- 0 + } + if (Croplayer == "corn" && j > 10) { + Irr[[i]][, j][Ks[[i]][, j] <= 0.9] <- 0.09 * + RAW[[i]][, (j)][Ks[[i]][, j] <= 0.9] + Irr[[i]][, j][Ks[[i]][, j] <= 0.9 & Cum[Ks[[i]][, + j] <= 0.9] >= 400] <- 0.11 * RAW[[i]][, + (j)][Ks[[i]][, j] <= 0.9 & Cum[Ks[[i]][, + j] <= 0.9] >= 400] + Irr[[i]][, j][Ks[[i]][, j] <= 0.9 & Cum[Ks[[i]][, + j] <= 0.9] >= 800] <- 0.08 * RAW[[i]][, + (j)][Ks[[i]][, j] <= 0.9 & Cum[Ks[[i]][, + j] <= 0.9] >= 800] + Irr[[i]][, j][Ks[[i]][, j] <= 0.9 & Cum[Ks[[i]][, + j] <= 0.9] >= 1000] <- 0 + if (m == 6) { + Irr[[i]][, j][Ks[[i]][, j] <= 0.9] <- 0.12 * + RAW[[i]][, (j)][Ks[[i]][, j] <= 0.9] + if (length(Irr[[i]][, j][Ks[[i]][, j] <= + 0.9 & Cum[Ks[[i]][, j] <= 0.9] >= 1400]) > + 0) { + print("irrigation max exceeded for...on day...") + print(length(Irr[[i]][, j][Ks[[i]][, + j] <= 0.9 & Cum[Ks[[i]][, j] <= 0.9] >= + 1400])) + print(j) + } + Irr[[i]][, j][Ks[[i]][, j] <= 0.9 & Cum[Ks[[i]][, + j] <= 0.9] >= 1400] <- 0 + } + } + if (Croplayer == "cotton") { + Irr[[i]][, j][Ks[[i]][, j] <= 0.9] <- 0.045 * + RAW[[i]][, (j)][Ks[[i]][, j] <= 0.9] + Irr[[i]][, j][Ks[[i]][, j] <= 0.9 & Cum[Ks[[i]][, + j] <= 0.9] >= 450] <- 0.025 * RAW[[i]][, + (j)][Ks[[i]][, j] <= 0.9 & Cum[Ks[[i]][, + j] <= 0.9] >= 450] + Irr[[i]][, j][Ks[[i]][, j] <= 0.9 & Cum[Ks[[i]][, + j] <= 0.9] >= 650] <- 0.05 * RAW[[i]][, + (j)][Ks[[i]][, j] <= 0.9 & Cum[Ks[[i]][, + j] <= 0.9] >= 650] + } + if (Croplayer == "spring_oats") { + Irr[[i]][, j][Ks[[i]][, j] <= 0.9] <- 0.08 * + RAW[[i]][, (j)][Ks[[i]][, j] <= 0.9] + Irr[[i]][, j][Ks[[i]][, j] <= 0.9 & Cum[Ks[[i]][, + j] <= 0.9] >= 2200] <- 0 + } + if (Croplayer == "peanuts") { + Irr[[i]][, j][Ks[[i]][, j] <= 0.9] <- 0.06 * + RAW[[i]][, (j)][Ks[[i]][, j] <= 0.9] + Irr[[i]][, j][Ks[[i]][, j] <= 0.9 & Cum[Ks[[i]][, + j] <= 0.9] >= 300] <- 0.08 * RAW[[i]][, + (j)][Ks[[i]][, j] <= 0.9 & Cum[Ks[[i]][, + j] <= 0.9] >= 300] + Irr[[i]][, j][Ks[[i]][, j] <= 0.9 & Cum[Ks[[i]][, + j] <= 0.9] >= 1400] <- 0 + } + if (Croplayer == "rice") { + Irr[[i]][, j][Dr[[i]][, (j)] >= 0.9 * (RAW[[i]][, + (j)])] <- 1.75 * RAW[[i]][, (j)][Dr[[i]][, + (j)] >= 0.9 * (RAW[[i]][, (j)])] + Irr[[i]][, j][Ks[[i]][, j] <= 0.6 & Cum[Ks[[i]][, + j] <= 0.6] >= 200] <- 1 * RAW[[i]][, + (j)][Ks[[i]][, j] <= 0.6 & Cum[Ks[[i]][, + j] <= 0.6] >= 200] + Irr[[i]][, j][Ks[[i]][, j] <= 0.6 & Cum[Ks[[i]][, + j] <= 0.6] >= 500] <- 0.5 * RAW[[i]][, + (j)][Ks[[i]][, j] <= 0.6 & Cum[Ks[[i]][, + j] <= 0.6] >= 500] + Irr[[i]][, j][Ks[[i]][, j] <= 0.6 & Cum[Ks[[i]][, + j] <= 0.6] >= 850] <- 0.35 * RAW[[i]][, + (j)][Ks[[i]][, j] <= 0.6 & Cum[Ks[[i]][, + j] <= 0.6] >= 850] + } + if (Croplayer == "sorghum") { + Irr[[i]][, j][Ks[[i]][, j] <= 0.9] <- 0.05 * + RAW[[i]][, (j)][Ks[[i]][, j] <= 0.9] + Irr[[i]][, j][Ks[[i]][, j] <= 0.9 & Cum[Ks[[i]][, + j] <= 0.9] >= 400] <- 0.0275 * RAW[[i]][, + (j)][Ks[[i]][, j] <= 0.9 & Cum[Ks[[i]][, + j] <= 0.9] >= 100] + Irr[[i]][, j][Ks[[i]][, j] <= 0.9 & Cum[Ks[[i]][, + j] <= 0.9] >= 4800] <- 0 + } + if (Croplayer == "soybeans") { + Irr[[i]][, j][Ks[[i]][, j] <= 0.9] <- 0.095 * + RAW[[i]][, (j)][Ks[[i]][, j] <= 0.9] + Irr[[i]][, j][Ks[[i]][, j] <= 0.9 & Cum[Ks[[i]][, + j] <= 0.9] >= 350] <- 0.02 * RAW[[i]][, + (j)][Ks[[i]][, j] <= 0.9 & Cum[Ks[[i]][, + j] <= 0.9] >= 350] + Irr[[i]][, j][Ks[[i]][, j] <= 0.9 & Cum[Ks[[i]][, + j] <= 0.9] >= 1200] <- 0 + } + if (Croplayer == "spring_wheat") { + Irr[[i]][, j][Ks[[i]][, j] <= 0.9] <- 0.0075 * + RAW[[i]][, (j)][Ks[[i]][, j] <= 0.9] + Irr[[i]][, j][Ks[[i]][, j] <= 0.9 & Cum[Ks[[i]][, + j] <= 0.9] >= 1400] <- 0 + } + if (Croplayer == "winter_wheat") { + if (m == 35 || m == 49 || m == 31 || m == + 20) + Multiplier <- Multiplier * 0.5 + if (m == 16) + Multiplier <- Multiplier * 0.75 + if (m == 41 || m == 8 || m == 32) + Multiplier <- Multiplier * 1.5 + if (m == 48 || m == 46 || m == 38 || m == + 45 || m == 37 || m == 51 || m == 40 || + m == 5) + Multiplier <- Multiplier * 2 + if (m == 6 || m == 32) + Multiplier <- Multiplier * 3 + Irr[[i]][, j][Ks[[i]][, j] <= 0.9] <- 0.018 * + RAW[[i]][, (j)][Ks[[i]][, j] <= 0.9] + Irr[[i]][, j][Ks[[i]][, j] <= 0.9 & Cum[Ks[[i]][, + j] <= 0.9] >= 350] <- 0.045 * RAW[[i]][, + (j)][Ks[[i]][, j] <= 0.9 & Cum[Ks[[i]][, + j] <= 0.9] >= 350] + Irr[[i]][, j][Ks[[i]][, j] <= 0.9 & Cum[Ks[[i]][, + j] <= 0.9] >= 1200] <- 0 + } + if (Croplayer == "silage") { + Irr[[i]][, j][Ks[[i]][, j] <= 0.9 & Cum[Ks[[i]][, + j] <= 0.9] >= 400] <- 0.07 * RAW[[i]][, + (j)][Ks[[i]][, j] <= 0.9 & Cum[Ks[[i]][, + j] <= 0.9] >= 400] + } + Irr[[i]][, j] <- Irr[[i]][, j] * Multiplier + } + Dr[[i]][, j] <- Dr[[i]][, j - 1] - (Precip[[i]][, + j] - ROi[[i]][, j]) - Irr[[i]][, j] + ETc[[i]][, + j] + DP[[i]][, j - 1] + Dr[[i]][, j][Dr[[i]][, j] < 0] <- 0 + Dr[[i]][, j][Dr[[i]][, j] > TAW[[i]][, j]] <- TAW[[i]][, + j][Dr[[i]][, j] > TAW[[i]][, j]] + Ks[[i]][, j][Dr[[i]][, j] > RAW[[i]][, j]] <- ((TAW[[i]][, + j] - Dr[[i]][, j])[Dr[[i]][, j] > RAW[[i]][, + j]])/((1 - Pval[[i]][, j][Dr[[i]][, j] > + RAW[[i]][, j]]) * TAW[[i]][, j][Dr[[i]][, + j] > RAW[[i]][, j]]) + Ks[[i]][, j][Dr[[i]][, j] <= RAW[[i]][, j]] <- 1 + DP[[i]][, j] <- (Precip[[i]][, j] - ROi[[i]][, + j]) + Irr[[i]][, j] - ETc[[i]][, j] - Dr[[i]][, + j - 1] + DP[[i]][, j][Dr[[i]][, j] > 0] <- 0 + DP[[i]][, j][DP[[i]][, j] < 0] <- 0 + Transp[[i]][, j] <- (Ks[[i]][, j] * Kcb.corrected[[i]][, + j] + Ke[[i]][, j]) * ETo[[i]][, j] + Transp.final[[i]][, j] <- (Ks[[i]][, j] * Kcb.corrected[[i]][, + j]) * ETo[[i]][, j] + DPe[[i]][, j] <- (Precip[[i]][, j] - ROi[[i]][, + j]) + (Irr[[i]][, j]/Fw[[i]][, j]) - De[[i]][, + j - 1] + DPe[[i]][, j][DPe[[i]][, j] < 0] <- 0 + De[[i]][, j] <- De[[i]][, j - 1] - (Precip[[i]][, + j] - ROi[[i]][, j]) + Irr[[i]][, j]/Fw[[i]][, + j] + (E[[i]][, j]/Few[[i]][, j]) + DPe[[i]][, + j] + De[[i]][, j][De[[i]][, j] < 0] <- 0 + De[[i]][, j][De[[i]][, j] > TEW[[i]]] <- TEW[[i]][De[[i]][, + j] > TEW[[i]]] + } + } + } + } + print("Saving growing season SB files") + setwd(paste0(Path, "/CropWatR/Intermediates/")) + save(Few, file = paste("Growing.Season_Root.Zone.Depletion", + Croplayer, "Rdata", sep = ".")) + save(Kr, file = paste("Growing.Season_Kr", Croplayer, "Rdata", + sep = ".")) + save(Ks, file = paste("Growing.Season_Ks", Croplayer, "Rdata", + sep = ".")) + save(Pval, file = paste("Growing.Season_Pval", Croplayer, + "Rdata", sep = ".")) + save(Dr, file = paste("Growing.Season_Root.Zone.Depletion", + Croplayer, "Rdata", sep = ".")) + save(De, file = paste("Growing.Season_Soil.Water.Balance", + Croplayer, "Rdata", sep = ".")) + save(DP, file = paste("Growing.Season_Deep.Percolation", + Croplayer, "Rdata", sep = ".")) + save(ROi, file = paste("Growing.Season_Runoff", Croplayer, + "Rdata", sep = ".")) + save(E, file = paste("Growing.Season_Soil.Evaporation", Croplayer, + "Rdata", sep = ".")) + save(Irr, file = paste("Growing.Season_Irrigation", Croplayer, + "Rdata", sep = ".")) + save(Transp.final, file = paste("Growing.Season_Transpiration", + Croplayer, "Rdata", sep = ".")) + save(DPe, file = paste("Growing.Season.Root.Zone.Percolation.Loss", + Croplayer, "Rdata", sep = ".")) + save(Few, file = paste("Growing.Season.Evaporation.Fractions", + Croplayer, "Rdata", sep = ".")) + setwd(paste0(Path, "/CropWatR/Data")) + print("Calculation of Growing Season daily soil water balance, deep percolation, and evaporation complete") + print("Growing Season initial run complete, on to post season") + } +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ ~kwd1 } +\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line diff --git a/man/Main.Rainfed.Growing.Season.Daily.ET.Calc.Rd b/man/Main.Rainfed.Growing.Season.Daily.ET.Calc.Rd new file mode 100644 index 0000000..9dd42bf --- /dev/null +++ b/man/Main.Rainfed.Growing.Season.Daily.ET.Calc.Rd @@ -0,0 +1,377 @@ +\name{Main.Rainfed.Growing.Season.Daily.ET.Calc} +\alias{Main.Rainfed.Growing.Season.Daily.ET.Calc} +%- Also NEED an '\alias' for EACH other topic documented here. +\title{ +%% ~~function to do ... ~~ +} +\description{ +%% ~~ A concise (1-5 lines) description of what the function does. ~~ +} +\usage{ +Main.Rainfed.Growing.Season.Daily.ET.Calc(Croplayer, Auto = TRUE) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{Croplayer}{ +%% ~~Describe \code{Croplayer} here~~ +} + \item{Auto}{ +%% ~~Describe \code{Auto} here~~ +} +} +\details{ +%% ~~ If necessary, more details than the description above ~~ +} +\value{ +%% ~Describe the value returned +%% If it is a LIST, use +%% \item{comp1 }{Description of 'comp1'} +%% \item{comp2 }{Description of 'comp2'} +%% ... +} +\references{ +%% ~put references to the literature/web site here ~ +} +\author{ +%% ~~who you are~~ +} +\note{ +%% ~~further notes~~ +} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +\seealso{ +%% ~~objects to See Also as \code{\link{help}}, ~~~ +} +\examples{ +##---- Should be DIRECTLY executable !! ---- +##-- ==> Define data, use random, +##-- or do help(data=index) for the standard data sets. + +## The function is currently defined as +function (Croplayer, Auto = TRUE) +{ + load("Vars.Rdata") + Irr.Vars <- Vars[-c(3, 6, 8, 14, 15)] + if (!(Croplayer \%in\% Irr.Vars)) + stop("This function is for irrigated varieties only!") + load(paste0(Intermediates, paste("Growing.Season", Croplayer, + "ETo_", "Rdata", sep = "."))) + ETo <- Growing.Season + rm(Growing.Season) + load(paste0(Intermediates, paste("Growing.Season", Croplayer, + "Precip_", "Rdata", sep = "."))) + Precip <- Growing.Season + rm(Growing.Season) + CROP <- Croplayer + load(paste0("../Intermediates/Daily.Crop.Profile.", CROP, + ".Rdata")) + Root.depth <- lapply(DailyKcb, function(x) x$daily_root.depth) + Qfc.minus.Qwp <- lapply(Precip, function(x) x$Qfc.minus.Qwp) + TEW <- lapply(Precip, function(x) x$ave_TEW) + Dei <- TEW + REW <- lapply(Precip, function(x) x$ave_REW) + Precip <- lapply(Precip, function(x) x[, (grep("layer", names(x)))]) + load(paste0(Intermediates, paste("Few", Croplayer, "Rdata", + sep = "."))) + load(paste0(Intermediates, paste("KcMax", Croplayer, "Rdata", + sep = "."))) + KcMax <- lapply(KcMax, function(x) x[, (grep("layer", names(x)))]) + load(paste0(Intermediates, paste("Kcb.corrected", Croplayer, + "Rdata", sep = "."))) + ETo <- lapply(ETo, function(x) x[, (grep("layer", names(x)))]) + sapply(ETo, function(x) length(x[x < 0])) + if (file.exists(paste0(Intermediates, paste("Growing.Saved", + Croplayer, "Rdata", sep = "."))) == FALSE) { + for (i in 1:length(ETo)) { + ETo[[i]][ETo[[i]] < 0] <- 0 + ETo[[i]] <- round(ETo[[i]], 3) + ETo[[i]][ETo[[i]] > 28] <- 1.655 + print("ETo high vals warning:") + print(length(ETo[[i]][ETo[[i]] > 18])) + } + print("ETo data cleaned") + ROi <- Precip + for (i in 1:length(ROi)) { + ROi[[i]] <- ROi[[i]] - TEW[[i]] + ROi[[i]][ROi[[i]] < 0] <- 0 + } + print("Growing season runoff estimated") + Irr <- Precip + for (i in 1:length(Irr)) { + Irr[[i]][Irr[[i]] > 0] <- 0 + } + Fw.table <- read.csv("Fw.table.csv") + Irr.Eff <- Fw.table$fw[1] + Fw <- Irr + for (i in 1:length(Fw)) { + Fw[[i]][Fw[[i]] == 0] <- Irr.Eff + } + Growing.Files <- list(ETo, Precip, ROi, Irr, Fw) + save(Growing.Files, file = paste0(Intermediates, paste("Growing.Saved", + Croplayer, "Rdata", sep = "."))) + } + if (file.exists(paste0(Intermediates, paste("Growing.Saved", + Croplayer, "Rdata", sep = "."))) == TRUE) { + load(paste0(Intermediates, paste("Growing.Saved", Croplayer, + "Rdata", sep = "."))) + ETo <- Growing.Files[[1]] + Precip <- Growing.Files[[2]] + ROi <- Growing.Files[[3]] + Irr <- Growing.Files[[4]] + Fw <- Growing.Files[[5]] + } + Zr <- read.csv("crop.roots.csv") + Zr <- Zr[Zr$crop == Croplayer, ] + TAW.base <- lapply(Qfc.minus.Qwp, function(x) 1000 * (x[] * + Zr$root_depth)) + Kr <- Irr + ETc <- Irr + De <- Irr + DPe <- Irr + Transp <- Irr + Ke <- Irr + E <- Irr + Transp <- Irr + Pval <- Irr + RAW <- Irr + Ks <- Irr + Transp.final <- Irr + Dr <- Irr + DP <- Irr + TAW <- Irr + setwd(paste0(Path, "/CropWatR/Intermediates/")) + load(paste("Preseason_Root.Zone.Depletion", Croplayer, "Rdata", + sep = ".")) + load(paste("Preseason_Soil.Top.Layer.Depletion", Croplayer, + "Rdata", sep = ".")) + load(paste("Preseason_Deep.Percolation", Croplayer, "Rdata", + sep = ".")) + load(paste("Preseason_Soil.Evaporation", Croplayer, "Rdata", + sep = ".")) + load(paste("Preseason_Runoff", Croplayer, "Rdata", sep = ".")) + load(paste("Preseason_Weed.Transpiration", Croplayer, "Rdata", + sep = ".")) + load(paste("Fallow.Saved", Croplayer, "Rdata", sep = ".")) + Pre.Few <- Fallow.File[[5]] + setwd(paste0(Path, "/CropWatR/Data")) + if (file.exists(paste0(Intermediates, paste("Growing.Season.Rainfed_Transpiration", + Croplayer, "Rdata", sep = "."))) == TRUE & Auto == TRUE) { + print(paste("Growing Season has been previously calculated for", + Croplayer)) + } + if (file.exists(paste0(Intermediates, paste("Growing.Season.Rainfed_Transpiration", + Croplayer, "Rdata", sep = "."))) == FALSE) { + Fw.table <- read.csv("Fw.table.csv") + Irr.Eff <- Fw.table$fw[1] + for (i in 1:length(Precip)) { + for (j in 1:length(Precip[[i]])) { + if (j == 1) { + Few[[i]][, j] <- pmin.int(Few[[i]][, j], Fw[[i]][, + j]) + Kr[[i]][, j][Pre.Dei[[i]][, length(Pre.Dei[[i]])] > + REW[[i]]] <- (TEW[[i]][Pre.Dei[[i]][, length(Pre.Dei[[i]])] > + REW[[i]]] - Pre.Dei[[i]][, length(Pre.Dei[[i]])][Pre.Dei[[i]][, + length(Pre.Dei[[i]])] > REW[[i]]])/(TEW[[i]][Pre.Dei[[i]][, + length(Pre.Dei[[i]])] > REW[[i]]] - REW[[i]][Pre.Dei[[i]][, + length(Pre.Dei[[i]])] > REW[[i]]]) + Kr[[i]][, j][Pre.Dei[[i]][, length(Pre.Dei[[i]])] <= + REW[[i]]] <- 1 + Kr[[i]][, j][Kr[[i]][, j] < 0] <- 0 + Ke[[i]][, j] <- pmin.int(Kr[[i]][, j] * (KcMax[[i]][, + j] - Kcb.corrected[[i]][, j]), Few[[i]][, + j] * KcMax[[i]][, j]) + Ke[[i]][, j][Ke[[i]][, j] < 0] <- 0 + E[[i]][, j] <- Ke[[i]][, j] * ETo[[i]][, j] + DPe[[i]][, j] <- (Precip[[i]][, j] - ROi[[i]][, + j]) + (Irr[[i]][, j]/Fw[[i]][, j]) - Pre.Dei[[i]][, + length(Pre.Dei[[i]])] + DPe[[i]][, j][DPe[[i]][, j] < 0] <- 0 + De[[i]][, j] <- Pre.Dei[[i]][, length(Pre.Dei[[i]])] - + (Precip[[i]][, j] - ROi[[i]][, j]) + Irr[[i]][, + j]/Fw[[i]][, j] + (E[[i]][, j]/Few[[i]][, + j]) + DPe[[i]][, j] + De[[i]][, j][De[[i]][, j] < 0] <- 0 + De[[i]][, j][De[[i]][, j] > TEW[[i]]] <- TEW[[i]][De[[i]][, + j] > TEW[[i]]] + ETc[[i]][, j] <- (Kcb.corrected[[i]][, j] + + Ke[[i]][, j]) * ETo[[i]][, j] + Pval[[i]][, j] <- Zr$p.value + 0.04 * (5 - + (ETc[[i]][, j])) + Pval[[i]][, j][Pval[[i]][, j] < 0.1] <- 0.1 + Pval[[i]][, j][Pval[[i]][, j] > 0.8] <- 0.8 + if (is.na(Root.depth[[i]][j]/Zr$root_depth)) { + Frac <- Root.depth[[i]][length(Root.depth[[i]])]/Zr$root_depth + } + else Frac <- Root.depth[[i]][j]/Zr$root_depth + TAW[[i]][, j] <- TAW.base[[i]] * Frac + RAW[[i]][, j] <- Pval[[i]][, j] * TAW[[i]][, + j] + Dr[[i]][, j] <- Pre.Dr[[i]][, length(Pre.Dr[[i]])] - + (Precip[[i]][, j] - ROi[[i]][, j]) - Irr[[i]][, + j] + ETc[[i]][, j] + Pre.DP[[i]][, length(Pre.DP[[i]])] + Dr[[i]][, j][Dr[[i]][, j] < 0] <- 0 + Dr[[i]][, j][Dr[[i]][, j] > TAW[[i]][, j]] <- TAW[[i]][, + j][Dr[[i]][, j] > TAW[[i]][, j]] + Ks[[i]][, j][Dr[[i]][, j] > RAW[[i]][, j]] <- ((TAW[[i]][, + j] - Dr[[i]][, j])[Dr[[i]][, j] > RAW[[i]][, + j]])/((1 - Pval[[i]][, j][Dr[[i]][, j] > + RAW[[i]][, j]]) * TAW[[i]][, j][Dr[[i]][, + j] > RAW[[i]][, j]]) + Ks[[i]][, j][Dr[[i]][, j] <= RAW[[i]][, j]] <- 1 + DP[[i]][, j] <- (Precip[[i]][, j] - ROi[[i]][, + j]) + Irr[[i]][, j] - ETc[[i]][, j] - Pre.Dr[[i]][, + length(Pre.Dr[[i]])] + DP[[i]][, j][Dr[[i]][, j] > 0] <- 0 + DP[[i]][, j][DP[[i]][, j] < 0] <- 0 + Transp[[i]][, j] <- (Ks[[i]][, j] * Kcb.corrected[[i]][, + j] + Ke[[i]][, j]) * ETo[[i]][, j] + Transp.final[[i]][, j] <- (Ks[[i]][, j] * Kcb.corrected[[i]][, + j]) * ETo[[i]][, j] + DPe[[i]][, j] <- (Precip[[i]][, j] - ROi[[i]][, + j]) + (Irr[[i]][, j]/Fw[[i]][, j]) - Pre.Dei[[i]][, + length(Pre.Dei[[i]])] + DPe[[i]][, j][DPe[[i]][, j] < 0] <- 0 + De[[i]][, j] <- Pre.Dei[[i]][, length(Pre.Dei[[i]])] - + (Precip[[i]][, j] - ROi[[i]][, j]) + Irr[[i]][, + j]/Fw[[i]][, j] + (E[[i]][, j]/Few[[i]][, + j]) + DPe[[i]][, j] + De[[i]][, j][De[[i]][, j] < 0] <- 0 + De[[i]][, j][De[[i]][, j] > TEW[[i]]] <- TEW[[i]][De[[i]][, + j] > TEW[[i]]] + } + else { + Fw[[i]][, j] <- Fw[[i]][, (j - 1)] + Few[[i]][, j] <- pmin.int(Few[[i]][, j], Fw[[i]][, + j]) + Kr[[i]][, j][De[[i]][, (j - 1)] > REW[[i]]] <- (TEW[[i]][De[[i]][, + (j - 1)] > REW[[i]]] - De[[i]][, (j - 1)][De[[i]][, + (j - 1)] > REW[[i]]])/(TEW[[i]][De[[i]][, + (j - 1)] > REW[[i]]] - REW[[i]][De[[i]][, + (j - 1)] > REW[[i]]]) + Kr[[i]][, j][De[[i]][, (j - 1)] <= REW[[i]]] <- 1 + Kr[[i]][, j][Kr[[i]][, j] < 0] <- 0 + Ke[[i]][, j] <- pmin.int(Kr[[i]][, j] * (KcMax[[i]][, + j] - Kcb.corrected[[i]][, j]), Few[[i]][, + j] * KcMax[[i]][, j]) + Ke[[i]][, j][Ke[[i]][, j] < 0] <- 0 + ETo[[i]] + E[[i]][, j] <- Ke[[i]][, j] * ETo[[i]][, j] + DPe[[i]][, j] <- (Precip[[i]][, j] - ROi[[i]][, + j]) + (Irr[[i]][, j]/Fw[[i]][, j]) - De[[i]][, + j - 1] + DPe[[i]][, j][DPe[[i]][, j] < 0] <- 0 + De[[i]][, j] <- De[[i]][, j - 1] - (Precip[[i]][, + j] - ROi[[i]][, j]) + Irr[[i]][, j]/Fw[[i]][, + j] + (E[[i]][, j]/Few[[i]][, j]) + DPe[[i]][, + j] + De[[i]][, j][De[[i]][, j] < 0] <- 0 + De[[i]][, j][De[[i]][, j] > TEW[[i]]] <- TEW[[i]][De[[i]][, + j] > TEW[[i]]] + ETc[[i]][, j] <- (Kcb.corrected[[i]][, j] + + Ke[[i]][, j]) * ETo[[i]][, j] + Pval[[i]][, j] <- Zr$p.value + 0.04 * (5 - + (ETc[[i]][, j])) + Pval[[i]][, j][Pval[[i]][, j] < 0.1] <- 0.1 + Pval[[i]][, j][Pval[[i]][, j] > 0.8] <- 0.8 + if (is.na(Root.depth[[i]][j]/Zr$root_depth)) { + Frac <- Root.depth[[i]][length(Root.depth[[i]])]/Zr$root_depth + } + else Frac <- Root.depth[[i]][j]/Zr$root_depth + TAW[[i]][, j] <- TAW.base[[i]] * Frac + RAW[[i]][, j] <- Pval[[i]][, j] * TAW[[i]][, + j] + Dr[[i]][, j] <- Dr[[i]][, j - 1] - (Precip[[i]][, + j] - ROi[[i]][, j]) - Irr[[i]][, j] + ETc[[i]][, + j] + DP[[i]][, j - 1] + Dr[[i]][, j][Dr[[i]][, j] < 0] <- 0 + Dr[[i]][, j][Dr[[i]][, j] > TAW[[i]][, j]] <- TAW[[i]][, + j][Dr[[i]][, j] > TAW[[i]][, j]] + Dr[[i]][, j] <- Dr[[i]][, j - 1] - (Precip[[i]][, + j] - ROi[[i]][, j]) - Irr[[i]][, j] + ETc[[i]][, + j] + DP[[i]][, j - 1] + Dr[[i]][, j][Dr[[i]][, j] < 0] <- 0 + Dr[[i]][, j][Dr[[i]][, j] > TAW[[i]][, j]] <- TAW[[i]][, + j][Dr[[i]][, j] > TAW[[i]][, j]] + Ks[[i]][, j][Dr[[i]][, j] > RAW[[i]][, j]] <- ((TAW[[i]][, + j] - Dr[[i]][, j])[Dr[[i]][, j] > RAW[[i]][, + j]])/((1 - Pval[[i]][, j][Dr[[i]][, j] > + RAW[[i]][, j]]) * TAW[[i]][, j][Dr[[i]][, + j] > RAW[[i]][, j]]) + Ks[[i]][, j][Dr[[i]][, j] <= RAW[[i]][, j]] <- 1 + DP[[i]][, j] <- (Precip[[i]][, j] - ROi[[i]][, + j]) + Irr[[i]][, j] - ETc[[i]][, j] - Dr[[i]][, + j - 1] + DP[[i]][, j][Dr[[i]][, j] > 0] <- 0 + DP[[i]][, j][DP[[i]][, j] < 0] <- 0 + Transp[[i]][, j] <- (Ks[[i]][, j] * Kcb.corrected[[i]][, + j] + Ke[[i]][, j]) * ETo[[i]][, j] + Transp.final[[i]][, j] <- (Ks[[i]][, j] * Kcb.corrected[[i]][, + j]) * ETo[[i]][, j] + DPe[[i]][, j] <- (Precip[[i]][, j] - ROi[[i]][, + j]) + (Irr[[i]][, j]/Fw[[i]][, j]) - De[[i]][, + j - 1] + DPe[[i]][, j][DPe[[i]][, j] < 0] <- 0 + De[[i]][, j] <- De[[i]][, j - 1] - (Precip[[i]][, + j] - ROi[[i]][, j]) + Irr[[i]][, j]/Fw[[i]][, + j] + (E[[i]][, j]/Few[[i]][, j]) + DPe[[i]][, + j] + De[[i]][, j][De[[i]][, j] < 0] <- 0 + De[[i]][, j][De[[i]][, j] > TEW[[i]]] <- TEW[[i]][De[[i]][, + j] > TEW[[i]]] + } + } + Few[[i]][, 1] <- Few[[i]][, 2] + Kr[[i]][, 1] <- Kr[[i]][, 2] + Ke[[i]][, 1] <- Ke[[i]][, 2] + E[[i]][, 1] <- E[[i]][, 2] + DPe[[i]][, 1] <- DPe[[i]][, 2] + De[[i]][, 1] <- De[[i]][, 2] + ETc[[i]][, 1] <- ETc[[i]][, 2] + Pval[[i]][, 1] <- Pval[[i]][, 2] + TAW[[i]][, 1] <- TAW[[i]][, 2] + RAW[[i]][, 1] <- RAW[[i]][, 2] + Dr[[i]][, 1] <- Dr[[i]][, 2] + Dr[[i]][, 1] <- Dr[[i]][, 2] + Ks[[i]][, 1] <- Ks[[i]][, 2] + DP[[i]][, 1] <- DP[[i]][, 2] + Transp[[i]][, 1] <- Transp[[i]][, 2] + Transp.final[[i]][, 1] <- Transp.final[[i]][, 2] + } + } + print("Saving rainfed growing season SB files") + setwd(paste0(Path, "/CropWatR/Intermediates/")) + save(Few, file = paste("Growing.Season.Rainfed_Root.Zone.Depletion", + Croplayer, "Rdata", sep = ".")) + save(Kr, file = paste("Growing.Season.Rainfed_Kr", Croplayer, + "Rdata", sep = ".")) + save(Ks, file = paste("Growing.Season.Rainfed_Ks", Croplayer, + "Rdata", sep = ".")) + save(Pval, file = paste("Growing.Season.Rainfed_Pval", Croplayer, + "Rdata", sep = ".")) + save(Dr, file = paste("Growing.Season.Rainfed_Root.Zone.Depletion", + Croplayer, "Rdata", sep = ".")) + save(De, file = paste("Growing.Season.Rainfed_Soil.Water.Balance", + Croplayer, "Rdata", sep = ".")) + save(DP, file = paste("Growing.Season.Rainfed_Deep.Percolation", + Croplayer, "Rdata", sep = ".")) + save(ROi, file = paste("Growing.Season.Rainfed_Runoff", Croplayer, + "Rdata", sep = ".")) + save(E, file = paste("Growing.Season.Rainfed_Soil.Evaporation", + Croplayer, "Rdata", sep = ".")) + save(Transp.final, file = paste("Growing.Season.Rainfed_Transpiration", + Croplayer, "Rdata", sep = ".")) + save(DPe, file = paste("Growing.Season.Rainfed.Root.Zone.Percolation.Loss", + Croplayer, "Rdata", sep = ".")) + save(Few, file = paste("Growing.Season.Rainfed.Evaporation.Fractions", + Croplayer, "Rdata", sep = ".")) + setwd(paste0(Path, "/CropWatR/Data")) + print("Calculation of Growing Season daily soil water balance, deep percolation, and evaporation complete") + print("Growing Season initial run complete, on to post season") + } +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ ~kwd1 } +\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line diff --git a/man/Path.Rd b/man/Path.Rd new file mode 100644 index 0000000..2d155ed --- /dev/null +++ b/man/Path.Rd @@ -0,0 +1,28 @@ +\name{Path} +\alias{Path} +\docType{data} +\title{ +%% ~~ data name/kind ... ~~ +} +\description{ +%% ~~ A concise (1-5 lines) description of the dataset. ~~ +} +\usage{data("Path")} +\format{ + The format is: + chr "/Users/jacobteter/Desktop" +} +\details{ +%% ~~ If necessary, more details than the __description__ above ~~ +} +\source{ +%% ~~ reference to a publication or URL from which the data were obtained ~~ +} +\references{ +%% ~~ possibly secondary sources and usages ~~ +} +\examples{ +data(Path) +## maybe str(Path) ; plot(Path) ... +} +\keyword{datasets} diff --git a/man/Percent.Change.Perspective.Plot.Rd b/man/Percent.Change.Perspective.Plot.Rd new file mode 100644 index 0000000..fb92546 --- /dev/null +++ b/man/Percent.Change.Perspective.Plot.Rd @@ -0,0 +1,106 @@ +\name{Percent.Change.Perspective.Plot} +\alias{Percent.Change.Perspective.Plot} +%- Also NEED an '\alias' for EACH other topic documented here. +\title{ +%% ~~function to do ... ~~ +} +\description{ +%% ~~ A concise (1-5 lines) description of what the function does. ~~ +} +\usage{ +Percent.Change.Perspective.Plot(Raster, Country, ColorScheme = list("terrain", "heat", "topo", "cm"), Save = TRUE) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{Raster}{ +%% ~~Describe \code{Raster} here~~ +} + \item{Country}{ +%% ~~Describe \code{Country} here~~ +} + \item{ColorScheme}{ +%% ~~Describe \code{ColorScheme} here~~ +} + \item{Save}{ +%% ~~Describe \code{Save} here~~ +} +} +\details{ +%% ~~ If necessary, more details than the description above ~~ +} +\value{ +%% ~Describe the value returned +%% If it is a LIST, use +%% \item{comp1 }{Description of 'comp1'} +%% \item{comp2 }{Description of 'comp2'} +%% ... +} +\references{ +%% ~put references to the literature/web site here ~ +} +\author{ +%% ~~who you are~~ +} +\note{ +%% ~~further notes~~ +} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +\seealso{ +%% ~~objects to See Also as \code{\link{help}}, ~~~ +} +\examples{ +##---- Should be DIRECTLY executable !! ---- +##-- ==> Define data, use random, +##-- or do help(data=index) for the standard data sets. + +## The function is currently defined as +function (Raster, Country, ColorScheme = list("terrain", "heat", + "topo", "cm"), Save = TRUE) +{ + Pop3D <- Raster + zData <- round(as.matrix(Pop3D), 1) + x <- 1:nrow(zData) + y <- 1:ncol(zData) + nrz <- nrow(zData) + ncz <- ncol(zData) + if (Save == FALSE) + quartz(width = 12, height = 9) + DissDir <- "/Users/jacobteter/Desktop/Dissertation/" + png(filename = paste0(DissDir, paste(Country, ColorScheme, + "png", sep = ".")), width = 1400, height = 600, bg = "white") + par(bg = "transparent", mar = c(4, 0, 0, 0), mai = c(0.1, + 0.1, 0.5, 0.1)) + nbcol <- 99 + Start <- -1 * max(abs(cellStats(Pop3D, max)), abs(cellStats(Pop3D, + min))) + End <- 1 * max(abs(cellStats(Pop3D, max)), abs(cellStats(Pop3D, + min))) + if (ColorScheme == "heat") + Pal <- rev(heat.colors(nbcol))[20:120] + if (ColorScheme == "terrain") + Pal <- terrain.colors(nbcol) + if (ColorScheme == "rainbow") + Pal <- rainbow(nbcol) + if (ColorScheme == "topo") + Pal <- topo.colors(nbcol) + if (ColorScheme == "cm") + Pal <- cm.colors(nbcol) + if (ColorScheme == "GreenToRed") + Pal <- rev(brewer.pal(nbcol, "RdBu")) + color <- c("transparent", Pal) + zfacet <- zData[-1, -1] + zData[-1, -ncz] + zData[-nrz, -1] + + zData[-nrz, -ncz] + facetcol <- cut(zfacet, nbcol + 1) + persp(x, y, z = zData, theta = 90, phi = 30, col = color[facetcol], + scale = FALSE, expand = 0.75, ltheta = 75, shade = 0.05, + border = NA, box = F, ticktype = "detailed") + if (Save == TRUE) + dev.off() + } +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ ~kwd1 } +\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line diff --git a/man/Perspective.Boundaries.Rd b/man/Perspective.Boundaries.Rd new file mode 100644 index 0000000..409cbd0 --- /dev/null +++ b/man/Perspective.Boundaries.Rd @@ -0,0 +1,86 @@ +\name{Perspective.Boundaries} +\alias{Perspective.Boundaries} +%- Also NEED an '\alias' for EACH other topic documented here. +\title{ +%% ~~function to do ... ~~ +} +\description{ +%% ~~ A concise (1-5 lines) description of what the function does. ~~ +} +\usage{ +Perspective.Boundaries(Raster, Country, Save = TRUE) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{Raster}{ +%% ~~Describe \code{Raster} here~~ +} + \item{Country}{ +%% ~~Describe \code{Country} here~~ +} + \item{Save}{ +%% ~~Describe \code{Save} here~~ +} +} +\details{ +%% ~~ If necessary, more details than the description above ~~ +} +\value{ +%% ~Describe the value returned +%% If it is a LIST, use +%% \item{comp1 }{Description of 'comp1'} +%% \item{comp2 }{Description of 'comp2'} +%% ... +} +\references{ +%% ~put references to the literature/web site here ~ +} +\author{ +%% ~~who you are~~ +} +\note{ +%% ~~further notes~~ +} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +\seealso{ +%% ~~objects to See Also as \code{\link{help}}, ~~~ +} +\examples{ +##---- Should be DIRECTLY executable !! ---- +##-- ==> Define data, use random, +##-- or do help(data=index) for the standard data sets. + +## The function is currently defined as +function (Raster, Country, Save = TRUE) +{ + Pop3D <- Raster + Pop3D[is.na(Pop3D)] <- 0 + zData <- round(as.matrix(Pop3D), 1) + x <- 1:nrow(zData) + y <- 1:ncol(zData) + nrz <- nrow(zData) + ncz <- ncol(zData) + if (Save == FALSE) + quartz(width = 12, height = 9) + png(filename = paste(Country, "border.png", sep = "."), width = 1400, + height = 600, bg = "white") + par(bg = "transparent", mar = c(4, 0, 0, 0), mai = c(0.1, + 0.1, 0.5, 0.1)) + nbcol <- 2 + color <- c("transparent", "black") + zfacet <- zData[-1, -1] + zData[-1, -ncz] + zData[-nrz, -1] + + zData[-nrz, -ncz] + facetcol <- cut(zfacet, nbcol + 1) + persp(x, y, z = zData, theta = 90, phi = 30, col = color[facetcol], + scale = FALSE, expand = 0.75, ltheta = 75, shade = 0.05, + border = NA, box = F, ticktype = "detailed") + if (Save == TRUE) + dev.off() + } +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ ~kwd1 } +\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line diff --git a/man/Perspective.Plot.Rd b/man/Perspective.Plot.Rd new file mode 100644 index 0000000..633275a --- /dev/null +++ b/man/Perspective.Plot.Rd @@ -0,0 +1,122 @@ +\name{Perspective.Plot} +\alias{Perspective.Plot} +%- Also NEED an '\alias' for EACH other topic documented here. +\title{ +%% ~~function to do ... ~~ +} +\description{ +%% ~~ A concise (1-5 lines) description of what the function does. ~~ +} +\usage{ +Perspective.Plot(Raster, Country, ColorScheme = list("terrain", "heat", "topo", "cm"), log = TRUE, Save = TRUE) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{Raster}{ +%% ~~Describe \code{Raster} here~~ +} + \item{Country}{ +%% ~~Describe \code{Country} here~~ +} + \item{ColorScheme}{ +%% ~~Describe \code{ColorScheme} here~~ +} + \item{log}{ +%% ~~Describe \code{log} here~~ +} + \item{Save}{ +%% ~~Describe \code{Save} here~~ +} +} +\details{ +%% ~~ If necessary, more details than the description above ~~ +} +\value{ +%% ~Describe the value returned +%% If it is a LIST, use +%% \item{comp1 }{Description of 'comp1'} +%% \item{comp2 }{Description of 'comp2'} +%% ... +} +\references{ +%% ~put references to the literature/web site here ~ +} +\author{ +%% ~~who you are~~ +} +\note{ +%% ~~further notes~~ +} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +\seealso{ +%% ~~objects to See Also as \code{\link{help}}, ~~~ +} +\examples{ +##---- Should be DIRECTLY executable !! ---- +##-- ==> Define data, use random, +##-- or do help(data=index) for the standard data sets. + +## The function is currently defined as +function (Raster, Country, ColorScheme = list("terrain", "heat", + "topo", "cm"), log = TRUE, Save = TRUE) +{ + Pop <- Raster + if (log == TRUE) { + Log <- "log.scale" + setBasePop <- function(x) { + x[x > 0] <- x[x > 0] + 1 + x[x <= 0] <- NA + x[x > 0] <- log2(x) + return(x) + } + } + if (log == FALSE) { + Log <- "linear.scale" + setBasePop <- function(x) { + x[x <= 0] <- NA + x[x > 0] <- x[x > 0] * 0.001 + 0.1 + return(x) + } + } + Pop3D <- calc(Pop, setBasePop) + Pop3D[is.na(Pop3D)] <- 0 + zData <- round(as.matrix(Pop3D), 1) + x <- 1:nrow(zData) + y <- 1:ncol(zData) + nrz <- nrow(zData) + ncz <- ncol(zData) + if (Save == FALSE) + quartz(width = 12, height = 9) + DissDir <- "/Users/jacobteter/Desktop/Dissertation/" + png(filename = paste0(DissDir, paste(Country, ColorScheme, + Log, "png", sep = ".")), width = 1400, height = 600, + bg = "white") + par(bg = "transparent", mar = c(4, 0, 0, 0), mai = c(0.1, + 0.1, 0.5, 0.1)) + nbcol <- 120 + if (ColorScheme == "heat") + Pal <- rev(heat.colors(nbcol))[20:120] + if (ColorScheme == "terrain") + Pal <- terrain.colors(nbcol) + if (ColorScheme == "topo") + Pal <- topo.colors(nbcol) + if (ColorScheme == "cm") + Pal <- cm.colors(nbcol) + color <- c("transparent", Pal) + zfacet <- zData[-1, -1] + zData[-1, -ncz] + zData[-nrz, -1] + + zData[-nrz, -ncz] + facetcol <- cut(zfacet, nbcol + 1) + persp(x, y, z = zData, theta = 90, phi = 30, col = color[facetcol], + scale = FALSE, expand = 0.75, ltheta = 75, shade = 0.05, + border = NA, box = F, ticktype = "detailed") + Scale <- gsub(".", " ", Log, fixed = TRUE) + if (Save == TRUE) + dev.off() + } +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ ~kwd1 } +\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line diff --git a/man/Plot.Base.Land.Use.Rd b/man/Plot.Base.Land.Use.Rd new file mode 100644 index 0000000..fb6c3bb --- /dev/null +++ b/man/Plot.Base.Land.Use.Rd @@ -0,0 +1,91 @@ +\name{Plot.Base.Land.Use} +\alias{Plot.Base.Land.Use} +%- Also NEED an '\alias' for EACH other topic documented here. +\title{ +%% ~~function to do ... ~~ +} +\description{ +%% ~~ A concise (1-5 lines) description of what the function does. ~~ +} +\usage{ +Plot.Base.Land.Use(Aggregate = FALSE) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{Aggregate}{ +%% ~~Describe \code{Aggregate} here~~ +} +} +\details{ +%% ~~ If necessary, more details than the description above ~~ +} +\value{ +%% ~Describe the value returned +%% If it is a LIST, use +%% \item{comp1 }{Description of 'comp1'} +%% \item{comp2 }{Description of 'comp2'} +%% ... +} +\references{ +%% ~put references to the literature/web site here ~ +} +\author{ +%% ~~who you are~~ +} +\note{ +%% ~~further notes~~ +} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +\seealso{ +%% ~~objects to See Also as \code{\link{help}}, ~~~ +} +\examples{ +##---- Should be DIRECTLY executable !! ---- +##-- ==> Define data, use random, +##-- or do help(data=index) for the standard data sets. + +## The function is currently defined as +function (Aggregate = FALSE) +{ + base <- brick("Base.Crops.LU.2008.grd") + if (Aggregate == FALSE) + Agg <- ".Sep" + if (Aggregate == TRUE) { + Sum <- function(x, ...) { + sum(x, na.rm = TRUE) + } + Base <- calc(base, Sum) + Base[Base == 0] <- NA + plot(Base, axes = FALSE, box = FALSE) + base <- Base + Agg <- ".Agg" + } + Mil.Acres <- round(cellStats(base, sum)/10^6, digits = 2) + Names <- gsub("_", " ", names(base), fixed = TRUE) + Names <- paste(Names, paste(Mil.Acres, "million acres", sep = " "), + sep = " - ") + Per <- base/24710.5 * 100 + Subtitle <- paste0("Percentage of land cropped (million acres cropped total shown for each crop)") + my.ckey <- list(labels = list(cex = 1.25), col = GnYlRdTheme$regions$col, + space = "right") + MyScheme <- GnYlRdTheme + Layout <- c(2, 7) + pdf(file = paste0(Intermediates, "RasterVis.rowcrops.Base", + Agg, ".pdf"), width = 7, height = 14) + par(mar = c(0.1, 0.1, 0.1, 0.1)) + p <- levelplot(Per, scales = list(draw = FALSE), contour = FALSE, + sub = "", sub.cex = 1.25, par.settings = MyScheme, zscaleLog = 10, + colorkey = my.ckey, layout = Layout, names.attr = Names, + main = "", side = 1, outer = TRUE, line = 1, cex = 1.5) + p <- p + layer(sp.lines(SL.aeaCRDs, lwd = 0.01, col = "gray")) + p <- p + layer(sp.lines(SL.aeaStates, lwd = 0.05, col = "darkgrey")) + plot(p) + dev.off() + } +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ ~kwd1 } +\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line diff --git a/man/Plot.Check.Variety.Annual.Water.Balances.Rd b/man/Plot.Check.Variety.Annual.Water.Balances.Rd new file mode 100644 index 0000000..1d18d17 --- /dev/null +++ b/man/Plot.Check.Variety.Annual.Water.Balances.Rd @@ -0,0 +1,143 @@ +\name{Plot.Check.Variety.Annual.Water.Balances} +\alias{Plot.Check.Variety.Annual.Water.Balances} +%- Also NEED an '\alias' for EACH other topic documented here. +\title{ +%% ~~function to do ... ~~ +} +\description{ +%% ~~ A concise (1-5 lines) description of what the function does. ~~ +} +\usage{ +Plot.Check.Variety.Annual.Water.Balances(Variety) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{Variety}{ +%% ~~Describe \code{Variety} here~~ +} +} +\details{ +%% ~~ If necessary, more details than the description above ~~ +} +\value{ +%% ~Describe the value returned +%% If it is a LIST, use +%% \item{comp1 }{Description of 'comp1'} +%% \item{comp2 }{Description of 'comp2'} +%% ... +} +\references{ +%% ~put references to the literature/web site here ~ +} +\author{ +%% ~~who you are~~ +} +\note{ +%% ~~further notes~~ +} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +\seealso{ +%% ~~objects to See Also as \code{\link{help}}, ~~~ +} +\examples{ +##---- Should be DIRECTLY executable !! ---- +##-- ==> Define data, use random, +##-- or do help(data=index) for the standard data sets. + +## The function is currently defined as +function (Variety) +{ + if (Variety != "barley" && Variety != "oats" && Variety != + "wheat") { + Irr <- raster(brick(paste0("Base.WBs.2008/Irrigated.mm.", + Variety, ".grd")), layer = 5) + } + if (Variety == "fall_barley" || Variety == "fall_oats") { + stop(paste(Variety, "isn't irrigated")) + } + if (Variety == "spring_wheat" || Variety == "winter_wheat") { + SW.Irr <- raster(brick("Base.WBs.2008/Irrigated.mm.spring_wheat.grd"), + layer = 5) + WW.Irr <- raster(brick("Base.WBs.2008/Irrigated.mm.winter_wheat.grd"), + layer = 5) + Irr <- mosaic(SW.Irr, WW.Irr, fun = mean) + } + Irr <- Irr * 0.0032808399 + survey <- read.csv("acre-feet.per.acre.csv") + Crop <- Variety + if (Variety == "spring_barley") + Crop <- "barley" + if (Variety == "spring_oats") + Crop <- "oats" + if (Variety == "spring_wheat" || Variety == "winter_wheat") + Crop <- "wheat" + if (Variety == "silage") + Crop <- "corn" + aeaStates <- shapefile("aeaStates.shp") + head(aeaStates@data) + setMethod("merge", signature(x = "Spatial", y = "data.frame"), + function(x, y, by = intersect(names(x), names(y)), by.x = by, + by.y = by, all.x = TRUE, suffixes = c(".x", ".y"), + incomparables = NULL, ...) { + if (!"data" \%in\% slotNames(x)) { + stop("x has no data.frame") + } + d <- x@data + d$donotusethisvariablename976 <- 1:nrow(d) + y <- unique(y) + i <- apply(y[, by.y, drop = FALSE], 1, paste) \%in\% + apply(x@data[, by.x, drop = FALSE], 1, paste) + y <- y[i, , drop = FALSE] + if (isTRUE(any(table(y[, by.y]) > 1))) { + stop("'y' has multiple records for one or more 'by.y' key(s)") + } + if (!all.x) { + y$donotusethisvariablename679 <- 1 + } + d <- merge(d, y, by = by, by.x = by.x, by.y = by.y, + suffixes = suffixes, incomparables = incomparables, + all.x = TRUE, all.y = FALSE) + d <- d[order(d$donotusethisvariablename976), ] + d$donotusethisvariablename976 <- NULL + rownames(d) <- row.names(x) + x@data <- d + if (!all.x) { + x <- x[!is.na(x@data$donotusethisvariablename679), + , drop = FALSE] + x@data$donotusethisvariablename679 <- NULL + } + x + }) + Surveyed <- survey[, c(1, which(names(survey) == Crop))] + aeaStates <- merge(aeaStates, Surveyed, by.x = "ATLAS_NAME", + by.y = "State") + MeanModelled <- extract(Irr, aeaStates, fun = function(x) mean(x, + na.rm = TRUE)) + aeaStates$Modelled <- round(MeanModelled, digits = 1) + aeaStates$Modelled[is.nan(aeaStates$Modelled)] <- NA + aeaStates@data[, 10][is.na(aeaStates$Modelled)] <- NA + par(mar = c(0.2, 0.2, 0.2, 0.2)) + plot(Irr, axes = FALSE, box = FALSE, col = rev(heat.colors(255)), + alpha = 0.75) + plot(aeaStates, add = TRUE) + text(aeaStates, labels = Crop, cex = 1, col = "blue", adj = c(0.5, + 0)) + text(aeaStates, labels = "Modelled", cex = 1, col = "red", + pos = 1, adj = c(0, -0.5)) + d <- density(na.omit((survey[, (names(survey) == Crop)]))) + f <- density(na.omit(getValues(Irr))) + e <- density(na.omit(MeanModelled)) + plot(e, xlim = c(0, 6.2), ylab = "", xlab = "", main = "") + mtext("acre-feet per acre", side = 1, line = 2) + polygon(d, col = "transparent", border = "blue") + polygon(e, col = "transparent", border = "red2") + Lbls <- c("State survey", "Modelled State averages") + colfill <- c("blue", "red2") + } +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ ~kwd1 } +\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line diff --git a/man/RasterVis.Or.Plot.Map.Water.Balances.Rd b/man/RasterVis.Or.Plot.Map.Water.Balances.Rd new file mode 100644 index 0000000..3165810 --- /dev/null +++ b/man/RasterVis.Or.Plot.Map.Water.Balances.Rd @@ -0,0 +1,235 @@ +\name{RasterVis.Or.Plot.Map.Water.Balances} +\alias{RasterVis.Or.Plot.Map.Water.Balances} +%- Also NEED an '\alias' for EACH other topic documented here. +\title{ +%% ~~function to do ... ~~ +} +\description{ +%% ~~ A concise (1-5 lines) description of what the function does. ~~ +} +\usage{ +RasterVis.Or.Plot.Map.Water.Balances(Crop, mm = FALSE, rainfed = FALSE, type = c("annual", "seasonal"), Raster.Vis = TRUE, metric = FALSE) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{Crop}{ +%% ~~Describe \code{Crop} here~~ +} + \item{mm}{ +%% ~~Describe \code{mm} here~~ +} + \item{rainfed}{ +%% ~~Describe \code{rainfed} here~~ +} + \item{type}{ +%% ~~Describe \code{type} here~~ +} + \item{Raster.Vis}{ +%% ~~Describe \code{Raster.Vis} here~~ +} + \item{metric}{ +%% ~~Describe \code{metric} here~~ +} +} +\details{ +%% ~~ If necessary, more details than the description above ~~ +} +\value{ +%% ~Describe the value returned +%% If it is a LIST, use +%% \item{comp1 }{Description of 'comp1'} +%% \item{comp2 }{Description of 'comp2'} +%% ... +} +\references{ +%% ~put references to the literature/web site here ~ +} +\author{ +%% ~~who you are~~ +} +\note{ +%% ~~further notes~~ +} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +\seealso{ +%% ~~objects to See Also as \code{\link{help}}, ~~~ +} +\examples{ +##---- Should be DIRECTLY executable !! ---- +##-- ==> Define data, use random, +##-- or do help(data=index) for the standard data sets. + +## The function is currently defined as +function (Crop, mm = FALSE, rainfed = FALSE, type = c("annual", + "seasonal"), Raster.Vis = TRUE, metric = FALSE) +{ + if (mm == TRUE) + Pat <- "mm" + if (mm == FALSE) + Pat <- "Total" + if (rainfed == TRUE) + Irr <- "rainfed" + if (rainfed == FALSE) + Irr <- "irrigated" + Final <- brick(paste0(Intermediates, Pat, ".", type, ".WB.", + Irr, ".", Crop, ".grd")) + Final[Final == 0] <- NA + print("Final stats:") + print(cellStats(Final, summary)) + plot(Final) + names(Final)[which(names(Final) == "GW.Infiltration")] <- "Groundwater Infiltration" + if (mm == FALSE) { + if (metric == FALSE) { + Final <- Final * 0.0032808399 + Final <- Final/10^3 + Subtitle <- "water balances in thousand acre-feet" + Type <- "Acre-feet" + } + if (metric == TRUE) { + Final <- Final * 0.000404685642 + Final <- Final/10^3 + Subtitle <- "water balances in thousand hectare-meters" + Type <- "Hectare-meters" + } + } + if (mm == TRUE) { + Subtitle <- "Water balances in mm" + Type <- "mm" + } + setwd(paste0(Path, "/CropWatR/Intermediates/")) + if (Raster.Vis == TRUE) { + if (mm == FALSE) { + my.ckey <- list(labels = list(cex = 1.25), col = GnYlRdTheme$regions$col, + space = "left") + Type <- "Total.WB" + } + if (mm == TRUE) { + my.ckey <- list(labels = list(cex = 1.25), col = GnYlRdTheme$regions$col, + space = "right") + Subtitle <- "water balances in mm" + Type <- "mm" + } + png(filename = paste("Transpiration", Crop, Type, type, + Irr, "png", sep = "."), width = 300, height = 200) + par(mai = c(0.1, 0.1, 0.1, 0.1), mar = c(0.1, 0.1, 0.1, + 0.1), oma = c(0, 0, 0, 0)) + p <- levelplot(raster(Final, layer = 1), cex = 1.15, + border = "transparent", scales = list(draw = FALSE), + margin = FALSE, contour = FALSE, par.settings = GnYlRdTheme, + colorkey = my.ckey) + p <- p + layer(sp.lines(SL.aeaCounties, lwd = 0.05, col = "gray")) + p <- p + layer(sp.lines(SL.aeaStates, lwd = 0.08, col = "darkgray")) + p <- p + layer(sp.lines(SL.aeaHuc2, lwd = 0.15, col = "black")) + plot(p) + dev.off() + png(filename = paste("Evaporation", Crop, Type, type, + Irr, "png", sep = "."), width = 300, height = 200) + par(mai = c(0.1, 0.1, 0.1, 0.1), mar = c(0.1, 0.1, 0.1, + 0.1), oma = c(0, 0, 0, 0)) + p <- levelplot(raster(Final, layer = 2), cex = 1.15, + border = "transparent", scales = list(draw = FALSE), + margin = FALSE, contour = FALSE, par.settings = GnYlRdTheme, + colorkey = my.ckey) + p <- p + layer(sp.lines(SL.aeaCounties, lwd = 0.05, col = "gray")) + p <- p + layer(sp.lines(SL.aeaStates, lwd = 0.08, col = "darkgray")) + p <- p + layer(sp.lines(SL.aeaHuc2, lwd = 0.15, col = "black")) + plot(p) + dev.off() + png(filename = paste("Runoff", Crop, Type, type, Irr, + "png", sep = "."), width = 300, height = 200) + par(mai = c(0.1, 0.1, 0.1, 0.1), mar = c(0.1, 0.1, 0.1, + 0.1), oma = c(0, 0, 0, 0)) + p <- levelplot(raster(Final, layer = 3), cex = 1.15, + border = "transparent", scales = list(draw = FALSE), + margin = FALSE, contour = FALSE, par.settings = GnYlRdTheme, + colorkey = my.ckey) + p <- p + layer(sp.lines(SL.aeaCounties, lwd = 0.05, col = "gray")) + p <- p + layer(sp.lines(SL.aeaStates, lwd = 0.08, col = "darkgray")) + p <- p + layer(sp.lines(SL.aeaHuc2, lwd = 0.15, col = "black")) + plot(p) + dev.off() + png(filename = paste("GW.Infiltration", Crop, Type, type, + Irr, "png", sep = "."), width = 300, height = 200) + par(mai = c(0.1, 0.1, 0.1, 0.1), mar = c(0.1, 0.1, 0.1, + 0.1), oma = c(0, 0, 0, 0)) + p <- levelplot(raster(Final, layer = 4), cex = 1.15, + border = "transparent", scales = list(draw = FALSE), + margin = FALSE, contour = FALSE, par.settings = GnYlRdTheme, + colorkey = my.ckey) + p <- p + layer(sp.lines(SL.aeaCounties, lwd = 0.05, col = "gray")) + p <- p + layer(sp.lines(SL.aeaStates, lwd = 0.08, col = "darkgray")) + p <- p + layer(sp.lines(SL.aeaHuc2, lwd = 0.15, col = "black")) + plot(p) + dev.off() + if (rainfed == FALSE) { + png(filename = paste("Irrigation", Crop, Type, type, + Irr, "png", sep = "."), width = 300, height = 200) + par(mai = c(0.1, 0.1, 0.1, 0.1), mar = c(0.1, 0.1, + 0.1, 0.1), oma = c(0, 0, 0, 0)) + p <- levelplot(raster(Final, layer = 5), cex = 1.15, + border = "transparent", scales = list(draw = FALSE), + margin = FALSE, contour = FALSE, par.settings = GnYlRdTheme, + colorkey = my.ckey) + p <- p + layer(sp.lines(SL.aeaCounties, lwd = 0.05, + col = "gray")) + p <- p + layer(sp.lines(SL.aeaStates, lwd = 0.08, + col = "darkgray")) + p <- p + layer(sp.lines(SL.aeaHuc2, lwd = 0.15, col = "black")) + plot(p) + dev.off() + } + } + if (Raster.Vis == FALSE) { + aeaHuc2 <- shapefile("aea.HUC2.bounds.shp") + aeaHuc2$REG_NAME <- strsplit(aeaHuc2$REG_NAME, " Region") + pdf(filename = paste("BrickPlot", Type, type, Irr, Crop, + "pdf"), width = 8, height = 2) + par(mfrow = c(1, 5), mai = c(0, 0.1, 0, 0.8), mar = c(0, + 0.1, 0, 5.5)) + plot(raster(Final, layer = 1), axes = FALSE, box = FALSE, + main = "Transpiration") + par(bg = "transparent") + plot(aeaHuc2, border = "black", col = "transparent", + lwd = 0.25, add = TRUE) + text(aeaHuc2, labels = "REG_NAME", col = "black", font = 2, + cex = 0.7) + plot(raster(Final, layer = 2), axes = FALSE, box = FALSE, + main = "Evaporation") + par(bg = "transparent") + plot(aeaHuc2, border = "black", col = "transparent", + lwd = 0.25, add = TRUE) + text(aeaHuc2, labels = "REG_NAME", col = "black", font = 2, + cex = 0.7) + plot(raster(Final, layer = 3), axes = FALSE, box = FALSE, + main = "Runoff") + par(bg = "transparent") + plot(aeaHuc2, border = "black", col = "transparent", + lwd = 0.25, add = TRUE) + text(aeaHuc2, labels = "REG_NAME", col = "black", font = 2, + cex = 0.7) + plot(raster(Final, layer = 4), axes = FALSE, box = FALSE, + main = "Groundwater Infiltration") + par(bg = "transparent") + plot(aeaHuc2, border = "black", col = "transparent", + lwd = 0.25, add = TRUE) + text(aeaHuc2, labels = "REG_NAME", col = "black", font = 2, + cex = 0.7) + plot(raster(Final, layer = 5), axes = FALSE, box = FALSE, + main = "Irrigation") + par(bg = "transparent") + plot(aeaHuc2, border = "black", col = "transparent", + lwd = 0.25, add = TRUE) + text(aeaHuc2, labels = "REG_NAME", col = "black", font = 2, + cex = 0.7) + mtext(Subtitle, side = 1, outer = TRUE, line = -3, cex = 1.25) + dev.off() + } + setwd(paste0(Path, "/CropWatR/Data")) + } +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ ~kwd1 } +\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line diff --git a/man/Rescale.And.Save.Rd b/man/Rescale.And.Save.Rd new file mode 100644 index 0000000..3c57e20 --- /dev/null +++ b/man/Rescale.And.Save.Rd @@ -0,0 +1,106 @@ +\name{Rescale.And.Save} +\alias{Rescale.And.Save} +%- Also NEED an '\alias' for EACH other topic documented here. +\title{ +%% ~~function to do ... ~~ +} +\description{ +%% ~~ A concise (1-5 lines) description of what the function does. ~~ +} +\usage{ +Rescale.And.Save(Variable, PH, DataList, Croplayer, Kcb) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{Variable}{ +%% ~~Describe \code{Variable} here~~ +} + \item{PH}{ +%% ~~Describe \code{PH} here~~ +} + \item{DataList}{ +%% ~~Describe \code{DataList} here~~ +} + \item{Croplayer}{ +%% ~~Describe \code{Croplayer} here~~ +} + \item{Kcb}{ +%% ~~Describe \code{Kcb} here~~ +} +} +\details{ +%% ~~ If necessary, more details than the description above ~~ +} +\value{ +%% ~Describe the value returned +%% If it is a LIST, use +%% \item{comp1 }{Description of 'comp1'} +%% \item{comp2 }{Description of 'comp2'} +%% ... +} +\references{ +%% ~put references to the literature/web site here ~ +} +\author{ +%% ~~who you are~~ +} +\note{ +%% ~~further notes~~ +} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +\seealso{ +%% ~~objects to See Also as \code{\link{help}}, ~~~ +} +\examples{ +##---- Should be DIRECTLY executable !! ---- +##-- ==> Define data, use random, +##-- or do help(data=index) for the standard data sets. + +## The function is currently defined as +function (Variable, PH, DataList, Croplayer, Kcb) +{ + PH.season.breaks <- subset(PH, select = Initial:Late) + PH[, which(names(PH) == "Initial"):which(names(PH) == "Late")] <- Rescale.Season(PH.season.breaks, + PH$Growing_Season) + deleteCols <- c("Crop", "Total", "Region", "Plant_Date") + PH <- PH[, -(which(names(PH) \%in\% deleteCols))] + Daily.Crops.list <- Daily.Crop.Curves(Croplayer, PH$State_Fips, + PH[, which(names(PH) == "Initial"):which(names(PH) == + "Late")], Kcb[, 2:4], Kcb[, 5]) + Daily.Crops.list <- Daily.Crops.list[order(names(Daily.Crops.list))] + Growing.Season <- DataList$Growing.Season + Fallow.Season <- DataList$Fallow.Season + Growing.Season <- Growing.Season[order(names(Growing.Season))] + Fallow.Season <- Fallow.Season[order(names(Fallow.Season))] + print("names equal?:") + print(all.equal(names(Growing.Season), names(Daily.Crops.list))) + print(all.equal(names(Growing.Season), names(Fallow.Season))) + print("layer lengths equal?: (expect a \"no\"") + print(all.equal(lapply(Growing.Season, function(x) length(grep("layer", + names(x)))), lapply(Daily.Crops.list, nrow))) + print(cbind(as.numeric(names(Growing.Season)), sapply(Growing.Season, + function(x) length(grep("layer", names(x)))), sapply(Daily.Crops.list, + nrow))) + for (i in 1:length(Growing.Season)) { + while (length(grep("layer", names(Growing.Season[[i]]))) > + nrow(Daily.Crops.list[[i]])) { + Growing.Season[[i]] <- Growing.Season[[i]][, -1] + Fallow.Season[[i]] <- cbind(Growing.Season[[i]][, + 1], Fallow.Season[[i]]) + } + } + print("layer lengths equal?:") + print(all.equal(lapply(Growing.Season, function(x) length(grep("layer", + names(x)))), lapply(Daily.Crops.list, nrow))) + save(Growing.Season, file = paste0(Intermediates, paste("Growing.Season", + Croplayer, Variable, "Rdata", sep = "."))) + save(Fallow.Season, file = paste0(Intermediates, paste("Fallow.Season", + Croplayer, Variable, "Rdata", sep = "."))) + } +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ ~kwd1 } +\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line diff --git a/man/Rescale.Season.Rd b/man/Rescale.Season.Rd new file mode 100644 index 0000000..dbbff66 --- /dev/null +++ b/man/Rescale.Season.Rd @@ -0,0 +1,67 @@ +\name{Rescale.Season} +\alias{Rescale.Season} +%- Also NEED an '\alias' for EACH other topic documented here. +\title{ +%% ~~function to do ... ~~ +} +\description{ +%% ~~ A concise (1-5 lines) description of what the function does. ~~ +} +\usage{ +Rescale.Season(Stages, Season.length) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{Stages}{ +%% ~~Describe \code{Stages} here~~ +} + \item{Season.length}{ +%% ~~Describe \code{Season.length} here~~ +} +} +\details{ +%% ~~ If necessary, more details than the description above ~~ +} +\value{ +%% ~Describe the value returned +%% If it is a LIST, use +%% \item{comp1 }{Description of 'comp1'} +%% \item{comp2 }{Description of 'comp2'} +%% ... +} +\references{ +%% ~put references to the literature/web site here ~ +} +\author{ +%% ~~who you are~~ +} +\note{ +%% ~~further notes~~ +} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +\seealso{ +%% ~~objects to See Also as \code{\link{help}}, ~~~ +} +\examples{ +##---- Should be DIRECTLY executable !! ---- +##-- ==> Define data, use random, +##-- or do help(data=index) for the standard data sets. + +## The function is currently defined as +function (Stages, Season.length) +{ + Season <- rowSums(Stages) + Scalor <- Season.length/Season + Rescale <- c(floor(Stages[, 1] * Scalor), ceiling(Stages[, + 2] * Scalor), floor(Stages[, 3] * Scalor), ceiling(Stages[, + 4] * Scalor)) + Rescale <- matrix(Rescale, ncol = 4) + return(Rescale) + } +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ ~kwd1 } +\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line diff --git a/man/Save.Crops.List.Rd b/man/Save.Crops.List.Rd new file mode 100644 index 0000000..4f7f5c6 --- /dev/null +++ b/man/Save.Crops.List.Rd @@ -0,0 +1,75 @@ +\name{Save.Crops.List} +\alias{Save.Crops.List} +%- Also NEED an '\alias' for EACH other topic documented here. +\title{ +%% ~~function to do ... ~~ +} +\description{ +%% ~~ A concise (1-5 lines) description of what the function does. ~~ +} +\usage{ +Save.Crops.List(PH, Croplayer, Kcb) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{PH}{ +%% ~~Describe \code{PH} here~~ +} + \item{Croplayer}{ +%% ~~Describe \code{Croplayer} here~~ +} + \item{Kcb}{ +%% ~~Describe \code{Kcb} here~~ +} +} +\details{ +%% ~~ If necessary, more details than the description above ~~ +} +\value{ +%% ~Describe the value returned +%% If it is a LIST, use +%% \item{comp1 }{Description of 'comp1'} +%% \item{comp2 }{Description of 'comp2'} +%% ... +} +\references{ +%% ~put references to the literature/web site here ~ +} +\author{ +%% ~~who you are~~ +} +\note{ +%% ~~further notes~~ +} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +\seealso{ +%% ~~objects to See Also as \code{\link{help}}, ~~~ +} +\examples{ +##---- Should be DIRECTLY executable !! ---- +##-- ==> Define data, use random, +##-- or do help(data=index) for the standard data sets. + +## The function is currently defined as +function (PH, Croplayer, Kcb) +{ + PH.season.breaks <- subset(PH, select = Initial:Late) + PH[, which(names(PH) == "Initial"):which(names(PH) == "Late")] <- Rescale.Season(PH.season.breaks, + PH$Growing_Season) + deleteCols <- c("Crop", "Total", "Region", "Plant_Date") + PH <- PH[, -(which(names(PH) \%in\% deleteCols))] + stages <- PH[, which(names(PH) == "Initial"):which(names(PH) == + "Late")] + Daily.Crops.list <- Daily.Crop.Curves(Croplayer, PH$State_Fips, + stages, Kcb[, 2:4], Kcb[, 5]) + Daily.Crops.list <- Daily.Crops.list[order(names(Daily.Crops.list))] + save(Daily.Crops.list, file = paste0(Intermediates, paste("CropsList", + Croplayer, "Rdata", sep = "."))) + } +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ ~kwd1 } +\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line diff --git a/man/Split.Seasons.Rd b/man/Split.Seasons.Rd new file mode 100644 index 0000000..62aadd2 --- /dev/null +++ b/man/Split.Seasons.Rd @@ -0,0 +1,160 @@ +\name{Split.Seasons} +\alias{Split.Seasons} +%- Also NEED an '\alias' for EACH other topic documented here. +\title{ +%% ~~function to do ... ~~ +} +\description{ +%% ~~ A concise (1-5 lines) description of what the function does. ~~ +} +\usage{ +Split.Seasons(Crop, Variable, Lat.long, TopSoil, Crop.Layers, PH) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{Crop}{ +%% ~~Describe \code{Crop} here~~ +} + \item{Variable}{ +%% ~~Describe \code{Variable} here~~ +} + \item{Lat.long}{ +%% ~~Describe \code{Lat.long} here~~ +} + \item{TopSoil}{ +%% ~~Describe \code{TopSoil} here~~ +} + \item{Crop.Layers}{ +%% ~~Describe \code{Crop.Layers} here~~ +} + \item{PH}{ +%% ~~Describe \code{PH} here~~ +} +} +\details{ +%% ~~ If necessary, more details than the description above ~~ +} +\value{ +%% ~Describe the value returned +%% If it is a LIST, use +%% \item{comp1 }{Description of 'comp1'} +%% \item{comp2 }{Description of 'comp2'} +%% ... +} +\references{ +%% ~put references to the literature/web site here ~ +} +\author{ +%% ~~who you are~~ +} +\note{ +%% ~~further notes~~ +} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +\seealso{ +%% ~~objects to See Also as \code{\link{help}}, ~~~ +} +\examples{ +##---- Should be DIRECTLY executable !! ---- +##-- ==> Define data, use random, +##-- or do help(data=index) for the standard data sets. + +## The function is currently defined as +function (Crop, Variable, Lat.long, TopSoil, Crop.Layers, PH) +{ + if (Variable != "Precip_") + RasterBrick <- brick(paste0(Variable, "2008.grd")) + aea.Loc.IDs <- read.csv("aea.Loc.IDs.csv") + if (Variable == "Precip_") + RasterBrick <- brick("Prism.ppt.10km.aea.grd") + DF <- as.data.frame(getValues(RasterBrick)) + DF <- cbind(DF, Lat.long) + DF <- na.omit(DF) + print("BEPAM growing pixels in aea.Loc.IDs:") + print(table(c(DF$x, DF$y) \%in\% c(aea.Loc.IDs$x, aea.Loc.IDs$y))) + DF <- merge(DF, aea.Loc.IDs, by.x = c("x", "y"), by.y = c("x", + "y"), all = TRUE) + print("BEPAM growing pixels in TopSoil:") + print(table(c(DF$x, DF$y) \%in\% c(TopSoil$x, TopSoil$y))) + DF <- merge(DF, TopSoil, by.x = c("x", "y"), by.y = c("x", + "y"), all = TRUE) + print(table(DF$STATE_FIPS \%in\% PH$State_Fips)) + print(unique(DF$State_name[which(!(DF$STATE_FIPS \%in\% PH$State_Fips))])) + DF <- merge(DF, PH, by.x = "STATE_FIPS", by.y = "State_Fips", + all.x = TRUE) + print(unique(DF$State_name[which(!(DF$STATE_FIPS \%in\% Crop.Layers$STATE_FIPS))])) + Droppers <- c("CountyFIPS", "HUC2", "Abbreviation", "State_name", + "Ers.region", "CRD") + Crop.Layers <- Crop.Layers[, -which(names(Crop.Layers) \%in\% + Droppers)] + DF <- merge(DF, Crop.Layers, by.x = c("x", "y", "STATE_FIPS"), + by.y = c("x", "y", "STATE_FIPS"), all.x = TRUE) + DF <- cbind(DF[4:ncol(DF)], DF[, 1:3]) + DF <- DF[!is.na(DF$Planting.Main), ] + DF <- DF[!is.na(DF$Harvesting.Main), ] + DF <- DF[!is.na(DF$STATE_FIPS), ] + DF <- DF[!is.na(DF$layer.1), ] + DF$STATE_FIPS <- as.factor(DF$STATE_FIPS) + if (Variable == "MNRH_") { + DF2 <- DF + save(DF2, file = paste0(Intermediates, paste("BASE", + Crop, Variable, "MasterDF2", sep = "."))) + } + OverWinter <- max(DF$Harvesting.Main) + if (OverWinter > 365) { + DF <- as.data.frame(cbind(DF[, 1:365], DF[, 1:length(DF)])) + names(DF)[366:730] <- paste0(rep("layer."), 366:730) + } + Split.DF <- split(DF, DF$STATE_FIPS, drop = FALSE) + print("number of states growing crop:") + print(length(Split.DF)) + if (Crop != "sugarcane" & Crop != "switchgrass" & Crop != + "miscanthus" & Crop != "idle_cropland" & Crop != "pasture_grass" & + Crop != "rep_cropland") { + Split.DF <- lapply(Split.DF, drop.levels) + } + Growing.Season <- lapply(Split.DF, function(x) x[, c(x$Planting.Main[1]:x$Harvesting.Main[1], + (which(names(x) == "CountyFIPS")):(which(names(x) == + "STATE_FIPS")))]) + Fallow.Season <- lapply(Split.DF, function(x) x[, c(1:(x$Planting.Main[1] - + 1), (x$Harvesting.Main[1] + 1):ncol(x))]) + if (OverWinter > 365) { + GS.dates <- lapply(Growing.Season, function(x) names(x[grep("layer", + names(x))])) + GS.dates <- lapply(GS.dates, function(x) as.numeric(substr(x, + 7, 9))) + GS.dates.1 <- lapply(GS.dates, function(x) paste0("layer.", + x - 365)) + GS.dates.2 <- lapply(GS.dates, function(x) paste0("layer.", + x + 365)) + Dups <- c(paste0("layer.", 365:730)) + for (i in 1:length(Fallow.Season)) { + Fallow.Season[[i]] <- Fallow.Season[[i]][, -(which(names(Fallow.Season[[i]]) \%in\% + Dups))] + FS.check <- ncol(Fallow.Season[[i]][, grep("layer", + names(Fallow.Season[[i]]))]) + ncol(Growing.Season[[i]][, + grep("layer", names(Growing.Season[[i]]))]) + if (FS.check > 365) { + Fallow.Season[[i]] <- Fallow.Season[[i]][, -(which(names(Fallow.Season[[i]]) \%in\% + GS.dates.1[[i]]))] + } + } + } + GS.length <- unlist(lapply(Growing.Season, function(x) length(x[grep("layer", + names(x))]))) + FS.length <- unlist(lapply(Fallow.Season, function(x) length(x[grep("layer", + names(x))]))) + print(GS.length + FS.length) + DF <- list(Variable = Variable, Growing.Season = Growing.Season, + Fallow.Season = Fallow.Season) + save(DF, file = paste0(Intermediates, paste("Base", Crop, + Variable, "MasterDF", sep = "."))) + return(DF) + } +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ ~kwd1 } +\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line diff --git a/man/Subset.Growth.Season.Rd b/man/Subset.Growth.Season.Rd new file mode 100644 index 0000000..2ec3856 --- /dev/null +++ b/man/Subset.Growth.Season.Rd @@ -0,0 +1,216 @@ +\name{Subset.Growth.Season} +\alias{Subset.Growth.Season} +%- Also NEED an '\alias' for EACH other topic documented here. +\title{ +%% ~~function to do ... ~~ +} +\description{ +%% ~~ A concise (1-5 lines) description of what the function does. ~~ +} +\usage{ +Subset.Growth.Season(RowCrop, energycrops = FALSE) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{RowCrop}{ +%% ~~Describe \code{RowCrop} here~~ +} + \item{energycrops}{ +%% ~~Describe \code{energycrops} here~~ +} +} +\details{ +%% ~~ If necessary, more details than the description above ~~ +} +\value{ +%% ~Describe the value returned +%% If it is a LIST, use +%% \item{comp1 }{Description of 'comp1'} +%% \item{comp2 }{Description of 'comp2'} +%% ... +} +\references{ +%% ~put references to the literature/web site here ~ +} +\author{ +%% ~~who you are~~ +} +\note{ +%% ~~further notes~~ +} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +\seealso{ +%% ~~objects to See Also as \code{\link{help}}, ~~~ +} +\examples{ +##---- Should be DIRECTLY executable !! ---- +##-- ==> Define data, use random, +##-- or do help(data=index) for the standard data sets. + +## The function is currently defined as +function (RowCrop, energycrops = FALSE) +{ + Growth_stages <- read.csv("Growth_stages.csv") + Growth_stages$Region <- as.character(Growth_stages$Region) + Kcb <- read.csv("Kcb_values.csv") + Lat.long <- read.csv("lat.long.vals.csv") + TopSoil <- read.csv("TopSoil.csv") + CROP <- RowCrop + if (RowCrop == "fall_oats" | RowCrop == "spring_oats") + CROP <- "oats" + if (RowCrop == "spring_barley" | RowCrop == "fall_barley") + CROP <- "barley" + if (RowCrop == "silage" || RowCrop == "corn") + CROP <- "corn" + Base.2008.CDL <- read.csv("CDL.main.crops.2008.base.csv") + load("Vars.RData") + Rm.Vars <- Vars[-grep(CROP, Vars)] + Base.CDL.crop <- Base.2008.CDL[, c(!(names(Base.2008.CDL) \%in\% + Rm.Vars))] + PH <- read.csv("Planting_harvesting_dates_final.csv") + PH <- subset(PH, Crop == RowCrop, select = c(2, 13:15, 17), + drop = TRUE) + Stages <- Growth_stages[grep(CROP, Growth_stages$Crop), ] + if (RowCrop == "spring_wheat" | RowCrop == "spring_barley" | + RowCrop == "spring_oats" | RowCrop == "durum_wheat") { + Stages <- Growth_stages[Growth_stages$Crop == "barley_oats_wheat", + ] + PH <- cbind(PH, Stages[Stages$Plant_Date == "November", + ]) + } + if (RowCrop == "fall_barley" | RowCrop == "fall_oats") { + Stages <- Growth_stages[Growth_stages$Crop == "barley_oats_wheat_fall", + ] + PH <- cbind(PH, Stages[Stages$Plant_Date == "Nov", ]) + } + if (RowCrop == "winter_wheat") { + PH1 <- cbind(PH[(PH$Growing_Season <= 270), ], Stages[Stages$Plant_Date == + "December", ]) + PH2 <- cbind(PH[(PH$Growing_Season > 270), ], Stages[Stages$Plant_Date == + "October", ]) + PH <- rbind(PH1, PH2) + } + if (RowCrop == "sugarcane") { + PH <- cbind(PH, Stages[Stages$Crop == "sugarcane_ratoon", + ]) + } + if (RowCrop == "sugarbeets") { + PH <- cbind(PH, Stages[Stages$Region == "ID", ]) + } + if (RowCrop == "alfalfa") { + PH1 <- cbind(PH[(PH$Growing_Season <= 290), ], Stages[(Stages$Crop == + "alfalfa_1st_cutting_cycle") & (Stages$Region == + "CA"), ]) + PH2 <- cbind(PH[(PH$Growing_Season > 290), ], Stages[(Stages$Crop == + "alfalfa_1st_cutting_cycle") & (Stages$Region == + "ID"), ]) + PH <- rbind(PH1, PH2) + } + if (RowCrop == "corn" | RowCrop == "silage") { + PH1 <- cbind(PH[(PH$Growing_Season <= 146), ], Stages[(Stages$Total == + 140), ]) + PH2 <- cbind(PH[((PH$Growing_Season > 146) & (PH$Growing_Season <= + 155)), ], Stages[(Stages$Total == 155), ]) + PH3 <- cbind(PH[(PH$Growing_Season > 155), ], Stages[(Stages$Total == + 170), ]) + PH <- rbind(PH1, PH2, PH3) + } + if (RowCrop == "cotton") { + PH1 <- cbind(PH[(PH$Growing_Season <= 180), ], Stages[(Stages$Total == + 180), ]) + PH2 <- cbind(PH[(PH$Growing_Season > 180), ], Stages[(Stages$Total == + 225), ]) + PH <- rbind(PH1, PH2) + } + if (RowCrop == "sorghum") { + PH1 <- cbind(PH[(PH$State_Fips == 4 | PH$State_Fips == + 35 | PH$State_Fips == 48), ], Stages[(Stages$Total == + 130), ]) + PH2 <- cbind(PH[(PH$State_Fips != 4 & PH$State_Fips != + 35 & PH$State_Fips != 48), ], Stages[(Stages$Total == + 125), ]) + PH <- rbind(PH1, PH2) + } + if (RowCrop == "idle_cropland" | RowCrop == "pasture_grass" | + RowCrop == "rep_cropland") { + PH <- cbind(PH, Stages) + } + if (RowCrop == "rice" | RowCrop == "soybeans" | RowCrop == + "peanuts" | RowCrop == "miscanthus" | RowCrop == "switchgrass") { + PH <- cbind(PH, Stages) + } + print("on to split seasons functions") + if (file.exists(paste0(Intermediates, paste("Base", RowCrop, + "MNRH_", "MasterDF", sep = "."))) == FALSE) { + E.Precip_Seasons <- Split.Seasons(RowCrop, "Precip_", + Lat.long, TopSoil, Base.CDL.crop, PH) + ETo.Seasons <- Split.Seasons(RowCrop, "ETo_", Lat.long, + TopSoil, Base.CDL.crop, PH) + U2.Seasons <- Split.Seasons(RowCrop, "U2.final_", Lat.long, + TopSoil, Base.CDL.crop, PH) + MNRH.Seasons <- Split.Seasons(RowCrop, "MNRH_", Lat.long, + TopSoil, Base.CDL.crop, PH) + } + if (file.exists(paste0(Intermediates, paste("Base", RowCrop, + "MNRH_", "MasterDF", sep = ".")))) { + load(paste0(Intermediates, paste("Base", RowCrop, "Precip_", + "MasterDF", sep = "."))) + E.Precip_Seasons <- DF + load(paste0(Intermediates, paste("Base", RowCrop, "ETo_", + "MasterDF", sep = "."))) + ETo.Seasons <- DF + load(paste0(Intermediates, paste("Base", RowCrop, "U2.final_", + "MasterDF", sep = "."))) + U2.Seasons <- DF + load(paste0(Intermediates, paste("Base", RowCrop, "MNRH_", + "MasterDF", sep = "."))) + MNRH.Seasons <- DF + rm(DF) + } + if (RowCrop == "cotton" | RowCrop == "rice" | RowCrop == + "soybeans" | RowCrop == "peanuts" | RowCrop == "alfalfa" | + RowCrop == "sugarcane" | RowCrop == "spring_wheat" | + RowCrop == "miscanthus" | RowCrop == "switchgrass" | + RowCrop == "idle_cropland" | RowCrop == "pasture_grass" | + RowCrop == "rep_cropland") { + Kcb <- Kcb[grep(RowCrop, Kcb$Crop), ] + } + if (RowCrop == "durum_wheat") + Kcb <- Kcb[Kcb$Crop == "spring_wheat", ] + if (RowCrop == "fall_oats") + Kcb <- Kcb[Kcb$Crop == "oats", ] + if (RowCrop == "spring_oats") + Kcb <- Kcb[Kcb$Crop == "spring_oats", ] + if (RowCrop == "fall_barley") + Kcb <- Kcb[Kcb$Crop == "barley", ] + if (RowCrop == "spring_barley") + Kcb <- Kcb[Kcb$Crop == "spring_barley", ] + if (RowCrop == "corn" | RowCrop == "silage") + Kcb <- Kcb[Kcb$Crop == "corn_field_harvest_high_grain_moisture", + ] + if (RowCrop == "winter_wheat") + Kcb <- Kcb[Kcb$Crop == "winter_wheat_unfrozen", ] + if (RowCrop == "sorghum") + Kcb <- Kcb[Kcb$Crop == "sorghum_grain", ] + if (RowCrop == "sugarbeets") + Kcb <- Kcb[Kcb$Crop == "sugarbeets_rainfed_or_dry_end", + ] + print("on to Rescale.And.Save") + Rescale.And.Save("Precip_", PH, E.Precip_Seasons, RowCrop, + Kcb) + Rescale.And.Save("ETo_", PH, ETo.Seasons, RowCrop, Kcb) + Rescale.And.Save("U2.final_", PH, U2.Seasons, RowCrop, Kcb) + Rescale.And.Save("MNRH_", PH, MNRH.Seasons, RowCrop, Kcb) + Save.Crops.List(PH, RowCrop, Kcb) + if (file.exists(paste0(Intermediates, paste("Base", RowCrop, + "MNRH_", "MasterDF", sep = "."))) == FALSE) { + print(paste("Crops List file already saved for", RowCrop)) + } + } +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ ~kwd1 } +\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line diff --git a/man/Sum.Save.Daily.Evapotranspiration.Rd b/man/Sum.Save.Daily.Evapotranspiration.Rd new file mode 100644 index 0000000..f8165e1 --- /dev/null +++ b/man/Sum.Save.Daily.Evapotranspiration.Rd @@ -0,0 +1,190 @@ +\name{Sum.Save.Daily.Evapotranspiration} +\alias{Sum.Save.Daily.Evapotranspiration} +%- Also NEED an '\alias' for EACH other topic documented here. +\title{ +%% ~~function to do ... ~~ +} +\description{ +%% ~~ A concise (1-5 lines) description of what the function does. ~~ +} +\usage{ +Sum.Save.Daily.Evapotranspiration(Croplayer, rainfed = FALSE) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{Croplayer}{ +%% ~~Describe \code{Croplayer} here~~ +} + \item{rainfed}{ +%% ~~Describe \code{rainfed} here~~ +} +} +\details{ +%% ~~ If necessary, more details than the description above ~~ +} +\value{ +%% ~Describe the value returned +%% If it is a LIST, use +%% \item{comp1 }{Description of 'comp1'} +%% \item{comp2 }{Description of 'comp2'} +%% ... +} +\references{ +%% ~put references to the literature/web site here ~ +} +\author{ +%% ~~who you are~~ +} +\note{ +%% ~~further notes~~ +} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +\seealso{ +%% ~~objects to See Also as \code{\link{help}}, ~~~ +} +\examples{ +##---- Should be DIRECTLY executable !! ---- +##-- ==> Define data, use random, +##-- or do help(data=index) for the standard data sets. + +## The function is currently defined as +function (Croplayer, rainfed = FALSE) +{ + Crop <- Croplayer + if (Croplayer == "spring_barley" || Croplayer == "fall_barley") + Crop <- "barley" + if (Croplayer == "spring_oats" || Croplayer == "fall_oats") + Crop <- "oats" + print(Croplayer) + setwd(paste0(Path, "/CropWatR/Intermediates/")) + if (rainfed == FALSE) { + load(paste("Preseason_Soil.Evaporation", Croplayer, "Rdata", + sep = ".")) + load(paste("Preseason_Weed.Transpiration", Croplayer, + "Rdata", sep = ".")) + Pre.Evap <- lapply(Pre.KeETo, function(x) x[, (grep("layer", + names(x)))]) + Pre.weed.Kcb <- lapply(Pre.Kcb.tot, function(x) x[, (grep("layer", + names(x)))]) + load(paste("Growing.Season_Soil.Evaporation", Croplayer, + "Rdata", sep = ".")) + load(file = paste("Growing.Season_Transpiration", Croplayer, + "Rdata", sep = ".")) + Transpiration <- lapply(Transp.final, function(x) x[, + (grep("layer", names(x)))]) + Evap <- lapply(E, function(x) x[, (grep("layer", names(x)))]) + Post.KeETo <- local(get(load(paste("Postseason_Soil.Evaporation", + Croplayer, "Rdata", sep = ".")))) + Post.Kcb.tot <- local(get(load(paste("Postseason_Weed.Transpiration", + Croplayer, "Rdata", sep = ".")))) + Post.Evap <- lapply(Post.KeETo, function(x) x[, (grep("layer", + names(x)))]) + Post.weed.Kcb <- lapply(Post.Kcb.tot, function(x) x[, + (grep("layer", names(x)))]) + } + if (rainfed == TRUE) { + load(paste("Preseason_Soil.Evaporation", Croplayer, "Rdata", + sep = ".")) + load(paste("Preseason_Weed.Transpiration", Croplayer, + "Rdata", sep = ".")) + Pre.Evap <- lapply(Pre.KeETo, function(x) x[, (grep("layer", + names(x)))]) + Pre.weed.Kcb <- lapply(Pre.Kcb.tot, function(x) x[, (grep("layer", + names(x)))]) + load(paste("Growing.Season.Rainfed_Soil.Evaporation", + Croplayer, "Rdata", sep = ".")) + load(file = paste("Growing.Season.Rainfed_Transpiration", + Croplayer, "Rdata", sep = ".")) + Transpiration <- lapply(Transp.final, function(x) x[, + (grep("layer", names(x)))]) + Evap <- lapply(E, function(x) x[, (grep("layer", names(x)))]) + Post.KeETo <- local(get(load(paste("Postseason_Soil.Evaporation", + Croplayer, "Rdata", sep = ".")))) + Post.Kcb.tot <- local(get(load(paste("Postseason_Weed.Transpiration", + Croplayer, "Rdata", sep = ".")))) + Post.Evap <- lapply(Post.KeETo, function(x) x[, (grep("layer", + names(x)))]) + Post.weed.Kcb <- lapply(Post.Kcb.tot, function(x) x[, + (grep("layer", names(x)))]) + } + load(paste("BASE", Croplayer, "MNRH_", "MasterDF2", sep = ".")) + IDs.1 <- as.numeric(rownames(DF2)) + Coords <- cbind(DF2$x, DF2$y) + Coords <- as.data.frame(cbind(IDs.1, Coords)) + IDs.2 <- as.numeric(unlist(lapply(E, function(x) rownames(x)))) + table(IDs.2 \%in\% IDs.1) + Rows <- as.data.frame(cbind(IDs.2)) + print(table(Coords$IDs.1 \%in\% Rows$IDs.2)) + Rows.Fin <- merge(Coords, Rows, by.x = "IDs.1", by.y = "IDs.2") + names(Rows.Fin)[1:3] <- c("IDs", "x", "y") + PreP <- Pre.Evap + PostP <- Post.Evap + GR.P <- Evap + Final <- Pre.Evap + for (i in 1:length(Pre.Evap)) { + PreP[[i]] <- Pre.Evap[[i]] + Pre.weed.Kcb[[i]] + GR.P[[i]] <- Evap[[i]] + Transpiration[[i]] + PostP[[i]] <- Post.Evap[[i]] + Post.weed.Kcb[[i]] + Final[[i]] <- as.data.frame(cbind(PreP[[i]], GR.P[[i]], + PostP[[i]])) + } + if (Croplayer == "durum_wheat" || Croplayer == "fall_barley") { + Cut <- names(unlist(lapply(Final, function(x) which(nrow(x) == + 0)))) + Fini <- Final[-(which(names(Final) \%in\% Cut))] + Fini <- lapply(Final, function(x) x[, 1:362]) + } + if (Croplayer == "sugarbeets") { + Cut <- names(unlist(lapply(Final, function(x) which(ncol(x) < + 362)))) + Fini <- Final[-(which(names(Final) \%in\% Cut))] + lapply(Fini, dim) + } + if (Croplayer == "alfalfa") { + Fini <- lapply(Final, function(x) x[, 1:358]) + } + if (Croplayer != "durum_wheat" && Croplayer != "alfalfa" && + Croplayer != "fall_barley") { + Fini <- lapply(Final, function(x) x[, 1:362]) + } + Base <- Fini[[1]] + for (i in 2:length(Fini)) { + names(Fini[[i]]) <- names(Base) + Base <- rbind(Base, Fini[[i]]) + } + Base$IDs <- as.numeric(rownames(Base)) + print(table(as.numeric(rownames(Base)) \%in\% Rows.Fin$IDs)) + Water.Balance <- merge(Rows.Fin, Base, by = "IDs", all.y = TRUE) + WB <- Water.Balance[, -c(1:3)] + Identifiers <- Water.Balance[, c(1:3)] + Water.Balance <- Water.Balance[, -1] + coordinates(Water.Balance) <- ~x + y + proj4string(Water.Balance) <- CRS("+proj=aea +lat_1=29.5 +lat_2=45.5 +lat_0=23 +lon_0=-96 +x_0=0 +y_0=0 +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs") + gridded(Water.Balance) = TRUE + WB.brick <- brick(Water.Balance) + projection(WB.brick) <- ("+proj=aea +lat_1=29.5 +lat_2=45.5 +lat_0=23 +lon_0=-96 +x_0=0 +y_0=0 +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs") + Crops.brick.2008 <- brick("cdl_10k_2008_albers.grd") + WB.brick <- extend(WB.brick, Crops.brick.2008) + print(cellStats(WB.brick, summary)) + names(WB.brick) <- gsub("layer", "day", names(WB.brick)) + if (Croplayer != "pasture_grass") { + if (file.exists(paste0(Croplayer, ".grd"))) { + LU.brick <- brick(paste0(Croplayer, ".grd")) + } + WB.brick[is.na(LU.brick)] <- NA + } + setwd(paste0(Path, "/CropWatR/Data")) + if (rainfed == FALSE) + writeRaster(WB.brick, filename = paste(Croplayer, "Daily.ET.grd", + sep = "."), overwrite = TRUE) + if (rainfed == TRUE) + writeRaster(WB.brick, filename = paste(Croplayer, "Rainfed.Daily.ET.grd", + sep = "."), overwrite = TRUE) + } +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ ~kwd1 } +\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line diff --git a/man/Sum.Save.Water.Balances.Rd b/man/Sum.Save.Water.Balances.Rd new file mode 100644 index 0000000..7372bd3 --- /dev/null +++ b/man/Sum.Save.Water.Balances.Rd @@ -0,0 +1,381 @@ +\name{Sum.Save.Water.Balances} +\alias{Sum.Save.Water.Balances} +%- Also NEED an '\alias' for EACH other topic documented here. +\title{ +%% ~~function to do ... ~~ +} +\description{ +%% ~~ A concise (1-5 lines) description of what the function does. ~~ +} +\usage{ +Sum.Save.Water.Balances(Croplayer, rainfed = FALSE, type = c("seasonal", "annual"), BW.GW = FALSE) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{Croplayer}{ +%% ~~Describe \code{Croplayer} here~~ +} + \item{rainfed}{ +%% ~~Describe \code{rainfed} here~~ +} + \item{type}{ +%% ~~Describe \code{type} here~~ +} + \item{BW.GW}{ +%% ~~Describe \code{BW.GW} here~~ +} +} +\details{ +%% ~~ If necessary, more details than the description above ~~ +} +\value{ +%% ~Describe the value returned +%% If it is a LIST, use +%% \item{comp1 }{Description of 'comp1'} +%% \item{comp2 }{Description of 'comp2'} +%% ... +} +\references{ +%% ~put references to the literature/web site here ~ +} +\author{ +%% ~~who you are~~ +} +\note{ +%% ~~further notes~~ +} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +\seealso{ +%% ~~objects to See Also as \code{\link{help}}, ~~~ +} +\examples{ +##---- Should be DIRECTLY executable !! ---- +##-- ==> Define data, use random, +##-- or do help(data=index) for the standard data sets. + +## The function is currently defined as +function (Croplayer, rainfed = FALSE, type = c("seasonal", "annual"), + BW.GW = FALSE) +{ + setwd(paste0(Path, "/CropWatR/Intermediates/")) + if (rainfed == FALSE && type == "annual") { + load(paste("Preseason_Deep.Percolation", Croplayer, "Rdata", + sep = ".")) + load(paste("Growing.Season_Deep.Percolation", Croplayer, + "Rdata", sep = ".")) + Post.DP <- local(get(load(paste("Postseason_Deep.Percolation", + Croplayer, "Rdata", sep = ".")))) + Pre.GW.Infiltration <- unlist(lapply(Pre.DP, function(x) rowSums(x[, + (grep("layer", names(x)))]))) + GS.GW.Infiltration <- unlist(lapply(DP, function(x) rowSums(x[, + (grep("layer", names(x)))]))) + Post.GW.Infiltration <- unlist(lapply(Post.DP, function(x) rowSums(x[, + (grep("layer", names(x)))]))) + GW.Infiltration <- rowSums(as.data.frame(cbind(Pre.GW.Infiltration, + GS.GW.Infiltration, Post.GW.Infiltration))) + print(paste("Infiltration Summary for", Croplayer)) + print(c(summary(Pre.GW.Infiltration), summary(GS.GW.Infiltration), + summary(Post.GW.Infiltration), summary(GW.Infiltration))) + load(paste("Preseason_Soil.Evaporation", Croplayer, "Rdata", + sep = ".")) + load(paste("Growing.Season_Soil.Evaporation", Croplayer, + "Rdata", sep = ".")) + Post.KeETo <- local(get(load(paste("Postseason_Soil.Evaporation", + Croplayer, "Rdata", sep = ".")))) + Pre.Evap <- unlist(lapply(Pre.KeETo, function(x) rowSums(x[, + (grep("layer", names(x)))]))) + Evap <- unlist(lapply(E, function(x) rowSums(x[, (grep("layer", + names(x)))]))) + Post.Evap <- unlist(lapply(Post.KeETo, function(x) rowSums(x[, + (grep("layer", names(x)))]))) + Evaporation <- rowSums(as.data.frame(cbind(Pre.Evap, + Evap, Post.Evap))) + print(paste("Evaporation Summary for", Croplayer)) + load(paste("Preseason_Weed.Transpiration", Croplayer, + "Rdata", sep = ".")) + Pre.weed.Kcb <- unlist(lapply(Pre.Kcb.tot, function(x) rowSums(x[, + (grep("layer", names(x)))]))) + Post.Kcb.tot <- local(get(load(paste("Postseason_Weed.Transpiration", + Croplayer, "Rdata", sep = ".")))) + Post.weed.Kcb <- unlist(lapply(Post.Kcb.tot, function(x) rowSums(x[, + (grep("layer", names(x)))]))) + Evapor.Fallow.Transpir <- rowSums(as.data.frame(cbind(Pre.Evap, + Pre.weed.Kcb, Evap, Post.Evap, Post.weed.Kcb))) + print(c(summary(Pre.Evap), summary(Evap), summary(Post.Evap), + summary(Evaporation))) + load(paste("Preseason_Runoff", Croplayer, "Rdata", sep = ".")) + load(paste("Growing.Season_Runoff", Croplayer, "Rdata", + sep = ".")) + Post.ROi <- local(get(load(paste("Postseason_Runoff", + Croplayer, "Rdata", sep = ".")))) + Pre.runoff <- unlist(lapply(Pre.ROi, function(x) rowSums(x[, + (grep("layer", names(x)))]))) + runoff <- unlist(lapply(ROi, function(x) rowSums(x[, + (grep("layer", names(x)))]))) + Post.runoff <- unlist(lapply(Post.ROi, function(x) rowSums(x[, + (grep("layer", names(x)))]))) + Runoff <- rowSums(as.data.frame(cbind(Pre.runoff, runoff, + Post.runoff))) + print(paste("Runoff Summary for", Croplayer)) + print(c(summary(Pre.runoff), summary(runoff), summary(Post.runoff), + summary(Runoff))) + load(file = paste("Growing.Season_Transpiration", Croplayer, + "Rdata", sep = ".")) + Transpiration <- unlist(lapply(Transp.final, function(x) rowSums(x[, + (grep("layer", names(x)))]))) + print(paste("Transpiration Summary for", Croplayer)) + print(summary(Transpiration)) + load(paste("Preseason_Weed.Transpiration", Croplayer, + "Rdata", sep = ".")) + Post.Kcb.tot <- local(get(load(paste("Postseason_Weed.Transpiration", + Croplayer, "Rdata", sep = ".")))) + Pre.weed.Kcb <- unlist(lapply(Pre.Kcb.tot, function(x) rowSums(x[, + (grep("layer", names(x)))]))) + Post.weed.Kcb <- unlist(lapply(Post.Kcb.tot, function(x) rowSums(x[, + (grep("layer", names(x)))]))) + Fallow.Transpiration <- rowSums(as.data.frame(cbind(Pre.weed.Kcb, + Post.weed.Kcb))) + print(paste("Weed Evaporation Summary for", Croplayer)) + print(c(summary(Pre.weed.Kcb), summary(Post.weed.Kcb), + summary(Fallow.Transpiration))) + load(file = paste("Growing.Season_Irrigation", Croplayer, + "Rdata", sep = ".")) + print(paste("Irrigation Summary for", Croplayer)) + Irrigation <- unlist(lapply(Irr, function(x) rowSums(x[, + (grep("layer", names(x)))]))) + Irrigate <- Irrigation + Irrigate[Irrigate == 0] <- NA + print(summary(Irrigate)) + load(paste("BASE", Croplayer, "MNRH_", "MasterDF2", sep = ".")) + IDs.1 <- as.numeric(rownames(DF2)) + Coords <- cbind(DF2$x, DF2$y) + Coords <- as.data.frame(cbind(IDs.1, Coords)) + IDs.2 <- as.numeric(unlist(lapply(Pre.DP, function(x) rownames(x)))) + table(IDs.2 \%in\% IDs.1) + Water.Balance <- as.data.frame(cbind(IDs.2, Transpiration, + Evapor.Fallow.Transpir, Runoff, GW.Infiltration, + Irrigation)) + } + if (rainfed == TRUE && type == "annual") { + load(paste("Preseason_Deep.Percolation", Croplayer, "Rdata", + sep = ".")) + load(paste("Growing.Season.Rainfed_Deep.Percolation", + Croplayer, "Rdata", sep = ".")) + Post.DP <- local(get(load(paste("Postseason_Deep.Percolation", + Croplayer, "Rdata", sep = ".")))) + Pre.GW.Infiltration <- unlist(lapply(Pre.DP, function(x) rowSums(x[, + (grep("layer", names(x)))]))) + GS.GW.Infiltration <- unlist(lapply(DP, function(x) rowSums(x[, + (grep("layer", names(x)))]))) + Post.GW.Infiltration <- unlist(lapply(Post.DP, function(x) rowSums(x[, + (grep("layer", names(x)))]))) + GW.Infiltration <- rowSums(as.data.frame(cbind(Pre.GW.Infiltration, + GS.GW.Infiltration, Post.GW.Infiltration))) + print(paste("Infiltration Summary for", Croplayer)) + print(c(summary(Pre.GW.Infiltration), summary(GS.GW.Infiltration), + summary(Post.GW.Infiltration), summary(GW.Infiltration))) + load(paste("Preseason_Soil.Evaporation", Croplayer, "Rdata", + sep = ".")) + load(paste("Growing.Season.Rainfed_Soil.Evaporation", + Croplayer, "Rdata", sep = ".")) + Post.KeETo <- local(get(load(paste("Postseason_Soil.Evaporation", + Croplayer, "Rdata", sep = ".")))) + Pre.Evap <- unlist(lapply(Pre.KeETo, function(x) rowSums(x[, + (grep("layer", names(x)))]))) + Evap <- unlist(lapply(E, function(x) rowSums(x[, (grep("layer", + names(x)))]))) + Post.Evap <- unlist(lapply(Post.KeETo, function(x) rowSums(x[, + (grep("layer", names(x)))]))) + load(paste("Preseason_Weed.Transpiration", Croplayer, + "Rdata", sep = ".")) + Pre.weed.Kcb <- unlist(lapply(Pre.Kcb.tot, function(x) rowSums(x[, + (grep("layer", names(x)))]))) + Post.Kcb.tot <- local(get(load(paste("Postseason_Weed.Transpiration", + Croplayer, "Rdata", sep = ".")))) + Post.weed.Kcb <- unlist(lapply(Post.Kcb.tot, function(x) rowSums(x[, + (grep("layer", names(x)))]))) + Evapor.Fallow.Transpir <- rowSums(as.data.frame(cbind(Pre.Evap, + Pre.weed.Kcb, Evap, Post.Evap, Post.weed.Kcb))) + Evaporation <- rowSums(as.data.frame(cbind(Pre.Evap, + Evap, Post.Evap))) + print(paste("Evaporation Summary for", Croplayer)) + print(c(summary(Pre.Evap), summary(Evap), summary(Post.Evap), + summary(Evaporation))) + load(paste("Preseason_Runoff", Croplayer, "Rdata", sep = ".")) + load(paste("Growing.Season.Rainfed_Runoff", Croplayer, + "Rdata", sep = ".")) + Post.ROi <- local(get(load(paste("Postseason_Runoff", + Croplayer, "Rdata", sep = ".")))) + Pre.runoff <- unlist(lapply(Pre.ROi, function(x) rowSums(x[, + (grep("layer", names(x)))]))) + runoff <- unlist(lapply(ROi, function(x) rowSums(x[, + (grep("layer", names(x)))]))) + Post.runoff <- unlist(lapply(Post.ROi, function(x) rowSums(x[, + (grep("layer", names(x)))]))) + Runoff <- rowSums(as.data.frame(cbind(Pre.runoff, runoff, + Post.runoff))) + print(paste("Runoff Summary for", Croplayer)) + print(c(summary(Pre.runoff), summary(runoff), summary(Post.runoff), + summary(Runoff))) + load(file = paste("Growing.Season.Rainfed_Transpiration", + Croplayer, "Rdata", sep = ".")) + Transpiration <- unlist(lapply(Transp.final, function(x) rowSums(x[, + (grep("layer", names(x)))]))) + print(paste("Transpiration Summary for", Croplayer)) + print(summary(Transpiration)) + load(paste("Preseason_Weed.Transpiration", Croplayer, + "Rdata", sep = ".")) + Post.Kcb.tot <- local(get(load(paste("Postseason_Weed.Transpiration", + Croplayer, "Rdata", sep = ".")))) + Pre.weed.Kcb <- unlist(lapply(Pre.Kcb.tot, function(x) rowSums(x[, + (grep("layer", names(x)))]))) + Post.weed.Kcb <- unlist(lapply(Post.Kcb.tot, function(x) rowSums(x[, + (grep("layer", names(x)))]))) + Fallow.Transpiration <- rowSums(as.data.frame(cbind(Pre.weed.Kcb, + Post.weed.Kcb))) + print(paste("Weed Transpiration Summary for", Croplayer)) + print(c(summary(Pre.weed.Kcb), summary(Post.weed.Kcb), + summary(Fallow.Transpiration))) + load(paste("BASE", Croplayer, "MNRH_", "MasterDF2", sep = ".")) + IDs.1 <- as.numeric(rownames(DF2)) + Coords <- cbind(DF2$x, DF2$y) + Coords <- as.data.frame(cbind(IDs.1, Coords)) + IDs.2 <- as.numeric(unlist(lapply(Pre.DP, function(x) rownames(x)))) + table(IDs.2 \%in\% IDs.1) + Water.Balance <- as.data.frame(cbind(IDs.2, Transpiration, + Evapor.Fallow.Transpir, Runoff, GW.Infiltration)) + } + if (rainfed == FALSE && type == "seasonal") { + load(paste("Growing.Season_Deep.Percolation", Croplayer, + "Rdata", sep = ".")) + GS.GW.Infiltration <- unlist(lapply(DP, function(x) rowSums(x[, + (grep("layer", names(x)))]))) + print(paste("Infiltration Summary for", Croplayer)) + print(summary(GS.GW.Infiltration)) + load(paste("Growing.Season_Soil.Evaporation", Croplayer, + "Rdata", sep = ".")) + Evap <- unlist(lapply(E, function(x) rowSums(x[, (grep("layer", + names(x)))]))) + print(paste("Evaporation Summary for", Croplayer)) + print(summary(Evap)) + load(paste("Growing.Season_Runoff", Croplayer, "Rdata", + sep = ".")) + runoff <- unlist(lapply(ROi, function(x) rowSums(x[, + (grep("layer", names(x)))]))) + print(paste("Runoff Summary for", Croplayer)) + print(summary(runoff)) + load(file = paste("Growing.Season_Transpiration", Croplayer, + "Rdata", sep = ".")) + Transpiration <- unlist(lapply(Transp.final, function(x) rowSums(x[, + (grep("layer", names(x)))]))) + print(paste("Transpiration Summary for", Croplayer)) + print(summary(Transpiration)) + load(file = paste("Growing.Season_Irrigation", Croplayer, + "Rdata", sep = ".")) + print(paste("Irrigation Summary for", Croplayer)) + Irrigation <- unlist(lapply(Irr, function(x) rowSums(x[, + (grep("layer", names(x)))]))) + Irrigate <- Irrigation + Irrigate[Irrigate == 0] <- NA + print(summary(Irrigate)) + load(paste("BASE", Croplayer, "MNRH_", "MasterDF2", sep = ".")) + IDs.1 <- as.numeric(rownames(DF2)) + Coords <- cbind(DF2$x, DF2$y) + Coords <- as.data.frame(cbind(IDs.1, Coords)) + IDs.2 <- as.numeric(unlist(lapply(DP, function(x) rownames(x)))) + table(IDs.2 \%in\% IDs.1) + if (BW.GW == FALSE) + Water.Balance <- as.data.frame(cbind(IDs.2, Transpiration, + Evap, runoff, GS.GW.Infiltration, Irrigation)) + if (BW.GW == TRUE) { + GreenWater <- Transpiration + Evap + BlueWater <- Irrigation + Water.Balance <- as.data.frame(cbind(IDs.2, GreenWater, + BlueWater)) + } + } + if (rainfed == TRUE && type == "seasonal") { + load(paste("Growing.Season.Rainfed_Deep.Percolation", + Croplayer, "Rdata", sep = ".")) + GS.GW.Infiltration <- unlist(lapply(DP, function(x) rowSums(x[, + (grep("layer", names(x)))]))) + print(paste("Infiltration Summary for", Croplayer)) + print(summary(GS.GW.Infiltration)) + load(paste("Growing.Season.Rainfed_Soil.Evaporation", + Croplayer, "Rdata", sep = ".")) + Evap <- unlist(lapply(E, function(x) rowSums(x[, (grep("layer", + names(x)))]))) + print(paste("Evaporation Summary for", Croplayer)) + print(summary(Evap)) + load(paste("Growing.Season.Rainfed_Runoff", Croplayer, + "Rdata", sep = ".")) + runoff <- unlist(lapply(ROi, function(x) rowSums(x[, + (grep("layer", names(x)))]))) + print(paste("Runoff Summary for", Croplayer)) + print(summary(runoff)) + load(file = paste("Growing.Season.Rainfed_Transpiration", + Croplayer, "Rdata", sep = ".")) + Transpiration <- unlist(lapply(Transp.final, function(x) rowSums(x[, + (grep("layer", names(x)))]))) + print(paste("Transpiration Summary for", Croplayer)) + print(summary(Transpiration)) + load(paste("BASE", Croplayer, "MNRH_", "MasterDF2", sep = ".")) + IDs.1 <- as.numeric(rownames(DF2)) + Coords <- cbind(DF2$x, DF2$y) + Coords <- as.data.frame(cbind(IDs.1, Coords)) + IDs.2 <- as.numeric(unlist(lapply(DP, function(x) rownames(x)))) + table(IDs.2 \%in\% IDs.1) + if (BW.GW == FALSE) + Water.Balance <- as.data.frame(cbind(IDs.2, Transpiration, + Evap, runoff, GS.GW.Infiltration)) + if (BW.GW == TRUE) { + GreenWater <- Transpiration + Evap + BlueWater <- Irrigation + Water.Balance <- as.data.frame(cbind(IDs.2, GreenWater, + BlueWater)) + } + } + print(table(Coords$IDs.1 \%in\% Water.Balance$IDs.2)) + Water.Balance <- merge(Coords, Water.Balance, by.x = "IDs.1", + by.y = "IDs.2") + names(Water.Balance)[1:3] <- c("IDs", "x", "y") + Water.Balance[Water.Balance == 0] <- NA + Water.Balance <- Water.Balance[, -1] + coordinates(Water.Balance) <- ~x + y + proj4string(Water.Balance) <- CRS("+proj=aea +lat_1=29.5 +lat_2=45.5 +lat_0=23 +lon_0=-96 +x_0=0 +y_0=0 +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs") + gridded(Water.Balance) = TRUE + WB.brick <- brick(Water.Balance) + projection(WB.brick) <- ("+proj=aea +lat_1=29.5 +lat_2=45.5 +lat_0=23 +lon_0=-96 +x_0=0 +y_0=0 +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs") + Crops.brick.2008 <- brick("../Data/cdl_10k_2008_albers.grd") + WB.brick <- extend(WB.brick, Crops.brick.2008) + plot(WB.brick) + print(cellStats(WB.brick, summary)) + if (rainfed == FALSE && type == "annual") + writeRaster(WB.brick, filename = paste(Croplayer, "Basic.WB.grd", + sep = "."), overwrite = TRUE) + if (rainfed == FALSE && type == "seasonal") + writeRaster(WB.brick, filename = paste(Croplayer, "Growing.Season.WB.grd", + sep = "."), overwrite = TRUE) + if (rainfed == TRUE && type == "annual") + writeRaster(WB.brick, filename = paste(Croplayer, "Basic.Rainfed.WB.grd", + sep = "."), overwrite = TRUE) + if (rainfed == TRUE && type == "seasonal") + writeRaster(WB.brick, filename = paste(Croplayer, "Growing.Season.Rainfed.WB.grd", + sep = "."), overwrite = TRUE) + if (BW.GW == FALSE && type == "annual") + writeRaster(WB.brick, filename = paste(Croplayer, "Growing.Season.WB.grd", + sep = "."), overwrite = TRUE) + if (BW.GW == TRUE && type == "seasonal") + writeRaster(WB.brick, filename = paste(Croplayer, "Growing.Season.GW.BW.WB.grd", + sep = "."), overwrite = TRUE) + if (BW.GW == TRUE && type != "seasonal") + print("Blue / Green water volumes only relevant for the growing season") + setwd(paste0(Path, "/CropWatR/Data")) + } +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ ~kwd1 } +\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line diff --git a/man/SuperImpose.WB.on.LU.Rd b/man/SuperImpose.WB.on.LU.Rd new file mode 100644 index 0000000..09637f6 --- /dev/null +++ b/man/SuperImpose.WB.on.LU.Rd @@ -0,0 +1,172 @@ +\name{SuperImpose.WB.on.LU} +\alias{SuperImpose.WB.on.LU} +%- Also NEED an '\alias' for EACH other topic documented here. +\title{ +%% ~~function to do ... ~~ +} +\description{ +%% ~~ A concise (1-5 lines) description of what the function does. ~~ +} +\usage{ +SuperImpose.WB.on.LU(Croplayer, rainfed = FALSE, type = c("seasonal", "annual"), Growing.Season.GW.BW = FALSE) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{Croplayer}{ +%% ~~Describe \code{Croplayer} here~~ +} + \item{rainfed}{ +%% ~~Describe \code{rainfed} here~~ +} + \item{type}{ +%% ~~Describe \code{type} here~~ +} + \item{Growing.Season.GW.BW}{ +%% ~~Describe \code{Growing.Season.GW.BW} here~~ +} +} +\details{ +%% ~~ If necessary, more details than the description above ~~ +} +\value{ +%% ~Describe the value returned +%% If it is a LIST, use +%% \item{comp1 }{Description of 'comp1'} +%% \item{comp2 }{Description of 'comp2'} +%% ... +} +\references{ +%% ~put references to the literature/web site here ~ +} +\author{ +%% ~~who you are~~ +} +\note{ +%% ~~further notes~~ +} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +\seealso{ +%% ~~objects to See Also as \code{\link{help}}, ~~~ +} +\examples{ +##---- Should be DIRECTLY executable !! ---- +##-- ==> Define data, use random, +##-- or do help(data=index) for the standard data sets. + +## The function is currently defined as +function (Croplayer, rainfed = FALSE, type = c("seasonal", "annual"), + Growing.Season.GW.BW = FALSE) +{ + load("Vars.Rdata") + Irr.Vars <- Vars[-c(3, 6, 8, 14, 15)] + if (Growing.Season.GW.BW == TRUE) + class <- "BW.GW" + if (Growing.Season.GW.BW == FALSE) + class <- "WB" + if (rainfed == FALSE) + Irr <- "irrigated" + if (rainfed == TRUE) + Irr <- "rainfed" + if (Croplayer \%in\% Irr.Vars) { + LU.brick <- raster(paste0(Intermediates, Croplayer, ".grd")) + LU.brick[LU.brick == 0] <- NA + if (rainfed == FALSE && type == "annual") + WB.brick <- brick(paste0(Intermediates, Croplayer, + ".Basic.WB.grd")) + if (rainfed == FALSE && type == "seasonal") + WB.brick <- brick(paste0(Intermediates, Croplayer, + ".Growing.Season.WB.grd")) + if (rainfed == TRUE && type == "annual") + WB.brick <- brick(paste0(Intermediates, Croplayer, + ".Basic.Rainfed.WB.grd")) + if (rainfed == TRUE && type == "seasonal") + WB.brick <- brick(paste0(Intermediates, Croplayer, + ".Growing.Season.Rainfed.WB.grd")) + if (Growing.Season.GW.BW == FALSE && type == "annual") + WB.brick <- brick(paste0(Intermediates, Croplayer, + ".Basic.WB.grd")) + if (Growing.Season.GW.BW == TRUE && type == "seasonal") + WB.brick <- brick(paste0(Intermediates, Croplayer, + ".Growing.Season.GW.BW.WB.grd")) + if (Growing.Season.GW.BW == TRUE && type == "seasonal" && + rainfed == FALSE) + WB.brick <- brick(paste0(Intermediates, Croplayer, + ".Growing.Season.BW.GW.WB.grd")) + Names <- names(WB.brick) + WB.brick <- extend(WB.brick, LU.brick) + LU.brick <- extend(LU.brick, WB.brick) + LU.brick <- extend(LU.brick, WB.brick) + WB.brick <- calc(WB.brick, fun = function(x) replace(x, + x < 0, 0.001)) + WB.total <- overlay(WB.brick, LU.brick, fun = prod) + names(WB.total) <- names(WB.brick) + WB.total[WB.total == 0] <- NA + LU.mm <- LU.brick + LU.mm[LU.mm > 0] <- 1 + WB.mm <- overlay(WB.brick, LU.mm, fun = prod) + names(WB.mm) <- names(WB.brick) + print(paste("saving", Croplayer)) + print(cellStats(WB.total, summary)) + print(cellStats(WB.mm, summary)) + writeRaster(WB.total, filename = paste0(Intermediates, + "Total.", type, ".", class, ".", Irr, ".", Croplayer, + ".grd"), overwrite = TRUE) + writeRaster(WB.mm, filename = paste0(Intermediates, "mm.", + type, ".", class, ".", Irr, ".", Croplayer, ".grd"), + overwrite = TRUE) + } + if (!(Croplayer \%in\% Irr.Vars)) { + LU.brick <- raster(paste0(Intermediates, Croplayer, ".grd")) + LU.brick[LU.brick == 0] <- NA + if (rainfed == FALSE && type == "annual") + WB.brick <- brick(paste0(Intermediates, Croplayer, + ".Basic.WB.grd")) + if (rainfed == FALSE && type == "seasonal") + WB.brick <- brick(paste0(Intermediates, Croplayer, + ".Growing.Season.WB.grd")) + if (rainfed == TRUE && type == "annual") + WB.brick <- brick(paste0(Intermediates, Croplayer, + ".Basic.Rainfed.WB.grd")) + if (rainfed == TRUE && type == "seasonal") + WB.brick <- brick(paste0(Intermediates, Croplayer, + ".Growing.Season.Rainfed.WB.grd")) + if (Growing.Season.GW.BW == FALSE && type == "annual") + WB.brick <- brick(paste0(Intermediates, Croplayer, + ".Basic.WB.grd")) + if (Growing.Season.GW.BW == TRUE && type == "seasonal") + WB.brick <- brick(paste0(Intermediates, Croplayer, + ".Growing.Season.GW.BW.WB.grd")) + if (Growing.Season.GW.BW == TRUE && type == "seasonal" && + rainfed == FALSE) + WB.brick <- brick(paste0(Intermediates, Croplayer, + ".Growing.Season.BW.GW.WB.grd")) + Names <- names(WB.brick) + WB.brick <- extend(WB.brick, LU.brick) + LU.brick <- extend(LU.brick, WB.brick) + WB.brick <- calc(WB.brick, fun = function(x) replace(x, + x < 0, 0.001)) + WB.total <- overlay(WB.brick, LU.brick, fun = prod) + names(WB.total) <- names(WB.brick) + WB.total[WB.total == 0] <- NA + LU.mm <- LU.brick + LU.mm[LU.mm > 0] <- 1 + WB.mm <- overlay(WB.brick, LU.mm, fun = prod) + names(WB.mm) <- names(WB.brick) + print(paste("saving", Croplayer)) + print(cellStats(WB.total, summary)) + print(cellStats(WB.mm, summary)) + writeRaster(WB.total, filename = paste0(Intermediates, + "Total.", type, ".", class, ".", Irr, ".", Croplayer, + ".grd"), overwrite = TRUE) + writeRaster(WB.mm, filename = paste0(Intermediates, "mm.", + type, ".", class, ".", Irr, ".", Croplayer, ".grd"), + overwrite = TRUE) + } + } +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ ~kwd1 } +\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line diff --git a/man/Vioplot.Water.Balances.Rd b/man/Vioplot.Water.Balances.Rd new file mode 100644 index 0000000..50d77b5 --- /dev/null +++ b/man/Vioplot.Water.Balances.Rd @@ -0,0 +1,235 @@ +\name{Vioplot.Water.Balances} +\alias{Vioplot.Water.Balances} +%- Also NEED an '\alias' for EACH other topic documented here. +\title{ +%% ~~function to do ... ~~ +} +\description{ +%% ~~ A concise (1-5 lines) description of what the function does. ~~ +} +\usage{ +Vioplot.Water.Balances(Crop, mm = TRUE, rainfed = FALSE, type = c("annual", "seasonal"), Agg.Level = "HUC2", metric = FALSE) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{Crop}{ +%% ~~Describe \code{Crop} here~~ +} + \item{mm}{ +%% ~~Describe \code{mm} here~~ +} + \item{rainfed}{ +%% ~~Describe \code{rainfed} here~~ +} + \item{type}{ +%% ~~Describe \code{type} here~~ +} + \item{Agg.Level}{ +%% ~~Describe \code{Agg.Level} here~~ +} + \item{metric}{ +%% ~~Describe \code{metric} here~~ +} +} +\details{ +%% ~~ If necessary, more details than the description above ~~ +} +\value{ +%% ~Describe the value returned +%% If it is a LIST, use +%% \item{comp1 }{Description of 'comp1'} +%% \item{comp2 }{Description of 'comp2'} +%% ... +} +\references{ +%% ~put references to the literature/web site here ~ +} +\author{ +%% ~~who you are~~ +} +\note{ +%% ~~further notes~~ +} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +\seealso{ +%% ~~objects to See Also as \code{\link{help}}, ~~~ +} +\examples{ +##---- Should be DIRECTLY executable !! ---- +##-- ==> Define data, use random, +##-- or do help(data=index) for the standard data sets. + +## The function is currently defined as +function (Crop, mm = TRUE, rainfed = FALSE, type = c("annual", + "seasonal"), Agg.Level = "HUC2", metric = FALSE) +{ + if (mm == TRUE) + Pat <- "mm" + if (mm == FALSE) + Pat <- "Total" + if (rainfed == TRUE) + Irr <- "rainfed" + if (rainfed == FALSE) + Irr <- "irrigated" + Final <- brick(paste0(Intermediates, Pat, ".", type, ".WB.", + Irr, ".", Crop, ".grd")) + Final[Final == 0] <- NA + print("Final stats:") + print(cellStats(Final, summary)) + plot(Final) + Final[Final == 0] <- NA + names(Final)[2] <- "Evaporation" + print("Final stats:") + print(cellStats(Final, summary)) + plot(Final) + names(Final)[which(names(Final) == "GW.Infiltration")] <- "Groundwater Infiltration" + if (mm == FALSE) { + if (metric == FALSE) { + Final <- Final * 0.0032808399 + Final <- Final/10^3 + Subtitle <- "water balances in thousand acre-feet" + Type <- "Acre-feet" + } + if (metric == TRUE) { + Final <- Final * 0.000404685642 + Final <- Final/10^3 + Subtitle <- "water balances in thousand hectare-meters" + Type <- "Hectare-meters" + } + } + if (mm == TRUE) { + Subtitle <- "Water balances in mm" + Type <- "mm" + } + AggShp <- shapefile(paste0("aea", Agg.Level, ".shp")) + if (Agg.Level == "HUC2") + Labels <- as.character(gsub(" Region", "", AggShp$REG_NAME, + fixed = TRUE)) + if (Agg.Level == "States") + Labels <- as.character(AggShp$ATLAS_NAME) + aea.Loc.IDs <- read.csv("aea.Loc.IDs.csv") + d <- as.data.frame(Final) + xy <- as.data.frame(xyFromCell(Final, 1:ncell(Final))) + DF <- cbind(xy, d) + DF[DF == 0] <- NA + summary(na.omit(DF)) + print(table(cbind(DF$x, DF$y) \%in\% cbind(aea.Loc.IDs$x, aea.Loc.IDs$y))) + print(table(cbind(aea.Loc.IDs$x, aea.Loc.IDs$y) \%in\% cbind(DF$x, + DF$y))) + DF <- merge(DF, aea.Loc.IDs, by.x = c("x", "y"), by.y = c("x", + "y"), all.x = TRUE) + require(vioplot) + library(plotrix) + Identifiers <- c("x", "y", "CountyFIPS", "STATE_FIPS", "HUC2", + "Abbreviation", "State_name", "Ers.region", "CRD") + Identifiers <- Identifiers[-(which(Identifiers == Agg.Level))] + Average <- DF[, -(which(names(DF) \%in\% Identifiers))] + str(Average) + Average <- Average[!is.na(Average$HUC2), ] + summary(Average) + Average[Average$HUC2 == "16", c(1, 3, 4)] <- Average[Average$HUC2 == + "16", c(1, 3, 4)] * 0.55 + Average[Average$HUC2 == "17", c(1, 3, 4)] <- Average[Average$HUC2 == + "17", c(1, 3, 4)] * 0.7 + Average[Average$HUC2 == "18", c(1, 3, 4)] <- Average[Average$HUC2 == + "18", c(1, 3, 4)] * 1.3 + Average[Average$HUC2 == "16", 5] <- Average[Average$HUC2 == + "16", 5] * 0.5 + Average[Average$HUC2 == "17", 5] <- Average[Average$HUC2 == + "17", 5] * 0.35 + Average[Average$HUC2 == "18", c(4, 5)] <- Average[Average$HUC2 == + "18", c(4, 5)] * 1.15 + Transp.by.HUC <- split(Average$Transpiration, as.factor(Average$HUC2)) + Tr.by.HUC <- lapply(Transp.by.HUC, function(x) na.omit(x)) + Tr.Means <- unlist(lapply(Transp.by.HUC, function(x) mean(x, + na.rm = TRUE) + 3 * sd(x, na.rm = TRUE))) + Tr.Labs <- unlist(lapply(Transp.by.HUC, function(x) mean(x, + na.rm = TRUE) + 2 * sd(x, na.rm = TRUE))) + Evap.by.HUC <- split(Average$Evaporation, as.factor(Average$HUC2)) + Ev.by.HUC <- lapply(Evap.by.HUC, function(x) na.omit(x)) + Runoff.by.HUC <- split(Average$Runoff, as.factor(Average$HUC2)) + Ro.by.HUC <- lapply(Runoff.by.HUC, function(x) na.omit(x)) + GW.Inf.by.HUC <- split(Average$Groundwater.Infiltration, + as.factor(Average$HUC2)) + GW.by.HUC <- lapply(GW.Inf.by.HUC, function(x) na.omit(x)) + Irr.Inf.by.HUC <- split(Average$Irrigation, as.factor(Average$HUC2)) + Irr.by.HUC <- lapply(Irr.Inf.by.HUC, function(x) na.omit(x)) + Irr.Means <- unlist(lapply(Irr.by.HUC, function(x) mean(x, + na.rm = TRUE) + 3 * sd(x, na.rm = TRUE))) + addAlpha <- function(colors, alpha = 1) { + r <- col2rgb(colors, alpha = T) + r[4, ] <- alpha * 255 + r <- r/255 + return(rgb(r[1, ], r[2, ], r[3, ], r[4, ])) + } + BlueT <- addAlpha("blue", alpha = 0.5) + GreenT <- addAlpha("green", alpha = 0.5) + RedT <- addAlpha("red", alpha = 0.75) + x <- c(0:18) + y <- c(0:18) + Max <- max(Tr.Means) + 150 + target.scale <- c(0, Max, na.rm = TRUE) + y <- rescale(y, target.scale) + setwd(paste0(Path, "/CropWatR/Intermediates/")) + bmp(filename = paste("ViolinPlot.Water.Regions", Crop, type, + Irr, Type, "WB.bmp", sep = "."), width = 1300, height = 700) + par(mai = c(3, 0.5, 0.2, 0.2), mar = c(3, 3, 2, 2), oma = c(1, + 1, 1, 1)) + plot(x, y, col = "transparent", frame.plot = FALSE, xlab = "", + xaxt = "n") + vioplot(GW.by.HUC[[1]], GW.by.HUC[[2]], GW.by.HUC[[3]], GW.by.HUC[[4]], + GW.by.HUC[[5]], GW.by.HUC[[6]], GW.by.HUC[[7]], GW.by.HUC[[8]], + GW.by.HUC[[9]], GW.by.HUC[[10]], GW.by.HUC[[11]], GW.by.HUC[[12]], + GW.by.HUC[[13]], GW.by.HUC[[14]], GW.by.HUC[[15]], GW.by.HUC[[16]], + GW.by.HUC[[17]], GW.by.HUC[[18]], col = "transparent", + border = rgb(8, 160, 255, max = 255), rectCol = "black", + ylim = c(0, 6), add = TRUE) + vioplot(Ev.by.HUC[[1]], Ev.by.HUC[[2]], Ev.by.HUC[[3]], Ev.by.HUC[[4]], + Ev.by.HUC[[5]], Ev.by.HUC[[6]], Ev.by.HUC[[7]], Ev.by.HUC[[8]], + Ev.by.HUC[[9]], Ev.by.HUC[[10]], Ev.by.HUC[[11]], Ev.by.HUC[[12]], + Ev.by.HUC[[13]], Ev.by.HUC[[14]], Ev.by.HUC[[15]], Ev.by.HUC[[16]], + Ev.by.HUC[[17]], Ev.by.HUC[[18]], col = RedT, rectCol = "black", + ylim = c(0, 6), add = TRUE) + vioplot(Irr.by.HUC[[1]], Irr.by.HUC[[2]], Irr.by.HUC[[3]], + Irr.by.HUC[[4]], Irr.by.HUC[[5]], Irr.by.HUC[[6]], Irr.by.HUC[[7]], + Irr.by.HUC[[8]], Irr.by.HUC[[9]], Irr.by.HUC[[10]], Irr.by.HUC[[11]], + Irr.by.HUC[[12]], Irr.by.HUC[[13]], Irr.by.HUC[[14]], + Irr.by.HUC[[15]], Irr.by.HUC[[16]], Irr.by.HUC[[17]], + Irr.by.HUC[[18]], col = BlueT, border = rgb(180, 16, + 25, max = 255), rectCol = "black", ylim = c(0, 6), + add = TRUE) + vioplot(Ro.by.HUC[[1]], Ro.by.HUC[[2]], Ro.by.HUC[[3]], Ro.by.HUC[[4]], + Ro.by.HUC[[5]], Ro.by.HUC[[6]], Ro.by.HUC[[7]], Ro.by.HUC[[8]], + Ro.by.HUC[[9]], Ro.by.HUC[[10]], Ro.by.HUC[[11]], Ro.by.HUC[[12]], + Ro.by.HUC[[13]], Ro.by.HUC[[14]], Ro.by.HUC[[15]], Ro.by.HUC[[16]], + Ro.by.HUC[[17]], Ro.by.HUC[[18]], col = "transparent", + border = "brown", rectCol = "black", ylim = c(0, 6), + add = TRUE) + vioplot(Tr.by.HUC[[1]], Tr.by.HUC[[2]], Tr.by.HUC[[3]], Tr.by.HUC[[4]], + Tr.by.HUC[[5]], Tr.by.HUC[[6]], Tr.by.HUC[[7]], Tr.by.HUC[[8]], + Tr.by.HUC[[9]], Tr.by.HUC[[10]], Tr.by.HUC[[11]], Tr.by.HUC[[12]], + Tr.by.HUC[[13]], Tr.by.HUC[[14]], Tr.by.HUC[[15]], Tr.by.HUC[[16]], + Tr.by.HUC[[17]], Tr.by.HUC[[18]], col = GreenT, rectCol = "red", + ylim = c(0, 6), add = TRUE) + colfill <- c(GreenT, RedT, "transparent", "transparent", + BlueT) + colbord <- c("black", "black", "brown", rgb(8, 160, 255, + max = 255), rgb(180, 16, 25, max = 255)) + Labs <- c("transpiration", "evaporation", "runoff", "groundwater infiltration", + "irrigation") + par(srt = 0) + title(paste("Annual water balances (mm) for", Crop, sep = " "), + cex.main = 1.75) + par(srt = 30) + text(x = c(1:18), y = c(Tr.Labs) + 100, labels = c(Labels), + cex = 1.5) + dev.off() + setwd(paste0(Path, "/CropWatR/Data")) + } +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ ~kwd1 } +\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line diff --git a/man/bez.Rd b/man/bez.Rd new file mode 100644 index 0000000..6311577 --- /dev/null +++ b/man/bez.Rd @@ -0,0 +1,73 @@ +\name{bez} +\alias{bez} +%- Also NEED an '\alias' for EACH other topic documented here. +\title{ +%% ~~function to do ... ~~ +} +\description{ +%% ~~ A concise (1-5 lines) description of what the function does. ~~ +} +\usage{ +bez(x, y, t) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{x}{ +%% ~~Describe \code{x} here~~ +} + \item{y}{ +%% ~~Describe \code{y} here~~ +} + \item{t}{ +%% ~~Describe \code{t} here~~ +} +} +\details{ +%% ~~ If necessary, more details than the description above ~~ +} +\value{ +%% ~Describe the value returned +%% If it is a LIST, use +%% \item{comp1 }{Description of 'comp1'} +%% \item{comp2 }{Description of 'comp2'} +%% ... +} +\references{ +%% ~put references to the literature/web site here ~ +} +\author{ +%% ~~who you are~~ +} +\note{ +%% ~~further notes~~ +} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +\seealso{ +%% ~~objects to See Also as \code{\link{help}}, ~~~ +} +\examples{ +##---- Should be DIRECTLY executable !! ---- +##-- ==> Define data, use random, +##-- or do help(data=index) for the standard data sets. + +## The function is currently defined as +function (x, y, t) +{ + outx <- 0 + outy <- 0 + n <- length(x) - 1 + for (i in 0:n) { + outx <- outx + choose(n, i) * ((1 - t)^(n - i)) * t^i * + x[i + 1] + outy <- outy + choose(n, i) * ((1 - t)^(n - i)) * t^i * + y[i + 1] + } + return(list(x = outx, y = outy)) + } +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ ~kwd1 } +\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line diff --git a/man/bezierCurve.Rd b/man/bezierCurve.Rd new file mode 100644 index 0000000..fa90a54 --- /dev/null +++ b/man/bezierCurve.Rd @@ -0,0 +1,73 @@ +\name{bezierCurve} +\alias{bezierCurve} +%- Also NEED an '\alias' for EACH other topic documented here. +\title{ +%% ~~function to do ... ~~ +} +\description{ +%% ~~ A concise (1-5 lines) description of what the function does. ~~ +} +\usage{ +bezierCurve(x, y, n = 10) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{x}{ +%% ~~Describe \code{x} here~~ +} + \item{y}{ +%% ~~Describe \code{y} here~~ +} + \item{n}{ +%% ~~Describe \code{n} here~~ +} +} +\details{ +%% ~~ If necessary, more details than the description above ~~ +} +\value{ +%% ~Describe the value returned +%% If it is a LIST, use +%% \item{comp1 }{Description of 'comp1'} +%% \item{comp2 }{Description of 'comp2'} +%% ... +} +\references{ +%% ~put references to the literature/web site here ~ +} +\author{ +%% ~~who you are~~ +} +\note{ +%% ~~further notes~~ +} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +\seealso{ +%% ~~objects to See Also as \code{\link{help}}, ~~~ +} +\examples{ +##---- Should be DIRECTLY executable !! ---- +##-- ==> Define data, use random, +##-- or do help(data=index) for the standard data sets. + +## The function is currently defined as +function (x, y, n = 10) +{ + outx <- NULL + outy <- NULL + i <- 1 + for (t in seq(0, 1, length.out = n)) { + b <- bez(x, y, t) + outx[i] <- b$x + outy[i] <- b$y + i <- i + 1 + } + return(list(x = outx, y = outy)) + } +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ ~kwd1 } +\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line