Skip to content

Commit 328d184

Browse files
ForModLabUHelForModLabUHel
committed
first commit
0 parents  commit 328d184

34 files changed

Lines changed: 6360 additions & 0 deletions

‎.Rbuildignore‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
^.*\.Rproj$
2+
^\.Rproj\.user$

‎.gitignore‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
.Rproj.user
2+
.Rhistory
3+
.RData
4+
.Ruserdata

‎DESCRIPTION‎

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,12 @@
1+
Package: Rprebasso
2+
Type: Package
3+
Title: PRELES, YASSO and PREBAS models
4+
Version: 0.1.0
5+
Author: Mikko Peltoniemi and Francesco Minunno
6+
Maintainer: Francesco Minunno <checcomi@gmail.com> and Mikko Peltoniemi <mikko.peltoniemi@metla.fi>
7+
Description: Implements PRELES,YASSO and PREBAS models to be called from R
8+
Depends: sm, data.table, Matrix, zoo
9+
License: What license is it under?
10+
Encoding: UTF-8
11+
LazyData: true
12+
RoxygenNote: 6.1.0

‎NAMESPACE‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
useDynLib(Rprebasso)
2+
exportPattern("^[[:alpha:]]+")

‎R/PRELES.R‎

Lines changed: 150 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,150 @@
1+
PRELES = function(PAR, TAir, VPD, Precip, CO2, fAPAR, ## REQUIRED
2+
GPPmeas=NA, ETmeas=NA, SWmeas=NA, ## OPTIONAL FOR BYPASSING PREDICTION
3+
p = rep(NA, 30), ## PARAMETER VECTOR. NA parameters replaced with defaults.
4+
DOY=NA, ## Needed for deciduous phenology (and if radmodel != 0), otherwise assume simulation
5+
## starting DOY=1, and continuing all years having 365 days
6+
## Irrelevant if fPheno-parameters are -999 (default, used for conifers)
7+
LOGFLAG = 0, control=0, pft="evergreen",# Control is the E model selection parameter.
8+
parmodel=0, LAT=NA, PAR0=NA,# If PAR is missing, set parmodel > 0 (and give lat and the DOY as input) # PAR0 is latititude and DOY specific information for parmodel 11 and 12
9+
returncols=c('GPP','ET','SW')) {
10+
11+
12+
len = as.integer(length(TAir))
13+
if (is.na(GPPmeas)) GPPmeas = rep(-999, len)
14+
if (is.na(ETmeas)) ETmeas = rep(-999, len)
15+
if (is.na(SWmeas)) SWmeas = rep(-999, len)
16+
transp = evap = fWE = rep(-999, len)
17+
18+
## NOT SUPPORTED PRESENTLY:
19+
## If radiation information is missing, daily radiation can be calculated
20+
## from theoretical model based on latitude (deg), modified by empirical relationship
21+
## if (parmodel == 1 | parmodel == 2) { ## Theoretical radiation modified by VPD
22+
## stopifnot(!any(is.na(LAT)))
23+
## PAR=dPAR(LAT=LAT,DOY=DOY,VPD=VPD, radmodel=parmodel)
24+
## }
25+
## if (parmodel == 11 | parmodel == 12) { ## Speed-up, requires calculation of dPAR0()
26+
## PAR=dPAR1(PAR0,VPD=VPD, radmodel=parmodel)
27+
##}
28+
29+
30+
## PARAMETERS
31+
if (control == -1) {} ## FOR TESTS
32+
## DEFAULT SET
33+
## The following is default set, calibrated for a range of conifer sites in Scandinavia
34+
## Ten sites with varying site-years used in the calibration.
35+
## Variant of the calibration made to the same data by F. Minunno,
36+
## where evapotranspiration was not affected by temperature.
37+
## Here free evap. essentially follows the form proposed by Priestley-taylor eq.
38+
if (control == 0) {
39+
defaults = c(413.0, ## 1 soildepth
40+
0.450, ## 2 ThetaFC
41+
0.118, ## 3 ThetaPWP
42+
3, ## 4 tauDrainage
43+
## GPP_MODEL_PARAMETERS
44+
0.7457, ## 5 betaGPP
45+
10.93, ## 6 tauGPP
46+
-3.063, ## 7 S0GPP
47+
17.72, ## 8 SmaxGPP
48+
-0.1027, ## 9 kappaGPP
49+
0.03673, ## 10 gammaGPP
50+
0.7779, ## 11 soilthresGPP
51+
0.500, ## 12 b.CO2, cmCO2
52+
-0.364, ## 13 x.CO2, ckappaCO2
53+
## EVAPOTRANSPIRATION_PARAMETERS
54+
0.2715, ## 14 betaET
55+
0.8351, ## 15 kappaET
56+
0.07348, ## 16 chiET
57+
0.9996, ## 17 soilthresET
58+
0.4428, ## 18 nu ET
59+
## SNOW_RAIN_PARAMETERS
60+
1.2, ## 19 Meltcoef
61+
0.33, ## 20 I_0
62+
4.970496, ## 21 CWmax, i.e. max canopy water
63+
0, ## 22 SnowThreshold,
64+
0, ## 23 T_0,
65+
160, ## 24 SWinit, ## START INITIALISATION PARAMETERS
66+
0, ## 25 CWinit, ## Canopy water
67+
0, ## 26 SOGinit, ## Snow on Ground
68+
20, ## 27 Sinit ##CWmax
69+
-999, ## t0 fPheno_start_date_Tsum_accumulation; conif -999, for birch 57
70+
-999, ## tcrit, fPheno_start_date_Tsum_Tthreshold, 1.5 birch
71+
-999 ##tsumcrit, fPheno_budburst_Tsum, 134 birch
72+
)
73+
}
74+
75+
if (control == 1) ## Peltoniemi et al., 2015, Boreal Env. Res. for Hyytiala
76+
defaults = c(413.0,
77+
0.450, 0.118, 3, 0.748464, 12.74915, -3.566967, 18.4513, -0.136732,
78+
0.033942, 0.448975, 0.500, -0.364, 0.33271, 0.857291, 0.041781,
79+
0.474173, 0.278332, 1.5, 0.33, 4.824704, 0, 0, 180, 0, 0, 10,
80+
-999, -999, -999)
81+
p[is.na(p)] = defaults[is.na(p)] ## Note: this may slow down a bit when looping MCMC
82+
83+
## DOY is needed for other than conifers. Phenology model requires parameters:
84+
## tip: p[28:30] <- c(57, 1.5, 134) # Phenol. mod. (Linkosalo et al. 2008)
85+
if (pft != "evergreen") {
86+
stopifnot(all(!is.na(DOY)))
87+
stopifnot(all(!is.na(p[28:30])))
88+
}
89+
## There is no phenology of shoot growth for conifers presently
90+
if (pft == "evergreen") {
91+
if (any(is.na(p[28:30]))) warning('Phenology parameters given, but not implemented in the model for conifers.')
92+
p[28] = -999
93+
}
94+
## If DOY is missing we need to give to the model, although conifer shoot growth phenology is not implemented.
95+
if (pft == "evergreen" & any(is.na(DOY))) {
96+
DOY = rep(1:365, ceiling(len/365))
97+
DOY = DOY[1:len]
98+
}
99+
100+
.C('call_preles',
101+
PAR=as.double(PAR), TAir=as.double(TAir), VPD=as.double(VPD),
102+
Precip=as.double(Precip), CO2=as.double(CO2), fAPAR=as.double(fAPAR),
103+
GPPmeas=as.double(GPPmeas), ETmeas=as.double(ETmeas), SWmeas=as.double(SWmeas),
104+
## OUTPUTS
105+
GPP = double(len), ET=double(len), SW=double(len), SOG=double(len),
106+
fS=double(len), fD=double(len), fW=double(len), fE=double(len),
107+
Throughfall=double(len), Interception=double(len), Snowmelt=double(len),
108+
Drainage =double(len),
109+
Canopywater=double(len), S=double(len),
110+
111+
##PARAMETERS
112+
p1=as.double(p[1]),
113+
p2=as.double(p[2]),
114+
p3=as.double(p[3]),
115+
p4=as.double(p[4]),
116+
p5=as.double(p[5]), ## START GPP PARAMETERS
117+
p6=as.double(p[6]),
118+
p7=as.double(p[7]),
119+
p8=as.double(p[8]),
120+
p9=as.double(p[9]),
121+
p10=as.double(p[10]),
122+
p11=as.double(p[11]), ## used for fW with ETmodel = 2 | 4 | 6
123+
p12=as.double(p[12]), ## used for fW with ETmodel = 1 | 3 | 5
124+
p13=as.double(p[13]), ## used for fW with ETmodel = 1 | 3 | 5) ;
125+
p14=as.double(p[14]), ## START ET PARAMETERS
126+
p15=as.double(p[15]),
127+
p16=as.double(p[16]),
128+
p17=as.double(p[17]), ## used for fW with ETmodel = 2 | 4
129+
p18=as.double(p[18]), ## used for fW with ETmodel = 1 | 3
130+
p19=as.double(p[19]), ## START WATER/SNOW PARAMETERS
131+
p20=as.double(p[20]),
132+
p21=as.double(p[21]),
133+
p22=as.double(p[22]),
134+
p23=as.double(p[23]),
135+
p24=as.double(p[24]), ## START INITIALISATION PARAMETERS // Soilw water at beginning
136+
p25=as.double(p[25]), ## Canopy water
137+
p26=as.double(p[26]), ## Snow on Ground
138+
p27=as.double(p[27]), ## State of temperature acclimation
139+
p28=as.double(p[28]), ## Canopy water
140+
p29=as.double(p[29]), ## Snow on Ground
141+
p30=as.double(p[30]), ## State of temperature acclimation
142+
etmodel=as.integer(control), ## useMeasurement, int *LOGFLAG, int *multisiteNday, int *NofDays
143+
LOGFLAG=as.integer(LOGFLAG),
144+
len=as.integer(len),
145+
DOY=as.integer(DOY),
146+
transp=as.double(transp), evap=as.double(evap),
147+
fWE=as.double(fWE))[returncols]
148+
149+
150+
}

