File:Lgm europe mpiesm baresoilfrac1.svg
Original file (SVG file, nominally 1,200 × 795 pixels, file size: 3.84 MB)
Captions
Summary
[edit]DescriptionLgm europe mpiesm baresoilfrac1.svg |
English: Fraction of bare soil in Europe during Last Glacial Maximum |
|||
Date | ||||
Source | Own work | |||
Author | Merikanto | |||
SVG development InfoField |
|
This image is based on PMIP Mpi-Esm simulation dataset and CHELSA datasets.
- data downscaler
- tex mpiesm cmip against chelsa
- v 0000
- 1.10.2020
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_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_2<-function(rext1)
{
# chelsa dataset
name1="d:/razter2/CHELSA_PMIP_CCSM4_BIO_12.tif"
name2="d:/razter2/CHELSA_PMIP_CCSM4_BIO_01.tif"
name3="d:/razter2/CHELSA_PMIP_CCSM4_BIO_18.tif"
name4="d:/razter2/CHELSA_PMIP_CCSM4_BIO_10.tif"
name5="d:/razter1/high_longlat.tif"
annprecip0<-raster(name1)
anntemp0<-raster(name2)
warmprecip0<-raster(name3)
warmtemp0<-raster(name4)
etopo0<-raster(name5)
#stop(-1)
## WARNING TEST ONLY KOE
icesheet0<-raster("./predata/lgm_ice_sheet.nc")
## bio 18 warmest precip
## bio 10 warmest temp
annprecip01<<-crop(annprecip0, rext1)
anntemp01<<-crop(anntemp0, rext1)
warmprecip01<<-crop(warmprecip0, rext1)
warmtemp01<<-crop(warmtemp0, rext1)
etopo01<<-crop(etopo0, rext1)
print(dim(annprecip01)[1:2])
dimx1<-dim(annprecip01)[1]
dimy1<-dim(annprecip01)[2]
print (dimx1)
print (dimy1)
samplecols1=dimx1/3
samplerows1=dimy1/3
print ("Sampled:")
print (samplecols1)
print (samplerows1)
sampler1 <- raster(ncol=samplecols1, nrow=samplerows1)
annprecip1<<-resample(annprecip01, sampler1)
anntemp1<<-resample(anntemp01, sampler1)
warmprecip1<<-resample(warmprecip01, sampler1)
warmtemp1<<-resample(warmtemp01, sampler1)
etopo1<<-resample(etopo01, sampler1)
# 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(annprecip1)<<-"PrecipAnn"
names(anntemp1)<<-"TempAnn"
names(warmprecip1)<<-"PrecipWarm"
names(warmtemp1)<<-"TempWarm"
names(etopo1)<<-"etopo"
#names(icesheet2)<<-"ice"
- NOTE first raster must be nameed "Elevation" , due to subroutine implementation
#dstak1<-stack(anntemp1, annprecip1, ptopet1,topowet1,icesheet2)
# dstak1<-stack(ptopet1,annprecip1, anntemp1,icesheet2, topowet1)
names(annprecip1)<<-"Elevation"
dstak1<-stack(annprecip1, anntemp1,icesheet2, etopo1)
## note remove NA
# dstak1[is.na(dstak1)] <- 0
##names(dstak1[1])<<-"Elevation"
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
- reurope0<-c(-15,40,30,70)
reurope<-c(-30,80,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"
infilname2<-"d:/varasto_iceagesimu/baresoilFrac_Lmon_MPI-ESM-P_lgm_r1i1p2_185001-194912.nc"
invarname2<-"baresoilFrac"
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_2(rext1)
plot(instak1)
names(instak1)
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_baresoilfrac_1.nc","baresoilfrac (LGM MPI-ESM)", "MPI-ESM", "Fraction of bare soil, 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 | 15:59, 1 October 2020 | 1,200 × 795 (3.84 MB) | 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 | 795px |