File:Beringia npp ipsl ds 2.svg
![File:Beringia npp ipsl ds 2.svg](https://upload.wikimedia.org/wikipedia/commons/thumb/0/05/Beringia_npp_ipsl_ds_2.svg/776px-Beringia_npp_ipsl_ds_2.svg.png?20191108170227)
Original file (SVG file, nominally 1,650 × 1,275 pixels, file size: 988 KB)
Captions
Captions
Summary
[edit]DescriptionBeringia npp ipsl ds 2.svg |
English: NPP in Beringia at Last Glacial Maximum, kg/ha pure carbon (kg ha-1 C) |
|||
Date | ||||
Source | Own work | |||
Author | Merikanto | |||
SVG development InfoField |
|
Camera location | 65° 00′ 00″ N, 150° 00′ 00″ W ![]() ![]() | View this and other nearby images on: OpenStreetMap | ![]() |
---|
This image is geneterad from IPSL PMIP data. Downscaling against Chelsa CCSM3 data Processing with R scripts. Visualizing with NASA Panoply
Chelsa data
library(raster)
indirrax1="D:/datav4/"
indirrax2="D:/data_processed/beringia_chelsa_ccsm4_lgm/"
indirrax3="D:/data_processed/beringia_chelsa_bio_lgm/"
- indirrax2="D:/data_processed/beringia_chelsa_current/"
- indirrax3="D:/data_processed/beringia_chelsa_bio_current/"
- inpath_etopo1<-"D:/datavarasto/etopo1.nc"
swename1="swe.nc"
shname1="snowheight.nc"
swiname1="chelsa_lgm_swi.nc"
simuname1="CCSM4"
varname1="prec"
varname2="tmean"
- East Beringia
lon1=-180
lon2=-120
lat1=50.0
lat2=80.0
ext11a<- extent(lon1,lon2,lat1,lat2)
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")
}
chelsa_pmipname1<-function(indirrax1, simuname1, varnamx1,month1)
{
retus1=""
numus1=sprintf("%02i",month1)
retus1=paste0(indirrax1,"CHELSA_PMIP_",simuname1,"_",varnamx1,"_",numus1,".tif")
return(retus1)
}
chelsa_pmipname2<-function(indirrax1, simuname1, varnamx1,month1)
{
retus1=""
numus1=sprintf("%i",month1)
retus1=paste0(indirrax1,"CHELSA_PMIP_",simuname1,"_",varnamx1,"_",numus1,"_1.tif")
return(retus1)
}
chelsa_pmipbioname1<-function(indirrax1, simuname1, varnamx1,month1)
{
retus1=""
numus1=sprintf("%02i",month1)
#"CHELSA_PMIP_CCSM4_BIO_01"
retus1=paste0(indirrax1,"CHELSA_PMIP_",simuname1,"_BIO_",numus1,".tif")
return(retus1)
}
acquire_chelsa_lgm_monthly_files<-function(indirrax1,indirrax2)
{
dir.create(indirrax2)
for (montho1 in 1:12)
{
finame1=chelsa_pmipname2(indirrax1, simuname1, varname1,montho1)
finame2=chelsa_pmipname1(indirrax1, simuname1, varname2,montho1)
foname1=paste0(indirrax2,varname1,montho1)
foname2=paste0(indirrax2,varname2,montho1)
print(finame1)
print(finame2)
preci0<-raster(finame1)
tempe0<-raster(finame2)
prec1<-crop(preci0, ext11a)
temp1<-crop(tempe0, ext11a)
writeout(prec1,foname1,varname1, "mm/month", "IceAgePrecip")
writeout(temp1,foname2,varname2, "tempunits", "IceAgeTemp")
}
}
acquire_chelsa_lgm_bio_files<-function(indirrax1,indirrax2)
{
dir.create(indirrax3)
for (montho1 in 1:19)
{
finame1=chelsa_pmipbioname1(indirrax1, simuname1, varname1,montho1)
foname1=paste0(indirrax3,"bio",montho1)
biona1=paste0("bio",montho1)
print(finame1)
bio0<-raster(finame1)
bio1<-crop(bio0, ext11a)
writeout(bio1,foname1,biona1, "mm/month", biona1)
}
}
calculate_lgm_snow_swe<-function(indirrax2)
{
foname2=paste0(indirrax2,varname2,1,".nc")
print(foname2)
swe0<-raster(foname2)
swe0<-swe0*0.0
for (montho1 in 1:12)
{
foname1=paste0(indirrax2,varname1,montho1,".nc")
foname2=paste0(indirrax2,varname2,montho1,".nc")
print(foname1)
print(foname2)
preci00<-raster(foname1)
tempe0<-raster(foname2)
preci0<-resample(preci00, tempe0)
tempe0[tempe0<2730]<-1.0
tempe0[tempe0>2729]<-0.0
swe0=swe0+((tempe0*preci0)/10)
}
writeout(swe0,swename1,"SWE", "mm", "swe")
}
chelsa_current_temp_name<-function(indirrax1,month1)
{
retus1=""
numus1=sprintf("%02i",month1)
#CHELSA_temp10_01_1979-2013_V1.2_land
retus1=paste0(indirrax1,"CHELSA_temp10_",numus1,"_1979-2013_V1.2_land.tif")
return(retus1)
}
chelsa_current_precip_name<-function(indirrax1,month1)
{
retus1=""
numus1=sprintf("%02i",month1)
#CHELSA_prec_01_V1.2_land
retus1=paste0(indirrax1,"CHELSA_prec_",numus1,"_V1.2_land.tif")
return(retus1)
}
chelsa_current_bio_name<-function(indirrax1,month1)
{
retus1=""
numus1=sprintf("%02i",month1)
- CHELSA_bio10_01
retus1=paste0(indirrax1,"CHELSA_bio10_",numus1,".tif")
return(retus1)
}
acquire_chelsa_current_monthly_files<-function(indirrax1,indirrax2)
{
dir.create(indirrax2)
for (montho1 in 1:12)
{
#finame1=chelsa_pmipname2(indirrax1, simuname1, varname1,montho1)
#finame2=chelsa_pmipname1(indirrax1, simuname1, varname2,montho1)
finame2=chelsa_current_temp_name(indirrax1,montho1)
finame1=chelsa_current_precip_name(indirrax1,montho1)
foname1=paste0(indirrax2,varname1,montho1)
foname2=paste0(indirrax2,varname2,montho1)
print(finame1)
print(finame2)
preci0<-raster(finame1)
tempe0<-raster(finame2)
prec1<-crop(preci0, ext11a)
temp1<-crop(tempe0, ext11a)
writeout(prec1,foname1,varname1, "mm/month", "Precip")
writeout(temp1,foname2,varname2, "Kmul0", "AgeTemp")
}
}
acquire_chelsa_current_bio_files<-function(indirrax1,indirrax2)
{
dir.create(indirrax3)
for (montho1 in 1:19)
{
#finame1=chelsa_pmipbioname1(indirrax1, simuname1, varname1,montho1)
finame1<-chelsa_current_bio_name(indirrax1,montho1)
foname1=paste0(indirrax3,"bio",montho1)
biona1=paste0("bio",montho1)
print(finame1)
bio0<-raster(finame1)
bio1<-crop(bio0, ext11a)
writeout(bio1,foname1,biona1, "mm/month", biona1)
}
}
calculate_current_snow_swe<-function(indirrax2)
{
foname2=paste0(indirrax2,varname2,1,".nc")
print(foname2)
swe0<-raster(foname2)
swe0<-swe0*0.0
for (montho1 in 1:12)
{
foname1=paste0(indirrax2,varname1,montho1,".nc")
foname2=paste0(indirrax2,varname2,montho1,".nc")
print(foname1)
print(foname2)
preci00<-raster(foname1)
tempe0<-raster(foname2)
preci0<-resample(preci00, tempe0)
tempe0[tempe0<2730]<-1.0
tempe0[tempe0>2729]<-0.0
swe0=swe0+((tempe0*preci0)/10)
}
writeout(swe0,swename1,"SWE", "mm", "swe")
}
calculate_snow_depth_test<-function()
{
swi0<-raster(swename1)
# 25%
#sh0=swi0*4 # umiat
## fairbanks test only
sh0=swi0*4/3
writeout(sh0,shname1,"SNOWH", "cm", "showh")
}
calculate_lgm_swi<-function(indirrax2)
{
foname2=paste0(indirrax2,varname2,1,".nc")
print(foname2)
swi0<-raster(foname2)
swi0<-swi0*0.0
for (montho1 in 1:12)
{
#foname1=paste0(indirrax2,varname1,montho1,".nc")
foname2=paste0(indirrax2,varname2,montho1,".nc")
#print(foname1)
print(foname2)
#preci00<-raster(foname1)
tempe0<-raster(foname2)
#preci0<-resample(preci00, tempe0)
tempe0=(tempe0-2730)/10
tempe0[tempe0<0.0]<-0.0
swi0=swi0+tempe0
}
writeout(swi0,swiname1,"SWI", "monthC", "Sumner Warmth Index")
}
- lgm
- acquire_chelsa_lgm_bio_files(indirrax1,indirrax3)
- acquire_chelsa_lgm_monthly_files(indirrax1, indirrax2)
- calculate_lgm_snow_swe(indirrax2)
- current
- acquire_chelsa_current_bio_files(indirrax1,indirrax3)
- acquire_chelsa_current_monthly_files(indirrax1, indirrax2)
- calculate_current_snow_swe(indirrax2)
- calculate_snow_depth_test()
calculate_lgm_swi(indirrax2)
NPP extract
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
ipsl_npp_load_ds <- function(dirra2, posit, numyears)
{
print("IPSL NPP ...")
nppname1="d:/datav3/npp_Lmon_MPI-ESM-P_lgm_r1i1p1_185001-194912.nc"
#nppname1="d:/datav3/npp_Lmon_IPSL-CM5A-LR_lgm_r1i1p1_260101-280012.nc"
## nppname1="d:/datav3/b40.lgm21ka.1deg.003M.clm2.h0.AGNPP.187001-190012.nc"
# nppname1="d:/datav3/b40.lgm21ka.1deg.003M.clm2.h0.NPP.187001-190012.nc"
nppin1 <- nc_open(nppname1)
- snow0 <- ncvar_get( snin1, varid='snd',start=c(1,1,lokat1), count=c(-1,-1,nummero1) )
vext1<-c(0,360,-90,90)
- !! note: we take snow of month 3, March
lok1=posit*12
mara=numyears*12
stacksnow1<-stack()
invarname1="npp"
for(n in 1:mara)
{
# print (".")
snow00 <- ncvar_get( nppin1, varid=invarname1,start=c(1,1,n), 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+1
}
rasnow0<-mean(stacksnow1)
## g m-2 s -1
rasnow1=rasnow0*12*30.5*24*3600 # g m-2 yr : mm dd hh minsec
crs(stacksnow1) <- "+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"
writeRaster(stacksnow1, "nppmany_ipsl.nc", overwrite=TRUE, format="CDF", xname="lon", yname="lat", varname="NPP", varunit="gm2",
longname="NPP")
crs(rasnow1) <- "+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"
writeRaster(rasnow1, "npp_ipsl.nc", overwrite=TRUE, format="CDF", xname="lon", yname="lat", varname="NPP", varunit="gm2",
longname="NPP")
print("Downscaling NPP ...")
bio5<-raster(bioname_5)
bio10<-raster(bioname_10)
- names(bio10)<-"Elevation"
- names(bio5)<-"bio5"
# rastafari1<-stack(bio10, bio5)
# swi1<-raster("./wanha1/summerwarmth_beringia.nc")
swi1<-raster("./wanha1/chelsa_lgm_swi.nc")
#print(names(rastafari1))
out3<-downscale_raster(rasnow1, swi1,2)
#out3<<-downscale_dissever(rasnow1, rastafari1,"glm",1.0)
## kg/m2 to kg/ha C
out4<<-out3*10000
writeout(out3,"./npp_mpiesm_ds.nc","NPP", "g/m2_C", "NPP")
writeout(out4,"./npp_mpiesm_c_kgha.nc","NPP", "kg/ha_C", "NPP")
- loadipslnpp
}
- program init
ipsl_npp_load_ds(dirra2, 0,40)
Licensing
[edit]![w:en:Creative Commons](https://upload.wikimedia.org/wikipedia/commons/thumb/7/79/CC_some_rights_reserved.svg/90px-CC_some_rights_reserved.svg.png)
![attribution](https://upload.wikimedia.org/wikipedia/commons/thumb/1/11/Cc-by_new_white.svg/24px-Cc-by_new_white.svg.png)
![share alike](https://upload.wikimedia.org/wikipedia/commons/thumb/d/df/Cc-sa_white.svg/24px-Cc-sa_white.svg.png)
- 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 | 17:02, 8 November 2019 | ![]() | 1,650 × 1,275 (988 KB) | Merikanto (talk | contribs) | User created page with UploadWizard |
You cannot overwrite this file.
File usage on Commons
There are no pages that use 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 | 1650px |
---|---|
Height | 1275px |