‎R/clcut.r‎

Lines changed: 53 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,53 @@
1+
ClCutD_Pine <- function(ETSmean,ETSthres,siteType){
2+
if(siteType<=3 & ETSmean>=ETSthres) inDclct <- ClCut_pine[1,1]
3+
if(siteType==4 & ETSmean>=ETSthres) inDclct <- ClCut_pine[2,1]
4+
if(siteType>=5 & ETSmean>=ETSthres) inDclct <- ClCut_pine[3,1]
5+
if(siteType<=3 & ETSmean<ETSthres) inDclct <- ClCut_pine[1,3]
6+
if(siteType==4 & ETSmean<ETSthres) inDclct <- ClCut_pine[2,3]
7+
if(siteType>=5 & ETSmean<ETSthres) inDclct <- ClCut_pine[3,3]
8+
return(as.double(inDclct))
9+
}
10+
11+
ClCutD_Spruce <- function(ETSmean,ETSthres,siteType){
12+
if(siteType<=2 & ETSmean>=ETSthres) inDclct <- ClCut_spruce[1,1]
13+
if(siteType>=3 & ETSmean>=ETSthres) inDclct <- ClCut_spruce[2,1]
14+
if(siteType<=2 & ETSmean<ETSthres) inDclct <- ClCut_spruce[1,3]
15+
if(siteType>=3 & ETSmean<ETSthres) inDclct <- ClCut_spruce[2,3]
16+
return(as.double(inDclct))
17+
}
18+
19+
ClCutD_Birch <- function(ETSmean,ETSthres,siteType){
20+
if(siteType<=2 & ETSmean>=ETSthres) inDclct <- ClCut_birch[1,1]
21+
if(siteType>=3 & ETSmean>=ETSthres) inDclct <- ClCut_birch[2,1]
22+
if(siteType<=2 & ETSmean<ETSthres) inDclct <- ClCut_birch[1,3]
23+
if(siteType>=3 & ETSmean<ETSthres) inDclct <- ClCut_birch[2,3]
24+
return(as.double(inDclct))
25+
}
26+
27+
ClCutA_Pine <- function(ETSmean,ETSthres,siteType){
28+
if(siteType<=3 & ETSmean>=ETSthres) inAclct <- ClCut_pine[1,2]
29+
if(siteType==4 & ETSmean>=ETSthres) inAclct <- ClCut_pine[2,2]
30+
if(siteType>=5 & ETSmean>=ETSthres) inAclct <- ClCut_pine[3,2]
31+
if(siteType<=3 & ETSmean<ETSthres) inAclct <- ClCut_pine[1,4]
32+
if(siteType==4 & ETSmean<ETSthres) inAclct <- ClCut_pine[2,4]
33+
if(siteType>=5 & ETSmean<ETSthres) inAclct <- ClCut_pine[3,4]
34+
return(as.double(inAclct))
35+
}
36+
37+
ClCutA_Spruce <- function(ETSmean,ETSthres,siteType){
38+
if(siteType<=2 & ETSmean>=ETSthres) inAclct <- ClCut_spruce[1,2]
39+
if(siteType>=3 & ETSmean>=ETSthres) inAclct <- ClCut_spruce[2,2]
40+
if(siteType<=2 & ETSmean<ETSthres) inAclct <- ClCut_spruce[1,4]
41+
if(siteType>=3 & ETSmean<ETSthres) inAclct <- ClCut_spruce[2,4]
42+
return(as.double(inAclct))
43+
}
44+
45+
ClCutA_Birch <- function(ETSmean,ETSthres,siteType){
46+
if(siteType<=2 & ETSmean>=ETSthres) inAclct <- ClCut_birch[1,2]
47+
if(siteType>=3 & ETSmean>=ETSthres) inAclct <- ClCut_birch[2,2]
48+
if(siteType<=2 & ETSmean<ETSthres) inAclct <- ClCut_birch[1,4]
49+
if(siteType>=3 & ETSmean<ETSthres) inAclct <- ClCut_birch[2,4]
50+
return(as.double(inAclct))
51+
}
52+
53+

