File:Chelsa trace downscaled gts5 europe 18000calBP 1.png

From Wikimedia Commons, the free media repository
Jump to navigation Jump to search

Original file (1,024 × 688 pixels, file size: 602 KB, MIME type: image/png)

Captions

Captions

GDD5 in Europe, 20000 BP

Summary

[edit]
Description
English: GDD5 in Europe, 20000 BP
Date
Source Own work
Author Merikanto
Camera location45° 00′ 00″ N, 0° 00′ 00″ E  Heading=270° Kartographer map based on OpenStreetMap.View this and other nearby images on: OpenStreetMapinfo

Source of data: CHELSA

https://chelsa-climate.org/

    3. "R" script: calculate gdd5, pet and ptopet rasters with Envirem package
    4. default: area of france
    5. with envirem
    6. source: exoplasim extracted files
    7. version 0000.0003
    8. 30.7.2022

library(raster) library(rgeos) library(maps) library(viridis) library(envirem) library(base) library(stringr) library(gtools)

  1. stop(-1)

stage_1=0 stage_2=0 stage_3=0 stage_4=0 rsaaga=1

makerasters=1 calculate_average_temp=1

inputDir <- "./origo" outputDir <- "./snapshot" processpath1<-outputDir processpath2<-"./snapshot2"


Sys.which('gdalinfo') Sys.which('gdal_translate')

  1. list.files(inputDir)

dir.create(outputDir) dir.create(processpath2)

    1. creation selection ractangle
  1. poly <- readWKT("POLYGON((
  2. -20 70,
  3. 80 70,
  4. 80 30,
  5. -20 30,
  6. -20 70
  7. ))", p4s = CRS("+proj=longlat +datum=WGS84"))


poly <- readWKT("POLYGON(( 

  -180 90,
  180 90,
  180 -90,
  -180 -90,
  -180 90

))", p4s = CRS("+proj=longlat +datum=WGS84"))


