File:Lgm europe mpiesm treefrac 1.svg
Original file (SVG file, nominally 1,200 × 927 pixels, file size: 5.49 MB)
Captions
Summary
[edit]DescriptionLgm europe mpiesm treefrac 1.svg |
English: Tree fraction in Europe, Last Glacial Maximum, downscaled MPI-ESM |
|||
Date | ||||
Source | Own work | |||
Author | Merikanto | |||
SVG development InfoField | This oversized map was created with an unknown SVG tool.
|
Source of data is CERA WDC lgm MPI-ESM dataset. "treeFrac_Lmon_MPI-ESM-P_lgm_r1i1p2_185001-194912.nc"
install_libraries=FALSE
if(install_libraries==TRUE)
{
install.packages("raster")
install.packages("rgdal")
install.packages("sp")
install.packages("spatialEco")
install.packages("ncdf4")
install.packages("dissever")
install.packages("viridis")
install.packages("dplyr")
install.packages("lattice")
install.packages("RColorBrewer")
install.packages("rgeos")
install.packages("sp")
install.packages("reshape2")
install.packages("data.table")
install.packages("stringr")
install.packages("rlist")
install.packages("pipeR")
install.packages("maptools")
install.packages("gdata", dependencies=TRUE)
install.packages("abind")
install.packages("Cairo")
install.packages("pals")
install.packages("REdaS")
install.packages("easyNCDF")
install.packages("numbers")
install.packages("rasterVis")
install.packages("OceanView")
install.packages("rainfarmr")
}
library(raster)
library(rgdal)
library(ncdf4)
library(lattice)
library(maptools)
library(rgeos)
library(spatialEco)
library(dissever)
library(rainfarmr)
library(RColorBrewer)
library(viridis)
library(pals)
library(data.table)
library(stringr)
library(rlist)
library(pipeR)
library(rasterVis)
- library(OceanView)
library(sp)
library(reshape2)
library(dplyr)
library(REdaS)
library(easyNCDF)
library(numbers)
- library(gdata)
library(abind)
- bioname_11="D:/datav3/CHELSA_PMIP_CCSM4_BIO_11.tif" # temperature of coldest 3 month
- bioname_19="D:/datav3/CHELSA_PMIP_CCSM4_BIO_19.tif" ## precip of coldest 3 month
- bioname_10="D:/datav3/CHELSA_PMIP_CCSM4_BIO_11.tif"
bioname_10="D:/data_processed/beringia_chelsa_bio_lgm/bio10.nc"
bioname_5="D:/data_processed/beringia_chelsa_bio_lgm/bio5.nc"
downscale_dissever <- function (coarse_rastera, fine_stack, dismethod, samplerate)
{
print ("Dissever()")
names(fine_stack)
coarse_raster<-coarse_rastera
p1<-fine_stack$Elevation
- plot(p1)
- return(0)
coarseoro<- resample(p1, coarse_raster)
coarseoro_big<-resample(coarseoro, p1)
orodelta<-(p1-coarseoro_big)
baset1 <- resample(coarse_raster, p1)
raster_stack <- fine_stack
min_iter <- 5 # Minimum number of iterations
max_iter <- 10 # Maximum number of iterations
p_train <- samplerate # Subsampling of the initial data
oma_juttu <- dissever(coarse = coarse_raster, fine = raster_stack, method = dismethod, p = p_train, min_iter = min_iter,max_iter = max_iter, verbose=1)
orotemp<-oma_juttu$map
#tempiso<-baset1+oma_juttu$map+biassi
coarseorotemp<- resample(orotemp, coarse_raster)
coarseorotemp_big<-resample(coarseorotemp, p1)
orotempdelta<-orotemp-coarseorotemp_big
outtemp<-baset1+orotempdelta
- plot(outtemp, col=rev(rainbow(256)) )
- outtempr<-rotate(outtemp)
#plot(outtempr)
return(outtemp)
}
downscale_raster <- function (coarse_rastera, fine_rastera, method)
{
## methods: 0 delta, 1 spatialeco, 2 dissever, 3 temperature lapse 6.5 C/1 km lm
print ("Downscaler()")
coarse_raster<-coarse_rastera
fine_raster<-fine_rastera
p1<-fine_raster
p2<-fine_raster
- plot(fine_raster)
- plot(coarse_raster, col=viridis(200))
coarseoro<- resample(p1, coarse_raster)
coarseoro_big<-resample(coarseoro, p1)
orodelta<-(p1-coarseoro_big)
baset1 <- resample(coarse_raster, p1)
raster_stack <- stack(p1,p2)
min_iter <- 5 # Minimum number of iterations
max_iter <- 20 # Maximum number of iterations
p_train <- 1.0 # Subsampling of the initial data
if(method>9999)
{
method=2
}
## dissever run
if(method==2)
{
oma_juttu <- dissever(coarse = coarse_raster, fine = raster_stack, method = "glm", p = p_train, min_iter = min_iter,max_iter = max_iter, verbose=1)
orotemp<-oma_juttu$map
}
## spatialeco downscale
if(method==1)
{
oma_juttu2 <- raster.downscale(p1, coarse_raster)
orotemp<-oma_juttu2$downscale
}
- delta regression 1,1
if(method==0)
{
orotemp<-orodelta
}
- delta regression by lapse rate
if(method==3)
{
orotemp<-orodelta*0.0065*-1
}
#biassi=4
#tempiso<-baset1+oma_juttu$map+biassi
coarseorotemp<- resample(orotemp, coarse_raster)
coarseorotemp_big<-resample(coarseorotemp, p1)
orotempdelta<-orotemp-coarseorotemp_big
outtemp<-baset1+orotempdelta
- plot(outtemp, col=rev(rainbow(256)) )
- outtempr<-rotate(outtemp)
#plot(outtempr)
return(outtemp)
}
downscale_dissever <- function (coarse_rastera, fine_stack, dismethod, samplerate)
{
print ("Dissever()")
names(fine_stack)
coarse_raster<-coarse_rastera
p1<-fine_stack$Elevation
- plot(p1)
- return(0)
coarseoro<- resample(p1, coarse_raster)
coarseoro_big<-resample(coarseoro, p1)
orodelta<-(p1-coarseoro_big)
baset1 <- resample(coarse_raster, p1)
raster_stack <- fine_stack
min_iter <- 5 # Minimum number of iterations
max_iter <- 10 # Maximum number of iterations
p_train <- samplerate # Subsampling of the initial data
oma_juttu <- dissever(coarse = coarse_raster, fine = raster_stack, method = dismethod, p = p_train, min_iter = min_iter,max_iter = max_iter, verbose=1)
orotemp<-oma_juttu$map
#tempiso<-baset1+oma_juttu$map+biassi
coarseorotemp<- resample(orotemp, coarse_raster)
coarseorotemp_big<-resample(coarseorotemp, p1)
orotempdelta<-orotemp-coarseorotemp_big
outtemp<-baset1+orotempdelta
- plot(outtemp, col=rev(rainbow(256)) )
- outtempr<-rotate(outtemp)
#plot(outtempr)
return(outtemp)
}
writeout<-function(oras, outn, varnamex, varunitx, longnamex)
{
crs(oras) <- "+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"
writeRaster(oras, filename=outn, overwrite=TRUE, format="CDF", varname=varnamex, varunit=varunitx,
longname=longnamex, xname="lon", yname="lat")
}
- snow
downscale_cmip5_variable <- function(dataname1, invarname1, instak1, posit, numyears, month1, methodi1, submethodi1, subaccuracu1)
{
print("Loading data ...")
nppin1 <- nc_open(dataname1)
vext1<-c(0,360,-90,90)
lok1=posit*12+month1
mara=numyears*12
stacksnow1<-stack()
for(n in 1:mara)
{
# print (".")
snow00 <- ncvar_get( nppin1, varid=invarname1,start=c(1,1,lok1), count=c(-1,-1,1) )
snow01=t(snow00)
snow02<-apply(snow01,2,rev)
snow0=raster(snow02)
extent(snow0)<-vext1
names(snow0)<-invarname1
snow2=rotate(snow0)
crs(snow2) <- "+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"
stacksnow1 <- stack( stacksnow1 , snow2 )
lok1=lok1+12
}
rasnow0<-mean(stacksnow1)
print (rasnow0)
rasnow1=rasnow0
rasnow1[is.na(rasnow1)] <- 0
print("Downscaling ...")
#methodi1, submethodi1, subaccuracu1
if(methodi1==2)
{
out3<-downscale_dissever(rasnow1, instak1, submethodi1, subaccuracu1)
}
return(out3)
- loadipslnpp
}
rasteroi <-function()
{
##rasterize ehrels gibbard lgm glaciers shapefiles
p1 <- shapefile('C:/Users/himot/aglacgis1/lgm.shp')
#p1 <- shapefile('C:/Users/himot/aglacgis1/lgm_global.shp')
p2 <- shapefile('C:/Users/himot/aglacgis1/lgm_alpen.shp')
#p3 <- shapefile('C:/Users/himot/aglacgis1/lgm_asia_west.shp')
#p4 <- shapefile('C:/Users/himot/aglacgis1/lgm_kuhle_asia.shp')
p5 <- shapefile('C:/Users/himot/aglacgis1/mountain_glaciers.shp')
print("Nuk")
p <- bind(p1,p2)
pgeo <- spTransform(p, CRS('+proj=longlat +datum=WGS84'))
ext <- floor(extent(pgeo))
#reso2=360/43200
#reso2=0.05
reso2=0.05
rr <- raster(ext, res=reso2)
#rr <- rasterize(pgeo, rr, field=1)
#rr <- fasterize(pgeo, rr, field = "value", fun="sum")
rr <- rasterize(pgeo, rr, field = 1)
plot(rr)
writeout(rr, "lgm_ice_sheet", "ice", "ice", "Ices Sheets")
}
create_stack_variables_1<-function(rext1)
{
ptopet0<-raster("d:/razter/lgm_ptopet_2_5m.tif")
annprecip0<-raster("d:/razter/bio_12.tif")
anntemp0<-raster("d:/razter/bio_1.tif")
warmprecip0<-raster("d:/razter/bio_18.tif")
warmtemp0<-raster("d:/razter/bio_10.tif")
topowet0<-raster("d:/razter/lgm_2-5arcmin_topoWet.tif")
gdd00<-raster("d:/razter/lgm_ccsm4_2-5arcmin_growingDegDays0.tif")
## WARNING TEST ONLY KOE
icesheet0<-raster("./lgm_ice_sheet.nc")
## bio 18 warmest precip
## bio 10 warmest temp
ptopet1<<-crop(ptopet0, rext1)
annprecip1<<-crop(annprecip0, rext1)
anntemp1<<-crop(anntemp0, rext1)
warmprecip1<<-crop(warmprecip0, rext1)
warmtemp1<<-crop(warmtemp0, rext1)
topowet1<<-crop(topowet0, rext1)
gdd01<<-crop(gdd00, rext1)
# icesheet10<<-crop(icesheet0, rext1)
print(dim(annprecip1)[1:2])
dimx1<-dim(annprecip1)[1]
dimy1<-dim(annprecip1)[2]
print (dimx1)
print (dimy1)
icesheet1<<-crop(icesheet0, rext1)
icesheet2 <- raster(nrow=dimx1, ncol=dimy1)
extent(icesheet2)<-extent(annprecip1)
icesheet2 <- resample(icesheet1, icesheet2, method='bilinear')
#plot(icesheet2)
writeout(icesheet2, "europe_ice_sheets.nc", "ice", "ice", "Ices Sheets")
icesheet2[is.na(icesheet2)]<-0
icesheet2[icesheet2!=0]<-1
names(ptopet1)<<-"PTOPET"
names(annprecip1)<<-"PrecipAnn"
names(anntemp1)<<-"TempAnn"
names(warmprecip1)<<-"PrecipWarm"
names(warmtemp1)<<-"TempWarm"
names(topowet1)<<-"Topowet"
names(gdd01)<<-"GDD0"
#names(icesheet2)<<-"ice"
- NOTE first raster must be nameed "Elevation" , due to subroutine implementation
names(ptopet1)<-"Elevation"
#dstak1<-stack(anntemp1, annprecip1, ptopet1,topowet1,icesheet2)
dstak1<-stack(ptopet1,annprecip1, anntemp1,icesheet2, topowet1)
## note remove NA
# dstak1[is.na(dstak1)] <- 0
return(dstak1)
}
- program init
- europe
- lon1=-15.0
- lon2=40.0
- lat1=30.0
- lat2=70.0
- beringia
- lon1=-180
- lon2=-120
- lat1=50.0
- lat2=80.0
reurope<-c(-15,40,30,70)
rberingia<-c(-180,-120,50,80)
- kolmas: grassfrac
- infilname2<-"d:/varasto_iceagesimu/grassFrac_Lmon_IPSL-CM5A-LR_lgm_r1i1p1_260101-280012.nc"
- infilname2<-"d:/varasto_iceagesimu/"
infilname2<-"d:/varasto_iceagesimu/treeFrac_Lmon_MPI-ESM-P_lgm_r1i1p2_185001-194912.nc"
invarname2<-"treeFrac"
posit=0
numyears=8
month1=7
- rext3<-c(-180,-120,50,80) # beringia
rext1<-reurope
methodi1=2
submethodi1="glm"
subaccuracu1=1.0
instak1<-create_stack_variables_1(rext1)
print (instak1)
rds3<-downscale_cmip5_variable(infilname2, invarname2, instak1, posit, numyears, month1, methodi1, submethodi1, subaccuracu1)
rds4<-rds3
rds4[rds4<0] <- 0
writeout(rds4,"./lgm_europe_mpiesm_treefrac_1.nc","treefrac (LGM MPI-ESM)", "MPI-ESM", "Fraction of Trees, Last Glacial Maximum, Europe")
Licensing
[edit]- 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/Time | Thumbnail | Dimensions | User | Comment | |
---|---|---|---|---|---|
current | 16:07, 1 October 2020 | 1,200 × 927 (5.49 MB) | Merikanto (talk | contribs) | True svg format. | |
11:35, 5 September 2020 | 1,650 × 1,275 (852 KB) | Merikanto (talk | contribs) | Uploaded own work with UploadWizard |
You cannot overwrite this file.
File usage on Commons
The following page uses this file:
Metadata
This file contains additional information such as Exif metadata which may have been added by the digital camera, scanner, or software program used to create or digitize it. If the file has been modified from its original state, some details such as the timestamp may not fully reflect those of the original file. The timestamp is only as accurate as the clock in the camera, and it may be completely wrong.
Width | 1200px |
---|---|
Height | 927px |