‎R/extractVars.r‎

Lines changed: 31 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,31 @@
1+
extractVars <- function(x,variables=NA,sites=NA,speciesIDs=NA,
2+
speciesNam = NA,years=NA){
3+
4+
varNam <- getVarNam()
5+
if (anyNA(speciesNam)) speciesNam <- as.character(paste("sp",1:nSp))
6+
if (any(variables == "all") | anyNA(variables)) variables <-c(5,6,8:18,22,24:34,37:46)
7+
variables <- c(7,variables)
8+
9+
if(inherits(x,"prebas")){
10+
if(anyNA(speciesIDs)) speciesIDs <- 1:dim(x$output)[3]
11+
nSp <- length(speciesIDs)
12+
if (anyNA(years)) years <- 1:(dim(x$output)[1])
13+
14+
out <- x$output[years,variables,speciesIDs,1]
15+
dimnames(out) <- list(NULL,varNam,speciesNam)
16+
17+
}
18+
19+
20+
if(inherits(x,"multiPrebas")){
21+
if(anyNA(speciesIDs)) speciesIDs <- 1:dim(x$multiOut)[4]
22+
nSp <- length(speciesIDs)
23+
if (anyNA(years)) years <- 1:(dim(x$output)[2])
24+
if (anyNA(sites)) sites <- 1:(dim(x$multiOut)[1])
25+
26+
out <- x$multiOut[sites,years,variables,speciesIDs,1]
27+
dimnames(out) <- list(x$multiOut[sites,1,1,1,1],NULL,varNam[variables],speciesNam[speciesIDs])
28+
29+
}
30+
return(out)
31+
}

‎R/mai.r‎

Lines changed: 21 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,21 @@
1+
2+
##function to compute mai from model output
3+
mai <- function(xx){
4+
end <- which(xx[,2,1]==0)[1]-1
5+
rot <- xx[end,1,1]
6+
mai=(xx[end,2,1] + sum(xx[2:end,2,2]))/rot
7+
return(as.double(mai))
8+
}
9+
10+
##function to compute mai from model output + predictive uncertainty
11+
maiPU <- function(xx,errP){
12+
end <- which(xx[,2,1]==0)[1]-1
13+
rot <- xx[end,1,1]
14+
totV <- xx[end,2,1] + sum(xx[2:end,2,2])
15+
errV <- rnorm(1,0,(errP[1] + errP[2]*totV))
16+
mai=(totV + errV)/rot
17+
return(as.double(mai))
18+
}
19+
20+
21+

0 commit comments

Comments
 (0)