if(stage_1==1) {


  1. plot(poly, border = 'blue', xpd = NA, add = TRUE)
  2. crop and mask input rasters

files <- list.files(inputDir, pattern = '.nc$', full.names = TRUE) files2 <- list.files(inputDir, pattern = '.nc$')

  1. read in a precipitation raster and crop/mask and keep as a mask layer
    1. precipitation rasters have the term "prec" in the file name
    2. crop/mask using polygon

grep(files, pattern = 'prec', value=TRUE)[1]

namme1<-grep(files, pattern = 'prec', value=TRUE)[1] namme0<-grep(files, pattern = 'prec', value=TRUE) namme2<-grep(files2, pattern = 'prec', value=TRUE)


print(namme0)

precstak1<-stack(namme0)

precipRaster <- raster(grep(files, pattern = 'prec', value=TRUE)[1])

plot(precipRaster)


precipRaster <- crop(precipRaster, poly) precipRaster <- mask(precipRaster, poly)

  1. create a terrestrial/marine mask by setting values < 0 to NA, and values >= 0 to 1

precipRaster[precipRaster < 0] <- NA precipRaster[!is.na(precipRaster)] <- 1


  1. plot(precipRaster, col = 'blue', legend = FALSE)
  1. print(dim(precipRaster))


  1. stop(-1)


title(main = 'terrestrial mask')

  1. supply some additional flags to writeRaster() to employ compression to achieve smaller file sizes

tifOptions <- c("COMPRESS=DEFLATE", "PREDICTOR=2", "ZLEVEL=6")

print("Files ...")


  1. namme0<-grep(files, pattern = 'prec', value=TRUE)
  2. files=namme0


print(namme0)

for (i in 1:length(namme0)) {

print(i)

filename1<-namme0[i]

print(filename1)

  1. stop(-1)
  2. cat(i, ' ')
 r <- raster(namme0[i])
  1. r <- crop(r, poly)
 #plot(r)
 image(r)



 extent(r)
 extent( precipRaster)
 dim(r)
 dim( precipRaster)
 



 r <- aggregate(r, fact = 2)
 
 #outfile <- paste0(outputDir, '/', namme0(r), '.tif')
 
 oname1<-namme2[i]
 print("Oname:")
 print(oname1)
 
 
 outfile <- paste0(outputDir, '/', oname1, '.tif')
 
 writeRaster(r, filename = outfile, format = 'GTiff', options = tifOptions, overwrite = TRUE)

}


junk <- dir(path="./snapshot/", pattern="tif.aux") # ?dir file.remove(junk) # ?file.remove


grep(files, pattern = 'mint', value=TRUE)[1]

namme1<-grep(files, pattern = 'mint', value=TRUE)[1] namme0<-grep(files, pattern = 'mint', value=TRUE) namme2<-grep(files2, pattern = 'mint', value=TRUE)


print(namme0)

for (i in 1:length(namme0)) {

print(i)

filename1<-namme0[i]

print(filename1)

  1. stop(-1)
  2. cat(i, ' ')
 r <- raster(namme0[i])
  1. r <- crop(r, poly)
 #plot(r)
 image(r)



 extent(r)
 extent( precipRaster)
 dim(r)
 dim( precipRaster)
 



 r <- aggregate(r, fact = 2)
 
 #outfile <- paste0(outputDir, '/', namme0(r), '.tif')
 
 oname1<-namme2[i]
 print("Oname:")
 print(oname1)
 
 
 outfile <- paste0(outputDir, '/', oname1, '.tif')
 
 writeRaster(r, filename = outfile, format = 'GTiff', options = tifOptions, overwrite = TRUE)

}

junk <- dir(path="./snapshot/", pattern="tif.aux") # ?dir file.remove(junk) # ?file.remove


grep(files, pattern = 'maxt', value=TRUE)[1]

namme1<-grep(files, pattern = 'maxt', value=TRUE)[1] namme0<-grep(files, pattern = 'maxt', value=TRUE) namme2<-grep(files2, pattern = 'maxt', value=TRUE)


print(namme0)

for (i in 1:length(namme0)) {

print(i)

filename1<-namme0[i]

print(filename1)

  1. stop(-1)
  2. cat(i, ' ')
 r <- raster(namme0[i])
  1. r <- crop(r, poly)
 #plot(r)
 image(r)



 extent(r)
 extent( precipRaster)
 dim(r)
 dim( precipRaster)
 



 r <- aggregate(r, fact = 2)
 
 #outfile <- paste0(outputDir, '/', namme0(r), '.tif')
 
 oname1<-namme2[i]
 print("Oname:")
 print(oname1)
 
 
 outfile <- paste0(outputDir, '/', oname1, '.tif')
 
 writeRaster(r, filename = outfile, format = 'GTiff', options = tifOptions, overwrite = TRUE)

}

junk <- dir(path="./snapshot/", pattern="tif.aux") # ?dir mydir <-"./snapshot/" junk <- dir(path=mydir ,pattern="tif.aux") file.remove(file.path(mydir, junk))

junk <- dir(path="./snapshot/", pattern="tif.aux") # ?dir

print(junk)


  1. stop(-1)

}


