Wikimedia Commons

File:Lgm europe mpiesm baresoilfrac1.svg

Original file ‎(SVG file, nominally 1,200 × 795 pixels, file size: 3.84 MB)

Captions

Captions

Fraction of bare soil in Europe during Last Glacial Maximum

Summary edit

Description
English: Fraction of bare soil in Europe during Last Glacial Maximum
Date
Source Own work
Author Merikanto
SVG development
InfoField
 
The source code of this large SVG is valid.
 
This oversized map was created with an unknown SVG tool by Merikanto.
This SVG (Scalable Vector Graphic) appears to have been inadequately vectorized, for example, by auto-tracing, and may require revectorization to meet quality standards.
Automatic tracing of complex images can produce overly-large files, inaccurate outlines, and often miss out smaller details completely. Please consider editing this image by hand in a vector editor to improve it. For further information please see our picture tutorial and SVG help. For assistance, refer to the Graphics Lab.
Deutsch ∙ English ∙ español ∙ français ∙ italiano ∙ sicilianu ∙ slovenščina ∙ svenska ∙ македонски ∙ português do Brasil ∙ русский ∙ 日本語 ∙ 한국어 ∙ 中文 ∙ 中文（简体） ∙ 中文（繁體） ∙ +/−

This image is based on PMIP Mpi-Esm simulation dataset and CHELSA datasets.

    1. data downscaler
    2. tex mpiesm cmip against chelsa
    3. v 0000
    4. 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)

  1. library(OceanView)

library(sp) library(reshape2)

library(dplyr) library(REdaS) library(easyNCDF) library(numbers)

  1. library(gdata)

library(abind)

  1. bioname_11="D:/datav3/CHELSA_PMIP_CCSM4_BIO_11.tif" # temperature of coldest 3 month
  2. bioname_19="D:/datav3/CHELSA_PMIP_CCSM4_BIO_19.tif" ## precip of coldest 3 month
  1. 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

  1. plot(fine_raster)
  2. 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 }

    1. delta regression 1,1

if(method==0) {

orotemp<-orodelta 

   	}
    1. 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

  1. plot(outtemp, col=rev(rainbow(256)) )
  1. 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


  1. plot(p1)
  1. 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

  1. plot(outtemp, col=rev(rainbow(256)) )
  1. 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")

}

    1. 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)
    1. 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"
    1. 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)

}

    1. program init
    1. europe
  2. lon1=-15.0
  3. lon2=40.0
  4. lat1=30.0
  5. lat2=70.0
  1. beringia
  2. lon1=-180
  3. lon2=-120
  4. lat1=50.0
  5. lat2=80.0
  1. reurope0<-c(-15,40,30,70)

reurope<-c(-30,80,30,70)

rberingia<-c(-180,-120,50,80)

    1. kolmas: grassfrac
  1. infilname2<-"d:/varasto_iceagesimu/grassFrac_Lmon_IPSL-CM5A-LR_lgm_r1i1p1_260101-280012.nc"
  2. infilname2<-"d:/varasto_iceagesimu/"
  3. 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

  1. 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

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
current15:59, 1 October 2020Thumbnail for version as of 15:59, 1 October 20201,200 × 795 (3.84 MB)Merikanto (talk | contribs)Uploaded own work with UploadWizard

You cannot overwrite this file.

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.

Retrieved from "https://commons.wikimedia.org/w/index.php?title=File:Lgm_europe_mpiesm_baresoilfrac1.svg&oldid=649717728"