if(stage_2==1) {

old_files <- list.files(processpath1, pattern = "*.tif", full.names = TRUE) #old_files

old_files_2=mixedsort(old_files)

len1=length(old_files)

print (len1)

#old_files_2

precipfiles=grep('prec', old_files_2, value=TRUE)


  1. print (precipfiles)

len2=length(precipfiles)

for (n in 1:len2) { infilee=precipfiles[n] #print (infilee) a=sprintf("%02d",n) #print (a) newfileename=paste0(processpath2, "/test_precip_",a,".tif")

  1. print (newfileename)

file.copy(from = infilee, to = newfileename)

}

  1. junk <- dir(path="./snapshot/", pattern="aux") # ?dir
  2. file.remove(junk) # ?file.remove

junk <- dir(path="./snapshot2/", pattern="tif.aux") # ?dir mydir <-"./snapshot2/" junk <- dir(path=mydir ,pattern="tif.aux") file.remove(file.path(mydir, junk))

  1. stop(-1)
  1. old_files <- list.files(processpath1, pattern = "*.tif", full.names = TRUE)

#old_files

old_files_2=mixedsort(old_files)

len1=length(old_files)

print (len1)

print("KKKK") print(old_files_2)


  1. stop(-1)

tminfiles=grep('mint', old_files_2, value=TRUE)

print("Tmin:")

print (tminfiles)

  1. stop(-1)


len2=length(tminfiles)

for (n in 1:len2) { infilee=tminfiles[n] #print (infilee) a=sprintf("%02d",n) #print (a) newfileename=paste0(processpath2,"/test_tmin_",a,".tif") print (newfileename) file.copy(from = infilee, to = newfileename) }

junk <- dir(path="./snapshot2/", pattern="tif.aux") # ?dir mydir <-"./snapshot2/" junk <- dir(path=mydir ,pattern="tif.aux") file.remove(file.path(mydir, junk))

  1. junk <- dir(path="./snapshot/", pattern="aux") # ?dir
  2. file.remove(junk) # ?file.remove
  1. stop(-1)


tmaxfiles=grep('maxt', old_files_2, value=TRUE)

print (tmaxfiles)

len2=length(tmaxfiles)

for (n in 1:len2) { infilee=tmaxfiles[n] #print (infilee) a=sprintf("%02d",n) #print (a) newfileename=paste0(processpath2,"/test_tmax_",a,".tif") print (newfileename) file.copy(from = infilee, to = newfileename) }

  1. junk <- dir(path="./snapshot/", pattern="aux") # ?dir
  2. file.remove(junk) # ?file.remove

junk <- dir(path="./snapshot2/", pattern="tif.aux") # ?dir mydir <-"./snapshot2/" junk <- dir(path=mydir ,pattern="tif.aux") file.remove(file.path(mydir, junk))


rasterTemplate <- raster('./snapshot2/test_precip_01.tif')

ETsolradRasters(rasterTemplate = rasterTemplate, year = -1, outputDir = './snapshot2', overwrite = TRUE) junk <- dir(path="./snapshot2/", pattern="tif.aux") # ?dir mydir <-"./snapshot2/" junk <- dir(path=mydir ,pattern="tif.aux") file.remove(file.path(mydir, junk))


print("kk") print("Stage2 ok") }



if(stage_3==1) {

junk <- dir(path="./snapshot/", pattern="tif.aux") # ?dir mydir <-"./snapshot/" junk <- dir(path=mydir ,pattern="tif.aux") file.remove(file.path(mydir, junk))


junk <- dir(path="./snapshot2/", pattern="tif.aux") # ?dir mydir <-"./snapshot2/" junk <- dir(path=mydir ,pattern="tif.aux") file.remove(file.path(mydir, junk))


old_files <- list.files(processpath1, pattern = "*.tif", full.names = TRUE)

  1. old_files

old_files_2=mixedsort(old_files)

tmaxfiles=grep('tmin', old_files_2, value=TRUE)

print (tmaxfiles)

len2=length(tmaxfiles)

print("Tmean ..")

months1<-c(1,2,3,4,5,6,7,8,9,10,11,12)

for (n in 1:12) { print(n) nana=months1[n] print(nana) a=sprintf("%02d",nana) print(a) infileename1=paste0(processpath2,"/test_tmax_",a,".tif") infileename2=paste0(processpath2,"/test_tmin_",a,".tif") outfileename1=paste0(processpath2,"/test_tmean_",a,".tif") print(infileename1) print(infileename2) #print (n) print (outfileename1) r1=raster(infileename1) #print("RK") r2=raster(infileename2)


#plot(r2) #print("R3 ...") r3=(r1+r2)/2

#plot(r3) #print("WR ...") writeRaster(r3, filename = outfileename1, format = 'GTiff',overwrite = TRUE)

#file.copy(from = infilee, to = newfileename) }

junk <- dir(path="./snapshot2/", pattern="tif.aux") # ?dir mydir <-"./snapshot2/" junk <- dir(path=mydir ,pattern="tif.aux") file.remove(file.path(mydir, junk))


}



if(stage_4==1) {


indir1<-'./snapshot2' outdir1 <- './envirem1'

dir.create(outdir1)

assignNames(reset = TRUE)

assignNames(tmax = "test_tmax_##", 

          tmin = "test_tmin_##",
          tmean="test_tmean_##",
          precip = "test_precip_##",
          solrad = "et_solrad_##"
          )

chelsaFiles <- list.files('./snapshot2', pattern = 'test', full.names = TRUE)

chelsaStack <- stack(chelsaFiles) solarFiles <- list.files('./snapshot2', pattern = 'solrad', full.names = TRUE) solarStack <- stack(solarFiles) print(solarFiles)

verifyFileStructure('./snapshot2', returnFileNames = FALSE)

verifyRasterNames(chelsaStack, solradstack = solarStack)

varnames()


inputDir <- indir1 outputDir <- outdir1



print ("Generating rasters") generateRasters(var = 'growingDegDays5',prefix = 'test_',maindir = indir1,outputDir = outdir1)


  1. print("PET")

generateRasters(var = 'annualPET',prefix = 'test_',maindir = indir1,outputDir = outdir1)


name1='./envirem1/test_growingDegDays5.tif' name2='./envirem1/test_annualPET.tif'

outname1="gdd5e.nc" outname2="pete.nc" outname3="ptopete.nc" outname4="precipanne.nc"

  1. read in the resulting raster

result <- raster(name1) plot(result, col = inferno(100)) writeRaster(result, filename = outname1, format = 'netCDF',overwrite = TRUE)

result <- raster(name2) plot(result, col = inferno(100)) writeRaster(result, filename = outname2, format = 'netCDF',overwrite = TRUE)

print(" Prec ..." ) rasterFiles <- list.files(indir1, pattern = '.tif$', full.names = TRUE)

env <- stack(rasterFiles) precip <- grep('prec', names(env), value=TRUE) precip <- stack(envprecip)

annualprecip<-sum(precip)

pet=raster(outname2)

ptopet=annualprecip/pet


plot(annualprecip, col = inferno(100)) plot(ptopet, col = inferno(100))

writeRaster(annualprecip, filename = outname4, format = 'netCDF',overwrite = TRUE)

writeRaster(ptopet, filename = outname3, format = 'netCDF',overwrite = TRUE)


}

    1. TWI NOK !

if (rsaaga==1) { ## NOK WARNING in alpha stage

library(RSAGA)


#myenv <- rsaga.env() #myenv # SAGA data in C:/sagadata, binaries in C:/SAGA-GIS, modules in C:/SAGA-GIS/modules: myenv <- rsaga.env(workspace="C:/Programs/sagadata", path="C:/Programs/saga")


## chelsa dem

dempath1<-"./indata/dryplanet_dem_sealevel.tiff" outdpath1<-"./origo/sagatwi.nc"

elev0<-raster(dempath1)

e1 <- extent(-180,180,-90,90) elev1 <- crop(elev0, e1)

plot(elev1)

env <- rsaga.env()

    1. not OK

tw1<-topoWetnessIndex(elev1, env)

#plot(tw1)

#writeRaster(tw1, filename = outdpath1, format = 'netCDF',overwrite = TRUE)

}



Karger, D.N., Conrad, O., Böhner, J., Kawohl, T., Kreft, H., Soria-Auza, R.W., Zimmermann, N.E., Linder, P., Kessler, M. (2017). Climatologies at high resolution for the Earth land surface areas. Scientific Data. 4 170122. https://doi.org/10.1038/sdata.2017.122

Karger D.N., Conrad, O., Böhner, J., Kawohl, T., Kreft, H., Soria-Auza, R.W., Zimmermann, N.E,, Linder, H.P., Kessler, M.. Data from: Climatologies at high resolution for the earth’s land surface areas. Dryad Digital Repository.http://dx.doi.org/doi:10.5061/dryad.kd1d4

Downscaling code is in

File:Chelsa_trace_calculated_gdd5_europe_20000BP_1.png

Licensing

[edit]
I, the copyright holder of this work, hereby publish it under the following license:
w:en:Creative Commons
attribution share alike
This file is licensed under the Creative Commons Attribution-Share Alike 4.0 International license.
You are free:
  • to share – to copy, distribute and transmit the work
  • to remix – to adapt the work
Under the following conditions:
  • attribution – You must give appropriate credit, provide a link to the license, and indicate if changes were made. You may do so in any reasonable manner, but not in any way that suggests the licensor endorses you or your use.
  • share alike – If you remix, transform, or build upon the material, you must distribute your contributions under the same or compatible license as the original.

File history

Click on a date/time to view the file as it appeared at that time.

Date/TimeThumbnailDimensionsUserComment
current13:18, 24 February 2021Thumbnail for version as of 13:18, 24 February 20211,024 × 688 (602 KB)Merikanto (talk | contribs)Typo in plot
13:16, 24 February 2021Thumbnail for version as of 13:16, 24 February 20211,024 × 688 (602 KB)Merikanto (talk | contribs)Better image description, better BP to plot (more accurate )
11:39, 21 February 2021Thumbnail for version as of 11:39, 21 February 20211,024 × 688 (535 KB)Merikanto (talk | contribs)Change of layout
13:42, 20 February 2021Thumbnail for version as of 13:42, 20 February 20211,168 × 784 (492 KB)Merikanto (talk | contribs)Uploaded own work with UploadWizard

You cannot overwrite this file.

The following page uses this file:

Retrieved from "https://commons.wikimedia.org/w/index.php?title=File:Chelsa_trace_downscaled_gts5_europe_18000calBP_1.png&oldid=855330311"